X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fshared.lisp;h=9fe9f42721b15dcd5363b335e52fbef601fbc7ee;hb=08b0e98910af7154f2afe68f2f16618754f74461;hp=f523aa8ae436acba6422874ce46b519965419720;hpb=ff92598854bf7cae8d57fe49cef4d9a98e1ab345;p=sbcl.git

diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp
index f523aa8..9fe9f42 100644
--- a/src/cold/shared.lisp
+++ b/src/cold/shared.lisp
@@ -23,14 +23,6 @@
 
 (in-package "SB-COLD")
 
-;;; FIXME: This is embarassing -- SBCL violates SBCL style-package locks
-;;; on the host lisp. Rather then find and fix all cases right now,
-;;; let's just remain self-hosting. The problems at least involve
-;;; a few defvars and local macros with names in the CL package.
-#+(and sbcl sb-package-locks)
-(dolist (p (list-all-packages))
-  (sb-ext:unlock-package p))
-
 ;;; prefixes for filename stems when cross-compiling. These are quite arbitrary
 ;;; (although of course they shouldn't collide with anything we don't want to
 ;;; write over). In particular, they can be either relative path names (e.g.
@@ -138,6 +130,7 @@
 		     (src-prefix "")
 		     (src-suffix ".lisp")
 		     (compile-file #'compile-file)
+		     trace-file
 		     ignore-failure-p)
 
   (declare (type function compile-file))
@@ -178,7 +171,13 @@
     (setf tmp-obj
 	  ;; (Note that this idiom is taken from the ANSI
 	  ;; documentation for TRUENAME.)
-	  (with-open-file (stream tmp-obj :direction :output)
+	  (with-open-file (stream tmp-obj
+                                  :direction :output
+                                  ;; Compilation would overwrite the
+                                  ;; temporary object anyway and overly
+                                  ;; strict implementations default
+                                  ;; to :ERROR.
+                                  :if-exists :supersede)
 	    (close stream)
 	    (truename stream)))
     ;; and some compilers (e.g. OpenMCL) will complain if they're
@@ -186,7 +185,7 @@
     ;; 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)
              (format stream "Recompile file ~S" src))
@@ -195,7 +194,10 @@
       (tagbody
        retry-compile-file
          (multiple-value-bind (output-truename warnings-p failure-p)
-             (funcall compile-file src :output-file tmp-obj)
+            (if trace-file
+                (funcall compile-file src :output-file tmp-obj
+                         :trace-file t)
+                (funcall compile-file src :output-file tmp-obj ))
            (declare (ignore warnings-p))
            (cond ((not output-truename)
                   (error "couldn't compile ~S" src))
@@ -303,6 +305,12 @@
     ;; SBCL. ("not target code" -- but still presumably host code,
     ;; used to support the cross-compilation process)
     :not-target
+    ;; meaning: The #'COMPILE-STEM argument :TRACE-FILE should be T.
+    ;; When the compiler is SBCL's COMPILE-FILE or something like it,
+    ;; compiling "foo.lisp" will generate "foo.trace" which contains lots
+    ;; of exciting low-level information about representation selection,
+    ;; VOPs used by the compiler, and bits of assembly.
+    :trace-file
     ;; meaning: This file is to be processed with the SBCL assembler,
     ;; not COMPILE-FILE. (Note that this doesn't make sense unless
     ;; :NOT-HOST is also set, since the SBCL assembler doesn't exist
@@ -383,12 +391,13 @@
 
 ;;; Run the cross-compiler on a file in the source directory tree to
 ;;; produce a corresponding file in the target object directory tree.
-(defun target-compile-stem (stem &key assem-p ignore-failure-p)
+(defun target-compile-stem (stem &key assem-p ignore-failure-p trace-file)
   (funcall *in-target-compilation-mode-fn*
 	   (lambda ()
 	     (compile-stem stem
 			   :obj-prefix *target-obj-prefix*
 			   :obj-suffix *target-obj-suffix*
+                          :trace-file trace-file
 			   :ignore-failure-p ignore-failure-p
 			   :compile-file (if assem-p
 					     *target-assemble-file*