Skip to content
Snippets Groups Projects
Commit e5c305b5 authored by wlott's avatar wlott
Browse files

Changed byte-compiler stuff to use new-assembler.

parent de434655
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/core.lisp,v 1.15 1992/07/11 02:11:49 wlott Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/core.lisp,v 1.16 1992/07/22 23:35:36 wlott Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -197,21 +197,29 @@ ...@@ -197,21 +197,29 @@
;;; MAKE-CORE-BYTE-COMPONENT -- Interface. ;;; MAKE-CORE-BYTE-COMPONENT -- Interface.
;;; ;;;
(defun make-core-byte-component (byte-output constants xeps object) (defun make-core-byte-component (segment constants xeps object)
(declare (type byte-output byte-output) (declare (type new-assem:segment segment)
(type vector constants) (type vector constants)
(type list xeps) (type list xeps)
(type core-object object)) (type core-object object))
(without-gcing (without-gcing
(let* ((num-constants (length constants)) (let* ((num-constants (length constants))
(length (byte-output-length byte-output)) (length (byte-output-length segment))
(code-obj (%primitive allocate-code-object (code-obj (%primitive allocate-code-object
(the index (1+ num-constants)) (the index (1+ num-constants))
length))) length))
(declare (type index length)) (fill-ptr (code-instructions code-obj)))
(declare (type index length)
(type system-area-pointer fill-ptr))
(output-byte-output byte-output (new-assem:segment-map-output
(make-code-instruction-stream code-obj)) 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))))
(dolist (noise xeps) (dolist (noise xeps)
(let ((xep (cdr noise))) (let ((xep (cdr noise)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment