0.7.6.26:
[sbcl.git] / src / cold / shared.lisp
index 5654245..985a444 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
+   #+openmcl ".pfsl"
+   ;; 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
 ;;; COMPILE-STEM function above. -- WHN 19990321
 (defun rename-file-a-la-unix (x y)
 
-  ;; CLISP signals an error when the target file exists, which
-  ;; seems unjustified by the ANSI definition of RENAME-FILE.
-  ;; Work around it.
-  #+clisp (ignore-errors (delete-file 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
     (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.
   (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)))
+(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