0.7.1.32:
[sbcl.git] / src / cold / shared.lisp
index 40f1eba..a55036c 100644 (file)
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 
-;;; GC tuning has little effect on the x86 due to the generational
-;;; collector.  For the older stop & copy collector, it assuredly
-;;; does.  GC time is proportional to the amount of non-garbage
-;;; needing collection and copying; when the application involved is
-;;; the SBCL compiler, it doesn't take any longer to collect 20 Mb than
-;;; to collect 2 Mb. -dan, 20000819
-;;;
-;;; Actually, tweaking *BYTES-CONSED-BETWEEN-GCS* to 20Mb instead of
-;;; the default 2 seemed to make SBCL rebuild O(25%) faster on my 256
-;;; Mb K6/3, so I think it does have some effect on X86/GENCGC. I
-;;; haven't looked into why this would be, though. Also, I'm afraid
-;;; that using 20Mb here might be unfriendly to people using more-reasonable
-;;; machines (like old laptops with 48Mb of memory..) so I've
-;;; suppressed this tweak except for Alpha. -- WHN 2001-05-11
-#+(and sbcl alpha) ; SBCL/Alpha uses stop-and-copy, and Alphas have lotso RAM.
-(progn
-  (sb-ext:gc-off)
-  (setf (sb-ext:bytes-consed-between-gcs) (* 20 (expt 10 6)))
-  (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)
   (format t
          "target features *SHEBANG-FEATURES*=~@<~S~:>~%"
          *shebang-features*))
+
+(defvar *shebang-backend-subfeatures*
+  (let* ((default-subfeatures nil)
+        (customizer-file-name "customize-backend-subfeatures.lisp")
+        (customizer (if (probe-file customizer-file-name)
+                        (compile nil 
+                                 (read-from-file customizer-file-name))
+                        #'identity)))
+    (funcall customizer default-subfeatures)))
+(export '*shebang-backend-subfeatures*)
+(let ((*print-length* nil)
+      (*print-level* nil))
+  (format t
+         "target backend-subfeatures *SHEBANG-BACKEND-FEATURES*=~@<~S~:>~%"
+         *shebang-backend-subfeatures*))
 \f
 ;;;; cold-init-related PACKAGE and SYMBOL tools
 
 ;;; values of special variables such as *** and +, anyway). Set up
 ;;; machinery to warn us when/if we change it.
 ;;;
-;;; FIXME: All this machinery should probably be conditional on
-;;; #!+SB-SHOW, i.e. we should be able to wrap #!+SB-SHOW around both
-;;; the LOAD and the DEFVAR here. 
-(load "src/cold/snapshot.lisp")
-(defvar *cl-snapshot* (take-snapshot "COMMON-LISP"))
+;;; All code depending on this is itself dependent on #!+SB-SHOW.
+#!+sb-show
+(progn
+  (load "src/cold/snapshot.lisp")
+  (defvar *cl-snapshot* (take-snapshot "COMMON-LISP")))
 \f
 ;;;; master list of source files and their properties
 
     ;; 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