(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
;; 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
;; 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
;;; a function of one functional argument, which calls its functional argument
;;; in an environment suitable for compiling the target. (This environment
;;; includes e.g. a suitable *FEATURES* value.)
;;; a function of one functional argument, which calls its functional argument
;;; in an environment suitable for compiling the target. (This environment
;;; includes e.g. a suitable *FEATURES* value.)
-;;; designator for a function with the same calling convention as
-;;; CL:COMPILE-FILE, to be used to translate ordinary Lisp source files into
-;;; target object files
+;;; a function with the same calling convention as CL:COMPILE-FILE, to be
+;;; used to translate ordinary Lisp source files into target object files
+(declaim (type function *target-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))
- ;; 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)))
- ;; Work around a bug in CLISP 1999-01-08 #'COMPILE-FILE: CLISP
- ;; mangles relative pathnames passed as :OUTPUT-FILE arguments,
- ;; but works OK with absolute pathnames.
- #+clisp
+ ;; Original comment:
+ ;;
+ ;; Work around a bug in CLISP 1999-01-08 #'COMPILE-FILE: CLISP
+ ;; mangles relative pathnames passed as :OUTPUT-FILE arguments,
+ ;; but works OK with absolute pathnames.
+ ;;
+ ;; following discussion on cmucl-imp 2002-07
+ ;; "COMPILE-FILE-PATHNAME", it would seem safer to deal with
+ ;; absolute pathnames all the time; it is no longer clear that the
+ ;; original behaviour in CLISP was wrong or that the current
+ ;; behaviour is right; and in any case absolutifying the pathname
+ ;; insulates us against changes of behaviour. -- CSR, 2002-08-09
- ;; (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
+ (when (probe-file tmp-obj)
+ (delete-file tmp-obj))
;; Try to use the compiler to generate a new temporary object file.
(flet ((report-recompile-restart (stream)
;; Try to use the compiler to generate a new temporary object file.
(flet ((report-recompile-restart (stream)
(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*))
- ;; cross-compiler which runs on the host ANSI Lisp.
+ ;; cross-compiler which runs on the host ANSI Lisp. ("not host
+ ;; code", i.e. does not execute on host -- but may still be
+ ;; cross-compiled by the host, so that it executes on the 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
(defparameter *stems-and-flags* (read-from-file "build-order.lisp-expr"))
(defmacro do-stems-and-flags ((stem flags) &body body)
(defparameter *stems-and-flags* (read-from-file "build-order.lisp-expr"))
(defmacro do-stems-and-flags ((stem flags) &body body)
`(dolist (,stem-and-flags *stems-and-flags*)
(let ((,stem (first ,stem-and-flags))
`(dolist (,stem-and-flags *stems-and-flags*)
(let ((,stem (first ,stem-and-flags))
\f
;;;; tools to compile SBCL sources to create the cross-compiler
;;; Execute function FN in an environment appropriate for compiling the
;;; cross-compiler's source code in the cross-compilation host.
(defun in-host-compilation-mode (fn)
\f
;;;; tools to compile SBCL sources to create the cross-compiler
;;; Execute function FN in an environment appropriate for compiling the
;;; cross-compiler's source code in the cross-compilation host.
(defun in-host-compilation-mode (fn)
- ;; 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*