1.0.28.66: implement SB-EXT:GET-TIME-OF-DAY

[sbcl.git] / src / code / target-pathname.lisp

diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index 109f639..04c5845 100644 (file)
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -286,8 +286,8 @@
 ;;;
 ;;; FIXME: was rewritten, should be tested (or rewritten again, this
 ;;; time using ONCE-ONLY, *then* tested)
-;;; FIXME: become SB!XC:DEFMACRO inside EVAL-WHEN (COMPILE EVAL)?
-(defmacro with-pathname ((pathname pathname-designator) &body body)
+(eval-when (:compile-toplevel :execute)
+(sb!xc:defmacro with-pathname ((pathname pathname-designator) &body body)
   (let ((pd0 (gensym)))
     `(let* ((,pd0 ,pathname-designator)
             (,pathname (etypecase ,pd0
@@ -296,7 +296,7 @@
                          (file-stream (file-name ,pd0)))))
        ,@body)))
 
-(defmacro with-native-pathname ((pathname pathname-designator) &body body)
+(sb!xc:defmacro with-native-pathname ((pathname pathname-designator) &body body)
   (let ((pd0 (gensym)))
     `(let* ((,pd0 ,pathname-designator)
             (,pathname (etypecase ,pd0
@@ -307,7 +307,7 @@
                          (file-stream (file-name ,pd0)))))
        ,@body)))
 
-(defmacro with-host ((host host-designator) &body body)
+(sb!xc:defmacro with-host ((host host-designator) &body body)
   ;; Generally, redundant specification of information in software,
   ;; whether in code or in comments, is bad. However, the ANSI spec
   ;; for this is messy enough that it's hard to hold in short-term
@@ -363,6 +363,7 @@
                              ,hd0))
                      (host ,hd0))))
       ,@body)))
+) ; EVAL-WHEN
 
 (defun find-host (host-designator &optional (errorp t))
   (with-host (host host-designator)
@@ -1063,7 +1064,7 @@ system's syntax for files."
              (frob %pathname-directory directory-components-match)
              (frob %pathname-name)
              (frob %pathname-type)
-             (or (eq (%pathname-host wildname) *unix-host*)
+             (or (eq (%pathname-host wildname) *physical-host*)
                  (frob %pathname-version)))))))
 
 ;;; Place the substitutions into the pattern and return the string or pattern
@@ -1704,3 +1705,24 @@ system's syntax for files."
       ;; might be cute to search in "SYS:TRANSLATIONS;<name>.LISP"
       (error "logical host ~S not found" host)))
 
+(defun !pathname-cold-init ()
+  (let* ((sys *default-pathname-defaults*)
+         (src
+          (merge-pathnames
+           (make-pathname :directory '(:relative "src" :wild-inferiors)
+                          :name :wild :type :wild)
+           sys))
+         (contrib
+          (merge-pathnames
+           (make-pathname :directory '(:relative "contrib" :wild-inferiors)
+                          :name :wild :type :wild)
+           sys))
+         (output
+          (merge-pathnames
+           (make-pathname :directory '(:relative "output" :wild-inferiors)
+                          :name :wild :type :wild)
+           sys)))
+    (setf (logical-pathname-translations "SYS")
+          `(("SYS:SRC;**;*.*.*" ,src)
+            ("SYS:CONTRIB;**;*.*.*" ,contrib)
+            ("SYS:OUTPUT;**;*.*.*" ,output)))))