a few patches for Lispworks and OpenMCL



Hi,

just if the maintainers are interested: here are some changes that I made to Maxima
to make it build under LispWorks.

Best regards,

Rainer Joswig



lisp-utils/defsystem.lisp


(defvar *central-registry*
  `(;; Current directory
    "./"
    #+:LUCID     (working-directory)
    #+ACLPC      (current-directory)
    #+:allegro   (excl:current-directory)
    #+:sbcl      (progn *default-pathname-defaults*)
    #+(or :cmu :scl)       (ext:default-directory)
    ;; *** Marco Antoniotti <marcoxa at icsi.berkeley.edu>
    ;; Somehow it is better to qualify default-directory in CMU with
    ;; the appropriate package (i.e. "EXTENSIONS".)
    ;; Same for Allegro.
    #+(and :lispworks (not :lispworks4))
    ,(multiple-value-bind (major minor)
           #-:lispworks-personal-edition
           (system::lispworks-version)
           #+:lispworks-personal-edition
           (values system::*major-version-number*
              system::*minor-version-number*)
       (if (or (> major 3)
          (and (= major 3) (> minor 2))
          (and (= major 3) (= minor 2)
          (equal (lisp-implementation-version) "3.2.1")))
      `(make-pathname :directory
            ,(find-symbol "*CURRENT-WORKING-DIRECTORY*"
                (find-package "SYSTEM")))
           (find-symbol "*CURRENT-WORKING-DIRECTORY*"
                        (find-package "LW"))))
    #+:lispworks4
    (hcl:get-working-directory)
    ;; Home directory
    #-sbcl
    (mk::home-subdirectory "lisp/systems/")

    ;; Global registry
    "/usr/local/lisp/Registry/")
  "Central directory of system definitions. May be either a single
   directory pathname, or a list of directory pathnames to be checked
   after the local directory.")

I think it is save to phase out LispWorks 3. LispWorks 4
is still used. Currently there is Lispworks5.
LispWorks 5 needs to be added.

(defvar *central-registry*
  `(;; Current directory
    "./"
    #+:LUCID     (working-directory)
    #+ACLPC      (current-directory)
    #+:allegro   (excl:current-directory)
    #+:sbcl      (progn *default-pathname-defaults*)
    #+(or :cmu :scl)       (ext:default-directory)
    ;; *** Marco Antoniotti <marcoxa at icsi.berkeley.edu>
    ;; Somehow it is better to qualify default-directory in CMU with
    ;; the appropriate package (i.e. "EXTENSIONS".)
    ;; Same for Allegro.
    #+(and :lispworks (not :lispworks4) (not :lispworks5))
    ,(multiple-value-bind (major minor)
           #-:lispworks-personal-edition
           (system::lispworks-version)
           #+:lispworks-personal-edition
           (values system::*major-version-number*
              system::*minor-version-number*)
       (if (or (> major 3)
          (and (= major 3) (> minor 2))
          (and (= major 3) (= minor 2)
          (equal (lisp-implementation-version) "3.2.1")))
      `(make-pathname :directory
            ,(find-symbol "*CURRENT-WORKING-DIRECTORY*"
                (find-package "SYSTEM")))
           (find-symbol "*CURRENT-WORKING-DIRECTORY*"
                        (find-package "LW"))))
    #+(or :lispworks4 :lispworks5)
    (hcl:get-working-directory)
    ;; Home directory
    #-sbcl
    (mk::home-subdirectory "lisp/systems/")

    ;; Global registry
    "/usr/local/lisp/Registry/")
  "Central directory of system definitions. May be either a single
   directory pathname, or a list of directory pathnames to be checked
   after the local directory.")


The patch above has the problem that for any LispWorks6 it
won't work.

;----------------------------------------------------------------


src/init-cl.lisp

(defvar *maxima-lispname* #+clisp "clisp"
   #+cmu "cmucl"
   #+scl "scl"
   #+sbcl "sbcl"
   #+gcl "gcl"
   #+allegro "acl"
   #+openmcl "openmcl"
   #+lispworks "lispworks"
   #-(or clisp cmu scl sbcl gcl allegro openmcl lispworks) "unknownlisp")

I propose also to change the lispname of openmcl
from mcl to openmcl. MCL is a Lisp from Digitool.
OpenMCL is a derived open source fork that
is sufficiently different from MCL. Essentially
MCL and OpenMCL are now two different
Lisp implementations.

...

(let* ((ext #+gcl "o"
         #+(or cmu scl) (c::backend-fasl-file-type c::*target-backend*)
         #+sbcl "fasl"
         #+clisp "fas"
         #+allegro "fasl"
         #+openmcl (pathname-type *.fasl-pathname*)
         #+lispworks system:*binary-file-type*
         #-(or gcl cmu scl sbcl clisp allegro openmcl lispworks)
         "")
...

Most Lisp systems have different fasl types for different
platforms. It is usually not a good idea to hardcode the
type into the source.
Above are the forms for OpenMCL and LispWorks.


;----------------------------------------------------------------


src/macsys.lisp

(defun macsyma-top-level (&optional (input-stream *standard-input*) batch-flag)
  (let ((*package* (find-package :maxima)))
    (if *maxima-started*
   (format t "Maxima restarted.~%")
   (progn
     (if (not *maxima-quiet*) (maxima-banner))
     (setq *maxima-started* t)))
    (if ($file_search "maxima-init.lisp") ($load ($file_search "maxima-init.lisp")))
    (if ($file_search "maxima-init.mac") ($batchload ($file_search "maxima-init.mac")))

    (catch 'quit-to-lisp
      (in-package :maxima)
      (loop
    do
    (catch #+kcl si::*quit-tag*
      #+(or cmu scl sbcl lispworks openmcl) 'continue
      #-(or kcl cmu scl sbcl lispworks openmcl) nil
      (catch 'macsyma-quit
        (continue input-stream batch-flag)
        (format t *maxima-epilog*)
        (bye)))))))

I'm not sure why there are different catch tags: NIL, CONTINUE, si::*quit-tag*.
NIL as a tag makes not much sense? What should catch do there? I guess
these are the place where documentation would be nice. ;-)

(defun $system (&rest args)
  #+gcl   (lisp:system (apply '$sconcat args))
  #+clisp (ext:run-shell-command (apply '$sconcat args))
  #+(or cmu scl) (ext:run-program "/bin/sh"
              (list "-c" (apply '$sconcat args)) :output t)
  #+allegro (excl:run-shell-command (apply '$sconcat args) :wait t)
  #+lispworks (system:run-shell-command (apply '$sconcat args) :wait t)
  #+sbcl  (sb-ext:run-program "/bin/sh"
               (list "-c" (apply '$sconcat args)) :output t)
  #+openmcl (ccl::run-program "/bin/sh"
               (list "-c" (apply '$sconcat args)) :output t)
  )

Added LispWorks.

;----------------------------------------------------------------


src/maxima.system


(mk:defsystem "maxima"
  :source-extension "lisp"  
  :binary-pathname #+clisp "binary-clisp"
                   #+cmu (make-pathname
           :name "binary-cmucl"
           :directory (pathname-directory *load-truename*))
                   #+scl (make-pathname
           :name "binary-scl"
           :directory (pathname-directory *load-truename*))
         #+sbcl (make-pathname
            :name "binary-sbcl"
            :directory (pathname-directory *load-truename*))
         #+gcl "binary-gcl"
         #+allegro "binary-acl"
         #+openmcl "binary-openmcl"
         #+lispworks (make-pathname
            :name "binary-lispworks"
            :directory (pathname-directory *load-truename*))
         #-(or clisp cmu scl sbcl gcl allegro openmcl lispworks) "binary-unknownlisp"
...


;----------------------------------------------------------------

src/suprv1.lisp


(defun generic-autoload (file &aux type)
  (setq file (pathname (cdr file)))
  (setq type (pathname-type file))
  (let ((bin-ext #+gcl "o"
    #+cmu (c::backend-fasl-file-type c::*target-backend*)
    #+clisp "fas"
    #+allegro "fasl"
    #+openmcl (pathname-type *.fasl-pathname*)
    #+lispworks system:*binary-file-type*
    #-(or gcl cmu clisp allegro openmcl lispworks) ""))
    (if (member type (list bin-ext "lisp" "lsp")  :test 'equalp)
      #-sbcl (load file :verbose 't) #+sbcl (with-compilation-unit nil (load file :verbose 't))
      ($batchload file))))

Added Lispworks and OpenMCL.


(defmfun $quit ()
  nil
  (princ *maxima-epilog*)
  #+kcl (lisp::bye)
  #+(or cmu scl) (ext:quit)
  #+sbcl (sb-ext:quit)
  #+clisp (ext:quit)
  #+(or openmcl mcl) (ccl::quit)
  #+gcl (quit)
  #+lispworks(lispworks:quit)
  #+excl "don't know quit function")

Added Lispworks and OpenMCL.

;----------------------------------------------------------------

src/transs.lisp

(defun $compile_file (input-file &optional bin-file translation-output-file &aux result)
  (setq input-file (maxima-string input-file))
  (and bin-file(setq  bin-file (maxima-string bin-file)))
  (and translation-output-file
       (setq translation-output-file (maxima-string translation-output-file)))
  (cond ((string-equal (pathname-type input-file) "LISP")
    (setq result (list '(mlist) input-file)))
   (t (setq result (translate-file input-file translation-output-file))
      (setq input-file (third result))))
  #+(or cmu scl sbcl clisp allegro openmcl lispworks)
  (multiple-value-bind (output-truename warnings-p failure-p)
      (if bin-file
     (compile-file input-file :output-file bin-file)
     (compile-file input-file))
    (declare (ignore warnings-p))
    ;; If the compiler encountered errors, don't set bin-file to
    ;; indicate that we found errors. Is this what we want?
    (unless failure-p
      (setq bin-file output-truename)))
  #-(or cmu scl sbcl clisp allegro openmcl lispworks)
  (setq bin-file (compile-file input-file :output-file bin-file))
  (append result (list bin-file)))


Added LispWorks

(defun bye ()
  #+(or cmu scl clisp) (ext:quit)
  #+sbcl           (sb-ext:quit)
  #+allegro        (excl:exit)
  #+(or mcl openmcl) (ccl:quit)
  #+gcl            (lisp:quit)
  #+lispworks      (lispworks:quit)
  )

Added LispWorks and OpenMCL.


;----------------------------------------------------------------

configure.lisp

(defvar *maxima-lispname* #+clisp "clisp"
   #+cmu "cmucl"
   #+scl "scl"
   #+sbcl "sbcl"
   #+gcl "gcl"
   #+allegro "acl"
   #+openmcl "openmcl"
   #+symbolics "symbolics"
   #+lispworks "lispworks"
   #-(or clisp cmu scl sbcl gcl allegro openmcl lispworks symbolics) "unknownlisp")

I guess one would also like to add Lispworks to the CONFIGURE function.

-- 
http://lispm.dyndns.org