From 10b7c4747f96b6e5d1d285925978962a7eab5ebb Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Wed, 13 Jan 1993 18:09:43 +0000 Subject: [PATCH] Added gengc support. --- compiler/dump.lisp | 45 +++++++++++++++++++++++++++++++-------------- 1 file changed, 31 insertions(+), 14 deletions(-) diff --git a/compiler/dump.lisp b/compiler/dump.lisp index f9bd908f4..354937ea5 100644 --- a/compiler/dump.lisp +++ b/compiler/dump.lisp @@ -7,12 +7,10 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.46 1992/10/10 10:03:43 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.47 1993/01/13 18:09:43 wlott Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.46 1992/10/10 10:03:43 wlott Exp $ -;;; ;;; This file contains stuff that knows about dumping FASL files. ;;; (in-package "C") @@ -449,17 +447,27 @@ (list trace-table) (type index code-length)) (let* ((2comp (component-info component)) (constants (ir2-component-constants 2comp)) - (num-consts (length constants)) + (gengc (backend-featurep :gengc)) + (header-length (length constants)) (trace-table (pack-trace-table trace-table)) (trace-table-length (length trace-table)) (total-length (+ code-length (* trace-table-length 2)))) (collect ((patches)) + ;; Dump the debug info. + (when gengc + (let ((info (debug-info-for-component component)) + (*dump-only-valid-structures* nil)) + (dump-object info file) + (let ((info-handle (dump-pop file))) + (dump-push info-handle file) + (push info-handle (fasl-file-debug-info file))))) + ;; Dump the offset of the trace table. (dump-object code-length file) ;; Dump the constants, noting any :entries that have to be fixed up. (do ((i vm:code-constants-offset (1+ i))) - ((>= i num-consts)) + ((>= i header-length)) (let ((entry (aref constants i))) (etypecase entry (constant @@ -484,14 +492,20 @@ (dump-fop 'lisp::fop-misc-trap file))))) ;; Dump the debug info. - (let ((info (debug-info-for-component component)) - (*dump-only-valid-structures* nil)) - (dump-object info file) - (let ((info-handle (dump-pop file))) - (dump-push info-handle file) - (push info-handle (fasl-file-debug-info file)))) - - (let ((num-consts (- num-consts vm:code-trace-table-offset-slot))) + (unless gengc + (let ((info (debug-info-for-component component)) + (*dump-only-valid-structures* nil)) + (dump-object info file) + (let ((info-handle (dump-pop file))) + (dump-push info-handle file) + (push info-handle (fasl-file-debug-info file))))) + + (let ((num-consts (if gengc + (- header-length vm:code-debug-info-slot) + (- header-length vm:code-trace-table-offset-slot))) + (total-length (if gengc + (ceiling total-length 4) + total-length))) (cond ((and (< num-consts #x100) (< total-length #x10000)) (dump-fop 'lisp::fop-small-code file) (dump-byte num-consts file) @@ -515,7 +529,10 @@ (defun dump-assembler-routines (code-segment length fixups routines file) (dump-fop 'lisp::fop-assembler-code file) - (dump-unsigned-32 length file) + (dump-unsigned-32 (if (backend-featurep :gengc) + (ceiling length 4) + length) + file) (flush-fasl-file-buffer file) (let ((stream (fasl-file-stream file))) (new-assem:segment-map-output -- GitLab