Commit eade9642 authored by Robert Goldman's avatar Robert Goldman

Merge branch 'mezzano-support' into 'master'

Add support for the Mezzano Common Lisp operating system

See merge request asdf/asdf!94
parents 245e2cfb 84f36ab9
...@@ -322,6 +322,7 @@ ...@@ -322,6 +322,7 @@
<a href="http://clisp.org/">CLISP</a>, <a href="http://clisp.org/">CLISP</a>,
<a href="http://cmucl.org/">CMUCL</a>, <a href="http://cmucl.org/">CMUCL</a>,
<a href="https://common-lisp.net/project/ecl/" title="Embeddable Common Lisp">ECL</a>, <a href="https://common-lisp.net/project/ecl/" title="Embeddable Common Lisp">ECL</a>,
<a href="https://github.com/froggey/Mezzano/" title="Mezzano">Mezzano</a>,
<a href="https://common-lisp.net/project/mkcl/" title="ManKai Common Lisp">MKCL</a>, <a href="https://common-lisp.net/project/mkcl/" title="ManKai Common Lisp">MKCL</a>,
<a href="http://www.sbcl.org/" title="Steel Bank Common Lisp">SBCL</a> <a href="http://www.sbcl.org/" title="Steel Bank Common Lisp">SBCL</a>
</td> </td>
......
...@@ -7,8 +7,8 @@ ...@@ -7,8 +7,8 @@
:asdf/system ;; used by ECL :asdf/system ;; used by ECL
:asdf/upgrade :asdf/system-registry :asdf/operate :asdf/bundle) :asdf/upgrade :asdf/system-registry :asdf/operate :asdf/bundle)
;; Happily, all those implementations all have the same module-provider hook interface. ;; Happily, all those implementations all have the same module-provider hook interface.
#+(or abcl clasp cmucl clozure ecl mkcl sbcl) #+(or abcl clasp cmucl clozure ecl mezzano mkcl sbcl)
(:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext (:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext #+mezzano :sys.int
#:*module-provider-functions* #:*module-provider-functions*
#+ecl #:*load-hooks*) #+ecl #:*load-hooks*)
#+(or clasp mkcl) (:import-from :si #:*load-hooks*)) #+(or clasp mkcl) (:import-from :si #:*load-hooks*))
...@@ -24,7 +24,7 @@ ...@@ -24,7 +24,7 @@
;;;; Hook ASDF into the implementation's REQUIRE and other entry points. ;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
#+(or abcl clasp clisp clozure cmucl ecl mkcl sbcl) #+(or abcl clasp clisp clozure cmucl ecl mezzano mkcl sbcl)
(with-upgradability () (with-upgradability ()
;; Hook into CL:REQUIRE. ;; Hook into CL:REQUIRE.
#-clisp (pushnew 'module-provide-asdf *module-provider-functions*) #-clisp (pushnew 'module-provide-asdf *module-provider-functions*)
......
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
#+(or mcl cmucl) (:shadow #:user-homedir-pathname)) #+(or mcl cmucl) (:shadow #:user-homedir-pathname))
(in-package :uiop/common-lisp) (in-package :uiop/common-lisp)
#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl) #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
(error "ASDF is not supported on your implementation. Please help us port it.") (error "ASDF is not supported on your implementation. Please help us port it.")
;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; DON'T: trust implementation defaults. ;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; DON'T: trust implementation defaults.
...@@ -29,7 +29,7 @@ ...@@ -29,7 +29,7 @@
;;;; Early meta-level tweaks ;;;; Early meta-level tweaks
#+(or allegro clasp clisp clozure cmucl ecl mkcl sbcl) #+(or allegro clasp clisp clozure cmucl ecl mezzano mkcl sbcl)
(eval-when (:load-toplevel :compile-toplevel :execute) (eval-when (:load-toplevel :compile-toplevel :execute)
(when (and #+allegro (member :ics *features*) (when (and #+allegro (member :ics *features*)
#+(or clasp clisp cmucl ecl mkcl) (member :unicode *features*) #+(or clasp clisp cmucl ecl mkcl) (member :unicode *features*)
......
...@@ -139,6 +139,9 @@ This is designed to abstract away the implementation specific quit forms." ...@@ -139,6 +139,9 @@ This is designed to abstract away the implementation specific quit forms."
(dbg:*debug-print-level* *print-level*) (dbg:*debug-print-level* *print-level*)
(dbg:*debug-print-length* *print-length*)) (dbg:*debug-print-length* *print-length*))
(dbg:bug-backtrace nil)) (dbg:bug-backtrace nil))
#+mezzano
(let ((*standard-output* stream))
(sys.int::backtrace count))
#+sbcl #+sbcl
(sb-debug:print-backtrace :stream stream :count (or count most-positive-fixnum)) (sb-debug:print-backtrace :stream stream :count (or count most-positive-fixnum))
#+xcl #+xcl
...@@ -227,12 +230,12 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die" ...@@ -227,12 +230,12 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die"
#+clozure ccl:*command-line-argument-list* #+clozure ccl:*command-line-argument-list*
#+(or cmucl scl) extensions:*command-line-strings* #+(or cmucl scl) extensions:*command-line-strings*
#+gcl si:*command-args* #+gcl si:*command-args*
#+(or genera mcl) nil #+(or genera mcl mezzano) nil
#+lispworks sys:*line-arguments-list* #+lispworks sys:*line-arguments-list*
#+mkcl (loop :for i :from 0 :below (mkcl:argc) :collect (mkcl:argv i)) #+mkcl (loop :for i :from 0 :below (mkcl:argc) :collect (mkcl:argv i))
#+sbcl sb-ext:*posix-argv* #+sbcl sb-ext:*posix-argv*
#+xcl system:*argv* #+xcl system:*argv*
#-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl) #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
(not-implemented-error 'raw-command-line-arguments)) (not-implemented-error 'raw-command-line-arguments))
(defun command-line-arguments (&optional (arguments (raw-command-line-arguments))) (defun command-line-arguments (&optional (arguments (raw-command-line-arguments)))
......
...@@ -59,6 +59,10 @@ keywords explicitly." ...@@ -59,6 +59,10 @@ keywords explicitly."
"Is the underlying operating system Haiku?" "Is the underlying operating system Haiku?"
(featurep :haiku)) (featurep :haiku))
(defun os-mezzano-p ()
"Is the underlying operating system Mezzano?"
(featurep :mezzano))
(defun detect-os () (defun detect-os ()
"Detects the current operating system. Only needs be run at compile-time, "Detects the current operating system. Only needs be run at compile-time,
except on ABCL where it might change between FASL compilation and runtime." except on ABCL where it might change between FASL compilation and runtime."
...@@ -66,7 +70,8 @@ except on ABCL where it might change between FASL compilation and runtime." ...@@ -66,7 +70,8 @@ except on ABCL where it might change between FASL compilation and runtime."
:for (feature . detect) :in '((:os-unix . os-unix-p) (:os-macosx . os-macosx-p) :for (feature . detect) :in '((:os-unix . os-unix-p) (:os-macosx . os-macosx-p)
(:os-windows . os-windows-p) (:os-windows . os-windows-p)
(:genera . os-genera-p) (:os-oldmac . os-oldmac-p) (:genera . os-genera-p) (:os-oldmac . os-oldmac-p)
(:haiku . os-haiku-p)) (:haiku . os-haiku-p)
(:mezzano . os-mezzano-p))
:when (and (or (not o) (eq feature :os-macosx)) (funcall detect)) :when (and (or (not o) (eq feature :os-macosx)) (funcall detect))
:do (setf o feature) (pushnew feature *features*) :do (setf o feature) (pushnew feature *features*)
:else :do (setf *features* (remove feature *features*)) :else :do (setf *features* (remove feature *features*))
...@@ -103,7 +108,7 @@ use getenvp to return NIL in such a case." ...@@ -103,7 +108,7 @@ use getenvp to return NIL in such a case."
(ct:free buffer) (ct:free buffer)
(ct:free buffer1))) (ct:free buffer1)))
#+gcl (system:getenv x) #+gcl (system:getenv x)
#+genera nil #+(or genera mezzano) nil
#+lispworks (lispworks:environment-variable x) #+lispworks (lispworks:environment-variable x)
#+mcl (ccl:with-cstrs ((name x)) #+mcl (ccl:with-cstrs ((name x))
(let ((value (_getenv name))) (let ((value (_getenv name)))
...@@ -111,7 +116,7 @@ use getenvp to return NIL in such a case." ...@@ -111,7 +116,7 @@ use getenvp to return NIL in such a case."
(ccl:%get-cstring value)))) (ccl:%get-cstring value))))
#+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x) #+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x)
#+sbcl (sb-ext:posix-getenv x) #+sbcl (sb-ext:posix-getenv x)
#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl) #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
(not-implemented-error 'getenv)) (not-implemented-error 'getenv))
(defsetf getenv (x) (val) (defsetf getenv (x) (val)
...@@ -157,7 +162,7 @@ then returning the non-empty string value of the variable" ...@@ -157,7 +162,7 @@ then returning the non-empty string value of the variable"
'(:abcl (:acl :allegro) (:ccl :clozure) :clisp (:corman :cormanlisp) '(:abcl (:acl :allegro) (:ccl :clozure) :clisp (:corman :cormanlisp)
(:cmu :cmucl :cmu) :clasp :ecl :gcl (:cmu :cmucl :cmu) :clasp :ecl :gcl
(:lwpe :lispworks-personal-edition) (:lw :lispworks) (:lwpe :lispworks-personal-edition) (:lw :lispworks)
:mcl :mkcl :sbcl :scl (:smbx :symbolics) :xcl))) :mcl :mezzano :mkcl :sbcl :scl (:smbx :symbolics) :xcl)))
(defvar *implementation-type* (implementation-type) (defvar *implementation-type* (implementation-type)
"The type of Lisp implementation used, as a short UIOP-standardized keyword") "The type of Lisp implementation used, as a short UIOP-standardized keyword")
...@@ -172,7 +177,8 @@ then returning the non-empty string value of the variable" ...@@ -172,7 +177,8 @@ then returning the non-empty string value of the variable"
(:solaris :solaris :sunos) (:solaris :solaris :sunos)
(:bsd :bsd :freebsd :netbsd :openbsd :dragonfly) (:bsd :bsd :freebsd :netbsd :openbsd :dragonfly)
:unix :unix
:genera))) :genera
:mezzano)))
(defun architecture () (defun architecture ()
"The CPU architecture of the current host" "The CPU architecture of the current host"
...@@ -230,6 +236,9 @@ then returning the non-empty string value of the variable" ...@@ -230,6 +236,9 @@ then returning the non-empty string value of the variable"
(multiple-value-bind (major minor) (sct:get-system-version "System") (multiple-value-bind (major minor) (sct:get-system-version "System")
(format nil "~D.~D" major minor)) (format nil "~D.~D" major minor))
#+mcl (subseq s 8) ; strip the leading "Version " #+mcl (subseq s 8) ; strip the leading "Version "
#+mezzano (format nil "~A-~D"
(subseq s 0 (position #\space s)) ; strip commit hash
sys.int::*llf-version*)
;; seems like there should be a shorter way to do this, like ACALL. ;; seems like there should be a shorter way to do this, like ACALL.
#+mkcl (or #+mkcl (or
(let ((fname (find-symbol* '#:git-describe-this-mkcl :mkcl nil))) (let ((fname (find-symbol* '#:git-describe-this-mkcl :mkcl nil)))
...@@ -255,7 +264,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie ...@@ -255,7 +264,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
(with-upgradability () (with-upgradability ()
(defun hostname () (defun hostname ()
"return the hostname of the current host" "return the hostname of the current host"
#+(or abcl clasp clozure cmucl ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance) #+(or abcl clasp clozure cmucl ecl genera lispworks mcl mezzano mkcl sbcl scl xcl) (machine-instance)
#+cormanlisp "localhost" ;; is there a better way? Does it matter? #+cormanlisp "localhost" ;; is there a better way? Does it matter?
#+allegro (symbol-call :excl.osi :gethostname) #+allegro (symbol-call :excl.osi :gethostname)
#+clisp (first (split-string (machine-instance) :separator " ")) #+clisp (first (split-string (machine-instance) :separator " "))
...@@ -275,7 +284,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie ...@@ -275,7 +284,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
(defun getcwd () (defun getcwd ()
"Get the current working directory as per POSIX getcwd(3), as a pathname object" "Get the current working directory as per POSIX getcwd(3), as a pathname object"
(or #+(or abcl genera xcl) (truename *default-pathname-defaults*) ;; d-p-d is canonical! (or #+(or abcl genera mezzano xcl) (truename *default-pathname-defaults*) ;; d-p-d is canonical!
#+allegro (excl::current-directory) #+allegro (excl::current-directory)
#+clisp (ext:default-directory) #+clisp (ext:default-directory)
#+clozure (ccl:current-directory) #+clozure (ccl:current-directory)
...@@ -293,7 +302,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie ...@@ -293,7 +302,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
(defun chdir (x) (defun chdir (x)
"Change current directory, as per POSIX chdir(2), to a given pathname object" "Change current directory, as per POSIX chdir(2), to a given pathname object"
(if-let (x (pathname x)) (if-let (x (pathname x))
#+(or abcl genera xcl) (setf *default-pathname-defaults* (truename x)) ;; d-p-d is canonical! #+(or abcl genera mezzano xcl) (setf *default-pathname-defaults* (truename x)) ;; d-p-d is canonical!
#+allegro (excl:chdir x) #+allegro (excl:chdir x)
#+clisp (ext:cd x) #+clisp (ext:cd x)
#+clozure (setf (ccl:current-directory) x) #+clozure (setf (ccl:current-directory) x)
......
...@@ -92,7 +92,7 @@ by the underlying implementation's MAKE-PATHNAME and other primitives" ...@@ -92,7 +92,7 @@ by the underlying implementation's MAKE-PATHNAME and other primitives"
;; This will be :unspecific if supported, or NIL if not. ;; This will be :unspecific if supported, or NIL if not.
(defparameter *unspecific-pathname-type* (defparameter *unspecific-pathname-type*
#+(or abcl allegro clozure cmucl genera lispworks sbcl scl) :unspecific #+(or abcl allegro clozure cmucl genera lispworks sbcl scl) :unspecific
#+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil #+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl mezzano) nil
"Unspecific type component to use with the underlying implementation's MAKE-PATHNAME") "Unspecific type component to use with the underlying implementation's MAKE-PATHNAME")
(defun make-pathname* (&rest keys &key directory host device name type version defaults (defun make-pathname* (&rest keys &key directory host device name type version defaults
......
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