diff --git a/backward-interface.lisp b/backward-interface.lisp index eec1e5db70c6524b663a32d329e94ca9e375fea7..30c11caec6a0ed3bf155a85a3c26f09600d94b17 100644 --- a/backward-interface.lisp +++ b/backward-interface.lisp @@ -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)) diff --git a/output-translations.lisp b/output-translations.lisp index 004557a30b4ca2fed40c52abbc3f13bf9a2db419..6905cf5bc4d0dfc731706ee8dc749d6b24b7d66a 100644 --- a/output-translations.lisp +++ b/output-translations.lisp @@ -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) diff --git a/source-registry.lisp b/source-registry.lisp index da6ed0ced07c9d1a3da6fc23826470b40f25cfbf..a558ed1fd2ce8e0102214b59c085e4e53b55b502 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -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))) diff --git a/uiop/image.lisp b/uiop/image.lisp index 98484dee78b79caa4c024ca6e884e1f048f6512a..5909d04d6bd6be8a91c7d561fe35ab00ced160ec 100644 --- a/uiop/image.lisp +++ b/uiop/image.lisp @@ -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)))))))