master: x86-64: support byte-array inline constants
stassats via Sbcl-commits <[email protected]> Fri, 17 Jul 2026 02:07:37 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 3f1f44a4bed91899f13893e4bf9d4a7690d99dc0 (commit)
from b30453bed86f63775b059cf5b995db394d7fc150 (commit)
- Log -----------------------------------------------------------------
commit 3f1f44a4bed91899f13893e4bf9d4a7690d99dc0
Author: Stas Boukarev <[email protected]>
Date: Fri Jul 17 04:55:59 2026 +0300
x86-64: support byte-array inline constants
---
src/code/x86-64-simd.lisp | 69 ++++++++++++++++++++++--------------------
src/compiler/x86-64/insts.lisp | 17 +++++++----
2 files changed, 47 insertions(+), 39 deletions(-)
diff --git a/src/code/x86-64-simd.lisp b/src/code/x86-64-simd.lisp
index 9fcc0bc7c..125abdc5e 100644
--- a/src/code/x86-64-simd.lisp
+++ b/src/code/x86-64-simd.lisp
@@ -2272,29 +2272,15 @@
(type index length)
(type (simple-array character (*)) string))
(let ((byte-index 0)
- (char-index 0)
- (table (load-time-value (let ((table (make-array (* #b10101011 16) :element-type '(unsigned-byte 8)
- :initial-element #xFF)))
- (loop for row to #b10101010 ;; highest possible inverted index for compressing 1/2 bytes
- do (loop with indexes = (loop for i below 8
- unless (logbitp i row)
- collect (* i 2)
- and
- collect (1+ (* i 2)))
- for column below 16
- for index = (pop indexes)
- when index
- do
- (setf (aref table (+ (* row 16) column)) index)))
- table))))
+ (char-index 0))
(declare (type index byte-index char-index))
(when (>= length 9)
- (with-pinned-objects (string table)
+ (with-pinned-objects (string)
(setf (values byte-index char-index)
(inline-vop
(((byte-array sap-reg t) sap)
((32-bit-array sap-reg t) (vector-sap string))
- ((table sap-reg t) (vector-sap table))
+ ((table sap-reg t))
((n unsigned-reg) (- length 9))
((string-length unsigned-reg) (logand (+ (length string) 3) -4))
((tmp unsigned-reg))
@@ -2310,6 +2296,22 @@
((mask-bf complex-double-reg)))
((byte-index unsigned-reg positive-fixnum :from :load)
(char-index unsigned-reg positive-fixnum :from :load))
+ (inst lea table
+ (register-inline-constant
+ (let ((table (make-array (* #b10101011 16) :element-type '(unsigned-byte 8)
+ :initial-element #xFF)))
+ (loop for row to #b10101010 ;; highest possible inverted index for compressing 1/2 bytes
+ do (loop with indexes = (loop for i below 8
+ unless (logbitp i row)
+ collect (* i 2)
+ and
+ collect (1+ (* i 2)))
+ for column below 16
+ for index = (pop indexes)
+ when index
+ do
+ (setf (aref table (+ (* row 16) column)) index)))
+ table)))
(inst mov tmp #xC0)
(inst vmovd temp tmp)
(inst vpbroadcastb mask-c0 temp)
@@ -2437,27 +2439,14 @@
(simple-character-string string)
((simple-array (unsigned-byte 8) (*)) byte-array)
(optimize speed (safety 0)))
- (let ((table (load-time-value (let ((table (make-array (* 256 16) :element-type '(unsigned-byte 8)
- :initial-element #xFF)))
- (loop for row below 256
- do (loop with indexes = (loop for i below 8
- collect (* i 2)
- unless (logbitp i row)
- collect (1+ (* i 2)))
- for column below 16
- for index = (pop indexes)
- when index
- do
- (setf (aref table (+ (* row 16) column)) index)))
- table)))
- (length (length string)))
- (with-pinned-objects (string byte-array table)
+ (let ((length (length string)))
+ (with-pinned-objects (string byte-array)
(multiple-value-bind (byte-index char-index)
(inline-vop (((byte-array sap-reg t) (vector-sap byte-array))
((32-bit-array sap-reg t) (vector-sap string))
((n signed-reg) (logand (+ (* length 4) 15) -16))
((byte-array-length unsigned-reg) (logand (+ byte-array-length 15) -16))
- ((table sap-reg t) (vector-sap table))
+ ((table sap-reg t))
((tmp unsigned-reg))
((temp complex-double-reg))
((bytes complex-double-reg))
@@ -2472,6 +2461,20 @@
((byte-index unsigned-reg positive-fixnum :from :load)
(char-index unsigned-reg positive-fixnum :from :load))
+ (inst lea table (register-inline-constant
+ (let ((table (make-array (* 256 16) :element-type '(unsigned-byte 8)
+ :initial-element #xFF)))
+ (loop for row below 256
+ do (loop with indexes = (loop for i below 8
+ collect (* i 2)
+ unless (logbitp i row)
+ collect (1+ (* i 2)))
+ for column below 16
+ for index = (pop indexes)
+ when index
+ do
+ (setf (aref table (+ (* row 16) column)) index)))
+ table)))
(inst mov tmp #x3F)
(inst vmovd temp tmp)
(inst vpbroadcastw mask-3f temp)
diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp
index 93f2ae258..465adb277 100644
--- a/src/compiler/x86-64/insts.lisp
+++ b/src/compiler/x86-64/insts.lisp
@@ -3364,7 +3364,9 @@
#+(and sb-simd-pack-512 (not sb-xc-host))
(simd-pack-512
(setq constant
- (sb-vm::%simd-pack-512-inline-constant first)))))
+ (sb-vm::%simd-pack-512-inline-constant first)))
+ ((simple-array (unsigned-byte 8) (*))
+ (setf constant (list :byte-array first)))))
(destructuring-bind (type value) constant
(ecase type
((:byte :word :dword :qword)
@@ -3399,8 +3401,8 @@
(cons :oword
(logior (ash (ldb (byte 64 0) (double-float-bits (imagpart value))) 64)
(ldb (byte 64 0) (double-float-bits (realpart value))))))
- ((:jump-table)
- (cons :jump-table value)))))
+ ((:jump-table :byte-array)
+ (cons type value)))))
(defun inline-constant-value (constant)
(declare (ignore constant)) ; weird!
@@ -3410,6 +3412,7 @@
(defun align-of (constant)
(case (car constant)
(:jump-table n-word-bytes)
+ (:byte-array (* n-word-bytes 2))
(t (size-nbyte (car constant)))))
(defun sort-inline-constants (constants)
@@ -3434,9 +3437,11 @@
;; Could add pseudo-ops for .WORD, .INT, .OCTA just like gcc has.
;; But it works fine to emit as a sequence of bytes
`(.byte ,@(let ((val (cdr constant)))
- (loop repeat size
- collect (prog1 (ldb (byte 8 0) val)
- (setf val (ash val -8))))))))))
+ (if (eq (car constant) :byte-array)
+ (coerce val 'list)
+ (loop repeat size
+ collect (prog1 (ldb (byte 8 0) val)
+ (setf val (ash val -8)))))))))))
#+sb-xc-host (declaim (ftype function sb-fasl::asm-routine-vector-elt-addr))
;;; Return an address which when added to NULL-TN and dereferenced will yield ADDR
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL