Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Didier Verna
asdf
Commits
4cb0dbf9
Commit
4cb0dbf9
authored
Nov 11, 2013
by
Francois-Rene Rideau
Browse files
Don't bind keywords as special variables in restore-image,
whether it's valid or not, it confuses SBCL. Remove GCL 2.6 support.
parent
9ff9d31a
Changes
4
Hide whitespace changes
Inline
Side-by-side
backward-interface.lisp
View file @
4cb0dbf9
...
@@ -40,8 +40,8 @@
...
@@ -40,8 +40,8 @@
(
defgeneric
operation-on-warnings
(
operation
))
(
defgeneric
operation-on-warnings
(
operation
))
(
defgeneric
operation-on-failure
(
operation
))
(
defgeneric
operation-on-failure
(
operation
))
#-
gcl2.6
(
defgeneric
(
setf
operation-on-warnings
)
(
x
operation
))
(
defgeneric
(
setf
operation-on-warnings
)
(
x
operation
))
#-
gcl2.6
(
defgeneric
(
setf
operation-on-failure
)
(
x
operation
))
(
defgeneric
(
setf
operation-on-failure
)
(
x
operation
))
(
defmethod
operation-on-warnings
((
o
operation
))
(
defmethod
operation-on-warnings
((
o
operation
))
(
declare
(
ignorable
o
))
*compile-file-warnings-behaviour*
)
(
declare
(
ignorable
o
))
*compile-file-warnings-behaviour*
)
(
defmethod
operation-on-failure
((
o
operation
))
(
defmethod
operation-on-failure
((
o
operation
))
...
...
output-translations.lisp
View file @
4cb0dbf9
...
@@ -48,10 +48,7 @@ and the order is by decreasing length of namestring of the source pathname.")
...
@@ -48,10 +48,7 @@ and the order is by decreasing length of namestring of the source pathname.")
(
let
((
directory
(
pathname-directory
(
car
x
))))
(
let
((
directory
(
pathname-directory
(
car
x
))))
(
if
(
listp
directory
)
(
length
directory
)
0
))))))))
(
if
(
listp
directory
)
(
length
directory
)
0
))))))))
new-value
)
new-value
)
#-
gcl2.6
(
defun*
((
setf
output-translations
))
(
new-value
)
(
set-output-translations
new-value
))
(
defun*
((
setf
output-translations
))
(
new-value
)
(
set-output-translations
new-value
))
#+
gcl2.6
(
defsetf
output-translations
set-output-translations
)
(
defun
output-translations-initialized-p
()
(
defun
output-translations-initialized-p
()
(
and
*output-translations*
t
))
(
and
*output-translations*
t
))
...
@@ -211,7 +208,7 @@ and the order is by decreasing length of namestring of the source pathname.")
...
@@ -211,7 +208,7 @@ and the order is by decreasing length of namestring of the source pathname.")
(
inherit
*default-output-translations*
)
(
inherit
*default-output-translations*
)
collect
)
collect
)
(
process-output-translations
(
funcall
x
)
:inherit
inherit
:collect
collect
))
(
process-output-translations
(
funcall
x
)
:inherit
inherit
:collect
collect
))
(
defmethod
process-output-translations
((
pathname
#-
gcl2.6
pathname
#+
gcl2.6
t
)
&key
inherit
collect
)
(
defmethod
process-output-translations
((
pathname
pathname
)
&key
inherit
collect
)
(
cond
(
cond
((
directory-pathname-p
pathname
)
((
directory-pathname-p
pathname
)
(
process-output-translations
(
validate-output-translations-directory
pathname
)
(
process-output-translations
(
validate-output-translations-directory
pathname
)
...
...
source-registry.lisp
View file @
4cb0dbf9
...
@@ -219,7 +219,7 @@ system names to pathnames of .asd files")
...
@@ -219,7 +219,7 @@ system names to pathnames of .asd files")
(
defmethod
process-source-registry
((
x
symbol
)
&key
inherit
register
)
(
defmethod
process-source-registry
((
x
symbol
)
&key
inherit
register
)
(
process-source-registry
(
funcall
x
)
:inherit
inherit
:register
register
))
(
process-source-registry
(
funcall
x
)
:inherit
inherit
:register
register
))
(
defmethod
process-source-registry
((
pathname
#-
gcl2.6
pathname
#+
gcl2.6
t
)
&key
inherit
register
)
(
defmethod
process-source-registry
((
pathname
pathname
)
&key
inherit
register
)
(
cond
(
cond
((
directory-pathname-p
pathname
)
((
directory-pathname-p
pathname
)
(
let
((
*here-directory*
(
resolve-symlinks*
pathname
)))
(
let
((
*here-directory*
(
resolve-symlinks*
pathname
)))
...
...
uiop/image.lisp
View file @
4cb0dbf9
...
@@ -70,7 +70,7 @@ This is designed to abstract away the implementation specific quit forms."
...
@@ -70,7 +70,7 @@ This is designed to abstract away the implementation specific quit forms."
#+
cormanlisp
(
win32:exitprocess
code
)
#+
cormanlisp
(
win32:exitprocess
code
)
#+
(
or
cmu
scl
)
(
unix:unix-exit
code
)
#+
(
or
cmu
scl
)
(
unix:unix-exit
code
)
#+
ecl
(
si:quit
code
)
#+
ecl
(
si:quit
code
)
#+
gcl
(
#+
gcl2.6
lisp:quit
#-
gcl2.6
system:quit
code
)
#+
gcl
(
system:quit
code
)
#+
genera
(
error
"You probably don't want to Halt the Machine. (code: ~S)"
code
)
#+
genera
(
error
"You probably don't want to Halt the Machine. (code: ~S)"
code
)
#+
lispworks
(
lispworks:quit
:status
code
:confirm
nil
:return
nil
:ignore-errors-p
t
)
#+
lispworks
(
lispworks:quit
:status
code
:confirm
nil
:return
nil
:ignore-errors-p
t
)
#+
mcl
(
progn
code
(
ccl:quit
))
;; or should we use FFI to call libc's exit(3) ?
#+
mcl
(
progn
code
(
ccl:quit
))
;; or should we use FFI to call libc's exit(3) ?
...
@@ -239,10 +239,10 @@ if we are not called from a directly executable image."
...
@@ -239,10 +239,10 @@ if we are not called from a directly executable image."
(
setf
*command-line-arguments*
(
command-line-arguments
)))
(
setf
*command-line-arguments*
(
command-line-arguments
)))
(
defun
restore-image
(
&key
(
defun
restore-image
(
&key
(
(
:
lisp-interaction
*lisp-interaction*
)
*lisp-interaction*
)
(
lisp-interaction
*lisp-interaction*
)
(
(
:
restore-hook
*image-restore-hook*
)
*image-
restore-hook
*
)
(
restore-hook
*image-restore-hook*
restore-hook
-p
)
(
(
:
prelude
*image-prelude*
)
*image-prelude*
)
(
prelude
*image-prelude*
)
(
(
:
entry-point
*image-entry-point*
)
*image-entry-point*
)
(
entry-point
*image-entry-point*
)
(
if-already-restored
'
(
cerror
"RUN RESTORE-IMAGE ANYWAY"
)))
(
if-already-restored
'
(
cerror
"RUN RESTORE-IMAGE ANYWAY"
)))
"From a freshly restarted Lisp image, restore the saved Lisp environment
"From a freshly restarted Lisp image, restore the saved Lisp environment
by setting appropriate variables, running various hooks, and calling any specified entry point."
by setting appropriate variables, running various hooks, and calling any specified entry point."
...
@@ -252,14 +252,16 @@ by setting appropriate variables, running various hooks, and calling any specifi
...
@@ -252,14 +252,16 @@ by setting appropriate variables, running various hooks, and calling any specifi
(
return-from
restore-image
)))
(
return-from
restore-image
)))
(
with-fatal-condition-handler
()
(
with-fatal-condition-handler
()
(
setf
*image-restored-p*
:in-progress
)
(
setf
*image-restored-p*
:in-progress
)
(
when
restore-hook-p
(
setf
*image-restore-hook*
restore-hook
))
(
call-image-restore-hook
)
(
call-image-restore-hook
)
(
standard-eval-thunk
*image-
prelude
*
)
(
standard-eval-thunk
prelude
)
(
setf
*image-restored-p*
t
)
(
setf
*image-restored-p*
t
)
(
let
((
results
(
multiple-value-list
(
let
((
results
(
multiple-value-list
(
if
*image-
entry-point
*
(
if
entry-point
(
call-function
*image-
entry-point
*
)
(
call-function
entry-point
)
t
))))
t
))))
(
if
*
lisp-interaction
*
(
if
lisp-interaction
(
apply
'values
results
)
(
apply
'values
results
)
(
shell-boolean-exit
(
first
results
)))))))
(
shell-boolean-exit
(
first
results
)))))))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment