Commit 5d99b537 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Try to compile with the latest GCL. It still dies compiling defgeneric in eval-when.

parent 5714c796
...@@ -245,6 +245,7 @@ Going forward, we recommend new users should be using the source-registry. ...@@ -245,6 +245,7 @@ Going forward, we recommend new users should be using the source-registry.
(setf (gethash (coerce-name system-name) *preloaded-systems*) keys)) (setf (gethash (coerce-name system-name) *preloaded-systems*) keys))
(dolist (s '("asdf" "uiop" "asdf-driver" "asdf-defsystem" "asdf-package-system")) (dolist (s '("asdf" "uiop" "asdf-driver" "asdf-defsystem" "asdf-package-system"))
;; don't bother with these, no one relies on them: "asdf-utils" "asdf-bundle"
(register-preloaded-system s :version *asdf-version*)) (register-preloaded-system s :version *asdf-version*))
(defmethod find-system ((name null) &optional (error-p t)) (defmethod find-system ((name null) &optional (error-p t))
......
...@@ -75,4 +75,3 @@ ...@@ -75,4 +75,3 @@
(rename-package :asdf away) (rename-package :asdf away)
(when *load-verbose* (when *load-verbose*
(format t "~&; Renamed old ~A package away to ~A~%" :asdf away)))))) (format t "~&; Renamed old ~A package away to ~A~%" :asdf away))))))
...@@ -67,16 +67,16 @@ Some constraints: ...@@ -67,16 +67,16 @@ Some constraints:
(when (and (= system::*gcl-major-version* 2) (when (and (= system::*gcl-major-version* 2)
(= system::*gcl-minor-version* 6)) (= system::*gcl-minor-version* 6))
(pushnew :gcl2.6 *features*) (pushnew :gcl2.6 *features*)
(shadowing-import 'system:*load-pathname* :asdf-test)) (shadowing-import 'system::*load-pathname* :asdf-test))
#+lispworks #+lispworks
(setf system:*stack-overflow-behaviour* :warn)) (setf system:*stack-overflow-behaviour* :warn))
#+(or gcl genera) #+(or gcl2.6 genera)
(unless (fboundp 'ensure-directories-exist) (unless (fboundp 'ensure-directories-exist)
(defun ensure-directories-exist (path) (defun ensure-directories-exist (path)
#+genera (fs:create-directories-recursively (pathname path)) #+genera (fs:create-directories-recursively (pathname path))
#+gcl (lisp:system (format nil "mkdir -p ~S" #+gcl2.6 (lisp:system (format nil "mkdir -p ~S"
(namestring (make-pathname :name nil :type nil :defaults path)))))) (namestring (make-pathname :name nil :type nil :defaults path))))))
;;; Survival utilities ;;; Survival utilities
(defun asym (name &optional package errorp) (defun asym (name &optional package errorp)
...@@ -280,7 +280,7 @@ Some constraints: ...@@ -280,7 +280,7 @@ Some constraints:
#+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 (lisp:quit code) #+gcl (#+gcl2.6 lisp:quit #-gcl2.6 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 (ccl:quit) ;; or should we use FFI to call libc's exit(3) ? #+mcl (ccl:quit) ;; or should we use FFI to call libc's exit(3) ?
......
...@@ -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 (lisp:quit code) #+gcl (#+gcl2.6 lisp:quit #-gcl2.6 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) ?
......
...@@ -537,7 +537,7 @@ or when loading the package is optional." ...@@ -537,7 +537,7 @@ or when loading the package is optional."
(unintern existing)) (unintern existing))
(when intern (when intern
(intern* name package)))))))) (intern* name package))))))))
(declaim (ftype function ensure-exported)) (declaim (ftype (function (t t t &optional t) t) ensure-exported))
(defun ensure-exported-to-user (name symbol to-package &optional recycle) (defun ensure-exported-to-user (name symbol to-package &optional recycle)
(check-type name string) (check-type name string)
(check-type symbol symbol) (check-type symbol symbol)
...@@ -750,20 +750,27 @@ UNINTERN -- Remove symbols here from PACKAGE." ...@@ -750,20 +750,27 @@ UNINTERN -- Remove symbols here from PACKAGE."
(setf excl::*autoload-package-name-alist* (setf excl::*autoload-package-name-alist*
(remove "asdf" excl::*autoload-package-name-alist* (remove "asdf" excl::*autoload-package-name-alist*
:test 'equalp :key 'car)) :test 'equalp :key 'car))
#+gcl #.(progn
;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, ;; Debian's antique GCL 2.7.0 has bugs with compiling multiple-value stuff,
;; but can run ASDF 2.011. GCL 2.6 has even more issues. ;; but can run ASDF 2.011. Its GCL 2.6.7 has even more issues.
(cond ;; What more, the compiler doesn't look like it's doing eval-when quite like we'd like,
((or (< system::*gcl-major-version* 2) ;; so we do this essential feature thing at read-time instead.
(and (= system::*gcl-major-version* 2) #+gcl
(< system::*gcl-minor-version* 6))) (let ((code
(error "GCL 2.6 or later required to use ASDF")) (cond
((and (= system::*gcl-major-version* 2) ((or (< system::*gcl-major-version* 2)
(= system::*gcl-minor-version* 6)) (and (= system::*gcl-major-version* 2)
(pushnew 'ignorable pcl::*variable-declarations-without-argument*) (< system::*gcl-minor-version* 6)))
(pushnew :gcl2.6 *features*)) '(error "GCL 2.6 or later required to use ASDF"))
(t ((and (= system::*gcl-major-version* 2)
(pushnew :gcl2.7 *features*)))) (= system::*gcl-minor-version* 6))
'(progn
(pushnew 'ignorable pcl::*variable-declarations-without-argument*)
(pushnew :gcl2.6 *features*)))
(t
'(pushnew :gcl2.7 *features*)))))
(eval code)
code)))
;; Compatibility with whoever calls asdf/package ;; Compatibility with whoever calls asdf/package
(define-package :asdf/package (:use :cl :uiop/package) (:reexport :uiop/package)) (define-package :asdf/package (:use :cl :uiop/package) (:reexport :uiop/package))
...@@ -772,7 +772,7 @@ It returns a process-info plist with possible keys: ...@@ -772,7 +772,7 @@ It returns a process-info plist with possible keys:
(*standard-output* *stdout*) (*standard-output* *stdout*)
(*error-output* *stderr*)) (*error-output* *stderr*))
(ext:system %command)) (ext:system %command))
#+gcl (lisp:system %command) #+gcl (#+gcl2.6 lisp:system #-gcl2.6 system:system %command)
#+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command)) #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
#+mkcl ;; PROBABLY BOGUS -- ask jcb #+mkcl ;; PROBABLY BOGUS -- ask jcb
(multiple-value-bind (io process exit-code) (multiple-value-bind (io process exit-code)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment