diff --git a/compiler/generic/core.lisp b/compiler/generic/core.lisp index 3f76727e3c70ebc357733e8e71a687bbff5690e1..491fe5924bdf99478ae7a4a32ab620f9cf1af884 100644 --- a/compiler/generic/core.lisp +++ b/compiler/generic/core.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/core.lisp,v 1.14 1992/05/22 15:32:18 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/core.lisp,v 1.15 1992/07/11 02:11:49 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -131,12 +131,11 @@ ;;; Dump a component to core. We pass in the assembler fixups, code vector ;;; and node info. ;;; -(defun make-core-component (component segment length trace-table object) +(defun make-core-component (component segment length trace-table fixups object) (declare (type component component) (type index length) - (list trace-table) + (list trace-table fixups) (type core-object object)) - (assert (not (backend-featurep :new-assembler))) (without-gcing (let* ((2comp (component-info component)) (constants (ir2-component-constants 2comp)) @@ -146,8 +145,22 @@ (total-length (+ length (ceiling trace-table-bits vm:byte-bits))) (box-num (- (length constants) vm:code-trace-table-offset-slot)) (code-obj (%primitive allocate-code-object box-num total-length)) - (inst-stream (make-code-instruction-stream code-obj)) - (fixups (assem:emit-code-vector inst-stream segment))) + (trace-table-sap + (cond ((backend-featurep :new-assembler) + (let ((fill-ptr (code-instructions code-obj))) + (new-assem:segment-map-output + segment + #'(lambda (sap amount) + (declare (type system-area-pointer sap) + (type index amount)) + (system-area-copy sap 0 fill-ptr 0 + (* amount vm:byte-bits)) + (setf fill-ptr (sap+ fill-ptr amount)))) + fill-ptr)) + (t + (let ((inst-stream (make-code-instruction-stream code-obj))) + (setf fixups (assem:emit-code-vector inst-stream segment)) + (code-instruction-stream-current inst-stream)))))) (declare (type index box-num total-length)) (do-core-fixups code-obj fixups) @@ -161,8 +174,7 @@ (setf (code-header-ref code-obj vm:code-trace-table-offset-slot) length) (copy-to-system-area trace-table (* vm:vector-data-offset vm:word-bits) - (code-instruction-stream-current inst-stream) 0 - trace-table-bits) + trace-table-sap 0 trace-table-bits) (do ((index vm:code-constants-offset (1+ index))) ((>= index (length constants))) diff --git a/compiler/main.lisp b/compiler/main.lisp index e4efc492b22cc72a69525abf5389e73f2dbf0c02..601e1a29b1a22a83706e8c9422cff7457bbee5dc 100644 --- a/compiler/main.lisp +++ b/compiler/main.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.64 1992/06/12 04:38:25 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.65 1992/07/11 02:11:20 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -305,7 +305,8 @@ (core-object (maybe-mumble "Core") (make-core-component component *code-segment* - length trace-table *compile-object*)) + length trace-table fixups + *compile-object*)) (null)))) (cond ((backend-featurep :new-assembler)