New defsystem 3.6i (Was Re: OpenMCL support Re: [Maxima] Installation of maxima-5.9.2 on Mac OS X)
Douglas Crosher
dcrosher at scieneer.com
Sat Feb 25 03:33:05 CST 2006
This is a multi-part message in MIME format.
--------------090602080203010009090002
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit
Yasuaki Honda wrote:
...
> defsystem 3.6i
> OK: clisp 2.38, openmcl 0.14.3, sbcl 0.9.7, cmucl 19c, gcl 2.6.7
> Not confirmed: SCL (some work under its way)
defsystem 3.6i does not work with recent SCL version for compiling maxima.
> Current defsystem
> OK: clisp 2.38, sbcl 0.9.7, cmucl 19c, gcl 2.6.7, SCL (Am I correct?)
> NG: openmcl 0.14.3
Please consider switching to defsystem 3.6i plus the attached patch
for SCL. The defsystem maintainer will consider integrating these when
he gets a chance and then maxima can just switch to the new defsystem.
Regards
Douglas Crosher
--------------090602080203010009090002
Content-Type: text/plain;
name="defsystem-patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="defsystem-patch"
Index: defsystem.lisp
===================================================================
RCS file: /cvsroot/clocc/clocc/src/defsystem-3.x/defsystem.lisp,v
retrieving revision 1.102
diff -c -r1.102 defsystem.lisp
*** defsystem.lisp 5 Sep 2005 18:39:21 -0000 1.102
--- defsystem.lisp 25 Feb 2006 00:34:55 -0000
***************
*** 886,892 ****
(fboundp 'system::require))
#-:lispworks
! (in-package "LISP")
#+:lispworks
(in-package "SYSTEM")
--- 886,892 ----
(fboundp 'system::require))
#-:lispworks
! (in-package :lisp)
#+:lispworks
(in-package "SYSTEM")
***************
*** 1024,1030 ****
;;; The code below, is originally executed also for CMUCL. However I
;;; believe this is wrong, since CMUCL comes with its own defpackage.
;;; I added the extra :CMU in the 'or'.
! #+(and :cltl2 (not (or :cmu :clisp :sbcl
(and :excl (or :allegro-v4.0 :allegro-v4.1))
:mcl)))
(eval-when (compile load eval)
--- 1024,1030 ----
;;; The code below, is originally executed also for CMUCL. However I
;;; believe this is wrong, since CMUCL comes with its own defpackage.
;;; I added the extra :CMU in the 'or'.
! #+(and :cltl2 (not (or :cmu :scl :clisp :sbcl
(and :excl (or :allegro-v4.0 :allegro-v4.1))
:mcl)))
(eval-when (compile load eval)
***************
*** 1047,1053 ****
#+(or :cltl2 :lispworks :scl)
(eval-when (compile load eval)
! (in-package "MAKE"))
#+ecl
(in-package "MAKE")
--- 1047,1053 ----
#+(or :cltl2 :lispworks :scl)
(eval-when (compile load eval)
! (in-package :make))
#+ecl
(in-package "MAKE")
***************
*** 1172,1192 ****
#|
#-(or :sbcl :cmu :ccl :allegro :excl :lispworks :symbolics)
(eval-when (compile load eval)
! (import *exports* #-(or :cltl2 :lispworks) "USER"
! #+(or :cltl2 :lispworks) "COMMON-LISP-USER")
! (import *special-exports* #-(or :cltl2 :lispworks) "USER"
! #+(or :cltl2 :lispworks) "COMMON-LISP-USER"))
#+(or :sbcl :cmu :ccl :allegro :excl :lispworks :symbolics)
(eval-when (compile load eval)
! (import *exports* #-(or :cltl2 :lispworks) "USER"
! #+(or :cltl2 :lispworks) "COMMON-LISP-USER")
(shadowing-import *special-exports*
! #-(or :cltl2 :lispworks) "USER"
! #+(or :cltl2 :lispworks) "COMMON-LISP-USER"))
|#
! #-(or :PCL :CLOS :scl)
! (when (find-package "PCL")
(pushnew :pcl *modules*)
(pushnew :pcl *features*))
--- 1172,1192 ----
#|
#-(or :sbcl :cmu :ccl :allegro :excl :lispworks :symbolics)
(eval-when (compile load eval)
! (import *exports* #-(or :cltl2 :lispworks) :user
! #+(or :cltl2 :lispworks) :common-lisp-user)
! (import *special-exports* #-(or :cltl2 :lispworks) :user
! #+(or :cltl2 :lispworks) :common-lisp-user))
#+(or :sbcl :cmu :ccl :allegro :excl :lispworks :symbolics)
(eval-when (compile load eval)
! (import *exports* #-(or :cltl2 :lispworks) :user
! #+(or :cltl2 :lispworks) :common-lisp-user)
(shadowing-import *special-exports*
! #-(or :cltl2 :lispworks) :user
! #+(or :cltl2 :lispworks) :common-lisp-user))
|#
! #-(or :pcl :clos :scl)
! (when (find-package :pcl)
(pushnew :pcl *modules*)
(pushnew :pcl *features*))
***************
*** 1203,1209 ****
;;; ********************************
(defvar *dont-redefine-require*
! #+cmu (if (find-symbol "*MODULE-PROVIDER-FUNCTIONS*" "EXT") t nil)
#+(or clisp sbcl) t
#+allegro t
#-(or cmu sbcl clisp allegro) nil
--- 1203,1209 ----
;;; ********************************
(defvar *dont-redefine-require*
! #+cmu (if (find-symbol "*MODULE-PROVIDER-FUNCTIONS*" :ext) t nil)
#+(or clisp sbcl) t
#+allegro t
#-(or cmu sbcl clisp allegro) nil
***************
*** 1231,1238 ****
#-cormanlisp
(defun home-subdirectory (directory)
(concatenate 'string
! #+(or :sbcl :cmu :scl)
"home:"
#-(or :sbcl :cmu :scl)
(let ((homedir (user-homedir-pathname)))
(or (and homedir (namestring homedir))
--- 1231,1239 ----
#-cormanlisp
(defun home-subdirectory (directory)
(concatenate 'string
! #+(or :sbcl :cmu)
"home:"
+ #+scl "file://home/"
#-(or :sbcl :cmu :scl)
(let ((homedir (user-homedir-pathname)))
(or (and homedir (namestring homedir))
***************
*** 1436,1442 ****
;; PA is Precision Architecture, HP's 9000/800 RISC cpu
#+(and Lucid PA) ("lisp" . "hbin")
#+excl ("cl" . ,(pathname-type (compile-file-pathname "foo.cl")))
! #+(or :cmu :scl) ("lisp" . ,(or (c:backend-fasl-file-type c:*backend*) "fasl"))
; #+(and :CMU (not (or :sgi :sparc))) ("lisp" . "fasl")
; #+(and :CMU :sgi) ("lisp" . "sgif")
; #+(and :CMU :sparc) ("lisp" . "sparcf")
--- 1437,1443 ----
;; PA is Precision Architecture, HP's 9000/800 RISC cpu
#+(and Lucid PA) ("lisp" . "hbin")
#+excl ("cl" . ,(pathname-type (compile-file-pathname "foo.cl")))
! #+(or cmu scl) ("lisp" . ,(or (c:backend-fasl-file-type c:*backend*) "fasl"))
; #+(and :CMU (not (or :sgi :sparc))) ("lisp" . "fasl")
; #+(and :CMU :sgi) ("lisp" . "sgif")
; #+(and :CMU :sparc) ("lisp" . "sparcf")
***************
*** 1719,1724 ****
--- 1720,1728 ----
(machine-type-translation "PC/386" "x86")
;;; CLisp Win32
+ ;;; SCL.
+ (machine-type-translation "AMD64" "amd64")
+
#+(and :lucid :sun :mc68000)
(machine-type-translation "unknown" "sun3")
***************
*** 1766,1772 ****
(defun compiler-type-translation (name &optional operation)
(if operation
(setf (gethash (string-upcase name) *compiler-type-alist*) operation)
! (gethash (string-upcase name) *compiler-type-alist*)))
(compiler-type-translation "lispworks 3.2.1" "lispworks")
--- 1770,1776 ----
(defun compiler-type-translation (name &optional operation)
(if operation
(setf (gethash (string-upcase name) *compiler-type-alist*) operation)
! (gethash (string-upcase name) *compiler-type-alist*)))
(compiler-type-translation "lispworks 3.2.1" "lispworks")
***************
*** 1800,1805 ****
--- 1804,1814 ----
(compiler-type-translation "cmu 17e" "cmu")
(compiler-type-translation "cmu 17d" "cmu")
+ (compiler-type-translation "scl 1.2.7" "scl")
+ (compiler-type-translation "scl 1.2.8" "scl")
+ (compiler-type-translation "scl 1.2.9" "scl")
+ (compiler-type-translation "scl 1.2.10" "scl")
+
;;; ********************************
;;; System Names *******************
***************
*** 1897,1902 ****
--- 1906,1912 ----
;;; "[root.][subdir]BAZ"
;;; Use #+:vaxlisp for VAXLisp 3.0, #+(and vms dec common vax) for v2.2
+ #-scl
(defun new-append-directories (absolute-dir relative-dir)
;; Version of append-directories for CLtL2-compliant lisps. In particular,
;; they must conform to section 23.1.3 "Structured Directories". We are
***************
*** 1984,1990 ****
#+(or :sbcl :MCL :clisp) rel-type
))))
!
(defun directory-to-list (directory)
;; The directory should be a list, but nonstandard implementations have
;; been known to use a vector or even a string.
--- 1994,2000 ----
#+(or :sbcl :MCL :clisp) rel-type
))))
! #-scl
(defun directory-to-list (directory)
;; The directory should be a list, but nonstandard implementations have
;; been known to use a vector or even a string.
***************
*** 2057,2063 ****
||#
-
(defun append-directories (absolute-directory relative-directory)
"There is no CL primitive for tacking a subdirectory onto a directory.
We need such a function because defsystem has both absolute and
--- 2067,2072 ----
***************
*** 2082,2091 ****
relative-directory)
;; For use with logical pathnames package.
(append-logical-directories-mk absolute-directory relative-directory))
! |#
((namestring-probably-logical absolute-directory)
;; A simplistic stab at handling logical pathnames
(append-logical-pnames absolute-directory relative-directory))
(t
;; In VMS, merge-pathnames actually does what we want!!!
#+:VMS
--- 2091,2102 ----
relative-directory)
;; For use with logical pathnames package.
(append-logical-directories-mk absolute-directory relative-directory))
! |#
! #-scl
((namestring-probably-logical absolute-directory)
;; A simplistic stab at handling logical pathnames
(append-logical-pnames absolute-directory relative-directory))
+ #-scl
(t
;; In VMS, merge-pathnames actually does what we want!!!
#+:VMS
***************
*** 2096,2102 ****
:name relative-directory))
;; Cross your fingers and pray.
#-(or :VMS :macl1.3.2)
! (new-append-directories absolute-directory relative-directory)))))
#+:logical-pathnames-mk
--- 2107,2127 ----
:name relative-directory))
;; Cross your fingers and pray.
#-(or :VMS :macl1.3.2)
! (new-append-directories absolute-directory relative-directory))
! #+scl
! (t
! (let ((absolute (pathname (or absolute-directory ""))))
! (when (or (pathname-name absolute) (pathname-type absolute))
! (let* ((directory (or (pathname-directory absolute) '(:relative)))
! (directory (append directory (list (file-namestring absolute)))))
! (setf absolute (make-pathname :directory directory
! :name nil
! :type nil
! :version nil
! :defaults absolute))))
! (ext:resolve-pathname (or relative-directory "")
! absolute))))))
!
#+:logical-pathnames-mk
***************
*** 2181,2186 ****
--- 2206,2212 ----
(defun logical-pathname-p (thing)
(typep (parse-namestring thing) 'logical-pathname))
+ #-scl
(defun pathname-logical-p (thing)
(typecase thing
(logical-pathname t)
***************
*** 2195,2200 ****
--- 2221,2227 ----
;;; 19990707 Marco Antoniotti
;;; old version
+ #-scl
(defun namestring-probably-logical (namestring)
(and (stringp namestring)
;; unix pathnames don't have embedded semicolons
***************
*** 2234,2239 ****
--- 2261,2267 ----
||#
+ #-scl
(defun append-logical-pnames (absolute relative)
(declare (type (or null string pathname) absolute relative))
(let ((abs (if absolute
***************
*** 2317,2325 ****
||#
- ;;; The following is a change proposed by DTC for SCL.
- ;;; Maybe it could be used all the time.
-
#-scl
(defun new-file-type (pathname type)
;; why not (make-pathname :type type :defaults pathname)?
--- 2345,2350 ----
***************
*** 2331,2348 ****
:type type
:version (pathname-version pathname)))
-
#+scl
(defun new-file-type (pathname type)
! ;; why not (make-pathname :type type :defaults pathname)?
! (make-pathname
! :host (pathname-host pathname :case :common)
! :device (pathname-device pathname :case :common)
! :directory (pathname-directory pathname :case :common)
! :name (pathname-name pathname :case :common)
! :type (string-upcase type)
! :version (pathname-version pathname :case :common)))
!
;;; ********************************
--- 2356,2364 ----
:type type
:version (pathname-version pathname)))
#+scl
(defun new-file-type (pathname type)
! (make-pathname :type type :defaults pathname))
;;; ********************************
***************
*** 2547,2553 ****
(when path
(gethash path *file-load-time-table*)))))))))
! #-(or :cmu)
(defsetf component-load-time (component) (value)
`(when ,component
(etypecase ,component
--- 2563,2569 ----
(when path
(gethash path *file-load-time-table*)))))))))
! #-(or :cmu :scl)
(defsetf component-load-time (component) (value)
`(when ,component
(etypecase ,component
***************
*** 2572,2578 ****
,value)))))))
,value))
! #+(or :cmu)
(defun (setf component-load-time) (value component)
(declare
(type (or null string pathname component) component)
--- 2588,2594 ----
,value)))))))
,value))
! #+(or :cmu :scl)
(defun (setf component-load-time) (value component)
(declare
(type (or null string pathname component) component)
***************
*** 2933,2939 ****
;; Added COMPONENT-NAME extraction to :NAME part, in case the
;; PATHNAME-NAME is NIL.
! (cond ((pathname-logical-p pathname) ; See definition of test above.
(setf pathname
(merge-pathnames pathname
(make-pathname
--- 2949,2956 ----
;; Added COMPONENT-NAME extraction to :NAME part, in case the
;; PATHNAME-NAME is NIL.
! (cond #-scl
! ((pathname-logical-p pathname) ; See definition of test above.
(setf pathname
(merge-pathnames pathname
(make-pathname
***************
*** 2941,2967 ****
:type (component-extension component
type))))
(namestring (translate-logical-pathname pathname)))
(t
(namestring
(make-pathname :host (or (component-host component)
(pathname-host pathname))
! :directory (pathname-directory pathname
! #+scl :case
! #+scl :common
! )
!
! :name (or (pathname-name pathname
! #+scl :case
! #+scl :common
! )
(component-name component))
! :type
! #-scl (component-extension component type)
! #+scl (string-upcase
! (component-extension component type))
!
:device
#+sbcl
:unspecific
--- 2958,2974 ----
:type (component-extension component
type))))
(namestring (translate-logical-pathname pathname)))
+ #-scl
(t
(namestring
(make-pathname :host (or (component-host component)
(pathname-host pathname))
! :directory (pathname-directory pathname)
! :name (or (pathname-name pathname)
(component-name component))
! :type (component-extension component type)
:device
#+sbcl
:unspecific
***************
*** 2972,2978 ****
#+scl :common
))
;; :version :newest
! ))))))
#-lispworks
--- 2979,2992 ----
#+scl :common
))
;; :version :newest
! )))
! #+scl
! (t
! (make-pathname
! :name (component-name component)
! :type (component-extension component type)
! :defaults pathname
! :case :uri)))))
#-lispworks
***************
*** 4403,4409 ****
(pushnew 'sbcl-mk-defsystem-module-provider sb-ext:*module-provider-functions*)
)
! #+#.(cl:if (cl:and (cl:find-package "EXT") (cl:find-symbol "*MODULE-PROVIDER-FUNCTIONS*" "EXT")) '(and) '(or))
(progn
(defun cmucl-mk-defsystem-module-provider (name)
(let ((module-name (string-downcase (string name))))
--- 4417,4423 ----
(pushnew 'sbcl-mk-defsystem-module-provider sb-ext:*module-provider-functions*)
)
! #+#.(cl:if (cl:and (cl:find-package :ext) (cl:find-symbol "*MODULE-PROVIDER-FUNCTIONS*" :ext)) '(and) '(or))
(progn
(defun cmucl-mk-defsystem-module-provider (name)
(let ((module-name (string-downcase (string name))))
***************
*** 4474,4480 ****
(defmacro define-language (name &key compiler loader
source-extension binary-extension)
! (let ((language (gensym "LANGUAGE")))
`(let ((,language (make-language :name ,name
:compiler ,compiler
:loader ,loader
--- 4488,4494 ----
(defmacro define-language (name &key compiler loader
source-extension binary-extension)
! (let ((language (gensym (symbol-name '#:language))))
`(let ((,language (make-language :name ,name
:compiler ,compiler
:loader ,loader
***************
*** 4688,4694 ****
(setf verbose-stream
(make-useable-stream
! #+cmu error-file-stream
(and verbose *trace-output*)))
(format verbose-stream "Running ~A~@[ ~{~A~^ ~}~]~%"
--- 4702,4708 ----
(setf verbose-stream
(make-useable-stream
! #+(or cmu scl) error-file-stream
(and verbose *trace-output*)))
(format verbose-stream "Running ~A~@[ ~{~A~^ ~}~]~%"
***************
*** 4703,4709 ****
(make-useable-stream error-file-stream
(if (eq error-output t)
*error-output*
! error-output)))
(process
(ext:run-program program arguments
:error error-output)))
--- 4717,4723 ----
(make-useable-stream error-file-stream
(if (eq error-output t)
*error-output*
! error-output)))
(process
(ext:run-program program arguments
:error error-output)))
***************
*** 4934,4942 ****
;; DeSoi [marcoxa at sourceforge.net 20020529]
(ensure-directories-exist
! (make-pathname
! :host (pathname-host output-file)
! :directory (pathname-directory output-file)))
(or *oos-test*
(apply (compile-function component)
--- 4948,4957 ----
;; DeSoi [marcoxa at sourceforge.net 20020529]
(ensure-directories-exist
! (make-pathname :name nil
! :type nil
! :version nil
! :defaults output-file))
(or *oos-test*
(apply (compile-function component)
***************
*** 4970,4977 ****
;;; See CLOCC/PORT/sys.lisp:compiled-file-p
(eval-when (:load-toplevel :execute :compile-toplevel)
! (when (find-package "PORT")
! (import (find-symbol "COMPILED-FILE-P" "PORT"))))
(unless (fboundp 'compiled-file-p)
(defun compiled-file-p (file-name)
--- 4985,4992 ----
;;; See CLOCC/PORT/sys.lisp:compiled-file-p
(eval-when (:load-toplevel :execute :compile-toplevel)
! (when (find-package :port)
! (import (find-symbol (symbol-name '#:compiled-file-p) :port))))
(unless (fboundp 'compiled-file-p)
(defun compiled-file-p (file-name)
--------------090602080203010009090002--
More information about the Maxima
mailing list