X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Ftarget-core.lisp;h=4168eba6cd4ea647b88a595e861914dd0c7dc70f;hb=361040122aed4fd4e24bd014818955e5e3028a8f;hp=aedc13141ee052d51e9d91c4cfece77096efa4e6;hpb=d40a76606c86722b0aef8179155f9f2840739b72;p=sbcl.git diff --git a/src/compiler/generic/target-core.lisp b/src/compiler/generic/target-core.lisp index aedc131..4168eba 100644 --- a/src/compiler/generic/target-core.lisp +++ b/src/compiler/generic/target-core.lisp @@ -17,29 +17,29 @@ (in-package "SB!C") ;;; Make a function entry, filling in slots from the ENTRY-INFO. -(defun make-function-entry (entry code-obj object) - (declare (type entry-info entry) (type core-object object)) - (let ((offset (label-position (entry-info-offset entry)))) +(defun make-fun-entry (entry-info code-obj object) + (declare (type entry-info entry-info) (type core-object object)) + (let ((offset (label-position (entry-info-offset entry-info)))) (declare (type index offset)) (unless (zerop (logand offset sb!vm:lowtag-mask)) (error "Unaligned function object, offset = #X~X." offset)) - (let ((res (%primitive compute-function code-obj offset))) + (let ((res (%primitive compute-fun code-obj offset))) (setf (%simple-fun-self res) res) (setf (%simple-fun-next res) (%code-entry-points code-obj)) (setf (%code-entry-points code-obj) res) - (setf (%simple-fun-name res) (entry-info-name entry)) - (setf (%simple-fun-arglist res) (entry-info-arguments entry)) - (setf (%simple-fun-type res) (entry-info-type entry)) + (setf (%simple-fun-name res) (entry-info-name entry-info)) + (setf (%simple-fun-arglist res) (entry-info-arguments entry-info)) + (setf (%simple-fun-type res) (entry-info-type entry-info)) - (note-fun entry res object)))) + (note-fun entry-info res object)))) ;;; 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 fixups object) +(defun make-core-component (component segment length trace-table fixup-notes object) (declare (type component component) (type sb!assem:segment segment) (type index length) - (list trace-table fixups) + (list trace-table fixup-notes) (type core-object object)) (without-gcing (let* ((2comp (component-info component)) @@ -51,15 +51,6 @@ (ceiling trace-table-bits sb!vm:n-byte-bits))) (box-num (- (length constants) sb!vm:code-trace-table-offset-slot)) (code-obj - ;; FIXME: In CMU CL the X86 behavior here depended on - ;; *ENABLE-DYNAMIC-SPACE-CODE*, but in SBCL we always use - ;; dynamic space code, so we could make - ;; ALLOCATE-DYNAMIC-CODE-OBJECT more parallel with - ;; ALLOCATE-CODE-OBJECT and remove this confusing - ;; read-macro conditionalization. - #!+x86 - (%primitive allocate-dynamic-code-object box-num total-length) - #!-x86 (%primitive allocate-code-object box-num total-length)) (fill-ptr (code-instructions code-obj))) (declare (type index box-num total-length)) @@ -71,10 +62,10 @@ (copy-byte-vector-to-system-area v fill-ptr) (setf fill-ptr (sap+ fill-ptr (length v))))) - (do-core-fixups code-obj fixups) + (do-core-fixups code-obj fixup-notes) (dolist (entry (ir2-component-entries 2comp)) - (make-function-entry entry code-obj object)) + (make-fun-entry entry code-obj object)) (sb!vm:sanctify-for-execution code-obj) @@ -101,8 +92,7 @@ (list (ecase (car const) (:entry - (reference-core-function code-obj index - (cdr const) object)) + (reference-core-fun code-obj index (cdr const) object)) (:fdefinition (setf (code-header-ref code-obj index) (fdefinition-object (cdr const) t))))))))))