(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
(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
(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 ppc x86 x86-64)))"
+ ":GENCGC not supported on selected architecture")
+ ("(not (or gencgc cheneygc))"
+ "One of :GENCGC or :CHENEYGC must be enabled")
+ ("(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 compatability check failed, ~S"
+ failed-test-descriptions)))
\f
;;;; cold-init-related PACKAGE and SYMBOL tools
(,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"
;; 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