master: Use soft card marking on all fixedobj pages
snuglas via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 5f3bf0b9e4083e0b626aedfcdf7014f9bb2a25ae (commit)
from d62ed2476fb4a4f7ed6966426f1608354410d11c (commit)
- Log -----------------------------------------------------------------
commit 5f3bf0b9e4083e0b626aedfcdf7014f9bb2a25ae
Author: Douglas Katzman <[email protected]>
Date: Tue Apr 7 10:20:50 2026 -0400
Use soft card marking on all fixedobj pages
---
src/assembly/x86-64/assem-rtns.lisp | 41 ++++++++++++++++++++++++++++
src/compiler/x86-64/cell.lisp | 52 +++++++++++++++++++++++++-----------
src/compiler/x86-64/memory.lisp | 23 +++++++++-------
src/compiler/x86-64/tls.lisp | 53 +++++++++++++++++++++++++------------
src/runtime/immobile-space.c | 29 +-------------------
5 files changed, 127 insertions(+), 71 deletions(-)
diff --git a/src/assembly/x86-64/assem-rtns.lisp b/src/assembly/x86-64/assem-rtns.lisp
index cad007afb..f1d24d7c8 100644
--- a/src/assembly/x86-64/assem-rtns.lisp
+++ b/src/assembly/x86-64/assem-rtns.lisp
@@ -466,6 +466,47 @@
(inst leave)
(inst ret)))))
+#+(and immobile-space sb-assembling)
+(define-assembly-routine (mark-symbol-card
+ (:return-style :none)
+ (:export mark-card)) ; if the space is unknown
+ ((:temp rax unsigned-reg rax-offset)
+ (:temp rdx unsigned-reg rdx-offset))
+ (inst push rax)
+ (inst mov rax (ea 16 rsp-tn)) ; load the argument
+ (inst push rdx)
+ ;; stack: symbol
+ ;; return PC
+ ;; saved rax
+ ;; saved rdx
+ (inst mov rdx (rip-relative-ea (make-fixup "FIXEDOBJ_SPACE_START" :foreign-dataref)))
+ (inst sub rax (ea rdx)) ; compute symbol - FIXEDOBJ_SPACE_START
+ (inst shr rax (1- (integer-length immobile-card-bytes)))
+ FIXEDOBJ
+ (inst mov rdx (rip-relative-ea (make-fixup "fixedobj_pages" :foreign-dataref)))
+ (inst mov rdx (ea rdx))
+ (inst mov :byte (ea 4 rdx rax 8) #x40) ; SET_WP_FLAG to WRITE_PROTECT_CLEARED
+ (inst pop rdx)
+ (inst pop rax)
+ (inst ret 8) ; remove 1 stack arg
+ (inst .align 4 :long-nop)
+ MARK-CARD
+ (inst push rax)
+ (inst mov rax (ea 16 rsp-tn)) ; load the argument
+ (inst push rdx)
+ (inst mov rdx (rip-relative-ea (make-fixup "FIXEDOBJ_SPACE_START" :foreign-dataref)))
+ (inst sub rax (ea rdx)) ; compute symbol - FIXEDOBJ_SPACE_START
+ ;; Preserve the sign in the right-shift so that one comparison suffices.
+ ;; (If the difference was negative, is looks like a large positive.)
+ (inst sar rax (1- (integer-length immobile-card-bytes)))
+ (inst cmp rax (/ fixedobj-space-size immobile-card-bytes))
+ (inst jmp :B FIXEDOBJ) ; unsigned comparison
+ (inst mov rax (ea 24 rsp-tn)) ; reload the argument
+ (mark-gc-card rax)
+ (inst pop rdx)
+ (inst pop rax)
+ (inst ret 8)) ; remove 1 stack arg
+
;; Adding to the thread-local remset has to be pseudo-atomic because GC takes
;; ownership of the the vector when it inserts rememberd objects into the common
;; remset and it assigns 0 into the thread slot.
diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp
index d56f04fc3..10029ee37 100644
--- a/src/compiler/x86-64/cell.lisp
+++ b/src/compiler/x86-64/cell.lisp
@@ -76,13 +76,23 @@
(:results (result :scs (descriptor-reg any-reg)))
(:vop-var vop)
(:generator 5
- (let ((newval-tn-ref (vop-nth-arg 2 vop)))
- (if (eq name 'sb-impl::cas-symbol-%info)
- (emit-symbol-write-barrier vop object rax newval-tn-ref)
- (emit-gengc-barrier object nil rax newval-tn-ref)))
- (move rax old)
- (inst cmpxchg :lock (ea (- (* offset n-word-bytes) lowtag) object) new)
- (move result rax)))
+ (let ((newval-tn-ref (vop-nth-arg 2 vop)))
+ (cond
+ #+immobile-space
+ ((eq name 'sb-impl::cas-symbol-%info)
+ (pseudo-atomic ()
+ (emit-symbol-write-barrier vop object rax newval-tn-ref)
+ (move rax old)
+ (inst cmpxchg :lock (ea (- (* offset n-word-bytes) lowtag) object) new)))
+ (t
+ (if (eq name 'sb-impl::cas-symbol-%info)
+ ;; symbol-write-barrier includes the special case for #+permgen
+ (emit-symbol-write-barrier vop object rax newval-tn-ref)
+ (emit-gengc-barrier object nil rax newval-tn-ref))
+ (emit-gengc-barrier object nil rax newval-tn-ref)
+ (move rax old)
+ (inst cmpxchg :lock (ea (- (* offset n-word-bytes) lowtag) object) new))))
+ (move result rax)))
;;;; symbol hacking VOPs
@@ -131,11 +141,14 @@
(:temporary (:sc unsigned-reg) val-temp)
(:vop-var vop)
(:generator 4
- (emit-symbol-write-barrier vop symbol val-temp (vop-nth-arg 1 vop))
- (emit-store (if (sc-is symbol immediate)
- (symbol-slot-ea (tn-value symbol) symbol-value-slot)
- (object-slot-ea symbol symbol-value-slot other-pointer-lowtag))
- value val-temp)))
+ (pseudo-atomic (:elide-if #+immobile-space
+ (not (symbol-set-barrier-p symbol (vop-nth-arg 1 vop)))
+ #-immobile-space t)
+ (emit-symbol-write-barrier vop symbol val-temp (vop-nth-arg 1 vop))
+ (emit-store (if (sc-is symbol immediate)
+ (symbol-slot-ea (tn-value symbol) symbol-value-slot)
+ (object-slot-ea symbol symbol-value-slot other-pointer-lowtag))
+ value val-temp))))
#-sb-thread
(progn
@@ -257,6 +270,11 @@
#+sb-xc-host ; not needed post-build
(macrolet ((gcbar ()
+ #+immobile-space
+ `(assemble ()
+ (inst push object)
+ (invoke-asm-routine 'call 'mark-card vop))
+ #-immobile-space
`(assemble ()
#+permgen
(progn
@@ -271,9 +289,10 @@
(index :scs (unsigned-reg))
(linkage-cell :scs (sap-reg))
(linkage-val :scs (unsigned-reg)))
- (:temporary (:sc unsigned-reg) temp)
+ #-immobile-space (:temporary (:sc unsigned-reg) temp)
(:vop-var vop)
(:generator 1
+ (pseudo-atomic (:elide-if (or #-immobile-space t))
(gcbar)
(inst cmp :byte (ea (- other-pointer-lowtag) object) fdefn-widetag)
(inst jmp :ne SYMBOL)
@@ -283,19 +302,20 @@
(inst or :dword :lock
(object-slot-ea object symbol-hash-slot other-pointer-lowtag) index)
CELL-SET
- (inst mov (ea linkage-cell) linkage-val)))
+ (inst mov (ea linkage-cell) linkage-val))))
(define-vop (set-fname-fun)
(:args (object :scs (descriptor-reg))
(function :scs (descriptor-reg))
(linkage-cell :scs (sap-reg))
(linkage-val :scs (unsigned-reg immediate)))
- (:temporary (:sc unsigned-reg) temp)
+ #-immobile-space (:temporary (:sc unsigned-reg) temp)
(:vop-var vop)
(:generator 1
+ (pseudo-atomic (:elide-if (or #-immobile-space t))
(gcbar)
(storew function object fdefn-fun-slot other-pointer-lowtag)
(unless (and (sc-is linkage-val immediate) (zerop (tn-value linkage-val)))
- (inst mov (ea linkage-cell) linkage-val)))))
+ (inst mov (ea linkage-cell) linkage-val))))))
(define-vop (fdefn-fun) ; This vop works on symbols and fdefns
(:args (fdefn :scs (descriptor-reg)))
diff --git a/src/compiler/x86-64/memory.lisp b/src/compiler/x86-64/memory.lisp
index 94246e385..8ffc2be3b 100644
--- a/src/compiler/x86-64/memory.lisp
+++ b/src/compiler/x86-64/memory.lisp
@@ -92,16 +92,19 @@
;;; Initially I'd like to just get this correct, and then see if it's worth
;;; doing that optimization which will complicate the GC a little.
(defun emit-symbol-write-barrier (vop symbol temp newval-tn-ref)
- (declare (ignorable vop))
- #+permgen
- (when (require-gengc-barrier-p symbol newval-tn-ref)
- (unless (and (sc-is symbol immediate) (static-symbol-p (tn-value symbol)))
- (inst push symbol)
- (invoke-asm-routine 'call 'gc-remember-symbol vop)))
- ;; IMMEDIATE sc means that the symbol is static or immobile.
- ;; Static symbols are roots, and immobile symbols use page fault handling.
- (unless (sc-is symbol immediate)
- (emit-gengc-barrier symbol nil temp newval-tn-ref)))
+ (declare (ignorable vop temp))
+ (when (symbol-set-barrier-p symbol newval-tn-ref)
+ #+immobile-space
+ (progn (inst push symbol)
+ (if (sc-is symbol immediate)
+ (invoke-asm-routine 'call 'mark-symbol-card vop)
+ (invoke-asm-routine 'call 'mark-card vop)))
+ #-immobile-space
+ (progn
+ #+permgen
+ (progn (inst push symbol)
+ (invoke-asm-routine 'call 'gc-remember-symbol vop))
+ (emit-gengc-barrier symbol nil temp newval-tn-ref))))
#-soft-card-marks
(defun emit-code-page-gengc-barrier (object scratch-reg)
diff --git a/src/compiler/x86-64/tls.lisp b/src/compiler/x86-64/tls.lisp
index 70124a978..f5f6ee15b 100644
--- a/src/compiler/x86-64/tls.lisp
+++ b/src/compiler/x86-64/tls.lisp
@@ -39,9 +39,10 @@
`(%cas-symbol-global-value symbol old new)
(sb-c::give-up-ir1-transform)))
-(flet ((emit-cas (ea symbol old new rax result vop &aux (node (sb-c::vop-node vop)))
+(flet ((emit-cas (ea symbol old new rax result pa vop &aux (node (sb-c::vop-node vop)))
(if (sc-is old immediate) (move-immediate rax (immediate-tn-repr old)) (move rax old))
(inst cmpxchg :lock ea new)
+ (when pa (emit-end-pseudo-atomic))
(unless (or (and (sc-is symbol immediate) (sb-c::always-boundp (tn-value symbol) node))
(policy node (= safety 0)))
(inst cmp :byte rax unbound-marker-widetag)
@@ -59,11 +60,14 @@
(:policy :fast-safe)
(:vop-var vop)
(:generator 10
- (emit-symbol-write-barrier vop symbol rax (vop-nth-arg 2 vop))
- (emit-cas (if (sc-is symbol immediate)
- (symbol-slot-ea (tn-value symbol) symbol-value-slot)
- (symbol-value-slot-ea symbol))
- symbol old new rax result vop)))
+ ;; There's an error trap in EMIT-CAS which mustn't be inside PSEUDO-ATOMIC
+ (let ((pa #+immobile-space (symbol-set-barrier-p symbol (vop-nth-arg 2 vop))))
+ (when pa (emit-begin-pseudo-atomic))
+ (emit-symbol-write-barrier vop symbol rax (vop-nth-arg 2 vop))
+ (emit-cas (if (sc-is symbol immediate)
+ (symbol-slot-ea (tn-value symbol) symbol-value-slot)
+ (symbol-value-slot-ea symbol))
+ symbol old new rax result pa vop))))
(define-vop (%compare-and-swap-symbol-value)
(:translate %compare-and-swap-symbol-value)
@@ -88,13 +92,19 @@
(symbol-tls-index-ea symbol)
(tls-index-of symbol)))
(inst add cell thread-tn)
- (inst cmp :qword (ea cell) no-tls-value-marker)
- (inst jmp :ne CAS)
- ;; GLOBAL
- (emit-symbol-write-barrier vop symbol cell (vop-nth-arg 2 vop))
- (emit-lea-symbol-value-slot cell symbol)
- CAS
- (emit-cas (ea cell) symbol old new rax result vop))))
+ ;; IF this is CAS of a thread-local value, then pseudo-atomic is not needed,
+ ;; but trying to skip the p-a (to "optimize") is just silly because we have
+ ;; to assume that this is NOT thread-local for CAS to have any merit.
+ (let ((pa #+immobile-space (symbol-set-barrier-p symbol (vop-nth-arg 2 vop)))
+ (cas (gen-label)))
+ (when pa (emit-begin-pseudo-atomic))
+ (inst cmp :qword (ea cell) no-tls-value-marker)
+ (inst jmp :ne CAS)
+ ;; GLOBAL
+ (emit-symbol-write-barrier vop symbol cell (vop-nth-arg 2 vop))
+ (emit-lea-symbol-value-slot cell symbol)
+ (emit-label CAS)
+ (emit-cas (ea cell) symbol old new rax result pa vop)))))
;;; The :tls-load-indirect feature is, in most situations, an improvement over "direct"
;;; access (contrary to what indirection implies, but I couldn't settle on a better name).
@@ -338,11 +348,20 @@
(tls-index-of symbol)))
(inst add cell thread-tn))))
(inst cmp :qword (ea cell) no-tls-value-marker)
- (inst jmp :ne STORE)
- (emit-symbol-write-barrier vop symbol val-temp (vop-nth-arg 1 vop))
- (emit-lea-symbol-value-slot cell symbol)
+ (inst jmp :ne STORE) ; is thread-local
+ (let ((pa #+immobile-space (symbol-set-barrier-p symbol (vop-nth-arg 1 vop))))
+ (cond (pa ; do barrier + store within P-A, then jump out
+ (pseudo-atomic ()
+ (emit-symbol-write-barrier vop symbol val-temp (vop-nth-arg 1 vop))
+ (emit-lea-symbol-value-slot cell symbol)
+ (emit-store (ea cell) value val-temp))
+ (inst jmp DONE))
+ (t
+ (emit-symbol-write-barrier vop symbol val-temp (vop-nth-arg 1 vop))
+ (emit-lea-symbol-value-slot cell symbol))))
STORE
- (emit-store (ea cell) value val-temp)))
+ (emit-store (ea cell) value val-temp)
+ DONE))
;;;; binding and unbinding
diff --git a/src/runtime/immobile-space.c b/src/runtime/immobile-space.c
index 2c603ad97..0bcab8f74 100644
--- a/src/runtime/immobile-space.c
+++ b/src/runtime/immobile-space.c
@@ -767,33 +767,9 @@ scavenge_immobile_roots(generation_index_t min_gen, generation_index_t max_gen)
scavenge_immobile_newspace();
}
-static int should_mprotect(low_page_index_t page) {
- return fixedobj_pages[page].attr.parts.obj_align == SYMBOL_SIZE
- && fixedobj_page_wp(page);
-}
void write_protect_immobile_space()
{
immobile_scav_queue_head = 0;
-
- if (!ENABLE_PAGE_PROTECTION)
- return;
-
- // Now find contiguous ranges of pages that are protectable,
- // minimizing the number of system calls as much as possible.
- int i, start = -1, end = -1; // inclusive bounds on page indices
- low_page_index_t max_used_fixedobj_page = calc_max_used_fixedobj_page();
- for (i = max_used_fixedobj_page ; i >= 0 ; --i) {
- if (should_mprotect(i)) {
- if (end < 0) end = i;
- start = i;
- }
- if (end >= 0 && (!should_mprotect(i) || i == 0)) {
- os_protect(fixedobj_page_address(start),
- IMMOBILE_CARD_BYTES * (1 + end - start),
- OS_VM_PROT_READ);
- start = end = -1;
- }
- }
}
static inline generation_index_t
@@ -1277,10 +1253,7 @@ void deport_codeblob_offsets_from_heap()
loaded_codeblob_offsets = memcpy(vector_copy, loaded_codeblob_offsets, nbytes);
SYMBOL(IMMOBILE_CODEBLOB_VECTOR)->value = NIL;
int page = 0, limit = calc_max_used_fixedobj_page();
- for (page = 0; page <= limit; ++page) {
- if (fixedobj_pages[page].attr.parts.obj_align > SYMBOL_SIZE) // layout page
- SET_WP_FLAG(page, WRITE_PROTECT_CLEARED);
- }
+ for (page = 0; page <= limit; ++page) SET_WP_FLAG(page, WRITE_PROTECT_CLEARED);
}
// Change all objects to generation 0
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL