0.8alpha.0.9:

[sbcl.git] / src / cold / shared.lisp

diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp
index f17fedf..86dcd58 100644 (file)
--- a/src/cold/shared.lisp
+++ b/src/cold/shared.lisp
@@ -59,11 +59,12 @@
 ;;; 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
@@ -130,6 +131,8 @@
                     (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
@@ -151,16 +154,29 @@
     (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.
     (flet ((report-recompile-restart (stream)
@@ -270,10 +286,13 @@
 (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
@@ -292,7 +311,7 @@
 (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)))
@@ -314,6 +333,7 @@
 ;;; 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: