From 0c8ef9f4551333788d3551f001a70108b939bc56 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Tue, 8 Nov 2016 18:24:31 -0500 Subject: [PATCH] Add :IMMOBILE-CODE feature. This is part 3 of 4 of the immobile space feature suite. Supported only on x86-64 for macOS and Linux. Includes some important bugfixes to the mark-and-sweep collector that seemed not to be triggered except by immobile code. --- NEWS | 3 + base-target-features.lisp-expr | 8 + make-config.sh | 2 +- src/assembly/assemfile.lisp | 1 + src/assembly/x86-64/arith.lisp | 2 + src/assembly/x86-64/support.lisp | 9 +- src/code/alloc.lisp | 8 +- src/code/debug-int.lisp | 3 +- src/code/fop.lisp | 8 + src/code/target-load.lisp | 10 +- src/code/x86-64-vm.lisp | 17 ++- src/cold/shared.lisp | 2 + src/compiler/dump.lisp | 4 + src/compiler/early-c.lisp | 3 + src/compiler/generic/core.lisp | 24 +++ src/compiler/generic/genesis.lisp | 44 +++++- src/compiler/generic/target-core.lisp | 17 ++- src/compiler/main.lisp | 5 +- src/compiler/target-disassem.lisp | 5 +- src/compiler/x86-64/insts.lisp | 4 +- src/compiler/x86-64/macros.lisp | 5 +- src/compiler/x86-64/static-fn.lisp | 10 ++ src/compiler/x86-64/system.lisp | 11 +- src/runtime/gc-common.c | 4 +- src/runtime/gc-internal.h | 2 +- src/runtime/gencgc.c | 20 ++- src/runtime/marknsweepgc.c | 280 ++++++++++++++++++++-------------- src/runtime/print.c | 1 + src/runtime/runtime.h | 10 +- 29 files changed, 347 insertions(+), 175 deletions(-) diff --git a/NEWS b/NEWS index 75c02ade3..bfcfd1d8c 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,9 @@ ;;;; -*- coding: utf-8; fill-column: 78 -*- changes relative to sbcl-1.3.11: + * enhancement: on x86-64, compiled functions can not be moved (but can + be freed) by GC. This facilitates examination of running images by + external tools. Code locality and performance are improved as well. * bug fix: calling a named function (e.g. a DEFUN) concurrently with redefining that same function could lead to execution of random bytes. * bug fix: yes-or-no-p accepts formatter functions (lp#1639490) diff --git a/base-target-features.lisp-expr b/base-target-features.lisp-expr index ec4fd62a3..fe9fed4bf 100644 --- a/base-target-features.lisp-expr +++ b/base-target-features.lisp-expr @@ -183,6 +183,14 @@ ;; consider disabling this feature and reporting a bug. ; :immobile-space + ;; Allocate most functions in the immobile space. + ;; Enabled by default if supported. + ;; The down-side of this feature is that the allocator is significantly + ;; slower than the allocator for movable code. If a particular application + ;; is performance-constrained by speed of creation of compiled functions + ;; (not including closures), the feature can be disabled. + ; :immobile-code + ;; Combine the layout pointer, instance-length, and widetag of INSTANCE ;; into a single machine word. This represents a space savings of anywhere ;; from 4% to 8% in typical applications. (Your mileage may vary). diff --git a/make-config.sh b/make-config.sh index b2d6dc30b..ff35f6b55 100755 --- a/make-config.sh +++ b/make-config.sh @@ -667,7 +667,7 @@ elif [ "$sbcl_arch" = "x86-64" ]; then case "$sbcl_os" in linux | darwin) # probably works on *BSD but not tested - printf ' :immobile-space :compact-instance-header' >> $ltf + printf ' :immobile-space :immobile-code :compact-instance-header' >> $ltf esac elif [ "$sbcl_arch" = "mips" ]; then printf ' :cheneygc :linkage-table' >> $ltf diff --git a/src/assembly/assemfile.lisp b/src/assembly/assemfile.lisp index a26424836..26a065621 100644 --- a/src/assembly/assemfile.lisp +++ b/src/assembly/assemfile.lisp @@ -39,6 +39,7 @@ (*elsewhere* nil) (*assembly-optimize* nil) (*fixup-notes* nil) + #!+immobile-code (*code-is-immobile* t) #!+inline-constants (*unboxed-constants* nil)) (unwind-protect (let ((*features* (cons :sb-assembling *features*))) diff --git a/src/assembly/x86-64/arith.lisp b/src/assembly/x86-64/arith.lisp index c36a48f78..d9b16b006 100644 --- a/src/assembly/x86-64/arith.lisp +++ b/src/assembly/x86-64/arith.lisp @@ -32,6 +32,8 @@ #+sb-xc-host (defmacro static-fun-addr (name) + #!+immobile-code `(make-fixup ,name :static-call) + #!-immobile-code `(make-ea :qword :disp (+ nil-value (static-fun-offset ,name)))) ;;;; addition, subtraction, and multiplication diff --git a/src/assembly/x86-64/support.lisp b/src/assembly/x86-64/support.lisp index 77c741046..f2ee7d904 100644 --- a/src/assembly/x86-64/support.lisp +++ b/src/assembly/x86-64/support.lisp @@ -10,8 +10,13 @@ (in-package "SB!VM") (defun invoke-asm-routine (inst routine vop temp-reg) - (declare (ignore vop)) - (inst mov temp-reg (make-fixup routine :assembly-routine)) + (declare (ignorable vop)) + (cond #!+immobile-code + ((neq (sb!c::component-kind + (sb!c::node-component (sb!c::vop-node vop))) :toplevel) + (setq temp-reg (make-fixup routine :assembly-routine))) + (t + (inst mov temp-reg (make-fixup routine :assembly-routine)))) (ecase inst (jmp (inst jmp temp-reg)) (call (inst call temp-reg)))) diff --git a/src/code/alloc.lisp b/src/code/alloc.lisp index f999f6605..1a451a10c 100644 --- a/src/code/alloc.lisp +++ b/src/code/alloc.lisp @@ -133,7 +133,7 @@ (table (cdr freelist)) (old (gethash (hole-size hole) table))) ;; Check for double-free error - #+immobile-space-debug (aver (not (member hole (gethash size table)))) + #!+immobile-space-debug (aver (not (member hole (gethash size table)))) (unless old (setf (car freelist) (sorted-list-insert size (car freelist) #'identity))) @@ -147,7 +147,7 @@ (old-length (length list)) (new (delete hole list :count 1))) (declare (ignorable old-length)) - #+immobile-space-debug (aver (= (length new) (1- old-length))) + #!+immobile-space-debug (aver (= (length new) (1- old-length))) (cond (new (setf (gethash key table) new)) (t @@ -185,7 +185,7 @@ n-fixnum-tag-bits))))) (defun unallocate (hole) - #+immobile-space-debug + #!+immobile-space-debug (awhen *in-use-bits* (mark-range it hole (hole-size hole) nil)) (let* ((hole-end (hole-end-address hole)) (end-is-free-ptr (eql (ash hole-end (- n-fixnum-tag-bits)) @@ -327,7 +327,7 @@ (when (>= page-start obj-end) (return)) (setf (deref varyobj-page-scan-start-offset index) (ash (- page-end addr) (- (1+ word-shift)))))) - #+immobile-space-debug ; "address sanitizer" + #!+immobile-space-debug ; "address sanitizer" (awhen *in-use-bits* (mark-range it addr n-bytes t)) (setf (sap-ref-word (int-sap addr) 0) word0 (sap-ref-word (int-sap addr) n-word-bytes) word1) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index db4fd3c72..c8c5cde13 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -3280,7 +3280,8 @@ register." (trap-loc (static-foreign-symbol-sap "fun_end_breakpoint_trap")) (length (sap- src-end src-start)) (code-object - (sb!c:allocate-code-object bogus-lra-constants length)) + (sb!c:allocate-code-object #!+immobile-code nil + bogus-lra-constants length)) (dst-start (code-instructions code-object))) (declare (type system-area-pointer src-start src-end dst-start trap-loc) diff --git a/src/code/fop.lisp b/src/code/fop.lisp index e93cb4f54..0ad61c9d8 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -622,6 +622,14 @@ a bug.~@:>") kind) code-object) +#!+immobile-code +(!define-fop 135 :not-host (fop-static-call-fixup (code-object kind name)) + (sb!vm:fixup-code-object code-object + (read-word-arg (fasl-input-stream)) + (sb!vm::function-raw-address name) + kind) + code-object) + (!define-fop 147 :not-host (fop-foreign-fixup (code-object kind)) (let* ((len (read-byte-arg (fasl-input-stream))) (sym (make-string len :element-type 'base-char))) diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index 8831d546d..de94ea4fa 100644 --- a/src/code/target-load.lisp +++ b/src/code/target-load.lisp @@ -149,7 +149,10 @@ (sb!c::*policy* sb!c::*policy*)) (return-from load (if faslp - (load-as-fasl stream verbose print) + (prog1 (load-as-fasl stream verbose print) + ;; Try to ameliorate immobile heap fragmentation + ;; in case somehow nontoplevel code is garbage. + #!+immobile-code (gc)) (sb!c:with-compiler-error-resignalling (load-as-source stream :verbose verbose :print print))))))) @@ -236,8 +239,9 @@ (declare (simple-vector stack) (type index ptr)) (let* ((debug-info-index (+ ptr box-num)) (toplevel-p (svref stack (1+ debug-info-index))) - (code (sb!c:allocate-code-object box-num code-length))) - (declare (ignore toplevel-p)) + (code (sb!c:allocate-code-object #!+immobile-code (not toplevel-p) + box-num code-length))) + (declare (ignorable toplevel-p)) (setf (%code-debug-info code) (svref stack debug-info-index)) (loop for i of-type index from sb!vm:code-constants-offset for j of-type index from ptr below debug-info-index diff --git a/src/code/x86-64-vm.lisp b/src/code/x86-64-vm.lisp index c77239673..5b628aaa3 100644 --- a/src/code/x86-64-vm.lisp +++ b/src/code/x86-64-vm.lisp @@ -63,11 +63,18 @@ (:relative ;; Fixup is the actual address wanted. ;; Replace word with value to add to that loc to get there. - (let* ((loc-sap (+ (sap-int sap) offset)) - (rel-val (- fixup loc-sap (/ n-word-bytes 2)))) - (declare (type (unsigned-byte 64) loc-sap) - (type (signed-byte 32) rel-val)) - (setf (signed-sap-ref-32 sap offset) rel-val)))))) + ;; In the #!-immobile-code case, there's nothing to assert. + ;; Relative fixups pretty much can't happen. + #!+immobile-code + (unless (<= immobile-space-start (get-lisp-obj-address code) immobile-space-end) + (error "Can't compute fixup relative to movable object ~S" code)) + (setf (signed-sap-ref-32 sap offset) + (etypecase fixup + (integer + ;; JMP/CALL are relative to the next instruction, + ;; so add 4 bytes for the size of the displacement itself. + (- fixup + (the (unsigned-byte 64) (+ (sap-int sap) offset 4)))))))))) nil) ;;;; low-level signal context access functions diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index 4b34c2930..a382d9087 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -219,6 +219,8 @@ ":IMMOBILE-SPACE is supported only on x86-64") ("(and compact-instance-header (not immobile-space))" ":COMPACT-INSTANCE-HEADER requires :IMMOBILE-SPACE feature") + ("(and immobile-code (not immobile-space))" + ":IMMOBILE-CODE requires :IMMOBILE-SPACE feature") ;; There is still hope to make multithreading on DragonFly x86-64 ("(and sb-thread x86 dragonfly)" ":SB-THREAD not supported on selected architecture"))) diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index ff49e97bb..ab541d215 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -1045,6 +1045,10 @@ (:code-object (aver (null name)) (dump-fop 'fop-code-object-fixup fasl-output)) + #!+immobile-code + (:static-call + (dump-non-immediate-object name fasl-output) + (dump-fop 'fop-static-call-fixup fasl-output)) (:symbol-tls-index (aver (symbolp name)) (dump-non-immediate-object name fasl-output) diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp index 61d0b1f62..66b8e45f4 100644 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -92,6 +92,9 @@ ;;; miscellaneous forward declarations (defvar *code-segment*) +;; FIXME: this is a kludge due to the absence of a 'vop' argument +;; to ALLOCATION-TRAMP in the x86-64 backend. +(defvar *code-is-immobile*) #!+sb-dyncount (defvar *collect-dynamic-statistics*) (defvar *component-being-compiled*) (defvar *compiler-error-context*) diff --git a/src/compiler/generic/core.lisp b/src/compiler/generic/core.lisp index 18cfb11b5..5b511f7b0 100644 --- a/src/compiler/generic/core.lisp +++ b/src/compiler/generic/core.lisp @@ -72,6 +72,9 @@ (:code-object (aver (null name)) (get-lisp-obj-address code)) + #!+immobile-code + (:static-call + (sb!vm::function-raw-address name)) (:symbol-tls-index (aver (symbolp name)) (ensure-symbol-tls-index name))))) @@ -111,3 +114,24 @@ (setf (debug-info-source info) source))) (setf (core-object-debug-info object) nil) (values)) + +#!+(and immobile-code (host-feature sb-xc)) +(progn +(defvar *linker-fixups*) +(defun sb!vm::function-raw-address (name &optional (fun (awhen (find-fdefn name) + (fdefn-fun it)))) + (let ((addr (and fun (get-lisp-obj-address fun)))) + (cond (addr + (cond ((not (<= sb!vm:immobile-space-start addr sb!vm:immobile-space-end)) + (error "Can't statically link to ~S: code is movable" name)) + ((neq (fun-subtype fun) sb!vm:simple-fun-header-widetag) + (error "Can't statically link to ~S: non-simple function" name)) + (t + (sap-ref-word (int-sap addr) + (- (ash sb!vm:simple-fun-self-slot sb!vm:word-shift) + sb!vm:fun-pointer-lowtag))))) + ((boundp '*linker-fixups*) + (warn "Deferring linkage to ~S" name) + (cons :defer name)) + (t + (error "Can't statically link to undefined function ~S" name)))))) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index b613bb17c..fd0fa542b 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1912,6 +1912,12 @@ core and return a descriptor to it." (defun cold-functionp (descriptor) (eql (descriptor-lowtag descriptor) sb!vm:fun-pointer-lowtag)) +(defun cold-fun-entry-addr (fun) + (aver (= (descriptor-lowtag fun) sb!vm:fun-pointer-lowtag)) + (+ (descriptor-bits fun) + (- sb!vm:fun-pointer-lowtag) + (ash sb!vm:simple-fun-code-offset sb!vm:word-shift))) + ;;; Handle a DEFUN in cold-load. (defun cold-fset (name defn source-loc &optional inline-expansion) ;; SOURCE-LOC can be ignored, because functions intrinsically store @@ -2102,6 +2108,7 @@ core and return a descriptor to it." (defvar *cold-assembler-routines*) (defvar *cold-assembler-fixups*) +(defvar *cold-static-call-fixups*) (defun record-cold-assembler-routine (name address) (/xhow "in RECORD-COLD-ASSEMBLER-ROUTINE" name address) @@ -2417,7 +2424,15 @@ core and return a descriptor to it." (let* ((routine (car fixup)) (value (lookup-assembler-reference routine))) (when value - (do-cold-fixup (second fixup) (third fixup) value (fourth fixup)))))) + (do-cold-fixup (second fixup) (third fixup) value (fourth fixup))))) + ;; Static calls are very similar to assembler routine calls, + ;; so take care of those too. + (dolist (fixup *cold-static-call-fixups*) + (destructuring-bind (name kind code offset) fixup + (do-cold-fixup code offset + (cold-fun-entry-addr + (cold-fdefn-fun (cold-fdefinition-object name))) + kind)))) #!+sb-dynamic-core (progn @@ -2911,12 +2926,16 @@ core and return a descriptor to it." (round-up raw-header-n-words 2)) (toplevel-p (pop-stack)) (debug-info (pop-stack)) - (des (allocate-cold-descriptor *dynamic* - (+ (ash header-n-words - sb!vm:word-shift) - code-size) - sb!vm:other-pointer-lowtag))) - (declare (ignore toplevel-p)) + (des (allocate-cold-descriptor + #!-immobile-code *dynamic* + ;; toplevel-p is an indicator of whether the code will + ;; will become garbage. If so, put it in dynamic space, + ;; otherwise immobile space. + #!+immobile-code + (if toplevel-p *dynamic* *immobile-varyobj*) + (+ (ash header-n-words sb!vm:word-shift) code-size) + sb!vm:other-pointer-lowtag))) + (declare (ignorable toplevel-p)) (write-header-word des header-n-words sb!vm:code-header-widetag) (write-wordindexed des sb!vm:code-code-size-slot @@ -3193,6 +3212,16 @@ core and return a descriptor to it." (value (descriptor-bits code-object))) (do-cold-fixup code-object offset value kind) code-object)) + +#!+immobile-code +(define-cold-fop (fop-static-call-fixup) + (let ((name (pop-stack)) + (kind (pop-stack)) + (code-object (pop-stack)) + (offset (read-word-arg (fasl-input-stream)))) + (push (list name kind code-object offset) *cold-static-call-fixups*) + code-object)) + ;;;; sanity checking space layouts @@ -3913,6 +3942,7 @@ initially undefined function references:~2%") (*unbound-marker* (make-other-immediate-descriptor 0 sb!vm:unbound-marker-widetag)) + *cold-static-call-fixups* *cold-assembler-fixups* *cold-assembler-routines* (*deferred-known-fun-refs* nil) diff --git a/src/compiler/generic/target-core.lisp b/src/compiler/generic/target-core.lisp index b33266cae..9a343a9e1 100644 --- a/src/compiler/generic/target-core.lisp +++ b/src/compiler/generic/target-core.lisp @@ -16,13 +16,17 @@ (in-package "SB!C") -(declaim (ftype (sfunction (fixnum fixnum) code-component) allocate-code-object)) -(defun allocate-code-object (boxed unboxed) +(declaim (ftype (sfunction (#!+immobile-code boolean fixnum fixnum) + code-component) allocate-code-object)) +(defun allocate-code-object (#!+immobile-code immobile-p boxed unboxed) #!+gencgc (without-gcing - (%make-lisp-obj - (alien-funcall (extern-alien "alloc_code_object" (function unsigned unsigned unsigned)) - boxed unboxed))) + (if (or #!+immobile-code immobile-p) + #!+immobile-code (sb!vm::allocate-immobile-code boxed unboxed) + #!-immobile-code nil + (%make-lisp-obj + (alien-funcall (extern-alien "alloc_code_object" (function unsigned unsigned unsigned)) + boxed unboxed)))) #!-gencgc (%primitive allocate-code-object boxed unboxed)) @@ -58,7 +62,8 @@ (let* ((2comp (component-info component)) (constants (ir2-component-constants 2comp)) (box-num (- (length constants) sb!vm:code-constants-offset)) - (code-obj (allocate-code-object box-num length)) + ;; All compilation into memory favors the immobile space. + (code-obj (allocate-code-object #!+immobile-code t box-num length)) (fill-ptr (code-instructions code-obj))) (declare (type index box-num length)) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 44df38bb2..06139e0c8 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -634,7 +634,10 @@ necessary, since type inference may take arbitrarily long to converge.") (maybe-mumble "code ") (multiple-value-bind (code-length fixup-notes) - (generate-code component) + (let (#!+immobile-code + (*code-is-immobile* + (neq (component-kind component) :toplevel))) + (generate-code component)) #-sb-xc-host (when *compiler-trace-output* diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index b4cfe1ef5..14db12d0d 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -1841,8 +1841,9 @@ (invert-address-hash *static-foreign-symbols* *assembler-routines-by-addr*)) (loop for name in sb!vm:*static-funs* - for address = (+ sb!vm::nil-value - (sb!vm::static-fun-offset name)) + for address = + #!+immobile-code (sb!vm::function-raw-address name) + #!-immobile-code (+ sb!vm::nil-value (sb!vm::static-fun-offset name)) do (setf (gethash address *assembler-routines-by-addr*) name)) ;; Not really a routine, but it uses the similar logic for annotations #!+sb-safepoint diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 22e73d366..130ffc82d 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -1567,8 +1567,8 @@ (reg-tn-encoding dst)) (emit-sized-immediate segment size src)))) ((and (fixup-p src) - (or (eq (fixup-flavor src) :foreign) - (eq (fixup-flavor src) :assembly-routine))) + (member (fixup-flavor src) + '(:static-call :foreign :assembly-routine))) (maybe-emit-rex-prefix segment :dword nil nil dst) (emit-byte-with-reg segment #b10111 (reg-tn-encoding dst)) (emit-absolute-fixup segment src)) diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index 88bf16d44..87ea7f005 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -179,8 +179,9 @@ (inst push alloc-tn)) (t (inst push size))) - (inst mov alloc-tn (make-fixup "alloc_tramp" :foreign)) - (inst call alloc-tn) + (let ((f (make-fixup "alloc_tramp" :foreign))) + (inst call (cond #!+immobile-code (sb!c::*code-is-immobile* f) + (t (inst mov alloc-tn f) alloc-tn)))) (inst pop result-tn) (when lowtag (inst or (reg-in-size result-tn :byte) lowtag)) diff --git a/src/compiler/x86-64/static-fn.lisp b/src/compiler/x86-64/static-fn.lisp index 1f0c370a3..7c973544a 100644 --- a/src/compiler/x86-64/static-fn.lisp +++ b/src/compiler/x86-64/static-fn.lisp @@ -108,6 +108,16 @@ ;; longer executed? Does it not depend on the ;; 1+3=4=fdefn_raw_address_offset relationship above? ;; Is something else going on?) + #!+immobile-code + (cond ((neq (sb!c::component-kind (sb!c::node-component ,node)) :toplevel) + (inst call (make-fixup function :static-call))) + (t + ;; While we could use CALL-INDIRECT here, + ;; the fixup allows calling _any_ Lisp function, + ;; not just those in *static-funs*. + (inst mov temp-reg-tn (make-fixup function :static-call)) + (inst call temp-reg-tn))) + #!-immobile-code (call-indirect (+ nil-value (static-fun-offset function))) ,(collect ((bindings) (links)) (do ((temp (temp-names) (cdr temp)) diff --git a/src/compiler/x86-64/system.lisp b/src/compiler/x86-64/system.lisp index f26fd3d8f..f056ba7a3 100644 --- a/src/compiler/x86-64/system.lisp +++ b/src/compiler/x86-64/system.lisp @@ -179,9 +179,9 @@ (:results (sap :scs (sap-reg) :from (:argument 0))) (:result-types system-area-pointer) (:generator 10 - (loadw sap code 0 other-pointer-lowtag) - (inst shr sap n-widetag-bits) - #!+immobile-space (inst and sap short-header-max-words) + (zeroize sap) + (inst mov (reg-in-size sap :word) + (make-ea :word :base code :disp (- 1 other-pointer-lowtag))) (inst lea sap (make-ea :byte :base code :index sap :scale n-word-bytes :disp (- other-pointer-lowtag))))) @@ -192,8 +192,9 @@ (:arg-types * positive-fixnum) (:results (func :scs (descriptor-reg) :from (:argument 0))) (:generator 10 - (loadw func code 0 other-pointer-lowtag) - (inst shr func n-widetag-bits) + (zeroize func) + (inst mov (reg-in-size func :word) + (make-ea :word :base code :disp (- 1 other-pointer-lowtag))) (inst lea func (make-ea :byte :base offset :index func :scale n-word-bytes diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c index a300ae20d..f5ddd6956 100644 --- a/src/runtime/gc-common.c +++ b/src/runtime/gc-common.c @@ -165,7 +165,7 @@ scavenge(lispobj *start, sword_t n_words) } else if (immobile_space_p(object)) { lispobj *ptr = native_pointer(object); if (immobile_obj_gen_bits(ptr) == from_space) - promote_immobile_obj(ptr); + promote_immobile_obj(ptr, 1); object_ptr++; #endif } else { @@ -815,7 +815,7 @@ scav_instance(lispobj *where, lispobj header) layout = native_pointer((lispobj)layout); #ifdef LISP_FEATURE_COMPACT_INSTANCE_HEADER if (__immobile_obj_gen_bits(layout) == from_space) - promote_immobile_obj(layout); + promote_immobile_obj(layout, 1); #else if (forwarding_pointer_p(layout)) layout = native_pointer((lispobj)forwarding_pointer_value(layout)); diff --git a/src/runtime/gc-internal.h b/src/runtime/gc-internal.h index e312430ff..ae03454da 100644 --- a/src/runtime/gc-internal.h +++ b/src/runtime/gc-internal.h @@ -219,7 +219,7 @@ static inline low_page_index_t find_immobile_page_index(void *addr) return -1; } int immobile_obj_younger_p(lispobj,generation_index_t); -void promote_immobile_obj(lispobj*); +void promote_immobile_obj(lispobj*,int); // Maximum number of boxed words in a code component #define CODE_HEADER_COUNT_MASK 0xFFFFFF diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index aa3bf1d0c..6dc884992 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -2739,7 +2739,8 @@ extern void update_immobile_nursery_bits(), scavenge_immobile_roots(generation_index_t,generation_index_t), scavenge_immobile_newspace(), - sweep_immobile_space(int raise); + sweep_immobile_space(int raise), + write_protect_immobile_space(); #else #define immobile_scav_queue_count 0 #endif @@ -3662,12 +3663,6 @@ garbage_collect_generation(generation_index_t generation, int raise) gc_assert(pinned_dwords(i) == NULL); } -#ifdef LISP_FEATURE_IMMOBILE_SPACE - /* Immobile space generation bits are lazily updated for gen0 - (not touched on every object allocation) so do it now */ - update_immobile_nursery_bits(); -#endif - /* Un-write-protect the old-space pages. This is essential for the * promoted pages as they may contain pointers into the old-space * which need to be scavenged. It also helps avoid unnecessary page @@ -3880,7 +3875,7 @@ garbage_collect_generation(generation_index_t generation, int raise) * scavenged. The new_space generation needs special handling as * objects may be moved in - it is handled separately below. */ #ifdef LISP_FEATURE_IMMOBILE_SPACE - scavenge_immobile_roots(generation+1, PSEUDO_STATIC_GENERATION); + scavenge_immobile_roots(generation+1, SCRATCH_GENERATION); #endif scavenge_generations(generation+1, PSEUDO_STATIC_GENERATION); @@ -4088,6 +4083,12 @@ collect_garbage(generation_index_t last_gen) if (gencgc_verbose > 1) print_generation_stats(); +#ifdef LISP_FEATURE_IMMOBILE_SPACE + /* Immobile space generation bits are lazily updated for gen0 + (not touched on every object allocation) so do it now */ + update_immobile_nursery_bits(); +#endif + do { /* Collect the generation. */ @@ -4171,6 +4172,9 @@ collect_garbage(generation_index_t last_gen) } write_protect_generation_pages(gen_to_wp); } +#ifdef LISP_FEATURE_IMMOBILE_SPACE + write_protect_immobile_space(); +#endif /* Set gc_alloc() back to generation 0. The current regions should * be flushed after the above GCs. */ diff --git a/src/runtime/marknsweepgc.c b/src/runtime/marknsweepgc.c index 22ac7957b..c4091d48d 100644 --- a/src/runtime/marknsweepgc.c +++ b/src/runtime/marknsweepgc.c @@ -350,8 +350,12 @@ void update_immobile_nursery_bits() os_protect((os_vm_address_t)IMMOBILE_SPACE_START, fixedobj_free_ptr - IMMOBILE_SPACE_START, OS_VM_PROT_ALL); + + // varyobj_free_ptr is typically not page-aligned - only by random chance + // might it be. Additionally we need a page beyond that for the re-scan queue. + os_vm_address_t limit = (char*)immobile_scav_queue + IMMOBILE_CARD_BYTES; os_protect((os_vm_address_t)(IMMOBILE_VARYOBJ_SUBSPACE_START), - varyobj_free_ptr - IMMOBILE_VARYOBJ_SUBSPACE_START, + limit - (os_vm_address_t)IMMOBILE_VARYOBJ_SUBSPACE_START, OS_VM_PROT_ALL); for (page=0; page <= max_used_fixedobj_page ; ++page) { @@ -383,12 +387,13 @@ static inline boolean unboxed_obj_p(int widetag) && widetag != SIMPLE_VECTOR_WIDETAG); } -/* Turn a white object grey. Also enqueue the object for re-scan */ +/* Turn a white object grey. Also enqueue the object for re-scan if required */ void -promote_immobile_obj(lispobj *ptr) // a native pointer +promote_immobile_obj(lispobj *ptr, int rescan) // a native pointer { if (widetag_of(*ptr) == SIMPLE_FUN_HEADER_WIDETAG) ptr = (lispobj*)code_obj_from_simple_fun((struct simple_fun*)ptr); + gc_assert(__immobile_obj_gen_bits(ptr) == from_space); int pointerish = !unboxed_obj_p(widetag_of(*ptr)); assign_generation(ptr, (pointerish ? 0 : IMMOBILE_OBJ_VISITED_FLAG) | new_space); low_page_index_t page_index = find_immobile_page_index(ptr); @@ -398,6 +403,20 @@ promote_immobile_obj(lispobj *ptr) // a native pointer } else { fixedobj_pages[page_index].gens |= 1<= FIRST_VARYOBJ_PAGE) + varyobj_page_touched_bits[(page_index-FIRST_VARYOBJ_PAGE)/32] + |= 1 << (page_index & 31); + else + SET_WP_FLAG(page_index, WRITE_PROTECT_CLEARED); + } + return; // No need to enqueue. + } + // Do nothing if either we don't need to look for pointers in this object, // or the work queue has already overflowed, causing a full scan. if (!pointerish || immobile_scav_queue_count > QCAPACITY) return; @@ -451,8 +470,9 @@ void immobile_space_preserve_pointer(void* addr) return; } if (__immobile_obj_gen_bits(header_addr) == from_space) { - dprintf((logfile,"immobile obj @ %p is conservatively live\n", addr)); - promote_immobile_obj(header_addr); + dprintf((logfile,"immobile obj @ %p (<- %p) is conservatively live\n", + header_addr, addr)); + promote_immobile_obj(header_addr, 0); } } @@ -545,8 +565,10 @@ void scavenge_immobile_newspace() // but subsequent iterations might not. if (immobile_scav_queue_count <= QCAPACITY) --immobile_scav_queue_count; - set_visited(obj); - scavenge(obj, sizetab[widetag_of(*obj)](obj)); + if (!(__immobile_obj_gen_bits(obj) & IMMOBILE_OBJ_VISITED_FLAG)) { + set_visited(obj); + scavenge(obj, sizetab[widetag_of(*obj)](obj)); + } } while (i != queue_index_to); } } @@ -555,13 +577,14 @@ void scavenge_immobile_newspace() // Return a page >= page_index having potential old->young pointers, // or -1 if there isn't one. static int next_varyobj_root_page(unsigned int page_index, + unsigned int end_bitmap_index, unsigned char genmask) { - int map_index = (page_index - FIRST_VARYOBJ_PAGE) / 32; + unsigned int map_index = (page_index - FIRST_VARYOBJ_PAGE) / 32; + if (map_index >= end_bitmap_index) return -1; int bit_index = page_index & 31; - if (map_index >= n_bitmap_elts) return -1; // Look only at bits of equal or greater weight than bit_index. - unsigned int word = (0xFFFFFFFF << bit_index) & varyobj_page_touched_bits[map_index]; + unsigned int word = (0xFFFFFFFFU << bit_index) & varyobj_page_touched_bits[map_index]; while (1) { if (word) { bit_index = ffs(word) - 1; @@ -573,7 +596,7 @@ static int next_varyobj_root_page(unsigned int page_index, continue; } } - if (++map_index >= n_bitmap_elts) return -1; + if (++map_index >= end_bitmap_index) return -1; word = varyobj_page_touched_bits[map_index]; } } @@ -581,13 +604,6 @@ static int next_varyobj_root_page(unsigned int page_index, void scavenge_immobile_roots(generation_index_t min_gen, generation_index_t max_gen) { - // When raise = 1, new_space is also among the root generations. - // To distinguish new_space objects that were already seen - meaning their - // contained pointers were walked - versus not seen, - // we mark the objects scavenged on this pass as visited. - // This essentialy distinguishes grey from black in the tri-color scheme. - int mark_visited = new_space == min_gen; - // example: scavenging gens 2..6, the mask of root gens is #b1111100 int genmask = ((1 << (max_gen - min_gen + 1)) - 1) << min_gen; @@ -603,42 +619,37 @@ scavenge_immobile_roots(generation_index_t min_gen, generation_index_t max_gen) int gen; // Immobile space can only contain objects with a header word, // no conses, so any fixnum where a header could be is not a live - // object. The scan loop is expanded twice, once for mark_visited - // and once for not, to avoid an extra test when 'raise=0' -#define SCAN(mark_it) \ - do { \ - if (!fixnump(*obj) && (genmask >> (gen=__immobile_obj_gen_bits(obj)) & 1)) { \ - if (gen == new_space) { mark_it; } \ - scavenge(obj, n_words); \ - } \ - } while ((obj = (lispobj*)((char*)obj + obj_spacing)) <= limit) - if (mark_visited) SCAN(set_visited(obj)); else SCAN(); + // object. + do { + if (!fixnump(*obj) && (genmask >> (gen=__immobile_obj_gen_bits(obj)) & 1)) { + if (gen == new_space) { set_visited(obj); } + scavenge(obj, n_words); + } + } while ((obj = (lispobj*)((char*)obj + obj_spacing)) <= limit); } -#undef SCAN // Variable-length object pages - page = next_varyobj_root_page(FIRST_VARYOBJ_PAGE, genmask); + unsigned n_varyobj_pages = 1+max_used_varyobj_page-FIRST_VARYOBJ_PAGE; + unsigned end_bitmap_index = (n_varyobj_pages+31)/32; + page = next_varyobj_root_page(FIRST_VARYOBJ_PAGE, end_bitmap_index, genmask); while (page >= 0) { lispobj* obj = varyobj_scan_start(page); do { lispobj* limit = (lispobj*)low_page_address(page) + WORDS_PER_PAGE; int widetag, n_words, gen; -#define SCAN(mark_it) \ - for ( ; obj < limit ; obj += n_words ) { \ - n_words = sizetab[widetag = widetag_of(*obj)](obj); \ - if (genmask >> (gen=__immobile_obj_gen_bits(obj)) & 1) { \ - if (gen == new_space) { mark_it; } \ - scavenge(obj, n_words); \ - } \ + for ( ; obj < limit ; obj += n_words ) { + n_words = sizetab[widetag = widetag_of(*obj)](obj); + if (genmask >> (gen=__immobile_obj_gen_bits(obj)) & 1) { + if (gen == new_space) { set_visited(obj); } + scavenge(obj, n_words); + } } - if (mark_visited) SCAN(set_visited(obj)) else SCAN(); page = find_immobile_page_index(obj); } while (page > 0 && (VARYOBJ_PAGE_GENS(page) & genmask) && varyobj_page_touched(page)); - page = next_varyobj_root_page(1+page, genmask); + page = next_varyobj_root_page(1+page, end_bitmap_index, genmask); } -#undef SCAN scavenge_immobile_newspace(); } @@ -683,27 +694,12 @@ void set_immobile_space_hints() 0)); } -static void protect_space() +void write_protect_immobile_space() { - int max; + immobile_scav_queue = NULL; + immobile_scav_queue_head = 0; set_immobile_space_hints(); - // find the highest page in use - for (max = FIRST_VARYOBJ_PAGE-1 ; max >= 0 ; --max) - if (fixedobj_pages[max].attr.parts.obj_size) - break; - max_used_fixedobj_page = max; // this is a page index, not the number of pages. - SYMBOL(IMMOBILE_FIXEDOBJ_FREE_POINTER)->value = - IMMOBILE_SPACE_START + IMMOBILE_CARD_BYTES*(1+max); - - for (max = (IMMOBILE_SPACE_SIZE/IMMOBILE_CARD_BYTES)-1 ; - max >= FIRST_VARYOBJ_PAGE ; --max) - if (VARYOBJ_PAGE_GENS(max)) - break; - max_used_varyobj_page = max; // this is a page index, not the number of pages. - - dprintf((logfile, "Protect space: set max used page to %d. end=%lx\n", - max, IMMOBILE_SPACE_START + IMMOBILE_CARD_BYTES*(1+max))); // Now find contiguous ranges of pages that are protectable, // minimizing the number of system calls as much as possible. @@ -828,6 +824,10 @@ varyobj_points_to_younger_p(lispobj* obj, int gen, int keep_gen, int new_gen, return 0; } +/// The next two functions are analogous to 'update_page_write_prot()' +/// but they differ in that they are "precise" - random code bytes that look +/// like pointers are not accidentally treated as pointers. + // If 'page' does not contain any objects that points to an object // younger than themselves, then return true. // This is called on pages that do not themselves contain objects of @@ -994,12 +994,14 @@ sweep_fixedobj_pages(int raise) fixedobj_pages[page].attr.packed = 0; } #ifdef DEBUG - verify_fixedobj_page(page); + check_fixedobj_page(page); #endif dprintf((logfile,"page %d: %d holes\n", page, n_holes)); } } +void verify_immobile_page_protection(int,int); + // Scan for freshly trashed objects and turn them into filler. // Lisp is responsible for consuming the free space // when it next allocates a variable-size object. @@ -1023,26 +1025,40 @@ sweep_varyobj_pages(int raise) lispobj* page_base = (lispobj*)low_page_address(page); lispobj* limit = page_base + WORDS_PER_PAGE; if (limit > free_pointer) limit = free_pointer; - // An object whose tail is on this page or which spans this - // page would have been dealt with by the page holding its header, - // so only objects whose headers are on this page - // are candidates to become garbage now. + int any_kept = 0; // was anything moved to the kept generation + // wp_it is 1 if we should try to write-protect it now. + // If already write-protected, skip the tests. + int wp_it = varyobj_page_touched(page); lispobj* obj = varyobj_scan_start(page); + int size, gen; + if (obj < page_base) { + // An object whose tail is on this page, or which spans this page, + // would have been promoted/kept while dealing with the page with + // the object header. Therefore we don't need to consider that object, + // * except * that we do need to consider whether it is an old object + // pointing to a young object. + if (wp_it // If we wanted to try write-protecting this page, + // and the object starting before this page is strictly older + // than the generation that we're moving retained objects into + && (gen = __immobile_obj_gen_bits(obj)) > new_gen + // and it contains an old->young pointer + && varyobj_points_to_younger_p(obj, gen, keep_gen, new_gen, + (os_vm_address_t)page_base, + (os_vm_address_t)limit)) { + wp_it = 0; + } + // We MUST skip this object in the sweep, because in the case of + // non-promotion (raise=0), we could see an object in from_space + // and believe it to be dead. obj += sizetab[widetag_of(*obj)](obj); // obj can't hop over this page. If it did, there would be no // headers on the page, and genmask would have been zero. gc_assert(obj < limit); } - int any_kept = 0; // was anything moved to the kept generation - // wp_it is 1 if we should try to write-protect it now. - // If already write-protected, skip the tests. - int wp_it = varyobj_page_touched(page); - int size; for ( ; obj < limit ; obj += size ) { lispobj word = *obj; size = sizetab[widetag_of(word)](obj); - int gen; if (immobile_filler_p(obj)) { // do nothing } else if ((gen = __immobile_obj_gen_bits(obj)) == discard_gen) { if (size < 4) @@ -1074,6 +1090,27 @@ sweep_varyobj_pages(int raise) if ( mask && wp_it ) varyobj_page_touched_bits[(page - FIRST_VARYOBJ_PAGE)/32] &= ~(1 << (page & 31)); } +#ifdef DEBUG + verify_immobile_page_protection(keep_gen, new_gen); +#endif +} + +static void compute_immobile_space_bound() +{ + int max; + // find the highest page in use + for (max = FIRST_VARYOBJ_PAGE-1 ; max >= 0 ; --max) + if (fixedobj_pages[max].attr.parts.obj_size) + break; + max_used_fixedobj_page = max; // this is a page index, not the number of pages. + SYMBOL(IMMOBILE_FIXEDOBJ_FREE_POINTER)->value = + IMMOBILE_SPACE_START + IMMOBILE_CARD_BYTES*(1+max); + + for (max = (IMMOBILE_SPACE_SIZE/IMMOBILE_CARD_BYTES)-1 ; + max >= FIRST_VARYOBJ_PAGE ; --max) + if (VARYOBJ_PAGE_GENS(max)) + break; + max_used_varyobj_page = max; // this is a page index, not the number of pages. } // TODO: (Maybe this won't work. Not sure yet.) rather than use the @@ -1087,9 +1124,7 @@ sweep_immobile_space(int raise) gc_assert(immobile_scav_queue_count == 0); sweep_fixedobj_pages(raise); sweep_varyobj_pages(raise); - protect_space(); - immobile_scav_queue = NULL; - immobile_scav_queue_head = 0; + compute_immobile_space_bound(); } void gc_init_immobile() @@ -1110,6 +1145,8 @@ void gc_init_immobile() gc_assert(varyobj_page_tables); memset(varyobj_page_tables, 0, request); varyobj_page_touched_bits = (unsigned int*)varyobj_page_tables; + // The conservative value for 'touched' is 1. + memset(varyobj_page_touched_bits, 0xff, n_bitmap_elts * sizeof (int)); varyobj_page_scan_start_offset = (unsigned short*)(varyobj_page_touched_bits + n_bitmap_elts); varyobj_page_header_gens = (unsigned char*)(varyobj_page_scan_start_offset + n_varyobj_pages); } @@ -1167,6 +1204,7 @@ void immobile_space_coreparse(uword_t address, uword_t len) lispobj* obj = (lispobj*)address; lispobj* limit = (lispobj*)(address + len); int n_words; + low_page_index_t last_page = 0; for ( ; obj < limit ; obj += n_words ) { n_words = sizetab[widetag_of(*obj)](obj); if (obj[1] == 0 && (obj[0] == INSTANCE_HEADER_WIDETAG || @@ -1192,8 +1230,8 @@ void immobile_space_coreparse(uword_t address, uword_t len) varyobj_holes = (lispobj)obj; continue; } - int first_page = find_immobile_page_index(obj); - int last_page = find_immobile_page_index(obj+n_words-1); + low_page_index_t first_page = find_immobile_page_index(obj); + last_page = find_immobile_page_index(obj+n_words-1); // Only the page with this object header gets a bit in its gen mask. VARYOBJ_PAGE_GENS(first_page) |= 1<<__immobile_obj_gen_bits(obj); // For each page touched by this object, set the page's @@ -1207,8 +1245,14 @@ void immobile_space_coreparse(uword_t address, uword_t len) } } } + // Write-protect the pages occupied by the core file. + // (There can be no inter-generation pointers.) + int page; + for (page = FIRST_VARYOBJ_PAGE ; page <= last_page ; ++page) + varyobj_page_touched_bits[(page-FIRST_VARYOBJ_PAGE)/32] &= ~(1<<(page & 31)); SYMBOL(IMMOBILE_SPACE_FREE_POINTER)->value = (lispobj)limit; - protect_space(); + compute_immobile_space_bound(); + write_protect_immobile_space(); } else { lose("unknown immobile subspace"); } @@ -1456,6 +1500,36 @@ lispobj alloc_fdefn(lispobj name) return (lispobj)f | OTHER_POINTER_LOWTAG; } +void verify_immobile_page_protection(int keep_gen, int new_gen) +{ + low_page_index_t page; + lispobj* end = (lispobj*)SYMBOL(IMMOBILE_SPACE_FREE_POINTER)->value; + low_page_index_t end_page = find_immobile_page_index((char*)end-1); + lispobj* obj; + + for (page = FIRST_VARYOBJ_PAGE; page <= end_page; ++page) { + if (!varyobj_page_touched(page)) { + lispobj* page_begin = low_page_address(page); + lispobj* page_end = page_begin + WORDS_PER_PAGE; + // Assert that there are no old->young pointers. + obj = varyobj_scan_start(page); + // Never scan past the free pointer. + // FIXME: It is is supposed to work to scan past the free pointer + // on the last page, but the allocator needs to plop an array header there, + // and sometimes it doesn't. + lispobj* varyobj_free_ptr = (lispobj*)(SYMBOL(IMMOBILE_SPACE_FREE_POINTER)->value); + if (page_end > varyobj_free_ptr) page_end = varyobj_free_ptr; + for ( ; obj < page_end ; obj += sizetab[widetag_of(*obj)](obj) ) { + if (!immobile_filler_p(obj) + && varyobj_points_to_younger_p(obj, __immobile_obj_gen_bits(obj), + keep_gen, new_gen, + (char*)page_begin, (char*)page_end)) + lose("page WP bit on page %d is wrong\n", page); + } + } + } +} + #ifdef VERIFY_PAGE_GENS void check_fixedobj_page(int page) { @@ -1477,22 +1551,15 @@ void check_fixedobj_page(int page) gc_assert(fixedobj_pages[page].gens ==0); return; } - while (obj <= limit) { + for ( ; obj <= limit ; obj += obj_spacing ) { header = *obj; - if (!fixnump(header)) { - if (__immobile_obj_gen_bits(obj) & IMMOBILE_OBJ_VISITED_FLAG) { - fprintf(stderr, "Obj header @ %p = %p\n", obj, (void*)header); - all_ok = 0; - } else { - int gen = __immobile_obj_gen_bits(obj); - gc_assert(0 <= gen && gen <= 6); - genmask |= 1<young pointers. - for (page = FIRST_VARYOBJ_PAGE; page <= end_page; ++page) { - if (!varyobj_page_touched(page)) { - lispobj* page_begin = low_page_address(page); - lispobj* page_end = page_begin + WORDS_PER_PAGE; - // Assert that there are no old->young pointers. - obj = varyobj_scan_start(page); - if (obj < page_begin) obj += sizetab[widetag_of(*obj)](obj); - // Never scan past the free pointer. - // FIXME: It is is supposed to work to scan past the free pointer - // on the last page, but the allocator needs to plop an array header there, - // and sometimes it doesn't. - lispobj* varyobj_free_ptr = (lispobj*)(SYMBOL(IMMOBILE_SPACE_FREE_POINTER)->value); - if (page_end > varyobj_free_ptr) page_end = varyobj_free_ptr; - for ( ; obj < page_end ; obj += sizetab[widetag_of(*obj)](obj) ) { - if (!immobile_filler_p(obj) - && varyobj_points_to_younger_p(obj, __immobile_obj_gen_bits(obj), - 0xff, 0xff, - (char*)page_begin, (char*)page_end)) - lose("page WP bit on page %d is wrong\n", page); - } - } - } } #endif diff --git a/src/runtime/print.c b/src/runtime/print.c index 584c7b48b..a936c35e4 100644 --- a/src/runtime/print.c +++ b/src/runtime/print.c @@ -750,6 +750,7 @@ static void print_otherptr(lispobj obj) break; case CODE_HEADER_WIDETAG: + count &= SHORT_HEADER_MAX_WORDS; print_slots(code_slots, count-1, ptr); break; diff --git a/src/runtime/runtime.h b/src/runtime/runtime.h index 131e73698..7bc40aab7 100644 --- a/src/runtime/runtime.h +++ b/src/runtime/runtime.h @@ -275,13 +275,13 @@ HeaderValue(lispobj obj) } #ifdef LISP_FEATURE_IMMOBILE_SPACE -#define HEADER_VALUE_MASKED(x) (header >> N_WIDETAG_BITS) & SHORT_HEADER_MAX_WORDS +#define HEADER_VALUE_MASKED(x) HeaderValue(x) & SHORT_HEADER_MAX_WORDS #else -#define HEADER_VALUE_MASKED(x) (header >> N_WIDETAG_BITS) +#define HEADER_VALUE_MASKED(x) HeaderValue(x) #endif static inline uword_t instance_length(lispobj header) { - return HEADER_VALUE_MASKED(header >> N_WIDETAG_BITS); + return HEADER_VALUE_MASKED(header); } static inline lispobj instance_layout(lispobj* instance_ptr) // native ptr { @@ -291,7 +291,6 @@ static inline lispobj instance_layout(lispobj* instance_ptr) // native ptr return instance_ptr[1]; // the word following the header is the layout #endif } -#undef HEADER_VALUE_MASKED static inline struct cons * CONS(lispobj obj) @@ -370,7 +369,7 @@ fixnum_value(lispobj n) static inline uword_t code_header_words(lispobj header) // given header = code->header { - return HeaderValue(header); + return HEADER_VALUE_MASKED(header); } static inline sword_t @@ -381,6 +380,7 @@ code_instruction_words(lispobj n) // given n = code->code_size return x >> WORD_SHIFT; } +#undef HEADER_VALUE_MASKED #if defined(LISP_FEATURE_WIN32) /* KLUDGE: Avoid double definition of boolean by rpcndr.h included via -- 2.11.4.GIT