1.0.28.15: Build desymlinkification
authorAlastair Bridgewater <lisphacker@users.sourceforge.net>
Tue, 5 May 2009 17:11:18 +0000 (17:11 +0000)
committerAlastair Bridgewater <lisphacker@users.sourceforge.net>
Tue, 5 May 2009 17:11:18 +0000 (17:11 +0000)
  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.

build-order.lisp-expr
make-config.sh
src/cold/shared.lisp
src/cold/slam.lisp
version.lisp-expr

index 70e040b..9c5d805 100644 (file)
  ("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)
index 0554600..491807c 100644 (file)
@@ -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/
index ee3d1df..d8d6f44 100644 (file)
   ;; 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
              (,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"
          ;; 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
 ;;; 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)
 \f
 ;;;; tools to compile SBCL sources to create object files which will
index 57e4a4f..aa3b1f7 100644 (file)
@@ -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)))))
index b852a29..388b1cb 100644 (file)
@@ -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"