mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
Futz with the first two words in code objects
With this change, the code header word contains the complete object size. The boxed portion size (measured in bytes) is in the following word. As evident from the number of deleted lines, it is easier to do pointer arithmetic this way because all of the COMPUTE-FUN vops want bytes, not words. For cheneygc, all of the backend-specific allocate-code-object vops are gone, and the allocator essentially reduces to VAR-ALLOC. For gencgc the change is similar but we still go through C code for reasons. In either case, object sizing is trivial, involving no adding or rounding.
This commit is contained in:
Douglas Katzman
parent
fbaa1f8989
commit
1e72a4ce7b
|
|
@ -1729,6 +1729,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
|
|||
"CODE-COMPONENT" "CODE-COMPONENT-P"
|
||||
"CODE-HEADER-REF" "CODE-HEADER-SET" "CODE-HEADER-WORDS"
|
||||
"CODE-INSTRUCTIONS" "CODE-N-UNBOXED-DATA-BYTES"
|
||||
"CODE-OBJECT-SIZE"
|
||||
"COERCE-SYMBOL-TO-FUN"
|
||||
"COERCE-TO-FUN" "COERCE-TO-LEXENV" "COERCE-TO-LIST"
|
||||
"COERCE-TO-VALUES" "COERCE-TO-VECTOR"
|
||||
|
|
@ -3096,9 +3097,10 @@ structure representations"
|
|||
"CLOSURE-FUN-SLOT"
|
||||
"CLOSURE-WIDETAG"
|
||||
"CLOSURE-INFO-OFFSET"
|
||||
"CODE-COMPONENT-SIZE"
|
||||
"CODE-CODE-SIZE-SLOT" "CODE-CONSTANTS-OFFSET"
|
||||
"CODE-BOXED-SIZE-SLOT"
|
||||
"CODE-CONSTANTS-OFFSET"
|
||||
"CODE-DEBUG-INFO-SLOT"
|
||||
"CODE-HEADER-SIZE-SHIFT"
|
||||
"CODE-HEADER-WIDETAG" "COMPLEX-ARRAY-WIDETAG"
|
||||
"COMPLEX-BIT-VECTOR-WIDETAG" "COMPLEX-DOUBLE-FLOAT-FILLER-SLOT"
|
||||
"COMPLEX-DOUBLE-FLOAT-IMAG-SLOT" "COMPLEX-DOUBLE-FLOAT-REAL-SLOT"
|
||||
|
|
|
|||
|
|
@ -56,7 +56,7 @@
|
|||
(sb-thread:make-mutex :name "Immobile space"))
|
||||
|
||||
(eval-when (:compile-toplevel)
|
||||
(assert (eql code-code-size-slot 1))
|
||||
(assert (eql code-boxed-size-slot 1))
|
||||
(assert (eql code-debug-info-slot 2)))
|
||||
|
||||
(define-alien-variable "varyobj_holes" long)
|
||||
|
|
@ -104,16 +104,12 @@
|
|||
|
||||
(declaim (inline hole-size))
|
||||
(defun hole-size (hole-address) ; in bytes
|
||||
(the (and fixnum unsigned-byte)
|
||||
(sap-ref-lispobj (int-sap hole-address) (ash code-code-size-slot word-shift))))
|
||||
(ash (sap-ref-32 (int-sap hole-address) 4) word-shift))
|
||||
|
||||
(declaim (inline (setf hole-size)))
|
||||
(defun (setf hole-size) (new-size hole) ; NEW-SIZE is in bytes
|
||||
;; FIXME: (SETF SET-REF-LISPOBJ) does not accept a fixnum
|
||||
;; because 'any-reg' is not an allowed storage class.
|
||||
(setf (sap-ref-word (int-sap hole) (ash code-code-size-slot word-shift))
|
||||
;; 0 boxed words, so %CODE-CODE-SIZE covers everything.
|
||||
(ash new-size n-fixnum-tag-bits)))
|
||||
(setf (sap-ref-32 (int-sap hole) 4) (ash new-size (- word-shift)))
|
||||
new-size)
|
||||
|
||||
(declaim (inline hole-end-address))
|
||||
(defun hole-end-address (hole-address)
|
||||
|
|
@ -423,8 +419,9 @@
|
|||
|
||||
(defun alloc-immobile-trampoline ()
|
||||
(values (%primitive alloc-immobile-fixedobj other-pointer-lowtag 6
|
||||
#.(make-code-header-word 4) ; boxed word count
|
||||
(ash (* 2 n-word-bytes) n-fixnum-tag-bits))))
|
||||
;; total word count
|
||||
(logior (ash 6 code-header-size-shift) code-header-widetag)
|
||||
(* 4 n-word-bytes)))) ; boxed size in bytes
|
||||
|
||||
;;; Test whether there is room to allocate NBYTES.
|
||||
;;; This only looks at the space in the frontier, not the free space list.
|
||||
|
|
@ -463,18 +460,20 @@
|
|||
;; This uses ATOMIC-INCF to get automatic wraparound, not because atomicity
|
||||
;; makes things deterministic per se. If multiple threads are allocating
|
||||
;; code objects, the order is unpredictable.
|
||||
(let ((serialno (atomic-incf sb-fasl::*code-serialno*)))
|
||||
;; FIXME: remove this use of WITHOUT-GCing and use pseudo-atomic.
|
||||
(let ((total-words (align-up (+ boxed (ceiling unboxed n-word-bytes)) 2))
|
||||
(serialno (atomic-incf sb-fasl::*code-serialno*)))
|
||||
;; FIXME: it seems possible now to use pseudo-atomic instead of
|
||||
;; without-gcing, except in the immobile code case.
|
||||
(without-gcing
|
||||
(block nil
|
||||
#!+immobile-code
|
||||
(when (member space '(:immobile :auto))
|
||||
(let ((code (allocate-immobile-bytes
|
||||
(align-up (+ (* boxed n-word-bytes) unboxed)
|
||||
(* 2 n-word-bytes))
|
||||
(make-code-header-word boxed)
|
||||
(ash total-words word-shift)
|
||||
(logior (ash total-words code-header-size-shift)
|
||||
code-header-widetag)
|
||||
(logior (logand (ash serialno 32) most-positive-word)
|
||||
(ash unboxed n-fixnum-tag-bits))
|
||||
(* boxed n-word-bytes))
|
||||
other-pointer-lowtag
|
||||
(eq space :immobile))))
|
||||
(unless (eql code 0)
|
||||
|
|
@ -485,20 +484,22 @@
|
|||
(alien-funcall (extern-alien "alloc_code_object"
|
||||
(function unsigned (unsigned 32)
|
||||
(unsigned 32) (unsigned 32)))
|
||||
boxed unboxed serialno)))))
|
||||
#!-gencgc
|
||||
(%primitive allocate-code-object boxed unboxed))
|
||||
|
||||
#!+64-bit
|
||||
(progn
|
||||
(declaim (inline %code-code-size))
|
||||
(defun %code-serialno (code) ; return high 4 bytes
|
||||
(ash (%%code-code-size code) (- n-fixnum-tag-bits 32)))
|
||||
(defun %code-code-size (code) ; clip to max imposed by allocate-code-object
|
||||
(ldb (byte 22 0) (%%code-code-size code))))
|
||||
|
||||
;; Placeholder function so that the PRINT-OBJECT method doesn't
|
||||
;; have to worry about whether this accessor exists.
|
||||
#!-64-bit
|
||||
(defun %code-serialno (code)
|
||||
(declare (ignore code)))
|
||||
total-words boxed serialno)))))
|
||||
#!+cheneygc
|
||||
;; Something like this could work for gencgc, except there we have a different
|
||||
;; problem - that of segregating code from data.
|
||||
(let* ((total-words
|
||||
(the index (align-up (+ boxed (ceiling unboxed n-word-bytes)) 2)))
|
||||
(code
|
||||
(%primitive var-alloc total-words 'alloc-code
|
||||
;; subtract 1 because var-alloc always adds 1 word
|
||||
;; for the header, which is not right for code objects.
|
||||
-1 code-header-widetag other-pointer-lowtag)))
|
||||
;; The 1st slot beyond the header stores the boxed header size in bytes
|
||||
;; as an untagged number, which on 32-bit architectures has the same
|
||||
;; representation as a tagged value denoting a count in words.
|
||||
;; 64-bit architectures do not use this code path.
|
||||
#!+64-bit (bug "No can do")
|
||||
(setf (code-header-ref code code-boxed-size-slot) boxed
|
||||
(code-header-ref code code-debug-info-slot) nil)
|
||||
code))
|
||||
|
|
|
|||
|
|
@ -136,7 +136,7 @@
|
|||
;; Compute code bounds
|
||||
(let* ((code-begin (- (get-lisp-obj-address code)
|
||||
sb-vm:other-pointer-lowtag))
|
||||
(code-end (+ code-begin (sb-vm::code-component-size code))))
|
||||
(code-end (+ code-begin (sb-vm::code-object-size code))))
|
||||
;; Loop over function's assembly code
|
||||
(dx-flet ((process-inst (chunk inst)
|
||||
(when (or (eq inst jmp) (eq inst call))
|
||||
|
|
|
|||
|
|
@ -194,10 +194,6 @@
|
|||
(round-to-dualword (+ (* vector-data-offset n-word-bytes)
|
||||
n-data-octets)))))
|
||||
|
||||
(defun code-component-size (x) ; in bytes
|
||||
(declare (code-component x))
|
||||
(round-to-dualword (+ (* (code-header-words x) n-word-bytes) (%code-code-size x))))
|
||||
|
||||
(defun primitive-object-size (object)
|
||||
"Return number of bytes of heap or stack directly consumed by OBJECT"
|
||||
(if (is-lisp-pointer (get-lisp-obj-address object))
|
||||
|
|
@ -230,7 +226,7 @@
|
|||
(nth-value 2 (reconstitute-vector
|
||||
object room-info))))))
|
||||
(code-component
|
||||
(return-from primitive-object-size (code-component-size object)))
|
||||
(return-from primitive-object-size (code-object-size object)))
|
||||
(t
|
||||
;; Other things (symbol, fdefn, value-cell, etc)
|
||||
;; don't have a sizer, so use GET-HEADER-DATA
|
||||
|
|
@ -290,7 +286,7 @@
|
|||
(let ((c (tagged-object other-pointer-lowtag)))
|
||||
(values c
|
||||
code-header-widetag
|
||||
(code-component-size c))))
|
||||
(code-object-size c))))
|
||||
|
||||
(:other
|
||||
(values (tagged-object other-pointer-lowtag)
|
||||
|
|
|
|||
|
|
@ -350,11 +350,6 @@
|
|||
|
||||
;;;; CODE-COMPONENT
|
||||
|
||||
(declaim (inline code-header-words))
|
||||
(defun code-header-words (code)
|
||||
#!+64-bit (ash (get-header-data code) -24)
|
||||
#!-64-bit (ldb (byte 22 0) (get-header-data code)))
|
||||
|
||||
(defun %code-entry-points (code-obj) ; DO NOT USE IN NEW CODE
|
||||
(%code-entry-point code-obj 0))
|
||||
|
||||
|
|
@ -372,7 +367,8 @@
|
|||
(declaim (inline code-fun-table-trailer-word))
|
||||
(defun code-fun-table-trailer-word (code-obj)
|
||||
(with-pinned-objects (code-obj)
|
||||
(sap-ref-16 (code-instructions code-obj) (- (%code-code-size code-obj) 2))))
|
||||
(sap-ref-16 (int-sap (get-lisp-obj-address code-obj))
|
||||
(- (code-object-size code-obj) 2 sb-vm:other-pointer-lowtag))))
|
||||
|
||||
;;; Return the number of simple-funs in CODE-OBJ
|
||||
;;; Keep in sync with C function code_n_funs()
|
||||
|
|
@ -390,8 +386,9 @@
|
|||
(declare ((unsigned-byte 16) fun-index))
|
||||
;; subtracting the size of trailing uint16_t puts us one byte beyond
|
||||
;; the last fun-index, so subtract an extra uint32_t as well.
|
||||
(sap-ref-32 (code-instructions code-obj)
|
||||
(- (%code-code-size code-obj) (* 4 fun-index) 8)))
|
||||
(sap-ref-32 (int-sap (get-lisp-obj-address code-obj))
|
||||
(- (code-object-size code-obj) (* 4 fun-index) 8
|
||||
sb-vm:other-pointer-lowtag)))
|
||||
|
||||
;;; Subtract from %CODE-CODE-SIZE the number of trailing data bytes which aren't
|
||||
;;; machine instructions. It's generally ok to use either accessor if searching
|
||||
|
|
|
|||
|
|
@ -86,8 +86,6 @@
|
|||
(def value-cell-ref)
|
||||
(def %caller-frame ())
|
||||
(def %caller-pc ())
|
||||
;; %code-code-size is an inline fun on 64-bit
|
||||
#-64-bit (def %code-code-size)
|
||||
(def %code-debug-info)
|
||||
#+(or x86 immobile-space) (def sb-vm::%code-fixups)
|
||||
|
||||
|
|
|
|||
|
|
@ -76,31 +76,6 @@
|
|||
|
||||
;;;; special purpose inline allocators
|
||||
|
||||
(define-vop (allocate-code-object)
|
||||
(:args (boxed-arg :scs (any-reg) :to :save)
|
||||
(unboxed-arg :scs (any-reg)))
|
||||
(:results (result :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:temporary (:scs (any-reg) :from (:argument 0)) boxed)
|
||||
(:temporary (:scs (non-descriptor-reg)) unboxed)
|
||||
(:generator 100
|
||||
(inst li (lognot lowtag-mask) ndescr)
|
||||
(inst lda boxed 0 boxed-arg)
|
||||
(inst srl unboxed-arg word-shift unboxed)
|
||||
(inst lda unboxed lowtag-mask unboxed)
|
||||
(inst and unboxed ndescr unboxed)
|
||||
(inst sll boxed (- n-widetag-bits word-shift) ndescr)
|
||||
(inst bis ndescr code-header-widetag ndescr)
|
||||
|
||||
(pseudo-atomic ()
|
||||
(inst bis alloc-tn other-pointer-lowtag result)
|
||||
(storew ndescr result 0 other-pointer-lowtag)
|
||||
(storew unboxed-arg result code-code-size-slot other-pointer-lowtag)
|
||||
(inst addq alloc-tn boxed alloc-tn)
|
||||
(inst addq alloc-tn unboxed alloc-tn))
|
||||
|
||||
(storew null-tn result code-debug-info-slot other-pointer-lowtag)))
|
||||
|
||||
(define-vop (make-fdefn)
|
||||
(:policy :fast-safe)
|
||||
(:translate make-fdefn)
|
||||
|
|
@ -193,9 +168,14 @@
|
|||
(:generator 6
|
||||
(inst lda bytes (* (1+ words) n-word-bytes) extra)
|
||||
(inst sll bytes (- n-widetag-bits 2) header)
|
||||
(inst lda header (+ (ash -2 n-widetag-bits) type) header)
|
||||
(inst srl bytes n-lowtag-bits bytes)
|
||||
(inst sll bytes n-lowtag-bits bytes)
|
||||
;; The specified EXTRA value is the exact value placed in the header
|
||||
;; as the word count when allocating code.
|
||||
(cond ((= type code-header-widetag)
|
||||
(inst lda header type header))
|
||||
(t
|
||||
(inst lda header (+ (ash -2 n-widetag-bits) type) header)
|
||||
(inst srl bytes n-lowtag-bits bytes)
|
||||
(inst sll bytes n-lowtag-bits bytes)))
|
||||
(pseudo-atomic ()
|
||||
(inst bis alloc-tn lowtag result)
|
||||
(storew header result 0 lowtag)
|
||||
|
|
|
|||
|
|
@ -177,9 +177,7 @@
|
|||
(:results (func :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:generator 10
|
||||
(loadw ndescr code 0 other-pointer-lowtag)
|
||||
(inst srl ndescr n-widetag-bits ndescr)
|
||||
(inst sll ndescr word-shift ndescr)
|
||||
(loadw ndescr code code-boxed-size-slot other-pointer-lowtag)
|
||||
(inst addq ndescr offset ndescr)
|
||||
(inst subq ndescr (- other-pointer-lowtag fun-pointer-lowtag) ndescr)
|
||||
(inst addq code ndescr func)))
|
||||
|
|
|
|||
|
|
@ -68,29 +68,6 @@
|
|||
(:variant t))
|
||||
|
||||
;;;; Special purpose inline allocators.
|
||||
#!-gencgc
|
||||
(define-vop (allocate-code-object)
|
||||
;; BOXED is a count of words as a fixnum; it is therefore also a byte count
|
||||
;; as a raw value because n-fixnum-tag-bits = word-shift.
|
||||
(:args (boxed :scs (any-reg))
|
||||
(unboxed-arg :scs (any-reg) :to :save))
|
||||
(:results (result :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:temporary (:scs (non-descriptor-reg)) size)
|
||||
(:temporary (:scs (non-descriptor-reg)) unboxed)
|
||||
(:temporary (:sc non-descriptor-reg :offset ocfp-offset) pa-flag)
|
||||
(:generator 100
|
||||
(inst mov unboxed (lsr unboxed-arg word-shift))
|
||||
(inst add unboxed unboxed lowtag-mask)
|
||||
(inst bic unboxed unboxed lowtag-mask)
|
||||
(inst mov ndescr (lsl boxed (- n-widetag-bits word-shift)))
|
||||
(inst orr ndescr ndescr code-header-widetag)
|
||||
(inst add size boxed unboxed)
|
||||
(pseudo-atomic (pa-flag)
|
||||
(allocation result size other-pointer-lowtag :flag-tn pa-flag)
|
||||
(storew ndescr result 0 other-pointer-lowtag)
|
||||
(storew unboxed-arg result code-code-size-slot other-pointer-lowtag)
|
||||
(storew null-tn result code-debug-info-slot other-pointer-lowtag))))
|
||||
|
||||
(define-vop (make-fdefn)
|
||||
(:args (name :scs (descriptor-reg) :to :eval))
|
||||
|
|
@ -186,12 +163,17 @@
|
|||
(:generator 6
|
||||
;; Build the object header, assuming that the header was in WORDS
|
||||
;; but should not be in the header
|
||||
(inst add bytes extra (* (1- words) n-word-bytes))
|
||||
(if (= type code-header-widetag)
|
||||
(inst add bytes extra 0)
|
||||
(inst add bytes extra (* (1- words) n-word-bytes)))
|
||||
(inst mov header (lsl bytes (- n-widetag-bits n-fixnum-tag-bits)))
|
||||
(inst add header header type)
|
||||
;; Add the object header to the allocation size and round up to
|
||||
;; the allocation granularity
|
||||
(inst add bytes bytes (* 2 n-word-bytes))
|
||||
;; The specified EXTRA value is the exact value placed in the header
|
||||
;; as the word count when allocating code.
|
||||
(unless (= type code-header-widetag)
|
||||
(inst add bytes bytes (* 2 n-word-bytes)))
|
||||
(inst bic bytes bytes lowtag-mask)
|
||||
;; Allocate the object and set its header
|
||||
(pseudo-atomic (pa-flag)
|
||||
|
|
|
|||
|
|
@ -171,10 +171,7 @@
|
|||
(:results (sap :scs (sap-reg)))
|
||||
(:result-types system-area-pointer)
|
||||
(:generator 10
|
||||
(loadw ndescr code 0 other-pointer-lowtag)
|
||||
;; CODE-HEADER-WIDETAG is #x38, which has the top two bits clear,
|
||||
;; so we don't to clear the low bits here. If we do, use BIC.
|
||||
(inst mov ndescr (lsr ndescr (- n-widetag-bits word-shift)))
|
||||
(loadw ndescr code code-boxed-size-slot other-pointer-lowtag)
|
||||
(inst sub ndescr ndescr other-pointer-lowtag)
|
||||
(inst add sap code ndescr)))
|
||||
|
||||
|
|
@ -185,10 +182,8 @@
|
|||
(:results (func :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:generator 10
|
||||
(loadw ndescr code 0 other-pointer-lowtag)
|
||||
;; CODE-HEADER-WIDETAG is #x38, which has the top two bits clear,
|
||||
;; so we don't to clear the low bits here. If we do, use BIC.
|
||||
(inst add ndescr offset (lsr ndescr (- n-widetag-bits word-shift)))
|
||||
(loadw ndescr code code-boxed-size-slot other-pointer-lowtag)
|
||||
(inst add ndescr offset ndescr)
|
||||
(inst sub ndescr ndescr (- other-pointer-lowtag fun-pointer-lowtag))
|
||||
(inst add func code ndescr)))
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -69,30 +69,6 @@
|
|||
(:variant t))
|
||||
|
||||
;;;; Special purpose inline allocators.
|
||||
#!-gencgc
|
||||
(define-vop (allocate-code-object)
|
||||
(:args (boxed-arg :scs (unsigned-reg))
|
||||
(unboxed-arg :scs (any-reg) :to :save))
|
||||
(:results (result :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:temporary (:scs (non-descriptor-reg)) size)
|
||||
(:temporary (:scs (any-reg) :from (:argument 0)) boxed)
|
||||
(:temporary (:scs (non-descriptor-reg)) unboxed)
|
||||
(:temporary (:sc non-descriptor-reg) pa-flag)
|
||||
(:temporary (:scs (interior-reg)) lip)
|
||||
(:generator 100
|
||||
(inst lsl boxed boxed-arg word-shift)
|
||||
(inst lsr unboxed unboxed-arg word-shift)
|
||||
(inst add unboxed unboxed lowtag-mask)
|
||||
(inst and unboxed unboxed (bic-mask lowtag-mask))
|
||||
(inst lsl ndescr boxed (- n-widetag-bits word-shift))
|
||||
(inst orr ndescr ndescr code-header-widetag)
|
||||
(inst add size boxed unboxed)
|
||||
(pseudo-atomic (pa-flag)
|
||||
(allocation result size other-pointer-lowtag :flag-tn pa-flag :lip lip)
|
||||
(storew ndescr result 0 other-pointer-lowtag)
|
||||
(storew unboxed-arg result code-code-size-slot other-pointer-lowtag)
|
||||
(storew null-tn result code-debug-info-slot other-pointer-lowtag))))
|
||||
|
||||
(define-vop (make-fdefn)
|
||||
(:args (name :scs (descriptor-reg) :to :eval))
|
||||
|
|
@ -183,6 +159,7 @@
|
|||
(:temporary (:sc non-descriptor-reg) pa-flag header)
|
||||
(:temporary (:scs (interior-reg)) lip)
|
||||
(:generator 6
|
||||
#!+cheneygc (bug "cheneygc not working for arm64")
|
||||
;; Build the object header, assuming that the header was in WORDS
|
||||
;; but should not be in the header
|
||||
(inst lsl bytes extra (- word-shift n-fixnum-tag-bits))
|
||||
|
|
|
|||
|
|
@ -159,8 +159,9 @@
|
|||
(:results (sap :scs (sap-reg)))
|
||||
(:result-types system-area-pointer)
|
||||
(:generator 10
|
||||
(inst ldr (32-bit-reg ndescr) (@ code (- 4 other-pointer-lowtag)))
|
||||
(inst add sap code (lsl ndescr word-shift))
|
||||
;; 4 byte load, ignoring serial# in the high bits
|
||||
(inst ldr (32-bit-reg ndescr) (@ code (- 8 other-pointer-lowtag)))
|
||||
(inst add sap code ndescr)
|
||||
(inst sub sap sap other-pointer-lowtag)))
|
||||
|
||||
(define-vop (compute-fun)
|
||||
|
|
@ -170,8 +171,8 @@
|
|||
(:results (func :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:generator 10
|
||||
(inst ldr (32-bit-reg ndescr) (@ code (- 4 other-pointer-lowtag)))
|
||||
(inst add ndescr offset (lsl ndescr word-shift))
|
||||
(inst ldr (32-bit-reg ndescr) (@ code (- 8 other-pointer-lowtag)))
|
||||
(inst add ndescr offset ndescr)
|
||||
(inst sub ndescr ndescr (- other-pointer-lowtag fun-pointer-lowtag))
|
||||
(inst add func code ndescr)))
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -625,6 +625,15 @@
|
|||
#!-gencgc 0))
|
||||
(write-wordindexed/raw des 0 (logior (ash gen 24) header-word))))
|
||||
|
||||
(defun write-code-header-words (descriptor boxed unboxed serialno)
|
||||
#!-64-bit (setq serialno 0)
|
||||
(let ((total-words (align-up (+ boxed (ceiling unboxed sb-vm:n-word-bytes)) 2)))
|
||||
(write-header-word descriptor
|
||||
(logior (ash total-words sb-vm::code-header-size-shift)
|
||||
sb-vm:code-header-widetag)))
|
||||
(write-wordindexed/raw descriptor 1
|
||||
(logior (ash serialno 32) (* boxed sb-vm:n-word-bytes))))
|
||||
|
||||
(defun write-header-data+tag (des header-data widetag)
|
||||
(write-header-word des (logior (ash header-data sb-vm:n-widetag-bits)
|
||||
widetag)))
|
||||
|
|
@ -2141,11 +2150,15 @@ core and return a descriptor to it."
|
|||
(defvar *cold-assembler-routines*)
|
||||
(defvar *cold-static-call-fixups*)
|
||||
|
||||
;;; Basically the same as the real CODE-HEADER-WORDS * n-word-bytes
|
||||
(defun code-header-bytes (code-object) ; Return boxed part size in bytes
|
||||
;;: See picture in 'objdef'
|
||||
(defun code-total-size (code-object) ; Return total size in bytes
|
||||
(* (ash (get-header-data code-object) (+ #!+64-bit -24))
|
||||
sb-vm:n-word-bytes))
|
||||
|
||||
;; Boxed header length is stored directly in bytes, not words
|
||||
(defun code-header-bytes (code-object)
|
||||
(ldb (byte 32 0) (read-bits-wordindexed code-object sb-vm:code-boxed-size-slot)))
|
||||
|
||||
(defun lookup-assembler-reference (symbol &optional (mode :direct) (errorp t))
|
||||
(let* ((code-component *cold-assembler-obj*)
|
||||
(list *cold-assembler-routines*)
|
||||
|
|
@ -2169,12 +2182,6 @@ core and return a descriptor to it."
|
|||
(defvar *code-fixup-notes*)
|
||||
(defvar *allocation-point-fixup-notes*)
|
||||
|
||||
(defun code-unboxed-size (code)
|
||||
;; though ALLOCATE-CODE-OBJECT imposes a size limit, the exact limit
|
||||
;; doesn't matter, provided we examine only the low 4 bytes.
|
||||
(ash (ldb (byte 32 0) (read-bits-wordindexed code sb-vm:code-code-size-slot))
|
||||
(- sb-vm:n-fixnum-tag-bits)))
|
||||
|
||||
(declaim (ftype (sfunction (descriptor sb-vm:word sb-vm:word keyword keyword)
|
||||
descriptor)
|
||||
cold-fixup))
|
||||
|
|
@ -2190,10 +2197,7 @@ core and return a descriptor to it."
|
|||
#!+(or x86 x86-64)
|
||||
(let* ((gspace-data (descriptor-mem code-object))
|
||||
(obj-start-addr (logandc2 (descriptor-bits code-object) sb-vm:lowtag-mask))
|
||||
(code-end-addr
|
||||
(+ obj-start-addr
|
||||
(code-header-bytes code-object)
|
||||
(code-unboxed-size code-object)))
|
||||
(code-end-addr (+ obj-start-addr (code-total-size code-object)))
|
||||
(gspace-base (gspace-byte-address (descriptor-gspace code-object)))
|
||||
(in-dynamic-space
|
||||
(= (gspace-identifier (descriptor-intuit-gspace code-object))
|
||||
|
|
@ -2751,12 +2755,8 @@ core and return a descriptor to it."
|
|||
*dynamic*)
|
||||
(+ (ash aligned-n-boxed-words sb-vm:word-shift) code-size)
|
||||
sb-vm:other-pointer-lowtag :code)))
|
||||
(write-header-word des
|
||||
(sb-vm::make-code-header-word aligned-n-boxed-words))
|
||||
(write-wordindexed des sb-vm:code-code-size-slot
|
||||
(make-random-descriptor
|
||||
(logior #!+64-bit (ash (incf *code-serialno*) 32)
|
||||
(ash code-size sb-vm:n-fixnum-tag-bits))))
|
||||
(write-code-header-words des aligned-n-boxed-words code-size
|
||||
(incf *code-serialno*))
|
||||
(write-wordindexed des sb-vm:code-debug-info-slot debug-info)
|
||||
(do ((index (1- n-boxed-words) (1- index)))
|
||||
((< index sb-vm:code-constants-offset))
|
||||
|
|
@ -2804,8 +2804,7 @@ core and return a descriptor to it."
|
|||
;; See related function %CODE-FUN-OFFSET.
|
||||
(bvref-32 (descriptor-mem code-object)
|
||||
(+ (descriptor-byte-offset code-object)
|
||||
(code-header-bytes code-object)
|
||||
(code-unboxed-size code-object)
|
||||
(code-total-size code-object)
|
||||
-8
|
||||
(* fun-index -4))))) ; and back to the desired index
|
||||
(let ((fun (+ (logandc2 (descriptor-bits code-object) sb-vm:lowtag-mask)
|
||||
|
|
@ -2847,10 +2846,7 @@ core and return a descriptor to it."
|
|||
(+ (ash header-n-words sb-vm:word-shift) length)
|
||||
sb-vm:other-pointer-lowtag)))
|
||||
(setf *cold-assembler-obj* asm-code)
|
||||
(write-header-word asm-code
|
||||
(sb-vm::make-code-header-word header-n-words))
|
||||
(write-wordindexed asm-code sb-vm:code-code-size-slot
|
||||
(make-fixnum-descriptor rounded-length))
|
||||
(write-code-header-words asm-code header-n-words rounded-length 0)
|
||||
(let ((start (+ (descriptor-byte-offset asm-code)
|
||||
(ash header-n-words sb-vm:word-shift))))
|
||||
(read-bigvec-as-sequence-or-die (descriptor-mem asm-code)
|
||||
|
|
|
|||
|
|
@ -143,62 +143,56 @@
|
|||
(data :rest-p t :c-type #!-alpha "uword_t" #!+alpha "u32"))
|
||||
|
||||
#|
|
||||
Proposed change to code header representation which allows computing
|
||||
code object sized based on reading only 1 word, not 2.
|
||||
Code header representation:
|
||||
|
||||
| total size | widetag |
|
||||
| total words | widetag |
|
||||
| (3 bytes less 2 bits) | |
|
||||
+-----------------------+---------+ [32-bit words]
|
||||
| N boxed header words |
|
||||
| N boxed header bytes |
|
||||
+---------------------------------+
|
||||
max total payload size in words = #x3fffff
|
||||
|
||||
| total size | gc_gen | 0 | 0 | widetag |
|
||||
| total words | gc_gen | 0 | 0 | widetag |
|
||||
| (4 bytes) | | | | |
|
||||
+------------------------------------------------------------+ [64-bit words]
|
||||
| serial# | N boxed header words |
|
||||
| serial# | N boxed header bytes |
|
||||
| (4 bytes) | (4 bytes) |
|
||||
+------------------------------------------------------------+
|
||||
|
||||
the two zero bytes are reserved for future use
|
||||
max total payload size in words = uint_max
|
||||
(should probably made the same as for 32-bit word size for consistency)
|
||||
|
||||
For both:
|
||||
code-size = (total words - boxed words) * n-word-bytes
|
||||
text-size = code-size - n padding bytes
|
||||
code-size = total words * n-word-bytes - boxed bytes
|
||||
text-size = code-size - simple-fun table size - padding bytes
|
||||
bit 31 of word 0 = fullcgc mark bit
|
||||
bit 30 = touched since last GC bit
|
||||
The boxed byte count is stored "raw" (i.e. it's not a tagged value,
|
||||
but it has fixnum nature)
|
||||
|
||||
This will be important to make heap scans more bulletproof
|
||||
in the presence of code object allocation, since most architectures
|
||||
can not atomically store and load 16 bytes at once.
|
||||
This is more problematic in immobile space than dynamic space,
|
||||
but is in fact a problem for either, in theory. Consider:
|
||||
|
||||
Thread 1: | Thread 2
|
||||
-------- | --------
|
||||
Store header word @ A = N |
|
||||
| Load word 0 @ A
|
||||
| Load word @ A + 1 = 0
|
||||
| compute total size = N words
|
||||
Store header word @ A + 1 |
|
||||
Store unboxed bytes @ A + N |
|
||||
... |
|
||||
| Load unboxed word @ A + N -> crash
|
||||
Since most architectures can not atomically store and load 2 words at once,
|
||||
it is essential that code size be computable by loading a single word
|
||||
to make backtrace reliable (i.e. in the heap search step).
|
||||
|
||||
Note that vector objects require reading their length from a non-header word,
|
||||
but this not subject to a data race because only 1 word conveys the size.
|
||||
In addition there are no vectors on code pages which are the pages scanned
|
||||
during backtrace.
|
||||
|#
|
||||
|
||||
;;; The header contains the size of slots and constants in words.
|
||||
;;; The header contains the total size of the object (including
|
||||
;;; the header itself) in words.
|
||||
(!define-primitive-object (code :type code-component
|
||||
:lowtag other-pointer-lowtag
|
||||
:widetag code-header-widetag)
|
||||
;; This is the size of instructions in bytes, not aligned.
|
||||
;; Adding the size from the header and aligned code-size will yield
|
||||
;; the total size of the code-object.
|
||||
;; The upper 4 bytes in 8-byte words can be used for ancillary data.
|
||||
(code-size :type index
|
||||
:ref-known (flushable movable)
|
||||
:ref-trans #!+64-bit %%code-code-size ; serialno + size
|
||||
#!-64-bit %code-code-size)
|
||||
;; This is the length of the boxed section, in bytes, not tagged.
|
||||
;; It will be a multiple of the word size.
|
||||
;; It can be accessed as a tagged value in Lisp by shifting.
|
||||
;; The upper 4 bytes store code-serial# on 64-bit words.
|
||||
(boxed-size :type fixnum ; see above figure
|
||||
:ref-known (flushable movable)
|
||||
:ref-trans %code-boxed-size)
|
||||
(debug-info :type t
|
||||
:ref-known (flushable)
|
||||
:ref-trans %code-debug-info
|
||||
|
|
@ -543,6 +537,31 @@ but is in fact a problem for either, in theory. Consider:
|
|||
;;; This constant is the index prior to scaling.
|
||||
(defconstant sb-thread::tls-index-start primitive-thread-object-length)
|
||||
|
||||
(defmacro make-code-header-word (boxed-nwords)
|
||||
`(logior (ash ,boxed-nwords #!+64-bit 32 #!-64-bit n-widetag-bits)
|
||||
code-header-widetag))
|
||||
(defconstant code-header-size-shift #!+64-bit 32 #!-64-bit n-widetag-bits)
|
||||
(declaim (inline code-object-size code-header-words %code-code-size))
|
||||
#-sb-xc-host
|
||||
(progn
|
||||
(defun code-object-size (code)
|
||||
(declare (code-component code))
|
||||
#!-64-bit (ash (logand (get-header-data code) #x3FFFFF) word-shift)
|
||||
#!+64-bit (ash (ash (get-header-data code) -24) word-shift))
|
||||
|
||||
(defun code-header-words (code)
|
||||
(declare (code-component code))
|
||||
;; The values stored is an untagged byte count. If N-FIXNUM-TAG-BITS is the same
|
||||
;; as WORD-SHIFT, then it can be conveniently read as word count with no shifting.
|
||||
;; Putting an upper bound on the word count improves the generated code, no matter
|
||||
;; that it's an excessive bound. 22 bits expresses the maximum object size
|
||||
;; for 32-bit words. The boxed count can't in practice be that large.
|
||||
(ldb (byte 22 0) (ash (%code-boxed-size code) (- n-fixnum-tag-bits word-shift))))
|
||||
|
||||
(defun %code-code-size (code)
|
||||
(declare (code-component code))
|
||||
(- (code-object-size code) (ash (code-header-words code) word-shift)))
|
||||
|
||||
(defun %code-serialno (code)
|
||||
(declare (code-component code) (ignorable code))
|
||||
#!+64-bit ; extract high 4 bytes of boxed-size slot
|
||||
(ash (%code-boxed-size code) (- n-fixnum-tag-bits 32)))
|
||||
|
||||
) ; end PROGN
|
||||
|
|
|
|||
|
|
@ -127,28 +127,6 @@
|
|||
(inst comb :<> temp csp-tn loop :nullify t)
|
||||
(inst stwm zero-tn n-word-bytes temp)))))
|
||||
|
||||
(define-vop (allocate-code-object)
|
||||
(:args (boxed-arg :scs (any-reg))
|
||||
(unboxed-arg :scs (any-reg) :to :save))
|
||||
(:results (result :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:temporary (:scs (any-reg) :from (:argument 0)) boxed)
|
||||
(:temporary (:scs (non-descriptor-reg)) unboxed)
|
||||
(:generator 100
|
||||
(inst addi 0 boxed-arg boxed)
|
||||
(inst srl unboxed-arg word-shift unboxed)
|
||||
(inst addi lowtag-mask unboxed unboxed)
|
||||
(inst dep 0 31 n-lowtag-bits unboxed)
|
||||
(inst sll boxed (- n-widetag-bits word-shift) ndescr)
|
||||
(inst addi code-header-widetag ndescr ndescr)
|
||||
(pseudo-atomic ()
|
||||
(set-lowtag other-pointer-lowtag alloc-tn result)
|
||||
(inst add alloc-tn boxed alloc-tn)
|
||||
(inst add alloc-tn unboxed alloc-tn)
|
||||
(storew ndescr result 0 other-pointer-lowtag)
|
||||
(storew unboxed-arg result code-code-size-slot other-pointer-lowtag)
|
||||
(storew null-tn result code-debug-info-slot other-pointer-lowtag))))
|
||||
|
||||
(define-vop (make-fdefn)
|
||||
(:translate make-fdefn)
|
||||
(:policy :fast-safe)
|
||||
|
|
@ -223,8 +201,13 @@
|
|||
(:generator 6
|
||||
(inst addi (* (1+ words) n-word-bytes) extra bytes)
|
||||
(inst sll bytes (- n-widetag-bits 2) header)
|
||||
(inst addi (+ (ash -2 n-widetag-bits) type) header header)
|
||||
(inst dep 0 31 n-lowtag-bits bytes)
|
||||
;; The specified EXTRA value is the exact value placed in the header
|
||||
;; as the word count when allocating code.
|
||||
(cond ((= type code-header-widetag)
|
||||
(inst addi type header header))
|
||||
(t
|
||||
(inst addi (+ (ash -2 n-widetag-bits) type) header header)
|
||||
(inst dep 0 31 n-lowtag-bits bytes)))
|
||||
(pseudo-atomic ()
|
||||
(set-lowtag lowtag alloc-tn result)
|
||||
(storew header result 0 lowtag)
|
||||
|
|
|
|||
|
|
@ -132,31 +132,6 @@
|
|||
(inst addu temp n-word-bytes))
|
||||
(align-csp temp))))
|
||||
|
||||
(define-vop (allocate-code-object)
|
||||
;; BOXED is a count of words as a fixnum; it is therefore also a byte count
|
||||
;; as a raw value because n-fixnum-tag-bits = word-shift.
|
||||
(:args (boxed :scs (any-reg) :to :save)
|
||||
(unboxed-arg :scs (any-reg) :to :save))
|
||||
(:results (result :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:temporary (:scs (non-descriptor-reg)) unboxed)
|
||||
(:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
|
||||
(:generator 100
|
||||
(inst li ndescr (lognot lowtag-mask))
|
||||
(inst srl unboxed unboxed-arg word-shift)
|
||||
(inst addu unboxed unboxed lowtag-mask)
|
||||
(inst and unboxed ndescr)
|
||||
(inst sll ndescr boxed (- n-widetag-bits word-shift))
|
||||
(inst or ndescr code-header-widetag)
|
||||
|
||||
(pseudo-atomic (pa-flag)
|
||||
(inst or result alloc-tn other-pointer-lowtag)
|
||||
(inst addu alloc-tn boxed)
|
||||
(storew ndescr result 0 other-pointer-lowtag)
|
||||
(storew unboxed-arg result code-code-size-slot other-pointer-lowtag)
|
||||
(inst addu alloc-tn unboxed)
|
||||
(storew null-tn result code-debug-info-slot other-pointer-lowtag))))
|
||||
|
||||
(define-vop (make-fdefn)
|
||||
(:policy :fast-safe)
|
||||
(:translate make-fdefn)
|
||||
|
|
@ -259,9 +234,14 @@
|
|||
(:generator 6
|
||||
(inst addu bytes extra (* (1+ words) n-word-bytes))
|
||||
(inst sll header bytes (- n-widetag-bits n-fixnum-tag-bits))
|
||||
(inst addu header header (+ (ash -2 n-widetag-bits) type))
|
||||
(inst srl bytes bytes n-lowtag-bits)
|
||||
(inst sll bytes bytes n-lowtag-bits)
|
||||
;; The specified EXTRA value is the exact value placed in the header
|
||||
;; as the word count when allocating code.
|
||||
(cond ((= type code-header-widetag)
|
||||
(inst addu header header type))
|
||||
(t
|
||||
(inst addu header header (+ (ash -2 n-widetag-bits) type))
|
||||
(inst srl bytes bytes n-lowtag-bits)
|
||||
(inst sll bytes bytes n-lowtag-bits)))
|
||||
(pseudo-atomic (pa-flag)
|
||||
(inst or result alloc-tn lowtag)
|
||||
(storew header result 0 lowtag)
|
||||
|
|
|
|||
|
|
@ -172,9 +172,7 @@
|
|||
(:results (sap :scs (sap-reg)))
|
||||
(:result-types system-area-pointer)
|
||||
(:generator 10
|
||||
(loadw ndescr code 0 other-pointer-lowtag)
|
||||
(inst srl ndescr n-widetag-bits)
|
||||
(inst sll ndescr word-shift)
|
||||
(loadw ndescr code code-boxed-size-slot other-pointer-lowtag)
|
||||
(inst subu ndescr other-pointer-lowtag)
|
||||
(inst addu sap code ndescr)))
|
||||
|
||||
|
|
@ -185,9 +183,7 @@
|
|||
(:results (func :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:generator 10
|
||||
(loadw ndescr code 0 other-pointer-lowtag)
|
||||
(inst srl ndescr n-widetag-bits)
|
||||
(inst sll ndescr word-shift)
|
||||
(loadw ndescr code code-boxed-size-slot other-pointer-lowtag)
|
||||
(inst addu ndescr offset)
|
||||
(inst addu ndescr (- fun-pointer-lowtag other-pointer-lowtag))
|
||||
(inst addu func code ndescr)))
|
||||
|
|
|
|||
|
|
@ -78,32 +78,6 @@
|
|||
|
||||
|
||||
;;;; Special purpose inline allocators.
|
||||
#!-gencgc
|
||||
(define-vop (allocate-code-object)
|
||||
;; BOXED is a count of words as a fixnum; it is therefore also a byte count
|
||||
;; as a raw value because n-fixnum-tag-bits = word-shift.
|
||||
(:args (boxed :scs (any-reg) :to :save)
|
||||
(unboxed-arg :scs (any-reg) :to :save))
|
||||
(:results (result :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:temporary (:scs (non-descriptor-reg)) size)
|
||||
(:temporary (:scs (non-descriptor-reg)) unboxed)
|
||||
(:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
|
||||
(:generator 100
|
||||
(inst srwi unboxed unboxed-arg word-shift)
|
||||
(inst addi unboxed unboxed lowtag-mask)
|
||||
(inst clrrwi unboxed unboxed n-lowtag-bits)
|
||||
(pseudo-atomic (pa-flag)
|
||||
;; Note: we don't have to subtract off the 4 that was added by
|
||||
;; pseudo-atomic, because oring in other-pointer-lowtag just adds
|
||||
;; it right back.
|
||||
(inst add size boxed unboxed)
|
||||
(allocation result size other-pointer-lowtag :temp-tn ndescr :flag-tn pa-flag)
|
||||
(inst slwi ndescr boxed (- n-widetag-bits word-shift))
|
||||
(inst ori ndescr ndescr code-header-widetag)
|
||||
(storew ndescr result 0 other-pointer-lowtag)
|
||||
(storew unboxed-arg result code-code-size-slot other-pointer-lowtag)
|
||||
(storew null-tn result code-debug-info-slot other-pointer-lowtag))))
|
||||
|
||||
(define-vop (make-fdefn)
|
||||
(:args (name :scs (descriptor-reg) :to :eval))
|
||||
|
|
@ -199,8 +173,13 @@
|
|||
(:generator 6
|
||||
(inst addi bytes extra (* (1+ words) n-word-bytes))
|
||||
(inst slwi header bytes (- n-widetag-bits n-fixnum-tag-bits))
|
||||
(inst addi header header (+ (ash -2 n-widetag-bits) type))
|
||||
(inst clrrwi bytes bytes n-lowtag-bits)
|
||||
;; The specified EXTRA value is the exact value placed in the header
|
||||
;; as the word count when allocating code.
|
||||
(cond ((= type code-header-widetag)
|
||||
(inst addi header header type))
|
||||
(t
|
||||
(inst addi header header (+ (ash -2 n-widetag-bits) type))
|
||||
(inst clrrwi bytes bytes n-lowtag-bits)))
|
||||
(pseudo-atomic (pa-flag)
|
||||
(allocation result bytes lowtag :temp-tn temp :flag-tn pa-flag)
|
||||
(storew header result 0 lowtag))))
|
||||
|
|
|
|||
|
|
@ -163,9 +163,7 @@
|
|||
(:results (sap :scs (sap-reg)))
|
||||
(:result-types system-area-pointer)
|
||||
(:generator 10
|
||||
(loadw ndescr code 0 other-pointer-lowtag)
|
||||
(inst srwi ndescr ndescr n-widetag-bits)
|
||||
(inst slwi ndescr ndescr word-shift)
|
||||
(loadw ndescr code code-boxed-size-slot other-pointer-lowtag)
|
||||
(inst subi ndescr ndescr other-pointer-lowtag)
|
||||
(inst add sap code ndescr)))
|
||||
|
||||
|
|
@ -176,9 +174,7 @@
|
|||
(:results (func :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:generator 10
|
||||
(loadw ndescr code 0 other-pointer-lowtag)
|
||||
(inst srwi ndescr ndescr n-widetag-bits)
|
||||
(inst slwi ndescr ndescr word-shift)
|
||||
(loadw ndescr code code-boxed-size-slot other-pointer-lowtag)
|
||||
(inst add ndescr ndescr offset)
|
||||
(inst addi ndescr ndescr (- fun-pointer-lowtag other-pointer-lowtag))
|
||||
(inst add func code ndescr)))
|
||||
|
|
|
|||
|
|
@ -78,32 +78,6 @@
|
|||
|
||||
|
||||
;;;; Special purpose inline allocators.
|
||||
#!-gencgc
|
||||
(define-vop (allocate-code-object)
|
||||
;; BOXED is a count of words as a fixnum; it is therefore also a byte count
|
||||
;; as a raw value because n-fixnum-tag-bits = word-shift.
|
||||
(:args (boxed :scs (any-reg) :to :save)
|
||||
(unboxed-arg :scs (any-reg) :to :save))
|
||||
(:results (result :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:temporary (:scs (non-descriptor-reg)) size)
|
||||
(:temporary (:scs (non-descriptor-reg)) unboxed)
|
||||
(:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
|
||||
(:generator 100
|
||||
(inst srwi unboxed unboxed-arg word-shift)
|
||||
(inst addi unboxed unboxed lowtag-mask)
|
||||
(inst clrrwi unboxed unboxed n-lowtag-bits)
|
||||
(pseudo-atomic (pa-flag)
|
||||
;; Note: we don't have to subtract off the 4 that was added by
|
||||
;; pseudo-atomic, because oring in other-pointer-lowtag just adds
|
||||
;; it right back.
|
||||
(inst add size boxed unboxed)
|
||||
(allocation result size other-pointer-lowtag :temp-tn ndescr :flag-tn pa-flag)
|
||||
(inst slwi ndescr boxed (- n-widetag-bits word-shift))
|
||||
(inst ori ndescr ndescr code-header-widetag)
|
||||
(storew ndescr result 0 other-pointer-lowtag)
|
||||
(storew unboxed-arg result code-code-size-slot other-pointer-lowtag)
|
||||
(storew null-tn result code-debug-info-slot other-pointer-lowtag))))
|
||||
|
||||
(define-vop (make-fdefn)
|
||||
(:args (name :scs (descriptor-reg) :to :eval))
|
||||
|
|
|
|||
|
|
@ -162,9 +162,8 @@
|
|||
(:results (sap :scs (sap-reg)))
|
||||
(:result-types system-area-pointer)
|
||||
(:generator 10
|
||||
(loadw ndescr code 0 other-pointer-lowtag)
|
||||
(inst srwi ndescr ndescr n-widetag-bits)
|
||||
(inst slwi ndescr ndescr word-shift)
|
||||
;; FIXME: should be zero-extending 4 byte load
|
||||
(loadw ndescr code code-boxed-size-slot other-pointer-lowtag)
|
||||
(inst subi ndescr ndescr other-pointer-lowtag)
|
||||
(inst add sap code ndescr)))
|
||||
|
||||
|
|
@ -175,9 +174,8 @@
|
|||
(:results (func :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:generator 10
|
||||
(loadw ndescr code 0 other-pointer-lowtag)
|
||||
(inst srwi ndescr ndescr n-widetag-bits)
|
||||
(inst slwi ndescr ndescr word-shift)
|
||||
;; FIXME: should be zero-extending 4 byte load
|
||||
(loadw ndescr code code-boxed-size-slot other-pointer-lowtag)
|
||||
(inst add ndescr ndescr offset)
|
||||
(inst addi ndescr ndescr (- fun-pointer-lowtag other-pointer-lowtag))
|
||||
(inst add func code ndescr)))
|
||||
|
|
|
|||
|
|
@ -72,36 +72,6 @@
|
|||
|
||||
;;;; Special purpose inline allocators.
|
||||
|
||||
(define-vop (allocate-code-object)
|
||||
;; BOXED is a count of words as a fixnum; it is therefore also a byte count
|
||||
;; as a raw value because n-fixnum-tag-bits = word-shift.
|
||||
(:args (boxed :scs (any-reg) :to :save)
|
||||
(unboxed-arg :scs (any-reg) :to :save))
|
||||
(:results (result :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:temporary (:scs (non-descriptor-reg)) size)
|
||||
(:temporary (:scs (non-descriptor-reg)) unboxed)
|
||||
(:generator 100
|
||||
(inst srl unboxed unboxed-arg word-shift)
|
||||
(inst add unboxed lowtag-mask)
|
||||
(inst and unboxed (lognot lowtag-mask))
|
||||
(pseudo-atomic ()
|
||||
;;
|
||||
;; This looks like another dreadful type pun. CSR - 2002-02-06
|
||||
;;
|
||||
;; Not any more, or not in that sense at least, because the
|
||||
;; "p/a bit is also the highest lowtag bit" assumption is now hidden
|
||||
;; in the allocation macro. DFL - 2012-10-01
|
||||
;;
|
||||
;; Figure out how much space we really need and allocate it.
|
||||
(inst add size boxed unboxed)
|
||||
(allocation result size other-pointer-lowtag :temp-tn ndescr)
|
||||
(inst sll ndescr boxed (- n-widetag-bits word-shift))
|
||||
(inst or ndescr code-header-widetag)
|
||||
(storew ndescr result 0 other-pointer-lowtag)
|
||||
(storew unboxed-arg result code-code-size-slot other-pointer-lowtag)
|
||||
(storew null-tn result code-debug-info-slot other-pointer-lowtag))))
|
||||
|
||||
(define-vop (make-fdefn)
|
||||
(:args (name :scs (descriptor-reg) :to :eval))
|
||||
(:temporary (:scs (non-descriptor-reg)) temp)
|
||||
|
|
@ -184,8 +154,13 @@
|
|||
(:generator 6
|
||||
(inst add bytes extra (* (1+ words) n-word-bytes))
|
||||
(inst sll header bytes (- n-widetag-bits 2))
|
||||
(inst add header header (+ (ash -2 n-widetag-bits) type))
|
||||
(inst and bytes (lognot lowtag-mask))
|
||||
;; The specified EXTRA value is the exact value placed in the header
|
||||
;; as the word count when allocating code.
|
||||
(cond ((= type code-header-widetag)
|
||||
(inst add header header type))
|
||||
(t
|
||||
(inst add header header (+ (ash -2 n-widetag-bits) type))
|
||||
(inst and bytes (lognot lowtag-mask))))
|
||||
(pseudo-atomic ()
|
||||
(allocation result bytes lowtag :temp-tn temp)
|
||||
(storew header result 0 lowtag))))
|
||||
|
|
|
|||
|
|
@ -169,9 +169,7 @@
|
|||
(:results (sap :scs (sap-reg)))
|
||||
(:result-types system-area-pointer)
|
||||
(:generator 10
|
||||
(loadw ndescr code 0 other-pointer-lowtag)
|
||||
(inst srl ndescr n-widetag-bits)
|
||||
(inst sll ndescr word-shift)
|
||||
(loadw ndescr code code-boxed-size-slot other-pointer-lowtag)
|
||||
(inst sub ndescr other-pointer-lowtag)
|
||||
(inst add sap code ndescr)))
|
||||
|
||||
|
|
@ -182,9 +180,7 @@
|
|||
(:results (func :scs (descriptor-reg)))
|
||||
(:temporary (:scs (non-descriptor-reg)) ndescr)
|
||||
(:generator 10
|
||||
(loadw ndescr code 0 other-pointer-lowtag)
|
||||
(inst srl ndescr n-widetag-bits)
|
||||
(inst sll ndescr word-shift)
|
||||
(loadw ndescr code code-boxed-size-slot other-pointer-lowtag)
|
||||
(inst add ndescr offset)
|
||||
(inst add ndescr (- fun-pointer-lowtag other-pointer-lowtag))
|
||||
(inst add func code ndescr)))
|
||||
|
|
|
|||
|
|
@ -216,20 +216,20 @@
|
|||
(:results (sap :scs (sap-reg) :from (:argument 0)))
|
||||
(:result-types system-area-pointer)
|
||||
(:generator 10
|
||||
(inst mov :dword sap (ea (- 4 other-pointer-lowtag) code))
|
||||
(inst lea sap (ea (- other-pointer-lowtag) code sap n-word-bytes))))
|
||||
;; load boxed header size in bytes
|
||||
(inst mov :dword sap (ea (- n-word-bytes other-pointer-lowtag) code))
|
||||
(inst lea sap (ea (- other-pointer-lowtag) code sap))))
|
||||
|
||||
(define-vop (compute-fun)
|
||||
(:args (code :scs (descriptor-reg) :to (:result 0))
|
||||
(offset :scs (signed-reg unsigned-reg) :to (:result 0)))
|
||||
(offset :scs (signed-reg unsigned-reg) :to :eval :target func))
|
||||
(:arg-types * positive-fixnum)
|
||||
(:results (func :scs (descriptor-reg) :from (:argument 0)))
|
||||
(:generator 10
|
||||
(inst mov :dword func (ea (- 4 other-pointer-lowtag) code))
|
||||
(inst lea func
|
||||
(ea (- fun-pointer-lowtag other-pointer-lowtag)
|
||||
offset func n-word-bytes))
|
||||
(inst add func code)))
|
||||
(:results (func :scs (descriptor-reg) :from :eval))
|
||||
(:generator 3
|
||||
(move func offset)
|
||||
;; add boxed header size in bytes
|
||||
(inst add :dword func (ea (- n-word-bytes other-pointer-lowtag) code))
|
||||
(inst lea func (ea (- fun-pointer-lowtag other-pointer-lowtag) code func))))
|
||||
|
||||
;;; This vop is quite magical - because 'closure-fun' is a raw program counter,
|
||||
;;; as soon as it's loaded into a register, it prevents the underlying fun from
|
||||
|
|
|
|||
|
|
@ -139,25 +139,22 @@
|
|||
(:results (sap :scs (sap-reg) :from (:argument 0)))
|
||||
(:result-types system-area-pointer)
|
||||
(:generator 10
|
||||
(loadw sap code 0 other-pointer-lowtag)
|
||||
(inst shl sap 2) ; shift out the two GC-reserved bits
|
||||
(inst shr sap (+ 2 n-widetag-bits))
|
||||
(inst lea sap (make-ea :byte :base code :index sap :scale 4
|
||||
;; load boxed header size in bytes
|
||||
(loadw sap code 1 other-pointer-lowtag)
|
||||
(inst lea sap (make-ea :byte :base code :index sap
|
||||
:disp (- other-pointer-lowtag)))))
|
||||
|
||||
(define-vop (compute-fun)
|
||||
(:args (code :scs (descriptor-reg) :to (:result 0))
|
||||
(offset :scs (signed-reg unsigned-reg) :to (:result 0)))
|
||||
(offset :scs (signed-reg unsigned-reg) :to :eval :target func))
|
||||
(:arg-types * positive-fixnum)
|
||||
(:results (func :scs (descriptor-reg) :from (:argument 0)))
|
||||
(:generator 10
|
||||
(loadw func code 0 other-pointer-lowtag)
|
||||
(inst shl func 2) ; shift out the two GC-reserved bits
|
||||
(inst shr func (+ 2 n-widetag-bits))
|
||||
(inst lea func
|
||||
(make-ea :byte :base offset :index func :scale 4
|
||||
:disp (- fun-pointer-lowtag other-pointer-lowtag)))
|
||||
(inst add func code)))
|
||||
(:results (func :scs (descriptor-reg) :from :eval))
|
||||
(:generator 3
|
||||
(move func offset)
|
||||
;; add boxed header size in bytes
|
||||
(inst add func (make-ea :dword :base code :disp (- 4 other-pointer-lowtag)))
|
||||
(inst lea func (make-ea :byte :base code :index func
|
||||
:disp (- fun-pointer-lowtag other-pointer-lowtag)))))
|
||||
|
||||
;;; This vop is quite magical - because 'closure-fun' is a raw program counter,
|
||||
;;; as soon as it's loaded into a register, it prevents the underlying fun from
|
||||
|
|
|
|||
|
|
@ -33,19 +33,20 @@ boolean alloc_profiling; // enabled flag
|
|||
static pthread_mutex_t allocation_lock = PTHREAD_MUTEX_INITIALIZER;
|
||||
pthread_mutex_t alloc_profiler_lock = PTHREAD_MUTEX_INITIALIZER;
|
||||
#endif
|
||||
lispobj alloc_code_object (unsigned boxed_nwords, unsigned unboxed_nbytes,
|
||||
unsigned __attribute__((unused)) serialno)
|
||||
lispobj alloc_code_object (unsigned total_words, unsigned boxed_words, unsigned serialno)
|
||||
{
|
||||
// serialno needs to be 0 for 32-bit builds.
|
||||
// It should probably consume an extra slot so that we can use serial#
|
||||
// for the same purpose regardless of word size.
|
||||
#ifndef LISP_FEATURE_64_BIT
|
||||
serialno = 0;
|
||||
#endif
|
||||
/* It used to be that even on gencgc builds the
|
||||
* ALLOCATE-CODE-OBJECT VOP did all this initialization within
|
||||
* pseudo atomic. Here, we rely on gc being inhibited. */
|
||||
struct thread *th = arch_os_get_current_thread();
|
||||
if (read_TLS(GC_INHIBIT, th) == NIL)
|
||||
lose("alloc_code_object called with GC enabled.");
|
||||
|
||||
int total_size = ALIGN_UP(boxed_nwords*N_WORD_BYTES + unboxed_nbytes,
|
||||
2*N_WORD_BYTES);
|
||||
|
||||
/* Since alloc_code_object is run under WITHOUT-GCING it doesn't
|
||||
* actaully need to be pseudo-atomic, this is just to appease the
|
||||
* assertions in general_alloc() */
|
||||
|
|
@ -56,20 +57,17 @@ lispobj alloc_code_object (unsigned boxed_nwords, unsigned unboxed_nbytes,
|
|||
int result = thread_mutex_lock(&allocation_lock);
|
||||
gc_assert(!result);
|
||||
struct code *code = (struct code *)
|
||||
lisp_alloc(&gc_alloc_region[CODE_PAGE_TYPE-1], total_size,
|
||||
lisp_alloc(&gc_alloc_region[CODE_PAGE_TYPE-1], total_words*N_WORD_BYTES,
|
||||
CODE_PAGE_TYPE, th);
|
||||
result = thread_mutex_unlock(&allocation_lock);
|
||||
gc_assert(!result);
|
||||
|
||||
clear_pseudo_atomic_atomic(th);
|
||||
|
||||
#ifdef LISP_FEATURE_64_BIT
|
||||
code->header = (uword_t)boxed_nwords << 32 | CODE_HEADER_WIDETAG;
|
||||
code->code_size = (uword_t)serialno << 32 | make_fixnum(unboxed_nbytes);
|
||||
#else
|
||||
code->header = (boxed_nwords << N_WIDETAG_BITS) | CODE_HEADER_WIDETAG;
|
||||
code->code_size = make_fixnum(unboxed_nbytes);
|
||||
#endif
|
||||
code->header = ((uword_t)total_words << CODE_HEADER_SIZE_SHIFT) | CODE_HEADER_WIDETAG;
|
||||
// boxed_size as stored is an untagged byte count. It can be read in Lisp as a
|
||||
// tagged fixnum due alignment considerations.
|
||||
code->boxed_size = ((uword_t)serialno << 32) | (boxed_words*N_WORD_BYTES);
|
||||
code->debug_info = NIL;
|
||||
return make_lispobj(code, OTHER_POINTER_LOWTAG);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -15,50 +15,29 @@
|
|||
#include "genesis/code.h"
|
||||
#include "gc-internal.h" // for gc_assert()
|
||||
|
||||
/// Internal use only (within this header)
|
||||
static inline sword_t code_boxed_nwords_(lispobj header)
|
||||
{
|
||||
static inline int code_total_nwords(struct code* c) {
|
||||
#ifdef LISP_FEATURE_64_BIT
|
||||
return header >> 32;
|
||||
return c->header >> 32;
|
||||
#else
|
||||
/* Mask out bits reserved for GC */
|
||||
return HeaderValue(header & ~((1 << 31) | (1 << 30)));
|
||||
return (c->header >> N_WIDETAG_BITS) & 0x3FFFFF;
|
||||
#endif
|
||||
}
|
||||
|
||||
/// Internal use only (within this header)
|
||||
static inline unsigned int
|
||||
code_unboxed_nbytes_(lispobj n) // given n = code->code_size
|
||||
{
|
||||
// Cast out high 32 bits of code_size if lispobj is 64 bits.
|
||||
return fixnum_value((uint32_t)n);
|
||||
}
|
||||
|
||||
/// Internal use only (within this header)
|
||||
static inline unsigned int
|
||||
code_unboxed_nwords_(lispobj n)
|
||||
{
|
||||
// Return ceiling |N / N_WORD_BYTES|
|
||||
return (code_unboxed_nbytes_(n) + (N_WORD_BYTES-1)) >> WORD_SHIFT;
|
||||
}
|
||||
|
||||
//// Interfaces
|
||||
|
||||
// Return signed int in case something tries to compute the number of boxed
|
||||
// words excluding the header word itself using "code_boxed_nwords(header) - 1",a
|
||||
// words excluding the header word itself using "code_header_words(header) - 1",
|
||||
// which, for a filler needs to come out as negative, not a huge positive.
|
||||
static inline sword_t code_header_nbytes(struct code* c)
|
||||
{
|
||||
return (c->boxed_size & 0xFFFFFFFF);
|
||||
}
|
||||
static inline sword_t code_header_words(struct code* c)
|
||||
{
|
||||
return code_boxed_nwords_(c->header);
|
||||
}
|
||||
|
||||
static inline int code_total_nwords(struct code* c) {
|
||||
return ALIGN_UP(code_boxed_nwords_(c->header) + code_unboxed_nwords_(c->code_size),
|
||||
2);
|
||||
return code_header_nbytes(c) >> WORD_SHIFT;
|
||||
}
|
||||
|
||||
static inline char* code_text_start(struct code* code) {
|
||||
return (char*)code + N_WORD_BYTES * code_header_words(code);
|
||||
return (char*)code + code_header_nbytes(code);
|
||||
}
|
||||
|
||||
/* Code component trailer words:
|
||||
|
|
@ -71,18 +50,19 @@ static inline char* code_text_start(struct code* code) {
|
|||
*/
|
||||
static inline unsigned int*
|
||||
code_fun_table(struct code* code) {
|
||||
return (unsigned int*)((char*)code + N_WORD_BYTES*code_total_nwords(code)-4);
|
||||
return (unsigned int*)((char*)code + N_WORD_BYTES*code_total_nwords(code) - 4);
|
||||
}
|
||||
static inline unsigned short
|
||||
code_n_funs(struct code* code) {
|
||||
// immobile space filler objects appear to be code but have no simple-funs.
|
||||
// Should probably consider changing the widetag to FILLER_WIDETAG.
|
||||
return code_header_words(code) ? 1[(unsigned short*)code_fun_table(code)] >> 4 : 0;
|
||||
return code_header_nbytes(code) ? 1[(unsigned short*)code_fun_table(code)] >> 4 : 0;
|
||||
}
|
||||
|
||||
/// The length in bytes of the unboxed portion excluding the simple-fun offset table.
|
||||
static inline int code_text_size(struct code* c) {
|
||||
return code_unboxed_nbytes_(c->code_size) - (1+code_n_funs(c)) * sizeof (uint32_t);
|
||||
return N_WORD_BYTES * code_total_nwords(c)
|
||||
- code_header_nbytes(c) - (1+code_n_funs(c)) * sizeof (uint32_t);
|
||||
}
|
||||
// Iterate over the native pointers to each function in 'code_var'
|
||||
// offsets are stored as the number of bytes into the instructions
|
||||
|
|
|
|||
|
|
@ -520,14 +520,14 @@ static uword_t sweep(lispobj* where, lispobj* end, uword_t arg)
|
|||
goto cons;
|
||||
struct code* code = (struct code*)where;
|
||||
// Keep in sync with the definition of filler_obj_p()
|
||||
lispobj header = CODE_HEADER_WIDETAG;
|
||||
if (code->header != header) {
|
||||
if (!filler_obj_p((lispobj*)code)) {
|
||||
page_index_t page = find_page_index(where);
|
||||
int gen = page >= 0 ? page_table[page].gen
|
||||
: __immobile_obj_gen_bits(where);
|
||||
NOTE_GARBAGE(gen, where, nwords, zeroed, {
|
||||
code->header = header;
|
||||
code->code_size = make_fixnum(nwords * N_WORD_BYTES);
|
||||
code->boxed_size = 0;
|
||||
code->header = (nwords << CODE_HEADER_SIZE_SHIFT)
|
||||
| CODE_HEADER_WIDETAG;
|
||||
memset(where+2, 0, (nwords - 2) * N_WORD_BYTES);
|
||||
})
|
||||
}
|
||||
|
|
|
|||
|
|
@ -148,7 +148,7 @@ static inline int __immobile_obj_gen_bits(lispobj* pointer) // native pointer
|
|||
#endif /* little-endian */
|
||||
|
||||
static inline boolean filler_obj_p(lispobj* obj) {
|
||||
return *obj == CODE_HEADER_WIDETAG;
|
||||
return widetag_of(obj) == CODE_HEADER_WIDETAG && obj[1] == 0;
|
||||
}
|
||||
|
||||
#endif /* immobile space */
|
||||
|
|
|
|||
|
|
@ -3493,6 +3493,10 @@ collect_garbage(generation_index_t last_gen)
|
|||
}
|
||||
gc_close_all_regions();
|
||||
|
||||
/* Immobile space generation bits are lazily updated for gen0
|
||||
(not touched on every object allocation) so do it now */
|
||||
update_immobile_nursery_bits();
|
||||
|
||||
/* Verify the new objects created by Lisp code. */
|
||||
if (pre_verify_gen_0)
|
||||
verify_heap(VERIFY_PRE_GC);
|
||||
|
|
@ -3500,10 +3504,6 @@ collect_garbage(generation_index_t last_gen)
|
|||
if (gencgc_verbose > 1)
|
||||
print_generation_stats();
|
||||
|
||||
/* Immobile space generation bits are lazily updated for gen0
|
||||
(not touched on every object allocation) so do it now */
|
||||
update_immobile_nursery_bits();
|
||||
|
||||
if (gc_mark_only) {
|
||||
garbage_collect_generation(PSEUDO_STATIC_GENERATION, 0);
|
||||
goto finish;
|
||||
|
|
|
|||
|
|
@ -1065,8 +1065,9 @@ static void make_filler(void* where, int nbytes)
|
|||
lose("can't place filler @ %p - too small", where);
|
||||
else { // Create a filler object.
|
||||
struct code* code = (struct code*)where;
|
||||
code->header = CODE_HEADER_WIDETAG; // 0 boxed words
|
||||
code->code_size = make_fixnum(nbytes);
|
||||
code->header = ((uword_t)nbytes << (CODE_HEADER_SIZE_SHIFT-WORD_SHIFT))
|
||||
| CODE_HEADER_WIDETAG;
|
||||
code->boxed_size = 0;
|
||||
code->debug_info = varyobj_holes;
|
||||
varyobj_holes = (lispobj)code;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -558,7 +558,7 @@ static void print_slots(char **slots, int count, lispobj *ptr)
|
|||
if (*slots) {
|
||||
// kludge for half-lispword sized slot
|
||||
print_obj(*slots,
|
||||
(N_WORD_BYTES == 8 && !strcmp(*slots, "code_size: "))
|
||||
(N_WORD_BYTES == 8 && !strcmp(*slots, "boxed_size: "))
|
||||
? *ptr & 0xFFFFFFFF : *ptr);
|
||||
slots++;
|
||||
} else {
|
||||
|
|
@ -739,9 +739,6 @@ static void print_otherptr(lispobj obj)
|
|||
|
||||
case CODE_HEADER_WIDETAG:
|
||||
// ptr was already bumped up
|
||||
#if N_WORD_BYTES == 8
|
||||
print_obj("serial#: ", (*ptr>>32));
|
||||
#endif
|
||||
count = code_header_words((struct code*)(ptr-1));
|
||||
for_each_simple_fun(fun_index, fun, (struct code*)(ptr-1), 0, {
|
||||
sprintf(buffer, "f[%d]: ", fun_index);
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@
|
|||
#:alien-value-sap #:alien-value-type)
|
||||
(:import-from "SB-C" #:+backend-page-bytes+)
|
||||
(:import-from "SB-VM" #:map-objects-in-range #:reconstitute-object
|
||||
#:%closure-callee #:code-component-size)
|
||||
#:%closure-callee #:code-object-size)
|
||||
(:import-from "SB-DISASSEM" #:get-inst-space #:find-inst
|
||||
#:make-dstate #:%make-segment
|
||||
#:seg-virtual-location #:seg-length #:seg-sap-maker
|
||||
|
|
@ -333,7 +333,7 @@
|
|||
(+ header-bytes (aref fun-map (1- i)))))
|
||||
(end-pc (if (< (1+ i) (length fun-map))
|
||||
(+ header-bytes (aref fun-map (1+ i)))
|
||||
(sb-vm::code-component-size code))))
|
||||
(code-object-size code))))
|
||||
(unless (= end-pc start-pc)
|
||||
;; Collapse adjacent address ranges named the same.
|
||||
;; Use EQUALP instead of EQUAL to compare names
|
||||
|
|
@ -800,7 +800,7 @@
|
|||
;; the unboxed bytes have an odd size in words making the total even.
|
||||
(format output " .byte ~{0x~x~^,~}~%"
|
||||
(loop for i from max-end
|
||||
below (- (code-component-size code)
|
||||
below (- (code-object-size code)
|
||||
(* (code-header-words code) n-word-bytes))
|
||||
collect (sap-ref-8 text-sap i)))))
|
||||
|
||||
|
|
@ -918,7 +918,7 @@
|
|||
start-offs)
|
||||
nbytes output nil core)))))
|
||||
(format output " .quad 0, 0~%") ; trailer with SIMPLE-FUN count of 0
|
||||
(let ((size (code-component-size code-component))) ; No need to pin
|
||||
(let ((size (code-object-size code-component))) ; No need to pin
|
||||
(incf code-addr size)
|
||||
(setf total-code-size size)))
|
||||
(format output "~%# end of lisp asm routines~2%")
|
||||
|
|
@ -930,15 +930,16 @@
|
|||
(ecase (%widetag-of (sap-ref-word (int-sap (translate-ptr code-addr spaces)) 0))
|
||||
(#.code-header-widetag
|
||||
(let* ((code (make-code-obj code-addr))
|
||||
(objsize (code-component-size code)))
|
||||
(objsize (code-object-size code)))
|
||||
(incf total-code-size objsize)
|
||||
(cond
|
||||
((< (code-header-words code) 4) ; filler object
|
||||
(let ((nbytes (code-component-size code)))
|
||||
(let ((sap (int-sap (- (get-lisp-obj-address code) other-pointer-lowtag))))
|
||||
(format output " .quad 0x~x, 0x~x~% .fill 0x~x~%# ~x:~%"
|
||||
code-header-widetag (ash nbytes n-fixnum-tag-bits)
|
||||
(- nbytes (* 2 n-word-bytes))
|
||||
(+ code-addr nbytes))))
|
||||
(sap-ref-word sap 0)
|
||||
(sap-ref-word sap n-word-bytes)
|
||||
(- objsize (* 2 n-word-bytes))
|
||||
(+ code-addr objsize))))
|
||||
((%instancep (%code-debug-info code)) ; assume it's a COMPILED-DEBUG-INFO
|
||||
(aver (plusp (code-n-entries code)))
|
||||
(let* ((source
|
||||
|
|
|
|||
Loading…
Reference in a new issue