Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/cold shared.lisp, 1.39, 1.40 slam.lisp, 1.4, 1.5
|
From: Alastair B. <lis...@us...> - 2009-05-05 17:11:31
|
Update of /cvsroot/sbcl/sbcl/src/cold In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv5088/src/cold Modified Files: shared.lisp slam.lisp Log Message: 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. Index: shared.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/cold/shared.lisp,v retrieving revision 1.39 retrieving revision 1.40 diff -u -d -r1.39 -r1.40 --- shared.lisp 5 May 2009 17:10:30 -0000 1.39 +++ shared.lisp 5 May 2009 17:11:18 -0000 1.40 @@ -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 Index: slam.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/cold/slam.lisp,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- slam.lisp 5 May 2009 17:10:30 -0000 1.4 +++ slam.lisp 5 May 2009 17:11:18 -0000 1.5 @@ -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))))) |