From: Alastair Bridgewater Date: Tue, 5 May 2009 17:11:18 +0000 (+0000) Subject: 1.0.28.15: Build desymlinkification X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b42c75203a3f077e8f59373a48af5e3a304addbf;p=sbcl.git 1.0.28.15: Build desymlinkification Changed the object filename computation function to use a different suffix for files in target-compile mode with the :assem flag. Changed the src/compiler/assembly/ paths in build-order.lisp-expr to refer to src/assembly/ instead. Changed the duplicate-stem check in src/cold/shared.lisp to operate in terms of target-compile object file names. Changed both the source and object filename computation functions to call a new function to remap stem path segments matching "/target/" to the appropriate per-arch directory. Removed the code for creating the compiler/assembly/ and target/ symlinks from make-config.sh. With this, source-location information in SBCL is now correct even when used against an unbuilt source tree. --- diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 70e040b..9c5d805 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -601,14 +601,14 @@ ("src/compiler/generic/late-type-vops") ;; KLUDGE: The assembly files need to be compiled twice: once as - ;; normal lisp files, and once by sb-c:assemble-file. We play some - ;; symlink games to make sure we don't scribble over anything we - ;; shouldn't, but these are actually the same files: - - ("src/compiler/assembly/target/assem-rtns") - ("src/compiler/assembly/target/array") - ("src/compiler/assembly/target/arith") - ("src/compiler/assembly/target/alloc") + ;; normal lisp files, and once by sb-c:assemble-file. We use a + ;; different suffix / "file type" for the :assem versions to make + ;; sure we don't scribble over anything we shouldn't. + + ("src/assembly/target/assem-rtns") + ("src/assembly/target/array") + ("src/assembly/target/arith") + ("src/assembly/target/alloc") ("src/assembly/target/assem-rtns" :assem :not-host) ("src/assembly/target/array" :assem :not-host) ("src/assembly/target/arith" :assem :not-host) diff --git a/make-config.sh b/make-config.sh index 0554600..491807c 100644 --- a/make-config.sh +++ b/make-config.sh @@ -137,27 +137,6 @@ if [ "$sbcl_arch" = "" ] ; then fi printf ":%s" "$sbcl_arch" >> $ltf -for d in src/compiler src/assembly; do - echo //setting up symlink $d/target - original_dir=`pwd` - remove_dir_safely "$d/target" - cd ./$d - if [ -d $sbcl_arch ] ; then - link_or_copy $sbcl_arch target - else - echo "missing sbcl_arch directory $PWD/$sbcl_arch" - exit 1 - fi - cd "$original_dir" -done - -echo //setting up symlink src/compiler/assembly -remove_dir_safely src/compiler/assembly -original_dir=`pwd` -cd src/compiler -link_or_copy ../assembly assembly -cd "$original_dir" - echo //setting up OS-dependent information original_dir=`pwd` cd ./src/runtime/ diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index ee3d1df..d8d6f44 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -56,6 +56,15 @@ ;; GENESIS) only by SBCL code, and it doesn't care about particular ;; extensions, so we can use something arbitrary. ".lisp-obj") +(defvar *target-assem-obj-suffix* + ;; Target fasl files from SB!C:ASSEMBLE-FILE are LOADed via GENESIS. + ;; The source files are compiled once as assembly files and once as + ;; normal lisp files. In the past, they were kept separate by + ;; clever symlinking in the source tree, but that became less clean + ;; as ports to host environments without symlinks started appearing. + ;; In order to keep them separate, we have the assembled versions + ;; with a separate suffix. + ".assem-obj") ;;; a function of one functional argument, which calls its functional argument ;;; in an environment suitable for compiling the target. (This environment @@ -205,27 +214,59 @@ (,flags (rest ,stem-and-flags))) ,@body)))) +;;; Given a STEM, remap the path component "/target/" to a suitable +;;; target directory. +(defun stem-remap-target (stem) + (let ((position (search "/target/" stem))) + (if position + (concatenate 'string + (subseq stem 0 (1+ position)) + #!+x86 "x86" + #!+x86-64 "x86-64" + #!+sparc "sparc" + #!+ppc "ppc" + #!+mips "mips" + #!+alpha "alpha" + #!+hppa "hppa" + (subseq stem (+ position 7))) + stem))) +(compile 'stem-remap-target) + ;;; Determine the source path for a stem. (defun stem-source-path (stem) - (concatenate 'string "" stem ".lisp")) + (concatenate 'string "" (stem-remap-target stem) ".lisp")) (compile 'stem-source-path) -;;; Determine the object path for a stem/mode combination. -(defun stem-object-path (stem mode) +;;; Determine the object path for a stem/flags/mode combination. +(defun stem-object-path (stem flags mode) (multiple-value-bind (obj-prefix obj-suffix) (ecase mode (:host-compile (values *host-obj-prefix* *host-obj-suffix*)) - (:target-compile (values *target-obj-prefix* *target-obj-suffix*))) - (concatenate 'string obj-prefix stem obj-suffix))) + (:target-compile (values *target-obj-prefix* + (if (find :assem flags) + *target-assem-obj-suffix* + *target-obj-suffix*)))) + (concatenate 'string obj-prefix (stem-remap-target stem) obj-suffix))) (compile 'stem-object-path) ;;; Check for stupid typos in FLAGS list keywords. (let ((stems (make-hash-table :test 'equal))) (do-stems-and-flags (stem flags) - (if (gethash stem stems) - (error "duplicate stem ~S in *STEMS-AND-FLAGS*" stem) - (setf (gethash stem stems) t)) + ;; We do duplicate stem comparison based on the object path in + ;; order to cover the case of stems with an :assem flag, which + ;; have two entries but separate object paths for each. KLUDGE: + ;; We have to bind *target-obj-prefix* here because it's normally + ;; set up later in the build process and we don't actually care + ;; what it is so long as it doesn't change while we're checking + ;; for duplicate stems. + (let* ((*target-obj-prefix* "") + (object-path (stem-object-path stem flags :target-compile))) + (if (gethash object-path stems) + (error "duplicate stem ~S in *STEMS-AND-FLAGS*" stem) + (setf (gethash object-path stems) t))) + ;; FIXME: We should make sure that the :assem flag is only used + ;; when paired with :not-host. (let ((set-difference (set-difference flags *expected-stem-flags*))) (when set-difference (error "found unexpected flag(s) in *STEMS-AND-FLAGS*: ~S" @@ -254,7 +295,7 @@ ;; port, it might or might be a good idea to do the rewrite. ;; -- WHN 19990815 (src (stem-source-path stem)) - (obj (stem-object-path stem mode)) + (obj (stem-object-path stem flags mode)) (tmp-obj (concatenate 'string obj "-tmp")) (compile-file (ecase mode @@ -376,7 +417,7 @@ ;;; like HOST-CLOAD-STEM, except that we don't bother to compile (defun host-load-stem (stem flags) (declare (ignore flags)) ; (It's only relevant when compiling.) - (load (stem-object-path stem :host-compile))) + (load (stem-object-path stem flags :host-compile))) (compile 'host-load-stem) ;;;; tools to compile SBCL sources to create object files which will diff --git a/src/cold/slam.lisp b/src/cold/slam.lisp index 57e4a4f..aa3b1f7 100644 --- a/src/cold/slam.lisp +++ b/src/cold/slam.lisp @@ -34,6 +34,6 @@ (do-stems-and-flags (stem flags) (unless (position :not-target flags) (let ((srcname (stem-source-path stem)) - (objname (stem-object-path stem :target-compile))) + (objname (stem-object-path stem flags :target-compile))) (unless (output-up-to-date-wrt-input-p objname srcname) (target-compile-stem stem flags))))) diff --git a/version.lisp-expr b/version.lisp-expr index b852a29..388b1cb 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.28.14" +"1.0.28.15"