Re: master: Use soft card marking on all fixedobj pages

On Tue, Apr 7, 2026 at 5:56 PM snuglas via Sbcl-commits
<[email protected]> wrote:
>
> 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)

Looks like the emit-gengc-barrier after the IF is wrong.


_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits