From 3a4e24072721239bf7fc4940bc2ed3fdb2790c7a Mon Sep 17 00:00:00 2001 From: "Peter S. Housel" Date: Wed, 28 Feb 2018 21:45:40 -0800 Subject: [PATCH] Add support for the Mezzano Common Lisp operating system These changes add support for the Mezzano operating system and its Common Lisp implementation. They are based on changes originally developed by Henry Harrington against ASDF 3.1.7. --- footer.lisp | 6 +++--- uiop/common-lisp.lisp | 4 ++-- uiop/image.lisp | 7 +++++-- uiop/os.lisp | 25 +++++++++++++++++-------- uiop/pathname.lisp | 2 +- 5 files changed, 28 insertions(+), 16 deletions(-) diff --git a/footer.lisp b/footer.lisp index 3d197825..705356eb 100644 --- a/footer.lisp +++ b/footer.lisp @@ -7,8 +7,8 @@ :asdf/system ;; used by ECL :asdf/upgrade :asdf/system-registry :asdf/operate :asdf/bundle) ;; Happily, all those implementations all have the same module-provider hook interface. - #+(or abcl clasp cmucl clozure ecl mkcl sbcl) - (:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext + #+(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 #+mezzano :sys.int #:*module-provider-functions* #+ecl #:*load-hooks*) #+(or clasp mkcl) (:import-from :si #:*load-hooks*)) @@ -24,7 +24,7 @@ ;;;; 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 () ;; Hook into CL:REQUIRE. #-clisp (pushnew 'module-provide-asdf *module-provider-functions*) diff --git a/uiop/common-lisp.lisp b/uiop/common-lisp.lisp index 2606e918..e536d43e 100644 --- a/uiop/common-lisp.lisp +++ b/uiop/common-lisp.lisp @@ -21,7 +21,7 @@ #+(or mcl cmucl) (:shadow #:user-homedir-pathname)) (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.") ;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; DON'T: trust implementation defaults. @@ -29,7 +29,7 @@ ;;;; 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) (when (and #+allegro (member :ics *features*) #+(or clasp clisp cmucl ecl mkcl) (member :unicode *features*) diff --git a/uiop/image.lisp b/uiop/image.lisp index 73e18305..793fdb83 100644 --- a/uiop/image.lisp +++ b/uiop/image.lisp @@ -139,6 +139,9 @@ This is designed to abstract away the implementation specific quit forms." (dbg:*debug-print-level* *print-level*) (dbg:*debug-print-length* *print-length*)) (dbg:bug-backtrace nil)) + #+mezzano + (let ((*standard-output* stream)) + (sys.int::backtrace count)) #+sbcl (sb-debug:print-backtrace :stream stream :count (or count most-positive-fixnum)) #+xcl @@ -227,12 +230,12 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die" #+clozure ccl:*command-line-argument-list* #+(or cmucl scl) extensions:*command-line-strings* #+gcl si:*command-args* - #+(or genera mcl) nil + #+(or genera mcl mezzano) nil #+lispworks sys:*line-arguments-list* #+mkcl (loop :for i :from 0 :below (mkcl:argc) :collect (mkcl:argv i)) #+sbcl sb-ext:*posix-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)) (defun command-line-arguments (&optional (arguments (raw-command-line-arguments))) diff --git a/uiop/os.lisp b/uiop/os.lisp index e79abf24..f77cdefe 100644 --- a/uiop/os.lisp +++ b/uiop/os.lisp @@ -59,6 +59,10 @@ keywords explicitly." "Is the underlying operating system Haiku?" (featurep :haiku)) + (defun os-mezzano-p () + "Is the underlying operating system Mezzano?" + (featurep :mezzano)) + (defun detect-os () "Detects the current operating system. Only needs be run at compile-time, 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) (:os-windows . os-windows-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)) :do (setf o feature) (pushnew feature *features*) :else :do (setf *features* (remove feature *features*)) @@ -103,7 +108,7 @@ use getenvp to return NIL in such a case." (ct:free buffer) (ct:free buffer1))) #+gcl (system:getenv x) - #+genera nil + #+(or genera mezzano) nil #+lispworks (lispworks:environment-variable x) #+mcl (ccl:with-cstrs ((name x)) (let ((value (_getenv name))) @@ -111,7 +116,7 @@ use getenvp to return NIL in such a case." (ccl:%get-cstring value)))) #+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) 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)) (defsetf getenv (x) (val) @@ -157,7 +162,7 @@ then returning the non-empty string value of the variable" '(:abcl (:acl :allegro) (:ccl :clozure) :clisp (:corman :cormanlisp) (:cmu :cmucl :cmu) :clasp :ecl :gcl (: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) "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" (:solaris :solaris :sunos) (:bsd :bsd :freebsd :netbsd :openbsd :dragonfly) :unix - :genera))) + :genera + :mezzano))) (defun architecture () "The CPU architecture of the current host" @@ -230,6 +236,9 @@ then returning the non-empty string value of the variable" (multiple-value-bind (major minor) (sct:get-system-version "System") (format nil "~D.~D" major minor)) #+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. #+mkcl (or (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 (with-upgradability () (defun hostname () "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? #+allegro (symbol-call :excl.osi :gethostname) #+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 (defun getcwd () "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) #+clisp (ext:default-directory) #+clozure (ccl:current-directory) @@ -293,7 +302,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie (defun chdir (x) "Change current directory, as per POSIX chdir(2), to a given pathname object" (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) #+clisp (ext:cd x) #+clozure (setf (ccl:current-directory) x) diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp index cfed30f9..1eb23bfd 100644 --- a/uiop/pathname.lisp +++ b/uiop/pathname.lisp @@ -92,7 +92,7 @@ by the underlying implementation's MAKE-PATHNAME and other primitives" ;; This will be :unspecific if supported, or NIL if not. (defparameter *unspecific-pathname-type* #+(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") (defun make-pathname* (&rest keys &key directory host device name type version defaults -- 2.15.1