+ ;; implementation-defined."
+ (prog1 t
+ (setf (logical-pathname-translations host)
+ (with-open-file (lpt (make-pathname :host "SYS"
+ :directory '(:absolute "SITE")
+ :name host
+ :type "TRANSLATIONS"
+ :version :newest))
+ (read lpt))))))
+
+(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)))))
+
+(defun set-sbcl-source-location (pathname)
+ "Initialize the SYS logical host based on PATHNAME, which should be
+the top-level directory of the SBCL sources. This will replace any
+existing translations for \"SYS:SRC;\", \"SYS:CONTRIB;\", and
+\"SYS:OUTPUT;\". Other \"SYS:\" translations are preserved."
+ (let ((truename (truename pathname))
+ (current-translations
+ (remove-if (lambda (translation)
+ (or (pathname-match-p "SYS:SRC;" translation)
+ (pathname-match-p "SYS:CONTRIB;" translation)
+ (pathname-match-p "SYS:OUTPUT;" translation)))
+ (logical-pathname-translations "SYS")
+ :key #'first)))
+ (flet ((physical-target (component)
+ (merge-pathnames
+ (make-pathname :directory (list :relative component
+ :wild-inferiors)
+ :name :wild
+ :type :wild)
+ truename)))
+ (setf (logical-pathname-translations "SYS")
+ `(("SYS:SRC;**;*.*.*" ,(physical-target "src"))
+ ("SYS:CONTRIB;**;*.*.*" ,(physical-target "contrib"))
+ ("SYS:OUTPUT;**;*.*.*" ,(physical-target "output"))
+ ,@current-translations)))))