X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fshared.lisp;h=479b426c90ce4870f377745555c101ee76c670fb;hb=51bc001b7a98af096af782a672389e51004af068;hp=ee3d1df24ed0a735750d75556b37e0e1274d60f2;hpb=577487adfc43408ef5fba0ce118b961407e33494;p=sbcl.git diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index ee3d1df..479b426 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -33,29 +33,20 @@ (defvar *host-obj-prefix*) (defvar *target-obj-prefix*) -;;; suffixes for filename stems when cross-compiling -(defvar *host-obj-suffix* - (or - ;; On some xc hosts, it's impossible to LOAD a fasl file unless it - ;; has the same extension that the host uses for COMPILE-FILE - ;; output, so we have to be careful to use the xc host's preferred - ;; extension. - ;; - ;; FIXME: This is a little ugly and annoying to maintain. And - ;; there's very likely some way to rearrange the build process so - ;; that we never explicitly refer to host object file suffixes, - ;; only to the result of CL:COMPILE-FILE-PATHNAME. - #+lispworks ".ufsl" ; as per Lieven Marchand sbcl-devel 2002-02-01 - #+(and openmcl (not darwin)) ".pfsl" - #+(and openmcl darwin) ".dfsl" - ;; On most xc hosts, any old extension works, so we use an - ;; arbitrary one. - ".lisp-obj")) (defvar *target-obj-suffix* ;; Target fasl files are LOADed (actually only quasi-LOADed, in ;; 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 @@ -122,7 +113,7 @@ (setf *shebang-features* (let* ((default-features (append (read-from-file "base-target-features.lisp-expr") - (read-from-file "local-target-features.lisp-expr"))) + (eval (read-from-file "local-target-features.lisp-expr")))) (customizer-file-name "customize-target-features.lisp") (customizer (if (probe-file customizer-file-name) (compile nil @@ -148,6 +139,49 @@ (format t "target backend-subfeatures *SHEBANG-BACKEND-FEATURES*=~@<~S~:>~%" *shebang-backend-subfeatures*)) + +;;; Some feature combinations simply don't work, and sometimes don't +;;; fail until quite a ways into the build. Pick off the more obvious +;;; combinations now, and provide a description of what the actual +;;; failure is (not always obvious from when the build fails). +(let ((feature-compatability-tests + '(("(and sb-thread (not gencgc))" + ":SB-THREAD requires :GENCGC") + ("(and sb-thread (not (or ppc x86 x86-64)))" + ":SB-THREAD not supported on selected architecture") + ("(and gencgc cheneygc)" + ":GENCGC and :CHENEYGC are incompatible") + ("(and cheneygc (not (or alpha hppa mips ppc sparc)))" + ":CHENEYGC not supported on selected architecture") + ("(and gencgc (not (or sparc ppc x86 x86-64)))" + ":GENCGC not supported on selected architecture") + ("(not (or gencgc cheneygc))" + "One of :GENCGC or :CHENEYGC must be enabled") + ("(and win32 (not (and sb-thread + sb-safepoint sb-thruption sb-wtimer + sb-dynamic-core)))" + ":SB-WIN32 requires :SB-THREAD and related features") + ("(and sb-dynamic-core (not (and linkage-table sb-thread)))" + ;; Subtle memory corruption follows when sb-dynamic-core is + ;; active, and non-threaded allocation routines have not been + ;; updated to take the additional indirection into account. + ;; Let's avoid this unusual combination. + ":SB-DYNAMIC-CORE requires :LINKAGE-TABLE and :SB-THREAD") + ("(or (and alpha (or hppa mips ppc sparc x86 x86-64)) + (and hppa (or mips ppc sparc x86 x86-64)) + (and mips (or ppc sparc x86 x86-64)) + (and ppc (or sparc x86 x86-64)) + (and sparc (or x86 x86-64)) + (and x86 x86-64))" + "More than one architecture selected"))) + (failed-test-descriptions nil)) + (dolist (test feature-compatability-tests) + (let ((*features* *shebang-features*)) + (when (read-from-string (concatenate 'string "#+" (first test) "T NIL")) + (push (second test) failed-test-descriptions)))) + (when failed-test-descriptions + (error "Feature compatibility check failed, ~S" + failed-test-descriptions))) ;;;; cold-init-related PACKAGE and SYMBOL tools @@ -205,27 +239,66 @@ (,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))) + (:host-compile + ;; On some xc hosts, it's impossible to LOAD a fasl file unless it + ;; has the same extension that the host uses for COMPILE-FILE + ;; output, so we have to be careful to use the xc host's preferred + ;; extension. + (values *host-obj-prefix* + (concatenate 'string "." + (pathname-type (compile-file-pathname stem))))) + (: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 +327,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 @@ -315,8 +388,8 @@ (multiple-value-bind (output-truename warnings-p failure-p) (if trace-file (funcall compile-file src :output-file tmp-obj - :trace-file t) - (funcall compile-file src :output-file tmp-obj )) + :trace-file t :allow-other-keys t) + (funcall compile-file src :output-file tmp-obj)) (declare (ignore warnings-p)) (cond ((not output-truename) (error "couldn't compile ~S" src)) @@ -375,8 +448,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