Re: master: Apply various micro-optimizations to VECTOR-FILL/T
Stas Boukarev <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs,gmane.lisp.steel-bank.devel |
|---|---|
| Message-ID | <CAF63=13TFZFpfjNs0_yEpSGbDvCzNMPCcFb1_7-iLXJnbe50KQ@mail.gmail.com> |
Would it be easier to patch vector_fill_offset_to_check if it were an
exported label?
diff --git a/src/assembly/x86-64/array.lisp b/src/assembly/x86-64/array.lisp
index d06e97fa0..e7844dc7a 100644
--- a/src/assembly/x86-64/array.lisp
+++ b/src/assembly/x86-64/array.lisp
@@ -24,7 +24,9 @@ (symbol-macrolet
(count end)) ; alias for RCX
(define-assembly-routine (vector-fill/t ; <-- this could work on raw bits too
(:translate vector-fill/t)
- (:policy :fast-safe))
+ (:policy :fast-safe)
+ #+sb-assembling
+ (:export VECTOR-FILL/T/PATCH))
((:arg vector (descriptor-reg) (:lisp-reg 0))
(:arg item (any-reg descriptor-reg) rax-offset)
(:arg start (any-reg descriptor-reg) (:lisp-reg 1))
@@ -97,6 +99,7 @@ (define-assembly-routine (vector-fill/t ; <-- this
could work on raw bits too
;; if STOS is deemed to be preferable on this cpu.
;; Otherwise we'll always jump over the REP STOS instruction.
;; The preceding CMP is pointless in that case, but harmless.
+ VECTOR-FILL/T/PATCH
(inst jmp unroll)
(inst shr count n-fixnum-tag-bits)
diff --git a/src/runtime/x86-64-arch.c b/src/runtime/x86-64-arch.c
index d24283d56..0e9eb6eb9 100644
--- a/src/runtime/x86-64-arch.c
+++ b/src/runtime/x86-64-arch.c
@@ -147,6 +147,7 @@ void tune_asm_routines_for_microarch(void)
set_up_win64_seh_thunk((lispobj*)get_asm_routine_by_name("SEH-TRAMPOLINE",
0));
#endif
+ printf("%p\n", get_asm_routine_by_name("VECTOR-FILL/T/PATCH", 0));
unsigned char* asm_routine =
(void*)get_asm_routine_by_name(VECTOR_FILL_T, 0);
if (!asm_routine) return;
// Since a particular runtime expects a particular core,
seems to work.
On Sat, Aug 22, 2026 at 5:01 AM snuglas via Sbcl-commits
<[email protected]> wrote:
>
> The branch "master" has been updated in SBCL:
> via 0eb8b556ac414e9c3e4f5efaec69022af69537fc (commit)
> from e4a5665070d36df7c150d17caec4338e39bbeb2a (commit)
>
> - Log -----------------------------------------------------------------
> commit 0eb8b556ac414e9c3e4f5efaec69022af69537fc
> Author: Douglas Katzman <[email protected]>
> Date: Sat Aug 22 02:00:51 2026 +0000
>
> Apply various micro-optimizations to VECTOR-FILL/T
>
> * use a loopless final pass after the unrolled pass
> * use one fewer temp register
> * remove a couple of instructions here and there
>
> Also some stylistic changes:
> * give better names to registers depending on their usage
> * avoid an #ifdef for SB_SAFEPOINT in x86-64-arch
>
> Co-authored with Gemini
> ---
> src/assembly/x86-64/array.lisp | 113 +++++++++++++++++++++++++----------------
> src/runtime/x86-64-arch.c | 10 +---
> tests/vectorfill.pure.lisp | 47 +++++++++++++++++
> 3 files changed, 119 insertions(+), 51 deletions(-)
>
> diff --git a/src/assembly/x86-64/array.lisp b/src/assembly/x86-64/array.lisp
> index 9ceb3e208..d06e97fa0 100644
> --- a/src/assembly/x86-64/array.lisp
> +++ b/src/assembly/x86-64/array.lisp
> @@ -16,55 +16,73 @@
> ;;; to deal with pre- and post-loop pieces for proper alignment.
> ;;; Alternatively, if the CPU has the enhanced MOVSB feature, use REP STOS
> ;;; depending on the number of elements to be written.
> +(symbol-macrolet
> + ((disp (- (ash vector-data-offset word-shift) other-pointer-lowtag))
> + (scale (ash 1 (- word-shift n-fixnum-tag-bits)))
> + (card-index scratch) ; alias for RSI
> + (end-card-index item) ; alias for RAX
> + (count end)) ; alias for RCX
> (define-assembly-routine (vector-fill/t ; <-- this could work on raw bits too
> (:translate vector-fill/t)
> (:policy :fast-safe))
> ((:arg vector (descriptor-reg) (:lisp-reg 0))
> (:arg item (any-reg descriptor-reg) rax-offset)
> (:arg start (any-reg descriptor-reg) (:lisp-reg 1))
> - (:arg end (any-reg descriptor-reg) (:lisp-reg 2))
> + (:arg end (any-reg descriptor-reg) rcx-offset)
> (:res res (descriptor-reg) (:lisp-reg 0))
> - (:temp count unsigned-reg rcx-offset)
> - (:temp end-card-index unsigned-reg rbx-offset)
> + (:temp scratch unsigned-reg rsi-offset)
> ;; storage class doesn't matter since all float regs
> ;; and sse regs map to the same storage base.
> (:temp wordpair double-reg 0))
> - (progn end-card-index)
> (move res vector) ; to "use" res
>
> + (inst cmp start end)
> + (inst jmp :ge DONE)
> + ;; stash ITEM safely away, exactly where we usually need it
> + (inst movq wordpair item)
> ;; Mark each GC card of the vector unless ITEM is not a pointer
> ;; (NIL is non-pointer) or the COUNT is 0.
> + ;; TODO: Skipping marking whenever VECTOR is younger than ITEM would yield a nice
> + ;; savings especially for things like (fill x :EMPTY) because keywords are nearly
> + ;; always immortal, at least for any image that was saved to disk. That being so,
> + ;; could we hoist marking into the IR1 representation so that transforms can
> + ;; decide whether to mark at all, and separate out the actual fill routine?
> #+soft-card-marks
> - (progn
> - (inst cmp start end)
> - (inst jmp :ge DONE)
> - (inst lea :dword count (ea -3 item)) ; same as POINTERP (see type-vops)
> - (inst test :byte count #b11)
> - (inst jmp :nz DONE-CARD-MARKING)
> - (inst cmp item null-tn)
> - (inst jmp :e DONE-CARD-MARKING)
> + (assemble ()
> + (inst lea :dword card-index (ea -3 item)) ; same as POINTERP (see type-vops)
> + (inst test :byte card-index #b11)
> + (inst jmp :nz DONE-CARD-MARKING)
> + (inst cmp item null-tn)
> + (inst jmp :e DONE-CARD-MARKING)
>
> - (let ((disp (- (ash vector-data-offset word-shift) other-pointer-lowtag))
> - (card-index count)
> - (loop (gen-label)))
> ;; Compute EA of starting and ending (inclusive) indices
> - (inst lea card-index (ea disp vector start (ash 1 (- word-shift n-fixnum-tag-bits))))
> - (inst lea end-card-index (ea (- disp n-word-bytes)
> - vector end (ash 1 (- word-shift n-fixnum-tag-bits))))
> + (inst lea card-index (ea disp vector start scale))
> (inst shr card-index gencgc-card-shift)
> + (inst and :dword card-index card-index-mask)
> + ;; Compute the modularly post-incremented end-card-mask so that our backward branch
> + ;; in the loop can use a not-equal test. (We can't use any branch on inequality
> + ;; because modular math screws it up)
> + (inst lea end-card-index (ea (- disp n-word-bytes) vector end scale))
> (inst shr end-card-index gencgc-card-shift)
> - (inst and :dword card-index card-index-mask)
> + (inst inc :dword end-card-index)
> (inst and :dword end-card-index card-index-mask)
> - (emit-label LOOP)
> - (mark-gc-card card-index nil) ; NIL = already shifted + masked
> - (inst cmp card-index end-card-index)
> - (inst jmp :e DONE-CARD-MARKING)
> + LOOP
> + ;; Were we to use MARK-GC-CARD which is technically the right abstraction,
> + ;; it emits different encodings of the 'disp 'field for #+/-sb-safepoint
> + ;; because in one case the disp is imm8 and the other imm32.
> + ;; Then we would have an annoyance in the C runtime of having to #ifdef
> + ;; the hot-patching of the "JMP UNROLL" below - its address would change.
> + (inst mov :byte (ea :disp32 nil-cardtable-disp null-tn card-index) CARD-MARKED)
> (inst inc :dword card-index)
> (inst and :dword card-index card-index-mask)
> - (inst jmp LOOP)))
> + (inst cmp :dword card-index end-card-index)
> + (inst jmp :ne LOOP))
>
> DONE-CARD-MARKING
> - (move count end)
> + ;; restore ITEM from its saved location. Needed for the STOS instruction
> + ;; and for the final elements after loop unrolling.
> + (inst movq item wordpair)
> + ;; compute number of elements as a fixnum
> (inst sub count start)
> ;; 'start' is an interior pointer to 'vector',
> ;; but 'vector' is pinned because it's in a register, so this is ok.
> @@ -87,8 +105,7 @@
> DONE
> (inst ret)
> UNROLL
> - (inst test count count)
> - (inst jmp :z DONE)
> + (inst lea scratch (ea start count scale)) ; compute end pointer
> ;; if address ends in 8, we must write 1 word before using MOVDQA
> (inst test :byte start #b1000)
> (inst jmp :z SETUP)
> @@ -96,17 +113,17 @@
> (inst add start n-word-bytes)
> (inst sub count (fixnumize 1))
> SETUP
> - ;; Compute (FLOOR COUNT 8) to compute the number of fast iterations.
> + ;; Compute (FLOOR COUNT 8) to get the number of fast iterations.
> + ;; We can untagify and divide by 8 in the same operation
> (inst shr count (+ 3 n-fixnum-tag-bits)) ; It's a native integer now.
> ;; For a very small number of elements, the unrolled loop won't execute.
> (inst jmp :z FINISH)
> - ;; Load the xmm register.
> - (inst movq wordpair item)
> + ;; WORDPAIR already holds ITEM in its low 64 bits
> (inst pshufd wordpair wordpair #b01000100)
> ;; Multiply count by 64 (= 8 lisp objects) and add to 'start'
> ;; to get the upper limit of the loop.
> (inst shl count 6)
> - (inst add count start)
> + (inst add count start) ; remember: COUNT and END are the same register!
> ;; MOVNTDQ is supposedly faster, but would require a trailing SFENCE
> ;; which measurably harms performance on a small number of iterations.
> UNROLL-LOOP ; Write 4 double-quads = 8 lisp objects
> @@ -115,20 +132,30 @@
> (inst movdqa (ea 32 start) wordpair)
> (inst movdqa (ea 48 start) wordpair)
> (inst add start (* 8 n-word-bytes))
> - (inst cmp start count)
> + (inst cmp start end)
> (inst jmp :b UNROLL-LOOP)
> FINISH
> - ;; Now recompute 'count' as the ending address
> - (inst lea count (ea (- (ash vector-data-offset word-shift) other-pointer-lowtag)
> - vector
> - end (ash 1 (- word-shift n-fixnum-tag-bits))))
> - (inst cmp start count)
> - (inst jmp :ae DONE)
> - FINAL-LOOP
> - (inst mov (ea start) item)
> - (inst add start n-word-bytes)
> - (inst cmp start count)
> - (inst jmp :b FINAL-LOOP))
> + ;; Now we're going to complete the fill with no looping by jumping
> + ;; to the middle of a sequence of stores.
> + ;; SCRATCH is the ending byte address. Bytes remaining is (SCRATCH - START)
> + ;; There are at most 7 more stores to do. Each takes 4 bytes to encode
> + ;; including the last one whose EA displacement is 0.
> + ;; Therefore divide scratch by 2 to get the number of bytes to execute.
> + (inst sub scratch start)
> + (inst shr :dword scratch 1)
> + ;; Subtract from TAIL to get the entry point without using a lookup table
> + (inst lea end (rip-relative-ea TAIL))
> + (inst sub end scratch)
> + (inst jmp end)
> + ;; entry points
> + (inst mov (ea 48 start) item)
> + (inst mov (ea 40 start) item)
> + (inst mov (ea 32 start) item)
> + (inst mov (ea 24 start) item)
> + (inst mov (ea 16 start) item)
> + (inst mov (ea 8 start) item)
> + (inst mov (ea :disp8 0 start) item)
> + TAIL))
>
> (define-assembly-routine (%data-vector-and-index
> (:translate %data-vector-and-index)
> diff --git a/src/runtime/x86-64-arch.c b/src/runtime/x86-64-arch.c
> index 878b99819..d24283d56 100644
> --- a/src/runtime/x86-64-arch.c
> +++ b/src/runtime/x86-64-arch.c
> @@ -73,14 +73,8 @@ static void xgetbv(unsigned *eax, unsigned *edx)
> }
>
> #define VECTOR_FILL_T "VECTOR-FILL/T"
> -#ifdef LISP_FEATURE_SB_SAFEPOINT
> -// the store to card table takes 3 bytes more encode
> -static const int vector_fill_offset_to_check = 0x53;
> -static const int vector_fill_offset_to_poke = 0x5A;
> -#else
> -static const int vector_fill_offset_to_check = 0x50;
> -static const int vector_fill_offset_to_poke = 0x57;
> -#endif
> +static const int vector_fill_offset_to_check = 0x59;
> +static const int vector_fill_offset_to_poke = 0x60;
> static const unsigned char vector_fill_expect_bytes[] = {
> 0x48, 0x81, 0xF9, 0xBC, 0x02, 0x00, 0x00,
> 0xEB, 0x07
> diff --git a/tests/vectorfill.pure.lisp b/tests/vectorfill.pure.lisp
> new file mode 100644
> index 000000000..dbc6a6017
> --- /dev/null
> +++ b/tests/vectorfill.pure.lisp
> @@ -0,0 +1,47 @@
> +#-x86-64 (invoke-restart 'run-tests::skip-file)
> +
> +(defun foofill (v elt start end)
> + (declare (simple-vector v) (sb-int:index start end))
> + ;; FILL with :START and :END could, but currently do not,
> + ;; always transform into VECTOR-FILL/T.
> + ;; That's silly and we should fix it.
> + ;; (Also we should fix that word-sized vectors could - but don't -
> + ;; use that assembly routine)
> + (values (sb-sys:%primitive sb-vm::vector-fill/t v elt start end)))
> +(compile 'foofill)
> +
> +(defun exercise-foofill (item)
> + ;; Test across multiple vector lengths. We can reasonably trust that the
> + ;; "REP STOSQ" code path works - it's literally 1 machine instruction after
> + ;; computing the start and length - so we only exercise vector fill operations
> + ;; which are smaller than our threshold of 350 elements or more.
> + (dolist (vec-len '(0 1 2 7 8 9 15 16 17 23 24 25 31 32 33 47 48 49 64 100))
> + ;; Test even 'start' (16-byte aligned, 0 peel) and odd 'start' (8-byte unaligned, 1 peel)
> + (dotimes (start (1+ vec-len))
> + ;; Test all possible counts (exercising 0, 1, 2, 3+ unroll loops and 0..7 tail stores)
> + (loop for end from start to vec-len
> + do
> + (let* ((sentinel (list ':sentinel))
> + (v (make-array vec-len :initial-element sentinel))
> + (res (foofill v item start end)))
> + ;; 1. Verify return value
> + (assert (eq res v))
> + ;; 2. Verify filled region
> + (loop for i from start below end do
> + (unless (eq (svref v i) item)
> + (error "Filled region mismatch at index ~A for len=~A [~A, ~A]: got ~S, expected ~S"
> + i vec-len start end (svref v i) item)))
> + ;; 3. Verify prefix + suffix untouched
> + (loop for i from 0 below start do
> + (unless (eq (svref v i) sentinel)
> + (error "Prefix corrupted at index ~A for len=~A [~A, ~A]"
> + i vec-len start end)))
> + (loop for i from end below vec-len do
> + (unless (eq (svref v i) sentinel)
> + (error "Suffix corrupted at index ~A for len=~A [~A, ~A]"
> + i vec-len start end))))))))
> +
> +(with-test (:name :vector-fill-unrolled)
> + (exercise-foofill 42)
> + (exercise-foofill '(a-list))
> + (exercise-foofill 'a-symbol))
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits
_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits