Changeset 14879

Timestamp:

09/29/16 21:39:05 (7 years ago)

Author:

Mark Evenson

Message:

EXT:OS-{UNIX,WINDOWS}-P now provide a pre-ASDF runtime check on hosting platform

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• compile-system.lisp (modified) (2 diffs)
• featurep.lisp (modified) (1 diff)
• run-program.lisp (modified) (2 diffs)

trunk/abcl/src/org/armedbear/lisp/compile-system.lisp

@@ -318 +318 @@
       (load (do-compile "ldb.lisp"))
       (load (do-compile "destructuring-bind.lisp"))
+      (load (do-compile "featurep.lisp"))
+
       ;; But not for these.
       (mapc #'do-compile '("adjoin.lisp"
@@ -369 +371 @@
                            "extensible-sequences.lisp"
                            "fasl-concat.lisp"
-                           "featurep.lisp"
                            "fdefinition.lisp"
                            "fill.lisp"

trunk/abcl/src/org/armedbear/lisp/featurep.lisp

@@ -52 +52 @@
         (t
          (error "Unknown operator in feature expression: ~S" form)))))
+
+;;;; Cribbed from ASDF 3.1.7; duplicated to establish runtime conditionals before ASDF is constructed
+(defun os-macosx-p ()
+  "Is the underlying operating system MacOS X?"
+  ;; OS-MACOSX is not mutually exclusive with OS-UNIX,
+  ;; in fact the former implies the latter.
+  (featurep '(:or :darwin (:and :allegro :macosx) (:and :clisp :macos))))
+
+(defun os-unix-p ()
+  "Is the underlying operating system some Unix variant?"
+  (or (featurep '(:or :unix :cygwin)) (os-macosx-p)))
+
+(defun os-windows-p ()
+  "Is the underlying operating system Microsoft Windows?"
+  (and (not (os-unix-p)) (featurep '(:or :win32 :windows :mswindows :mingw32 :mingw64))))
+
+(defun os-genera-p ()
+  "Is the underlying operating system Genera (running on a Symbolics Lisp Machine)?"
+  (featurep :genera))
+
+(defun os-oldmac-p ()
+  "Is the underlying operating system an (emulated?) MacOS 9 or earlier?"
+  (featurep :mcl))
+
+(defun os-haiku-p ()
+  "Is the underlying operating system Haiku?"
+  (featurep :haiku))
+
+(export '(os-unix-p os-windows-p))
+

trunk/abcl/src/org/armedbear/lisp/run-program.lisp

@@ -171 +171 @@
    (if value
        (namestring value)
-       #+unix "/dev/null"
-       #+windows "nul"
-       #-(or unix windows) (error "Don't know how to set up null stream on this platform."))))
+       (cond
+         ((ext:os-unix-p)
+          "/dev/null")
+         ((ext:os-windows-p) 
+          "nul")
+         (t
+          (error "Don't know how to set up null stream on this platform."))))))
 
 (defun setup-input-redirection (process-builder value if-does-not-exist)
@@ -299 +303 @@
   (ignore-errors (java:jcall "exitValue" jprocess)))
 
-#+unix
-(defconstant +pid-field+
-  (let ((field (java:jcall "getDeclaredField" (java:jclass "java.lang.UNIXProcess") "pid")))
-    (java:jcall "setAccessible" field java:+true+)
-    field))
-
 (defun %process-pid (jprocess)
-  #+unix (java:jcall "get" +pid-field+ jprocess)
-  #-unix (error "Can't retrieve PID on this platform."))
+  (if (ext:os-unix-p)
+      ;; TODO: memoize this 
+      (let ((field (java:jcall "getDeclaredField" (java:jclass "java.lang.UNIXProcess") "pid")))
+        (java:jcall "setAccessible" field java:+true+)
+        (java:jcall "get" field jprocess))
+      (error "Can't retrieve PID on this platform.")))
 
 (defun %process-kill (jprocess)