Add a global switch to work around CL pathname nonsense

There are at least two aspects:
 - what pathname should go in *compile-file-pathname*

 - what namestrings should be stored into on-disk artifacts
  (also relates to the namestrings in coverage hash-table)

The spec has nothing to say about the latter, so we can pick anything.
But unfortunately we base the choice on the former, which the spec does say
something about. However, we can clean up a pile of crap and eliminate some
custom handling around this by just making SBCL do the right thing under
control of SB-C::*MERGE-PATHNAMES*. And as it happens, self-build had a use
for this which is now just expoiting the selector switch.
This commit is contained in:
Douglas Katzman 2021-05-05 14:57:37 -04:00
parent 7094f222bd
commit 9cfb57efdf
3 changed files with 27 additions and 13 deletions

View file

@ -476,10 +476,6 @@ Please check that all strings which were not recognizable to the compiler
sum-delta-ext sum-delta-int
(+ sum-delta-ext sum-delta-int))))
;;; Use historical (stupid) behavior for storing pathname namestrings
;;; in fasls.
(setq sb-c::*name-context-file-path-selector* 'truename)
;;; Lock internal packages
#-(and sb-devel
(not sb-devel-lock-packages))

View file

@ -58,12 +58,17 @@ if [ "$warm_compile" = yes ]; then
fi
echo //doing warm init - load and dump phase
./src/runtime/sbcl --core output/cold-sbcl.core \
--lose-on-corruption $SBCL_MAKE_TARGET_2_OPTIONS --no-sysinit --no-userinit \
--eval "(progn ${devel})" \
--eval '(sb-fasl::!warm-load "make-target-2-load.lisp")' \
--eval '(setf (extern-alien "gc_coalesce_string_literals" char) 2)' \
--eval '(let ((sb-ext:*invoke-debugger-hook* (prog1 sb-ext:*invoke-debugger-hook* (sb-ext:enable-debugger))))
(sb-ext:save-lisp-and-die "output/sbcl.core"))'
--lose-on-corruption $SBCL_MAKE_TARGET_2_OPTIONS --no-sysinit --no-userinit <<EOF
(progn ${devel})
(sb-fasl::!warm-load "make-target-2-load.lisp")
(setf (extern-alien "gc_coalesce_string_literals" char) 2)
;;; Use the historical (bad) convention for *compile-file-pathname*
(setf sb-c::*merge-pathnames* t)
;;; and for storing pathname namestrings in fasls too.
(setq sb-c::*name-context-file-path-selector* 'truename)
(let ((sb-ext:*invoke-debugger-hook* (prog1 sb-ext:*invoke-debugger-hook* (sb-ext:enable-debugger))))
(sb-ext:save-lisp-and-die "output/sbcl.core"))
EOF
# Confirm that default evaluation strategy is :INTERPRET if sb-fasteval was built
src/runtime/sbcl --core output/sbcl.core --lose-on-corruption --noinform \

View file

@ -836,11 +836,20 @@ necessary, since type inference may take arbitrarily long to converge.")
(terpri)
(values))
;;; Leave this as NIL if you want modern, rational, correct, behavior,
;;; or switch it to T for legacy (CLHS-specified) bullshit a la
;;; "During a call to compile-file, *compile-file-pathname* is bound to the pathname
;;; denoted by the first argument to compile-file, merged against the defaults"
;;; The normal build sets it to T in make-target-2, despite that I think most people would
;;; prefer the nonstandard behavior. The standard behavior makes stored pathnames all wrong
;;; when files are physically moved. (Same problem as SBCL_HOME embedded into C pretty much)
(defglobal *merge-pathnames* t)
;;; Given a pathname, return a SOURCE-INFO structure.
(defun make-file-source-info (file external-format &optional form-tracking-p)
(make-source-info
:file-info (make-file-info :untruename #+sb-xc-host file ; becomes *C-F-PATHNAME*
#-sb-xc-host (merge-pathnames file)
:file-info (make-file-info :untruename ; becomes *C-F-PATHNAME*
(if *merge-pathnames* (merge-pathnames file) file)
:external-format external-format
:subforms
(if form-tracking-p
@ -903,7 +912,11 @@ necessary, since type inference may take arbitrarily long to converge.")
;; SBCL stream classes aren't available in the host
#-sb-xc-host :class
#-sb-xc-host 'form-tracking-stream)))
(setf *compile-file-pathname* (pathname stream)
;; If you don't want merged pathnames embedded in your build artifacts,
;; then you surely don't want them in *COMPILE-FILE-PATHNAME* either.
;; [And can't we just bind this to PATHNAME is all cases? If anything,
;; it seems to me that asking the stream for its name is expressly backwards]
(setf *compile-file-pathname* (if *merge-pathnames* (pathname stream) pathname)
*compile-file-truename* (truename stream)
(file-info-name file-info) *compile-file-truename*)
(when (file-info-subforms file-info)