0.7.1.18:
[sbcl.git] / src / cold / shared.lisp
index 40f1eba..b2dc290 100644 (file)
   (sb-ext:gc-on)
   (sb-ext:gc))
 
-;;; FIXME: I'm now inclined to make all the bootstrap stuff run in CL-USER
-;;; instead of SB-COLD. If I do so, I should first take care to
-;;; UNINTERN any old stuff in CL-USER, since ANSI says (11.1.2.2, "The
-;;; COMMON-LISP-USER Package") that CL-USER can have arbitrary symbols in
-;;; it. (And of course I should set the USE list to only CL.)
+;;; SB-COLD holds stuff used to build the initial SBCL core file
+;;; (including not only the final construction of the core file, but
+;;; also the preliminary steps like e.g. building the cross-compiler
+;;; and running the cross-compiler to produce target FASL files).
 (defpackage "SB-COLD" (:use "CL"))
+
 (in-package "SB-COLD")
 
 ;;; prefixes for filename stems when cross-compiling. These are quite arbitrary
 ;;; "host-objects/" or absolute pathnames (e.g. "/tmp/sbcl-xc-host-objects/").
 ;;;
 ;;; The cross-compilation process will force the creation of these directories
-;;; by executing CL:ENSURE-DIRECTORIES-EXIST (on the host Common Lisp).
+;;; by executing CL:ENSURE-DIRECTORIES-EXIST (on the xc host Common Lisp).
 (defvar *host-obj-prefix*)
 (defvar *target-obj-prefix*)
 
-;;; suffixes for filename stems when cross-compiling. Everything should work
-;;; fine for any arbitrary string values here. With more work maybe we
-;;; could cause these automatically to become the traditional extensions for
-;;; whatever host and target architectures (e.g. ".x86f" or ".axpf") we're
-;;; currently doing. That would make it easier for a human looking at the
-;;; temporary files to figure out what they're for, but it's not necessary for
-;;; the compilation process to work, so we haven't bothered.
-(defvar *host-obj-suffix* ".lisp-obj")
-(defvar *target-obj-suffix* ".lisp-obj")
+;;; 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
+   ;; 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")
 
 ;;; a function of one functional argument, which calls its functional argument
 ;;; in an environment suitable for compiling the target. (This environment
 ;;; able to get rid of this function and use plain RENAME-FILE in the
 ;;; COMPILE-STEM function above. -- WHN 19990321
 (defun rename-file-a-la-unix (x y)
-  (rename-file x
-              ;; (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))))
+    (delete-file path)
+    (rename-file x path)))
 (compile 'rename-file-a-la-unix)
 
 ;;; a wrapper for compilation/assembly, used mostly to centralize
                     (compile-file #'compile-file)
                     ignore-failure-p)
 
-  (format t "~&/entering COMPILE-STEM~%") ; REMOVEME
-
   (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)))
 
     (ensure-directories-exist obj :verbose t)
 
     ;; the temporary output file to the permanent object file.
     (rename-file-a-la-unix tmp-obj obj)
 
-    (format t "~&/nearly done with COMPILE-STEM~%") ; REMOVEME
-
     ;; nice friendly traditional return value
     (pathname obj)))
 (compile 'compile-stem)
     ;; warnings and remove support for this flag. -- WHN 19990323)
     :ignore-failure-p))
 
-(defparameter *stems-and-flags* (read-from-file "stems-and-flags.lisp-expr"))
+(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 ((stems (make-hash-table :test 'equal)))
   (do-stems-and-flags (stem flags)
     (if (gethash stem stems)
-      (error "duplicate stem ~S in stems-and-flags data" stem)
+      (error "duplicate stem ~S in *STEMS-AND-FLAGS*" stem)
       (setf (gethash stem stems) t))
     (let ((set-difference (set-difference flags *expected-stem-flags*)))
       (when set-difference
                                              :sb-propagate-fun-type))))
     (with-additional-nickname ("SB-XC" "SB!XC")
       (funcall fn))))
-;;; FIXME: This COMPILE caused problems in sbcl-0.6.11.26. (bug 93)
-;;;(compile 'in-host-compilation-mode)
+(compile 'in-host-compilation-mode)
 
 ;;; Process a file as source code for the cross-compiler, compiling it
 ;;; (if necessary) in the appropriate environment, then loading it
 ;;; into the cross-compilation host Common lisp.
 (defun host-cload-stem (stem &key ignore-failure-p)
-  (format t "~&/entering HOST-CLOAD-STEM ~S ~S" stem ignore-failure-p) ; REMOVEME
-  (load (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)))))
+  (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)))))
+    (load compiled-filename)))
 (compile 'host-cload-stem)
 
-;;; Like HOST-CLOAD-STEM, except that we don't bother to compile.
+;;; like HOST-CLOAD-STEM, except that we don't bother to compile
 (defun host-load-stem (stem &key ignore-failure-p)
   (declare (ignore ignore-failure-p)) ; (It's only relevant when
   ;; compiling.) KLUDGE: It's untidy to have the knowledge of how to