master: arm64: always require vector sizes for simd instructions
stassats via Sbcl-commits <[email protected]> Sat, 13 Jun 2026 23:40:05 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via c23611286406641a7d0c0eeb30fdceac574fa6f7 (commit)
from cfab1dd1444f47d9e1c563bf9f53aaaa5c5c5ab3 (commit)
- Log -----------------------------------------------------------------
commit c23611286406641a7d0c0eeb30fdceac574fa6f7
Author: Stas Boukarev <[email protected]>
Date: Sun Jun 14 02:02:10 2026 +0300
arm64: always require vector sizes for simd instructions
Instead of defaulting to :16b
---
src/code/arm64-simd.lisp | 98 +++++++--------
src/compiler/arm64/float.lisp | 12 +-
src/compiler/arm64/insts.lisp | 268 +++++++++++++++++++----------------------
src/compiler/arm64/macros.lisp | 5 +-
4 files changed, 184 insertions(+), 199 deletions(-)
diff --git a/src/code/arm64-simd.lisp b/src/code/arm64-simd.lisp
index fa94b941d..cd55028ca 100644
--- a/src/code/arm64-simd.lisp
+++ b/src/code/arm64-simd.lisp
@@ -95,8 +95,8 @@
((res complex-double-reg complex-double-float))
(inst sub temp bits a-mask :4s)
(inst cmhs temp z-mask temp :4s)
- (inst and temp temp flip)
- (inst eor res bits temp)))))))
+ (inst and temp temp flip :16b)
+ (inst eor res bits temp :16b)))))))
(defun simd-nreverse8 (result vector start end)
(declare (optimize speed (safety 0)))
@@ -121,10 +121,10 @@
(inst ldr vl (@ left))
(inst ldr vr (@ right))
- (inst rev64 vl vl)
- (inst ext vl vl vl 8)
- (inst rev64 vr vr)
- (inst ext vr vr vr 8)
+ (inst rev64 vl vl :16b)
+ (inst ext vl vl vl 8 :16b)
+ (inst rev64 vr vr :16b)
+ (inst ext vr vr vr 8 :16b)
(inst str vr (@ left 16 :post-index))
(inst str vl (@ right -16 :post-index))
@@ -188,9 +188,9 @@
(inst ldr vr (@ right))
(inst rev64 vl vl :4s)
- (inst ext vl vl vl 8)
+ (inst ext vl vl vl 8 :16b)
(inst rev64 vr vr :4s)
- (inst ext vr vr vr 8)
+ (inst ext vr vr vr 8 :16b)
(inst str vr (@ left 16 :post-index))
(inst str vl (@ right -16 :post-index))
@@ -239,8 +239,8 @@
LOOP
(inst ldr v (@ source s-i))
- (inst rev64 v v)
- (inst ext v v v 8)
+ (inst rev64 v v :16b)
+ (inst ext v v v 8 :16b)
(inst str v (@ target t-i))
(inst add t-i t-i 16)
@@ -294,7 +294,7 @@
(inst ldr v (@ source s-i))
(inst rev64 v v :4s)
- (inst ext v v v 8)
+ (inst ext v v v 8 :16b)
(inst str v (@ target t-i))
(inst add t-i t-i 16)
@@ -434,18 +434,18 @@
(inst ldr b (@ b-array 16 :post-index))
;; Upcase a
- (inst sub temp a a-mask)
- (inst cmhs temp z-mask temp)
- (inst and temp temp flip)
- (inst eor a a temp)
+ (inst sub temp a a-mask :16b)
+ (inst cmhs temp z-mask temp :16b)
+ (inst and temp temp flip :16b)
+ (inst eor a a temp :16b)
;; Upcase b
- (inst sub temp2 b a-mask)
- (inst cmhs temp2 z-mask temp2)
- (inst and temp2 temp2 flip)
- (inst eor b b temp2)
+ (inst sub temp2 b a-mask :16b)
+ (inst cmhs temp2 z-mask temp2 :16b)
+ (inst and temp2 temp2 flip :16b)
+ (inst eor b b temp2 :16b)
- (inst cmeq a a b)
+ (inst cmeq a a b :16b)
(inst uminv a a :16b)
(inst umov cmp a 0 :b)
(inst cbz cmp FALSE)
@@ -488,8 +488,8 @@
;; Upcase 32-bit wide characters
(inst sub temp characters a-mask :4s)
(inst cmhs temp z-mask temp :4s)
- (inst and temp temp flip)
- (inst eor characters characters temp)
+ (inst and temp temp flip :16b)
+ (inst eor characters characters temp :16b)
;; Widen 8-bit wide characters to 32-bits
(inst ushll base-chars :8h base-chars :8b 0)
@@ -498,8 +498,8 @@
;; And upcase them too
(inst sub temp2 base-chars a-mask :4s)
(inst cmhs temp2 z-mask temp2 :4s)
- (inst and temp2 temp2 flip)
- (inst eor base-chars base-chars temp2)
+ (inst and temp2 temp2 flip :16b)
+ (inst eor base-chars base-chars temp2 :16b)
(inst cmeq base-chars base-chars characters :4s)
(inst uminv base-chars base-chars :4s)
@@ -696,7 +696,7 @@
(check-ascii next-bytes temp DONE)
LOOP
- (inst mov bytes next-bytes)
+ (inst mov bytes next-bytes :16b)
(inst ldr next-bytes (@ byte-array 16))
(check-ascii next-bytes temp DONE)
@@ -715,16 +715,16 @@
;; SLI retains the destination parts, matching elements
;; will have FFFF, shifting and inserting will combine
;; them with zeros producing just one FF
- (inst sli temp temp2 :8h 8)
+ (inst sli temp temp2 8 :8h)
;; Count matches
- (inst ushr temp3 temp :16b 7)
+ (inst ushr temp3 temp 7 :16b)
(inst addv temp2 temp3 :8b)
(inst fmov count (reg-in-sc temp2 'single-reg))
;; bit-mask has powers of two for each byte index,
;; adding them together will produce an 8-bit mask.
- (inst and temp2 temp bit-mask)
+ (inst and temp2 temp bit-mask :16b)
(inst addv temp temp2 :8b)
(inst fmov tmp-tn (reg-in-sc temp 'single-reg))
@@ -826,7 +826,7 @@
(check-ascii next-bytes temp DONE)
LOOP
- (inst mov bytes next-bytes)
+ (inst mov bytes next-bytes :16b)
(inst ldr next-bytes (@ byte-array 16))
(check-ascii next-bytes temp DONE)
@@ -842,16 +842,16 @@
;; SLI retains the destination parts, matching elements
;; will have FFFF, shifting and inserting will combine
;; them with zeros producing just one FF
- (inst sli temp temp2 :8h 8)
+ (inst sli temp temp2 8 :8h)
;; Count matches
- (inst ushr temp3 temp :16b 7)
+ (inst ushr temp3 temp 7 :16b)
(inst addv temp2 temp3 :8b)
(inst fmov count (reg-in-sc temp2 'single-reg))
;; bit-mask has powers of two for each byte index,
;; adding them together will produce an 8-bit mask.
- (inst and temp2 temp bit-mask)
+ (inst and temp2 temp bit-mask :16b)
(inst addv temp temp2 :8b)
(inst fmov tmp-tn (reg-in-sc temp 'single-reg))
@@ -938,17 +938,17 @@
(inst ldp bytes bytes2 (@ 32-bit-array))
(inst ldp bytes3 bytes4 (@ 32-bit-array 32))
- (inst orr temp bytes bytes2)
- (inst orr temp2 bytes3 bytes4)
- (inst orr temp temp temp2)
+ (inst orr temp bytes bytes2 :16b)
+ (inst orr temp2 bytes3 bytes4 :16b)
+ (inst orr temp temp temp2 :16b)
(check-ascii temp temp DONE 4)
;; Find newlines
(loop for bytes in (list bytes bytes2 bytes3 bytes4)
do
(inst cmeq temp bytes newlines :4s)
- (inst bit last-newlines indexes temp)
- (inst add indexes indexes increment))
+ (inst bit last-newlines indexes temp :16b)
+ (inst add indexes indexes increment :16b))
(inst add 32-bit-array 32-bit-array 64)
@@ -1005,8 +1005,8 @@
(inst sub vector-start vector diff)
(inst ldr bytes (@ vector-start))
- (inst cmeq cmp bytes search)
- (inst shrn cmp cmp :8b 4)
+ (inst cmeq cmp bytes search :16b)
+ (inst shrn cmp cmp 4 :8b)
(inst fmov length (reg-in-sc cmp 'double-reg))
@@ -1023,8 +1023,8 @@
(inst cmp vector end)
(inst b :eq DONE)
(inst ldr bytes (@ vector))
- (inst cmeq cmp bytes search)
- (inst shrn cmp cmp :8b 4)
+ (inst cmeq cmp bytes search :16b)
+ (inst shrn cmp cmp 4 :8b)
(inst fmov length (reg-in-sc cmp 'double-reg))
(inst cbnz length FOUND)
(inst add vector vector 16)
@@ -1077,8 +1077,8 @@
(inst b :le TAIL)
(inst ldr bytes (@ vector))
- (inst cmeq cmp bytes search)
- (inst shrn cmp cmp :8b 4)
+ (inst cmeq cmp bytes search :16b)
+ (inst shrn cmp cmp 4 :8b)
(inst fmov found-bits (reg-in-sc cmp 'double-reg))
(inst cbnz found-bits FOUND)
@@ -1088,8 +1088,8 @@
;; Read past the start if needed.
;; Vector header and length are 16-byte long, making it safe.
(inst ldr bytes (@ vector))
- (inst cmeq cmp bytes search)
- (inst shrn cmp cmp :8b 4)
+ (inst cmeq cmp bytes search :16b)
+ (inst shrn cmp cmp 4 :8b)
;; Clear the extra bits
(inst sub padded padded-length length)
@@ -1150,7 +1150,7 @@
(inst ldr bytes (@ vector-start))
(inst cmeq cmp bytes search :4s)
- (inst shrn cmp cmp :8b 4)
+ (inst shrn cmp cmp 4 :8b)
(inst fmov length (reg-in-sc cmp 'double-reg))
@@ -1168,7 +1168,7 @@
(inst b :eq DONE)
(inst ldr bytes (@ vector))
(inst cmeq cmp bytes search :4s)
- (inst shrn cmp cmp :8b 4)
+ (inst shrn cmp cmp 4 :8b)
(inst fmov length (reg-in-sc cmp 'double-reg))
(inst cbnz length FOUND)
(inst add vector vector 16)
@@ -1221,7 +1221,7 @@
(inst b :le TAIL)
(inst ldr bytes (@ vector))
(inst cmeq cmp bytes search :4s)
- (inst shrn cmp cmp :8b 4)
+ (inst shrn cmp cmp 4 :8b)
(inst fmov found-bits (reg-in-sc cmp 'double-reg))
(inst cbnz found-bits FOUND)
(inst b LOOP)
@@ -1231,7 +1231,7 @@
;; Vector header and length are 16-byte long, making it safe.
(inst ldr bytes (@ vector))
(inst cmeq cmp bytes search :4s)
- (inst shrn cmp cmp :8b 4)
+ (inst shrn cmp cmp 4 :8b)
;; Clear the extra bits
(inst sub padded padded-length length)
diff --git a/src/compiler/arm64/float.lisp b/src/compiler/arm64/float.lisp
index 7f426d4f0..08487ae00 100644
--- a/src/compiler/arm64/float.lisp
+++ b/src/compiler/arm64/float.lisp
@@ -172,7 +172,7 @@
(:results (y :scs (complex-single-reg) :load-if (not (location= x y))))
(:note "complex single float move")
(:generator 0
- (move y x)))
+ (move y x :8b)))
(define-move-vop complex-single-move :move
(complex-single-reg) (complex-single-reg))
@@ -182,7 +182,7 @@
(:results (y :scs (complex-double-reg) :load-if (not (location= x y))))
(:note "complex double float move")
(:generator 0
- (move y x)))
+ (move y x :16b)))
(define-move-vop complex-double-move :move
(complex-double-reg) (complex-double-reg))
@@ -466,7 +466,7 @@
(frob */complex-single-float complex-single-reg complex-single-float :2s :s 20
(inst rev64 swap-y y :2s))
(frob */complex-double-float complex-double-reg complex-double-float :2d :d 25
- (inst ext swap-y y y 8)))
+ (inst ext swap-y y y 8 :16b)))
(define-vop (fsqrtd)
(:args (x :scs (double-reg)))
@@ -918,7 +918,7 @@
(:generator 5
(sc-case r
(complex-single-reg
- (move r real)
+ (move r real :8b)
(inst ins r 1 imag 0 :s))
(complex-single-stack
(let ((nfp (current-nfp-tn vop))
@@ -948,7 +948,7 @@
(:generator 5
(sc-case r
(complex-double-reg
- (move r real)
+ (move r real :16b)
(inst ins r 1 imag 0 :d))
(complex-double-stack
(let ((nfp (current-nfp-tn vop))
@@ -1045,7 +1045,7 @@
(def swap-complex/complex-single-float complex-single-reg complex-single-float
(inst rev64 r x :2s))
(def swap-complex/complex-double-float complex-double-reg complex-double-float
- (inst ext r x x 8)))
+ (inst ext r x x 8 :16b)))
(define-vop ()
(:translate round-double)
diff --git a/src/compiler/arm64/insts.lisp b/src/compiler/arm64/insts.lisp
index cf6b06c8d..469254357 100644
--- a/src/compiler/arm64/insts.lisp
+++ b/src/compiler/arm64/insts.lisp
@@ -525,12 +525,12 @@
(defmacro def-add-sub+simd (name op printers
simd-u simd-op)
- `(define-instruction ,name (segment rd rn rm &optional (size :16b))
+ `(define-instruction ,name (segment rd rn rm &optional vector-size)
,@printers
(:printer simd-three-same-sized ((u ,simd-u) (op ,simd-op)))
(:emitter
- (if (fp-register-p rd)
- (multiple-value-bind (q size) (encode-vector-size size)
+ (if vector-size
+ (multiple-value-bind (q size) (encode-vector-size vector-size)
(emit-simd-three-same segment
q
,simd-u
@@ -847,14 +847,14 @@
(emit-logical-imm segment size ,opc n immr imms (gpr-offset rn) (gpr-offset rd))))))))
(defmacro def-logical-imm-and-reg+simd (name opc printers simd-u simd-size simd-op &rest simd-printer)
- `(define-instruction ,name (segment rd rn rm &optional (size :16b))
+ `(define-instruction ,name (segment rd rn rm &optional vector-size)
(:printer simd-three-same ((u ,simd-u) (size ,simd-size) (op ,simd-op))
,@simd-printer)
,@printers
(:emitter
- (if (fp-register-p rd)
+ (if vector-size
(emit-simd-three-same segment
- (encode-vector-size size)
+ (encode-vector-size vector-size)
,simd-u
,simd-size
(fpr-offset rm)
@@ -915,13 +915,13 @@
(defmacro def-logical-reg+simd (name opc printers
simd-u simd-size simd-op &rest simd-printer)
- `(define-instruction ,name (segment rd rn rm &optional (size :16b))
+ `(define-instruction ,name (segment rd rn rm &optional vector-size)
,@printers
,@simd-printer
(:emitter
- (if (fp-register-p rd)
+ (if vector-size
(emit-simd-three-same segment
- (encode-vector-size size)
+ (encode-vector-size vector-size)
,simd-u
,simd-size
(fpr-offset rm)
@@ -1101,16 +1101,14 @@
(define-instruction-macro mov-sp (rd rm)
`(inst add ,rd ,rm 0))
-(define-instruction-macro mov (rd rm &optional (size :16b))
+(define-instruction-macro mov (rd rm &optional vector-size)
`(let ((rd ,rd)
- (rm ,rm)
- (size ,size))
- (cond ((integerp rm)
- (sb-vm::load-immediate-word rd rm))
- ((fp-register-p rd)
- (inst orr rd rm rm size))
- (t
- (inst orr rd zr-tn rm)))))
+ (rm ,rm))
+ (if (integerp rm)
+ (sb-vm::load-immediate-word rd rm)
+ ,(if vector-size
+ `(inst orr rd rm rm ,vector-size)
+ `(inst orr rd zr-tn rm)))))
(define-instruction movn (segment rd imm &optional (shift 0))
(:printer move-wide ((op #b00)))
@@ -1264,58 +1262,38 @@
(gpr-offset rn)
(gpr-offset rd)))))
-(defmacro def-data-processing-1+simd (name opc &optional 32-bit-opcode)
- `(define-instruction ,name (segment rd rn)
- (:printer data-processing-1 ((op ,opc)))
- (:emitter
- (emit-data-processing-1 segment
- (reg-size rd)
- ,(if 32-bit-opcode
- `(sc-case rd
- (32-bit-reg
- ,32-bit-opcode)
- (t
- ,opc))
- opc)
- (gpr-offset rn)
- (gpr-offset rd)))))
-
(def-data-processing-1 rbit #b000)
(def-data-processing-1 rev16 #b001)
(def-data-processing-1 clz #b100)
(def-data-processing-1 cls #b101)
-(define-instruction rev16 (segment rd rn &optional (size :16b))
+(define-instruction rev16 (segment rd rn &optional vector-size)
(:printer simd-two-misc ((u 0) (op 1)))
(:printer data-processing-1 ((op 1)))
(:emitter
- (cond ((fp-register-p rd)
- (check-type size (member :8b :16b))
- (multiple-value-bind (q size) (encode-vector-size size)
- (emit-simd-two-misc segment q #b0 size #b00001
- (fpr-offset rn) (fpr-offset rd))))
- (t
- (emit-data-processing-1 segment
- (reg-size rd)
- #b001
- (gpr-offset rn)
- (gpr-offset rd))))))
+ (if vector-size
+ (multiple-value-bind (q size) (encode-vector-size (the (member :8b :16b) vector-size))
+ (emit-simd-two-misc segment q #b0 size #b00001
+ (fpr-offset rn) (fpr-offset rd)))
+ (emit-data-processing-1 segment
+ (reg-size rd)
+ #b001
+ (gpr-offset rn)
+ (gpr-offset rd)))))
-(define-instruction rev32 (segment rd rn &optional (size :16b))
+(define-instruction rev32 (segment rd rn &optional vector-size)
(:printer data-processing-1 ((size 1) (op #b10)))
(:printer simd-two-misc ((u 1) (op 0)))
(:emitter
- (cond ((fp-register-p rd)
- (check-type size (member :8b :16b :4h :8h))
- (multiple-value-bind (q size) (encode-vector-size size)
- (emit-simd-two-misc segment q #b1 size #b00000
- (fpr-offset rn) (fpr-offset rd))))
- (t
- (emit-data-processing-1 segment
- (reg-size rd)
- #b10
- (gpr-offset rn)
- (gpr-offset rd))))))
+ (if vector-size
+ (multiple-value-bind (q size) (encode-vector-size (the (member :8b :16b :4h :8h) vector-size))
+ (emit-simd-two-misc segment q #b1 size #b00000
+ (fpr-offset rn) (fpr-offset rd)))
+ (emit-data-processing-1 segment
+ (reg-size rd)
+ #b10
+ (gpr-offset rn)
+ (gpr-offset rd)))))
(define-instruction rev (segment rd rn)
(:printer data-processing-1 ((size #b1) (op #b11)))
@@ -3086,7 +3064,7 @@
(:2d (values 1 #b11))))
(macrolet ((def (name u size op &rest printer)
- `(define-instruction ,name (segment rd rn rm &optional (size :16b))
+ `(define-instruction ,name (segment rd rn rm size)
(:printer simd-three-same ((u ,u) (size ,size) (op ,op))
,@printer)
(:emitter
@@ -3103,7 +3081,7 @@
(def bif #b1 #b11 #b00011))
(macrolet ((def (name u op)
- `(define-instruction ,name (segment rd rn rm &optional (size :16b))
+ `(define-instruction ,name (segment rd rn rm size)
(:printer simd-three-same-sized ((u ,u) (op ,op)))
(:emitter
(multiple-value-bind (q size) (encode-vector-size size)
@@ -3126,7 +3104,7 @@
(def smax #b0 #b01100))
(macrolet ((def (name u neg op)
- `(define-instruction ,name (segment rd rn rm &optional (size :16b))
+ `(define-instruction ,name (segment rd rn rm size)
(:printer simd-three-same-float ((u ,u) (neg ,neg) (op ,op)))
(:emitter
(multiple-value-bind (q size) (encode-vector-size size)
@@ -3190,7 +3168,7 @@
(rn :fields (list (byte 1 30) (byte 5 5)) :type 'simd-reg)
(rd :fields (list (byte 1 30) (byte 5 0)) :type 'simd-reg))
-(define-instruction ext (segment rd rn rm index &optional (size :16b))
+(define-instruction ext (segment rd rn rm index size)
(:printer simd-extract ())
(:emitter
(emit-simd-extract segment
@@ -3400,7 +3378,7 @@
(macrolet
((def (name u op &optional (sizes '(:8b :16b)))
- `(define-instruction ,name (segment rd rn &optional (size :16b))
+ `(define-instruction ,name (segment rd rn size)
(:printer simd-two-misc ((u ,u) (op ,op)))
(:emitter
(check-type size (member ,@sizes))
@@ -3418,7 +3396,7 @@
(macrolet
((def (name u op q &optional sizes)
- `(define-instruction ,name (segment rd rn &optional (size ,(car sizes)))
+ `(define-instruction ,name (segment rd rn size)
(:printer simd-two-misc ((q ,q) (u ,u) (op ,op)))
(:emitter
(check-type size (member ,@sizes))
@@ -3508,7 +3486,7 @@
(macrolet
((def (name u op &optional right 2d)
- `(define-instruction ,name (segment rd rn size shift)
+ `(define-instruction ,name (segment rd rn shift size)
;; Conflicts with simd-modified-imm where immh=0
,@(loop for (size pos) in '((4 19)
(3 20)
@@ -3704,7 +3682,7 @@
-(define-instruction fcadd (segment rd rn rm &optional size (rot 90))
+(define-instruction fcadd (segment rd rn rm rot size)
(:printer simd-three-extension ((op #b1100) (u 1))
'(:name :tab rd ", " rn ", " rm ", #90"))
(:printer simd-three-extension ((op #b1110) (u 1))
@@ -3721,7 +3699,7 @@
(fpr-offset rn)
(fpr-offset rd)))))
-(define-instruction fcmla (segment rd rn rm &optional size (rot 90))
+(define-instruction fcmla (segment rd rn rm rot size)
(:printer simd-three-extension ((op #b1000) (u 1))
'(:name :tab rd ", " rn ", " rm ", #0"))
(:printer simd-three-extension ((op #b1001) (u 1))
@@ -3771,7 +3749,7 @@
(macrolet
((def (name op)
- `(define-instruction ,name (segment rd rns rm &optional (size :16b))
+ `(define-instruction ,name (segment rd rns rm size)
(:printer simd-table ((op ,op)))
(:emitter
(assert (<= 1 (length rns) 4))
@@ -3821,7 +3799,7 @@
(macrolet
((def (name op)
- `(define-instruction ,name (segment rd rn rm &optional (size :16b))
+ `(define-instruction ,name (segment rd rn rm size)
(:printer simd-permute ((op ,op)))
(:emitter
(multiple-value-bind (q size) (encode-vector-size size)
@@ -4130,91 +4108,97 @@
;;; Tagging and applying a tagged mask can be done in one step.
(defpattern "lsl + and -> ubfiz" ((ubfm) (and)) (stmt next)
(destructuring-bind (dst1 src1 immr imms) (stmt-operands stmt)
- (destructuring-bind (dst2 src2 mask) (stmt-operands next)
- (let (tagged)
- (when (and (location= dst1 src2)
- (or (setf tagged (tagged-mask-p mask))
- (untagged-mask-p mask))
- (= immr 63)
- (= imms 62)
- (stmt-delete-safe-p dst1 dst2 '(logand)))
- (setf (stmt-mnemonic next) 'ubfm
- (stmt-operands next) (list dst2 src1 63 (+ (logcount mask)
- (if tagged
- -1
- -2))))
- (add-stmt-labels next (stmt-labels stmt))
- (delete-stmt stmt)
- next)))))
+ (destructuring-bind (dst2 src2 mask &optional vector-size) (stmt-operands next)
+ (unless vector-size
+ (let (tagged)
+ (when (and (location= dst1 src2)
+ (or (setf tagged (tagged-mask-p mask))
+ (untagged-mask-p mask))
+ (= immr 63)
+ (= imms 62)
+ (stmt-delete-safe-p dst1 dst2 '(logand)))
+ (setf (stmt-mnemonic next) 'ubfm
+ (stmt-operands next) (list dst2 src1 63 (+ (logcount mask)
+ (if tagged
+ -1
+ -2))))
+ (add-stmt-labels next (stmt-labels stmt))
+ (delete-stmt stmt)
+ next))))))
;;; Helps with SBIT
(defpattern "and + lsl -> ubfiz" ((and) (ubfm)) (stmt next)
- (destructuring-bind (dst1 src1 mask) (stmt-operands stmt)
- (destructuring-bind (dst2 src2 immr imms) (stmt-operands next)
- (when (and (location= dst1 src2)
- (untagged-mask-p mask)
- (= immr 63)
- (= imms 62)
- (stmt-delete-safe-p dst1 dst2 nil '(sb-vm::move-from-word/fixnum)))
- (setf (stmt-mnemonic next) 'ubfm
- (stmt-operands next) (list dst2 src1 63 (1- (logcount mask))))
- (add-stmt-labels next (stmt-labels stmt))
- (delete-stmt stmt)
- next))))
+ (destructuring-bind (dst1 src1 mask &optional vector-size) (stmt-operands stmt)
+ (unless vector-size
+ (destructuring-bind (dst2 src2 immr imms) (stmt-operands next)
+ (when (and (location= dst1 src2)
+ (untagged-mask-p mask)
+ (= immr 63)
+ (= imms 62)
+ (stmt-delete-safe-p dst1 dst2 nil '(sb-vm::move-from-word/fixnum)))
+ (setf (stmt-mnemonic next) 'ubfm
+ (stmt-operands next) (list dst2 src1 63 (1- (logcount mask))))
+ (add-stmt-labels next (stmt-labels stmt))
+ (delete-stmt stmt)
+ next)))))
;;; If the sign bit gets cut off it can be done with just a logical shift.
(defpattern "asr + and -> lsr" ((sbfm) (and)) (stmt next)
(destructuring-bind (dst1 src1 immr imms) (stmt-operands stmt)
- (destructuring-bind (dst2 src2 mask) (stmt-operands next)
- (when (and (location= dst1 src2)
- (untagged-mask-p mask)
- (= (integer-length mask) 63)
- (= immr 1)
- (= imms 63)
- (stmt-delete-safe-p dst1 dst2 '(logand)))
- (setf (stmt-mnemonic next) 'ubfm
- (stmt-operands next) (list dst2 src1 immr imms))
- (add-stmt-labels next (stmt-labels stmt))
- (delete-stmt stmt)
- next))))
+ (destructuring-bind (dst2 src2 mask &optional vector-size) (stmt-operands next)
+ (unless vector-size
+ (when (and (location= dst1 src2)
+ (untagged-mask-p mask)
+ (= (integer-length mask) 63)
+ (= immr 1)
+ (= imms 63)
+ (stmt-delete-safe-p dst1 dst2 '(logand)))
+ (setf (stmt-mnemonic next) 'ubfm
+ (stmt-operands next) (list dst2 src1 immr imms))
+ (add-stmt-labels next (stmt-labels stmt))
+ (delete-stmt stmt)
+ next)))))
;;; Applying a tagged mask and untagging
(defpattern "and + asr -> ubfx" ((and) (sbfm)) (stmt next)
- (destructuring-bind (dst1 src1 mask) (stmt-operands stmt)
- (destructuring-bind (dst2 src2 immr imms) (stmt-operands next)
- (when (and (location= dst1 src2)
- (tagged-mask-p mask)
- (= immr 1)
- (= imms 63)
- (stmt-delete-safe-p dst1 dst2 nil '(sb-vm::move-to-word/fixnum)))
- ;; Leave the ASR if the sign bit is left,
- ;; but the AND is not needed.
- (if (= (integer-length mask) 64)
- (setf (stmt-operands next) (list dst2 src1 immr imms))
- (setf (stmt-mnemonic next) 'ubfm
- (stmt-operands next) (list dst2 src1 1 (logcount mask))))
- (add-stmt-labels next (stmt-labels stmt))
- (delete-stmt stmt)
- next))))
+ (destructuring-bind (dst1 src1 mask &optional vector-size) (stmt-operands stmt)
+ (unless vector-size
+ (destructuring-bind (dst2 src2 immr imms) (stmt-operands next)
+ (when (and (location= dst1 src2)
+ (tagged-mask-p mask)
+ (= immr 1)
+ (= imms 63)
+ (stmt-delete-safe-p dst1 dst2 nil '(sb-vm::move-to-word/fixnum)))
+ ;; Leave the ASR if the sign bit is left,
+ ;; but the AND is not needed.
+ (if (= (integer-length mask) 64)
+ (setf (stmt-operands next) (list dst2 src1 immr imms))
+ (setf (stmt-mnemonic next) 'ubfm
+ (stmt-operands next) (list dst2 src1 1 (logcount mask))))
+ (add-stmt-labels next (stmt-labels stmt))
+ (delete-stmt stmt)
+ next)))))
(defpattern "and + and -> and" ((and) (and)) (stmt next)
- (destructuring-bind (dst1 src1 mask1) (stmt-operands stmt)
- (destructuring-bind (dst2 src2 mask2) (stmt-operands next)
- (when
- (and (location= dst1 src2)
- (integerp mask1)
- (integerp mask2)
- (stmt-delete-safe-p dst1 dst2 '(logand)))
- (let ((mask (logand mask1 mask2)))
- (when (or (zerop mask)
- (encode-logical-immediate mask))
- (if (zerop mask)
- (setf (stmt-mnemonic next) 'orr
- (stmt-operands next) (list dst2 zr-tn zr-tn))
- (setf (stmt-operands next) (list dst2 src1 mask)))
- (add-stmt-labels next (stmt-labels stmt))
- (delete-stmt stmt)
- next))))))
+ (destructuring-bind (dst1 src1 mask1 &optional vector-size) (stmt-operands stmt)
+ (unless vector-size
+ (destructuring-bind (dst2 src2 mask2 &optional vector-size) (stmt-operands next)
+ (unless vector-size
+ (when
+ (and (location= dst1 src2)
+ (integerp mask1)
+ (integerp mask2)
+ (stmt-delete-safe-p dst1 dst2 '(logand)))
+ (let ((mask (logand mask1 mask2)))
+ (when (or (zerop mask)
+ (encode-logical-immediate mask))
+ (if (zerop mask)
+ (setf (stmt-mnemonic next) 'orr
+ (stmt-operands next) (list dst2 zr-tn zr-tn))
+ (setf (stmt-operands next) (list dst2 src1 mask)))
+ (add-stmt-labels next (stmt-labels stmt))
+ (delete-stmt stmt)
+ next))))))))
(defpattern "lsl + arith -> arith" ((ubfm) (add and orr eor)) (stmt next)
(destructuring-bind (dst1 src1 immr imms) (stmt-operands stmt)
diff --git a/src/compiler/arm64/macros.lisp b/src/compiler/arm64/macros.lisp
index 9576b936c..505e3db81 100644
--- a/src/compiler/arm64/macros.lisp
+++ b/src/compiler/arm64/macros.lisp
@@ -13,12 +13,13 @@
;;; Instruction-like macros.
-(defmacro move (dst src)
+(defmacro move (dst src &optional vector-size)
"Move SRC into DST unless they are location=."
(once-only ((n-dst dst)
(n-src src))
`(unless (location= ,n-dst ,n-src)
- (inst mov ,n-dst ,n-src))))
+ (inst mov ,n-dst ,n-src ,@(when vector-size
+ `(,vector-size))))))
(defmacro move-float (dst src)
(once-only ((n-dst dst)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL