;; 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
+ #+openmcl ".pfsl"
;; On most xc hosts, any old extension works, so we use an
;; arbitrary one.
".lisp-obj"))
;;; 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.)
+(declaim (type function *in-target-compilation-mode-fn*))
(defvar *in-target-compilation-mode-fn*)
-;;; 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*))
(defvar *target-compile-file*)
;;; designator for a function with the same calling convention as
(compile-file #'compile-file)
ignore-failure-p)
+ (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
(when (probe-file obj)
(delete-file obj))
- ;; 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
(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)))
+ ;; 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.
- (multiple-value-bind (output-truename warnings-p failure-p)
- (funcall compile-file src :output-file tmp-obj)
- (declare (ignore warnings-p))
- (cond ((not output-truename)
- (error "couldn't compile ~S" src))
- (failure-p
- (if ignore-failure-p
- (warn "ignoring FAILURE-P return value from compilation of ~S"
- src)
- (unwind-protect
- (progn
- ;; FIXME: This should have another option,
- ;; redoing compilation.
- (cerror "Continue, using possibly-bogus ~S."
- "FAILURE-P was set when creating ~S."
- obj)
- (setf failure-p nil))
- ;; Don't leave failed object files lying around.
- (when (and failure-p (probe-file tmp-obj))
- (delete-file tmp-obj)
- (format t "~&deleted ~S~%" tmp-obj)))))
- ;; Otherwise: success, just fall through.
- (t nil)))
+ (flet ((report-recompile-restart (stream)
+ (format stream "Recompile file ~S" src))
+ (report-continue-restart (stream)
+ (format stream "Continue, using possibly bogus file ~S" obj)))
+ (tagbody
+ retry-compile-file
+ (multiple-value-bind (output-truename warnings-p failure-p)
+ (funcall compile-file src :output-file tmp-obj)
+ (declare (ignore warnings-p))
+ (cond ((not output-truename)
+ (error "couldn't compile ~S" src))
+ (failure-p
+ (if ignore-failure-p
+ (warn "ignoring FAILURE-P return value from compilation of ~S"
+ src)
+ (unwind-protect
+ (restart-case
+ (error "FAILURE-P was set when creating ~S."
+ obj)
+ (recompile ()
+ :report report-recompile-restart
+ (go retry-compile-file))
+ (continue ()
+ :report report-continue-restart
+ (setf failure-p nil)))
+ ;; Don't leave failed object files lying around.
+ (when (and failure-p (probe-file tmp-obj))
+ (delete-file tmp-obj)
+ (format t "~&deleted ~S~%" tmp-obj)))))
+ ;; Otherwise: success, just fall through.
+ (t nil)))))
;; If we get to here, compilation succeeded, so it's OK to rename
;; the temporary output file to the permanent object file.
(defparameter
*expected-stem-flags*
'(;; meaning: This file is not to be compiled when building the
- ;; 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)
:not-host
;; meaning: This file is not to be compiled as part of the target
- ;; SBCL.
+ ;; SBCL. ("not target code" -- but still presumably host code,
+ ;; used to support the cross-compilation process)
:not-target
;; meaning: This file is to be processed with the SBCL assembler,
;; not COMPILE-FILE. (Note that this doesn't make sense unless
(defparameter *stems-and-flags* (read-from-file "build-order.lisp-expr"))
(defmacro do-stems-and-flags ((stem flags) &body body)
- (let ((stem-and-flags (gensym "STEM-AND-FLAGS-")))
+ (let ((stem-and-flags (gensym "STEM-AND-FLAGS")))
`(dolist (,stem-and-flags *stems-and-flags*)
(let ((,stem (first ,stem-and-flags))
(,flags (rest ,stem-and-flags)))
;;; 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)
+ (declare (type function fn))
(let ((*features* (cons :sb-xc-host *features*))
;; the CROSS-FLOAT-INFINITY-KLUDGE, as documented in
;; base-target-features.lisp-expr:
projects / sbcl.git / blobdiff