X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdump.lisp;h=98d482b1897cafaba61b9634711de36d00128473;hb=f61bddabbb69f1347b81b8ab76e709635a7a0739;hp=ba1aaa29e3e8e3f89be8ddd089f99d2de96b197e;hpb=aa2dc9529460ea0d9c99998dc87283fc1a43e808;p=sbcl.git

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index ba1aaa2..98d482b 100644
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -544,8 +544,12 @@
        (declare (double-float im))
        (dump-unsigned-32 (double-float-low-bits im) file)
        (dump-integer-as-n-bytes (double-float-high-bits im) 4 file)))
-    #!+(and long-float (not sb-xc))
+    #!+long-float
     ((complex long-float)
+     ;; (There's no easy way to mix #!+LONG-FLOAT and #-SB-XC-HOST
+     ;; conditionalization at read time, so we do this SB-XC-HOST
+     ;; conditional at runtime instead.)
+     #+sb-xc-host (error "can't dump COMPLEX-LONG-FLOAT in cross-compiler")
      (dump-fop 'fop-complex-long-float file)
      (dump-long-float (realpart x) file)
      (dump-long-float (imagpart x) file))
@@ -902,15 +906,6 @@
       (error "internal error, code-length=~D, nwritten=~D"
 	     code-length
 	     nwritten)))
-  ;; KLUDGE: It's not clear what this is trying to do, but it looks as
-  ;; though it's an implicit undocumented dependence on a 4-byte
-  ;; wordsize which could be painful in porting. Note also that there
-  ;; are other undocumented modulo-4 things scattered throughout the
-  ;; code and conditionalized with GENGC, and I don't know what those
-  ;; do either. -- WHN 19990323
-  #!+gengc (unless (zerop (logand code-length 3))
-	     (dotimes (i (- 4 (logand code-length 3)))
-	       (dump-byte 0 fasl-output)))
   (values))
 
 ;;; Dump all the fixups. Currently there are three flavors of fixup:
@@ -997,15 +992,6 @@
 
     (collect ((patches))
 
-      ;; Dump the debug info.
-      #!+gengc
-      (let ((info (sb!c::debug-info-for-component component))
-	    (*dump-only-valid-structures* nil))
-	(dump-object info fasl-output)
-	(let ((info-handle (dump-pop fasl-output)))
-	  (dump-push info-handle fasl-output)
-	  (push info-handle (fasl-output-debug-info fasl-output))))
-
       ;; Dump the offset of the trace table.
       (dump-object code-length fasl-output)
       ;; FIXME: As long as we don't have GENGC, the trace table is
@@ -1044,7 +1030,6 @@
 	     (dump-fop 'fop-misc-trap fasl-output)))))
 
       ;; Dump the debug info.
-      #!-gengc
       (let ((info (sb!c::debug-info-for-component component))
 	    (*dump-only-valid-structures* nil))
 	(dump-object info fasl-output)
@@ -1052,12 +1037,7 @@
 	  (dump-push info-handle fasl-output)
 	  (push info-handle (fasl-output-debug-info fasl-output))))
 
-      (let ((num-consts #!+gengc (- header-length
-				    sb!vm:code-debug-info-slot)
-			#!-gengc (- header-length
-				    sb!vm:code-trace-table-offset-slot))
-	    (total-length #!+gengc (ceiling total-length 4)
-			  #!-gengc total-length))
+      (let ((num-consts (- header-length sb!vm:code-trace-table-offset-slot)))
 	(cond ((and (< num-consts #x100) (< total-length #x10000))
 	       (dump-fop 'fop-small-code fasl-output)
 	       (dump-byte num-consts fasl-output)
@@ -1105,10 +1085,6 @@
 ;;; Dump a function-entry data structure corresponding to ENTRY to
 ;;; FILE. CODE-HANDLE is the table offset of the code object for the
 ;;; component.
-;;;
-;;; If the entry is a DEFUN, then we also dump a FOP-FSET so that the
-;;; cold loader can instantiate the definition at cold-load time,
-;;; allowing forward references to functions in top-level forms.
 (defun dump-one-entry (entry code-handle file)
   (declare (type sb!c::entry-info entry) (type index code-handle)
 	   (type fasl-output file))
@@ -1119,12 +1095,7 @@
     (dump-object (sb!c::entry-info-type entry) file)
     (dump-fop 'fop-function-entry file)
     (dump-unsigned-32 (label-position (sb!c::entry-info-offset entry)) file)
-    (let ((handle (dump-pop file)))
-      (when (and name (or (symbolp name) (listp name)))
-	(dump-object name file)
-	(dump-push handle file)
-	(dump-fop 'fop-fset file))
-      handle)))
+    (dump-pop file)))
 
 ;;; Alter the code object referenced by CODE-HANDLE at the specified
 ;;; OFFSET, storing the object referenced by ENTRY-HANDLE.
@@ -1205,6 +1176,9 @@
     (dump-object nil file)
 
     ;; Dump the constants.
+    ;;
+    ;; FIXME: There's a family resemblance between this and the
+    ;; corresponding code in DUMP-CODE-OBJECT. Could some be shared?
     (dotimes (i (length constants))
       (let ((entry (aref constants i)))
 	(etypecase entry
@@ -1297,34 +1271,51 @@
 	    (remhash info patch-table))))))
   (values))
 
-;;; Dump a FOP-FUNCALL to call an already dumped top-level lambda at
-;;; load time.
-(defun fasl-dump-top-level-lambda-call (fun file)
-  (declare (type sb!c::clambda fun) (type fasl-output file))
+(defun dump-push-previously-dumped-fun (fun fasl-output)
+  (declare (type sb!c::clambda fun))
   (let ((handle (gethash (sb!c::leaf-info fun)
-			 (fasl-output-entry-table file))))
+			 (fasl-output-entry-table fasl-output))))
     (aver handle)
-    (dump-push handle file)
-    (dump-fop 'fop-funcall-for-effect file)
-    (dump-byte 0 file))
+    (dump-push handle fasl-output))
   (values))
 
+;;; Dump a FOP-FUNCALL to call an already-dumped top-level lambda at
+;;; load time.
+(defun fasl-dump-top-level-lambda-call (fun fasl-output)
+  (declare (type sb!c::clambda fun))
+  (dump-push-previously-dumped-fun fun fasl-output)
+  (dump-fop 'fop-funcall-for-effect fasl-output)
+  (dump-byte 0 fasl-output)
+  (values))
+
+;;; Dump a FOP-FSET to arrange static linkage (at cold init) between
+;;; FUN-NAME and the already-dumped function whose dump handle is
+;;; FUN-DUMP-HANDLE.
+#+sb-xc-host
+(defun fasl-dump-cold-fset (fun-name fun-dump-handle fasl-output)
+  (declare (type fixnum fun-dump-handle))
+  (aver (legal-function-name-p fun-name))
+  (dump-non-immediate-object fun-name fasl-output)
+  (dump-push fun-dump-handle fasl-output)
+  (dump-fop 'fop-fset fasl-output)
+  (values))
+    
 ;;; Compute the correct list of DEBUG-SOURCE structures and backpatch
 ;;; all of the dumped DEBUG-INFO structures. We clear the
 ;;; FASL-OUTPUT-DEBUG-INFO, so that subsequent components with
 ;;; different source info may be dumped.
-(defun fasl-dump-source-info (info file)
-  (declare (type sb!c::source-info info) (type fasl-output file))
+(defun fasl-dump-source-info (info fasl-output)
+  (declare (type sb!c::source-info info))
   (let ((res (sb!c::debug-source-for-info info))
 	(*dump-only-valid-structures* nil))
-    (dump-object res file)
-    (let ((res-handle (dump-pop file)))
-      (dolist (info-handle (fasl-output-debug-info file))
-	(dump-push res-handle file)
-	(dump-fop 'fop-structset file)
-	(dump-unsigned-32 info-handle file)
-	(dump-unsigned-32 2 file))))
-  (setf (fasl-output-debug-info file) nil)
+    (dump-object res fasl-output)
+    (let ((res-handle (dump-pop fasl-output)))
+      (dolist (info-handle (fasl-output-debug-info fasl-output))
+	(dump-push res-handle fasl-output)
+	(dump-fop 'fop-structset fasl-output)
+	(dump-unsigned-32 info-handle fasl-output)
+	(dump-unsigned-32 2 fasl-output))))
+  (setf (fasl-output-debug-info fasl-output) nil)
   (values))
 
 ;;;; dumping structures