master: Apply various micro-optimizations to VECTOR-FILL/T
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 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