Skip to content
GitLab
Projects
Groups
Snippets
/
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 @@
(
defgeneric
operation-on-warnings
(
operation
))
(
defgeneric
operation-on-failure
(
operation
))
#-
gcl2.6
(
defgeneric
(
setf
operation-on-warnings
)
(
x
operation
))
#-
gcl2.6
(
defgeneric
(
setf
operation-on-failure
)
(
x
operation
))
(
defgeneric
(
setf
operation-on-warnings
)
(
x
operation
))
(
defgeneric
(
setf
operation-on-failure
)
(
x
operation
))
(
defmethod
operation-on-warnings
((
o
operation
))
(
declare
(
ignorable
o
))
*compile-file-warnings-behaviour*
)
(
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.")
(
let
((
directory
(
pathname-directory
(
car
x
))))
(
if
(
listp
directory
)
(
length
directory
)
0
))))))))
new-value
)
#-
gcl2.6
(
defun*
((
setf
output-translations
))
(
new-value
)
(
set-output-translations
new-value
))
#+
gcl2.6
(
defsetf
output-translations
set-output-translations
)
(
defun
output-translations-initialized-p
()
(
and
*output-translations*
t
))
...
...
@@ -211,7 +208,7 @@ and the order is by decreasing length of namestring of the source pathname.")
(
inherit
*default-output-translations*
)
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
((
directory-pathname-p
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")
(
defmethod
process-source-registry
((
x
symbol
)
&key
inherit
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
((
directory-pathname-p
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."
#+
cormanlisp
(
win32:exitprocess
code
)
#+
(
or
cmu
scl
)
(
unix:unix-exit
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
)
#+
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) ?
...
...
@@ -239,10 +239,10 @@ if we are not called from a directly executable image."
(
setf
*command-line-arguments*
(
command-line-arguments
)))
(
defun
restore-image
(
&key
(
(
:
lisp-interaction
*lisp-interaction*
)
*lisp-interaction*
)
(
(
:
restore-hook
*image-restore-hook*
)
*image-
restore-hook
*
)
(
(
:
prelude
*image-prelude*
)
*image-prelude*
)
(
(
:
entry-point
*image-entry-point*
)
*image-entry-point*
)
(
lisp-interaction
*lisp-interaction*
)
(
restore-hook
*image-restore-hook*
restore-hook
-p
)
(
prelude
*image-prelude*
)
(
entry-point
*image-entry-point*
)
(
if-already-restored
'
(
cerror
"RUN RESTORE-IMAGE ANYWAY"
)))
"From a freshly restarted Lisp image, restore the saved Lisp environment
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
(
return-from
restore-image
)))
(
with-fatal-condition-handler
()
(
setf
*image-restored-p*
:in-progress
)
(
when
restore-hook-p
(
setf
*image-restore-hook*
restore-hook
))
(
call-image-restore-hook
)
(
standard-eval-thunk
*image-
prelude
*
)
(
standard-eval-thunk
prelude
)
(
setf
*image-restored-p*
t
)
(
let
((
results
(
multiple-value-list
(
if
*image-
entry-point
*
(
call-function
*image-
entry-point
*
)
(
if
entry-point
(
call-function
entry-point
)
t
))))
(
if
*
lisp-interaction
*
(
if
lisp-interaction
(
apply
'values
results
)
(
shell-boolean-exit
(
first
results
)))))))
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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