(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))
(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:
(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
(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)
(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)
;;; 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))
(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.
(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
(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))
\f
;;;; dumping structures