(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
(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
- (let ((path ;; (Note that the TRUENAME expression here is lifted from an
- ;; example in the ANSI spec for TRUENAME.)
- (with-open-file (stream y :direction :output)
- (close stream)
- ;; From the ANSI spec: "In this case, the file is closed
- ;; when the truename is tried, so the truename
- ;; information is reliable."
- (truename stream))))
+ (let ((path ;; (Note that the TRUENAME expression here is lifted from an
+ ;; example in the ANSI spec for TRUENAME.)
+ (with-open-file (stream y :direction :output)
+ (close stream)
+ ;; From the ANSI spec: "In this case, the file is closed
+ ;; when the truename is tried, so the truename
+ ;; information is reliable."
+ (truename stream))))
;;; :OBJ-PREFIX, :OBJ-SUFFIX =
;;; strings to be concatenated to STEM to produce object filename
;;; :TMP-OBJ-SUFFIX-SUFFIX =
;;; :OBJ-PREFIX, :OBJ-SUFFIX =
;;; strings to be concatenated to STEM to produce object filename
;;; :TMP-OBJ-SUFFIX-SUFFIX =
;;; the name of a temporary object file
;;; :COMPILE-FILE, :IGNORE-FAILURE-P =
;;; :COMPILE-FILE is a function to use for compiling the file
;;; the name of a temporary object file
;;; :COMPILE-FILE, :IGNORE-FAILURE-P =
;;; :COMPILE-FILE is a function to use for compiling the file
;;; :IGNORE-FAILURE-P is set, in which case only a warning will be
;;; signalled.
(defun compile-stem (stem
;;; :IGNORE-FAILURE-P is set, in which case only a warning will be
;;; signalled.
(defun compile-stem (stem
- &key
- (obj-prefix "")
- (obj-suffix (error "missing OBJ-SUFFIX"))
- (tmp-obj-suffix-suffix "-tmp")
- (src-prefix "")
- (src-suffix ".lisp")
- (compile-file #'compile-file)
- ignore-failure-p)
+ &key
+ (obj-prefix "")
+ (obj-suffix (error "missing OBJ-SUFFIX"))
+ (tmp-obj-suffix-suffix "-tmp")
+ (src-prefix "")
+ (src-suffix ".lisp")
+ (compile-file #'compile-file)
+ trace-file
+ ignore-failure-p)
(declare (type function compile-file))
(let* (;; KLUDGE: Note that this CONCATENATE 'STRING stuff is not The Common
(declare (type function compile-file))
(let* (;; KLUDGE: Note that this CONCATENATE 'STRING stuff is not The Common
- ;; Lisp Way, although it works just fine for common UNIX environments.
- ;; Should it come to pass that the system is ported to environments
- ;; where version numbers and so forth become an issue, it might become
- ;; urgent to rewrite this using the fancy Common Lisp PATHNAME
- ;; machinery instead of just using strings. In the absence of such a
- ;; port, it might or might be a good idea to do the rewrite.
- ;; -- WHN 19990815
- (src (concatenate 'string src-prefix stem src-suffix))
- (obj (concatenate 'string obj-prefix stem obj-suffix))
- (tmp-obj (concatenate 'string obj tmp-obj-suffix-suffix)))
+ ;; Lisp Way, although it works just fine for common UNIX environments.
+ ;; Should it come to pass that the system is ported to environments
+ ;; where version numbers and so forth become an issue, it might become
+ ;; urgent to rewrite this using the fancy Common Lisp PATHNAME
+ ;; machinery instead of just using strings. In the absence of such a
+ ;; port, it might or might be a good idea to do the rewrite.
+ ;; -- WHN 19990815
+ (src (concatenate 'string src-prefix stem src-suffix))
+ (obj (concatenate 'string obj-prefix stem obj-suffix))
+ (tmp-obj (concatenate 'string obj tmp-obj-suffix-suffix)))
;; behaviour is right; and in any case absolutifying the pathname
;; insulates us against changes of behaviour. -- CSR, 2002-08-09
(setf tmp-obj
;; behaviour is right; and in any case absolutifying the pathname
;; insulates us against changes of behaviour. -- CSR, 2002-08-09
(setf tmp-obj
- ;; (Note that this idiom is taken from the ANSI
- ;; documentation for TRUENAME.)
- (with-open-file (stream tmp-obj :direction :output)
- (close stream)
- (truename stream)))
+ ;; (Note that this idiom is taken from the ANSI
+ ;; documentation for TRUENAME.)
+ (with-open-file (stream tmp-obj
+ :direction :output
+ ;; Compilation would overwrite the
+ ;; temporary object anyway and overly
+ ;; strict implementations default
+ ;; to :ERROR.
+ :if-exists :supersede)
+ (close stream)
+ (truename stream)))
;; and some compilers (e.g. OpenMCL) will complain if they're
;; asked to write over a file that exists already (and isn't
;; recognizeably a fasl file), so
;; and some compilers (e.g. OpenMCL) will complain if they're
;; asked to write over a file that exists already (and isn't
;; recognizeably a fasl file), so
(declare (ignore warnings-p))
(cond ((not output-truename)
(error "couldn't compile ~S" src))
(declare (ignore warnings-p))
(cond ((not output-truename)
(error "couldn't compile ~S" src))
- (append (read-from-file "base-target-features.lisp-expr")
- (read-from-file "local-target-features.lisp-expr")))
- (customizer-file-name "customize-target-features.lisp")
- (customizer (if (probe-file customizer-file-name)
- (compile nil
- (read-from-file customizer-file-name))
- #'identity)))
- (funcall customizer default-features)))
+ (append (read-from-file "base-target-features.lisp-expr")
+ (read-from-file "local-target-features.lisp-expr")))
+ (customizer-file-name "customize-target-features.lisp")
+ (customizer (if (probe-file customizer-file-name)
+ (compile nil
+ (read-from-file customizer-file-name))
+ #'identity)))
+ (funcall customizer default-features)))
- (customizer-file-name "customize-backend-subfeatures.lisp")
- (customizer (if (probe-file customizer-file-name)
- (compile nil
- (read-from-file customizer-file-name))
- #'identity)))
+ (customizer-file-name "customize-backend-subfeatures.lisp")
+ (customizer (if (probe-file customizer-file-name)
+ (compile nil
+ (read-from-file customizer-file-name))
+ #'identity)))
- "target backend-subfeatures *SHEBANG-BACKEND-FEATURES*=~@<~S~:>~%"
- *shebang-backend-subfeatures*))
+ "target backend-subfeatures *SHEBANG-BACKEND-FEATURES*=~@<~S~:>~%"
+ *shebang-backend-subfeatures*))
;; SBCL. ("not target code" -- but still presumably host code,
;; used to support the cross-compilation process)
:not-target
;; SBCL. ("not target code" -- but still presumably host code,
;; used to support the cross-compilation process)
:not-target
+ ;; meaning: The #'COMPILE-STEM argument :TRACE-FILE should be T.
+ ;; When the compiler is SBCL's COMPILE-FILE or something like it,
+ ;; compiling "foo.lisp" will generate "foo.trace" which contains lots
+ ;; of exciting low-level information about representation selection,
+ ;; VOPs used by the compiler, and bits of assembly.
+ :trace-file
;; meaning: This file is to be processed with the SBCL assembler,
;; not COMPILE-FILE. (Note that this doesn't make sense unless
;; :NOT-HOST is also set, since the SBCL assembler doesn't exist
;; meaning: This file is to be processed with the SBCL assembler,
;; not COMPILE-FILE. (Note that this doesn't make sense unless
;; :NOT-HOST is also set, since the SBCL assembler doesn't exist
(let ((stem-and-flags (gensym "STEM-AND-FLAGS")))
`(dolist (,stem-and-flags *stems-and-flags*)
(let ((,stem (first ,stem-and-flags))
(let ((stem-and-flags (gensym "STEM-AND-FLAGS")))
`(dolist (,stem-and-flags *stems-and-flags*)
(let ((,stem (first ,stem-and-flags))
(defun in-host-compilation-mode (fn)
(declare (type function fn))
(let ((*features* (cons :sb-xc-host *features*))
(defun in-host-compilation-mode (fn)
(declare (type function fn))
(let ((*features* (cons :sb-xc-host *features*))
- ;; the CROSS-FLOAT-INFINITY-KLUDGE, as documented in
- ;; base-target-features.lisp-expr:
- (*shebang-features* (set-difference *shebang-features*
- '(:sb-propagate-float-type
- :sb-propagate-fun-type))))
+ ;; the CROSS-FLOAT-INFINITY-KLUDGE, as documented in
+ ;; base-target-features.lisp-expr:
+ (*shebang-features* (set-difference *shebang-features*
+ '(:sb-propagate-float-type
+ :sb-propagate-fun-type))))
;;; into the cross-compilation host Common lisp.
(defun host-cload-stem (stem &key ignore-failure-p)
(let ((compiled-filename (in-host-compilation-mode
;;; into the cross-compilation host Common lisp.
(defun host-cload-stem (stem &key ignore-failure-p)
(let ((compiled-filename (in-host-compilation-mode
- (lambda ()
- (compile-stem
- stem
- :obj-prefix *host-obj-prefix*
- :obj-suffix *host-obj-suffix*
- :compile-file #'cl:compile-file
- :ignore-failure-p ignore-failure-p)))))
+ (lambda ()
+ (compile-stem
+ stem
+ :obj-prefix *host-obj-prefix*
+ :obj-suffix *host-obj-suffix*
+ :compile-file #'cl:compile-file
+ :ignore-failure-p ignore-failure-p)))))
;;; Run the cross-compiler on a file in the source directory tree to
;;; produce a corresponding file in the target object directory tree.
;;; Run the cross-compiler on a file in the source directory tree to
;;; produce a corresponding file in the target object directory tree.
- (lambda ()
- (compile-stem stem
- :obj-prefix *target-obj-prefix*
- :obj-suffix *target-obj-suffix*
- :ignore-failure-p ignore-failure-p
- :compile-file (if assem-p
- *target-assemble-file*
- *target-compile-file*)))))
+ (lambda ()
+ (compile-stem stem
+ :obj-prefix *target-obj-prefix*
+ :obj-suffix *target-obj-suffix*
+ :trace-file trace-file
+ :ignore-failure-p ignore-failure-p
+ :compile-file (if assem-p
+ *target-assemble-file*
+ *target-compile-file*)))))
(compile 'target-compile-stem)
;;; (This function is not used by the build process, but is intended
(compile 'target-compile-stem)
;;; (This function is not used by the build process, but is intended
;;; necessarily in the source tree, e.g. in "/tmp".)
(defun target-compile-file (filename)
(funcall *in-target-compilation-mode-fn*
;;; necessarily in the source tree, e.g. in "/tmp".)
(defun target-compile-file (filename)
(funcall *in-target-compilation-mode-fn*