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)