master: avx512 assembler support
stassats via Sbcl-commits <[email protected]> Wed, 01 Jul 2026 03:38:40 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 36fceec808c6e97783913d01c42ba3c04d68003e (commit)
from cb716e24d642f69fa40dbdc09f2a7bfe50b29823 (commit)
- Log -----------------------------------------------------------------
commit 36fceec808c6e97783913d01c42ba3c04d68003e
Author: Robert Smith <[email protected]>
Date: Tue Mar 3 18:09:16 2026 -0500
avx512 assembler support
---
src/cold/build-order.lisp-expr | 1 +
src/compiler/x86-64/avx2-insts.lisp | 621 +++++++++++++---
src/compiler/x86-64/avx512-insts.lisp | 1087 ++++++++++++++++++++++++++++
src/compiler/x86-64/insts.lisp | 65 +-
src/compiler/x86-64/macros.lisp | 8 +
src/compiler/x86-64/target-avx2-insts.lisp | 34 +-
src/compiler/x86-64/target-insts.lisp | 13 +-
src/compiler/x86-64/vm.lisp | 57 +-
8 files changed, 1793 insertions(+), 93 deletions(-)
diff --git a/src/cold/build-order.lisp-expr b/src/cold/build-order.lisp-expr
index 7d5fa64ce..23a392ad7 100644
--- a/src/cold/build-order.lisp-expr
+++ b/src/cold/build-order.lisp-expr
@@ -391,6 +391,7 @@
("src/compiler/target-dstate" :not-host)
("src/compiler/asm-target/insts")
#+avx2 ("src/compiler/{arch}/avx2-insts")
+ #+avx2 ("src/compiler/{arch}/avx512-insts")
("src/compiler/{arch}/macros")
("src/assembly/{arch}/support")
diff --git a/src/compiler/x86-64/avx2-insts.lisp b/src/compiler/x86-64/avx2-insts.lisp
index 99256691c..1d6539ade 100644
--- a/src/compiler/x86-64/avx2-insts.lisp
+++ b/src/compiler/x86-64/avx2-insts.lisp
@@ -44,6 +44,12 @@
:printer #'print-sized-xmmreg/mem-default-qword)
(defconstant +vex-l+ #b10000000000)
+;; EVEX L'L=10 (512-bit) sets bit 11; L'L=01 (256-bit) sets bit 10 (=+vex-l+)
+(defconstant +evex-l1+ #b100000000000)
+;; EVEX R' bit (reg bit 4, for registers 16-31 in ModR/M.reg)
+(defconstant +evex-r-prime+ #b1000000000000)
+;; EVEX X bit as B' (r/m bit 4, for registers 16-31 in ModR/M.r/m, reg-direct only)
+(defconstant +evex-b-prime+ #b10000000000000)
(define-arg-type vex-l
:prefilter (lambda (dstate value)
@@ -76,6 +82,39 @@
:type 'imm-byte
:printer +avx-conditions+)
+
+;;; EVEX arg-types
+
+;; EVEX R' extends ModR/M.reg bit 4 (inverted in prefix)
+;; R'=0 in prefix means bit4=1 (register 16-31)
+(define-arg-type evex-r-prime
+ :prefilter (lambda (dstate value)
+ (dstate-setprop dstate (if (zerop value) +evex-r-prime+ 0))))
+
+;; EVEX V' extends vvvv bit 4 (inverted in prefix)
+;; V'=0 means bit4=1 (register 16-31 in vvvv)
+;; Note: the printer for vvvv (print-ymmreg via ymm-vvvv-reg) gets
+;; a 4-bit value from the invert-4 prefilter. V' provides the 5th bit.
+(define-arg-type evex-v-prime
+ :prefilter (lambda (dstate value)
+ (declare (ignore dstate value))))
+
+;; EVEX L'L: 2-bit vector length (00=128, 01=256, 10=512)
+;; Stores into dstate bits 10-11: L'L=01 sets bit 10 (+vex-l+),
+;; L'L=10 sets bit 11 (+evex-l1+), L'L=11 sets both.
+(define-arg-type evex-ll
+ :prefilter (lambda (dstate value)
+ (dstate-setprop dstate (ash value 10))))
+
+;; EVEX W: same semantics as VEX.W
+(define-arg-type evex-w
+ :prefilter (lambda (dstate value)
+ (dstate-setprop dstate (if (plusp value) +rex-w+ 0))))
+
+;; Opmask register k0-k7
+(define-arg-type opmask-reg
+ :printer #'print-opmask-reg)
+
(define-instruction-format (vex2 16)
(vex :field (byte 8 0) :value #xC5)
@@ -103,24 +142,22 @@
(defmacro define-vex-instruction-format ((format-name length-in-bits
&key default-printer include)
&body arg-specs)
- `
- (progn
- (define-instruction-format (,(symbolicate "VEX2-" format-name) (+ 16 ,length-in-bits)
- :include ,(if include
- (symbolicate "VEX2-" include)
- 'vex2)
- :default-printer ,default-printer)
- ,@(subst 16 'start arg-specs))
- (define-instruction-format (,(symbolicate "VEX3-" format-name) (+ 24 ,length-in-bits)
- :include ,(if include
- (symbolicate "VEX3-" include)
- 'vex3)
- :default-printer ,default-printer)
- ,@(subst 24 'start arg-specs))))
+ `(progn
+ (define-instruction-format (,(symbolicate "VEX2-" format-name) (+ 16 ,length-in-bits)
+ :include ,(if include
+ (symbolicate "VEX2-" include)
+ 'vex2)
+ :default-printer ,default-printer)
+ ,@(subst 16 'start arg-specs))
+ (define-instruction-format (,(symbolicate "VEX3-" format-name) (+ 24 ,length-in-bits)
+ :include ,(if include
+ (symbolicate "VEX3-" include)
+ 'vex3)
+ :default-printer ,default-printer)
+ ,@(subst 24 'start arg-specs))))
(define-vex-instruction-format (ymm-ymm/mem 16
- :default-printer
- '(:name :tab reg ", " reg/mem))
+ :default-printer '(:name :tab reg ", " reg/mem))
(op :field (byte 8 (+ start 0)))
(reg/mem :fields (list (byte 2 (+ start 14)) (byte 3 (+ start 8)))
:type 'ymmreg/mem)
@@ -130,18 +167,16 @@
(imm))
(define-vex-instruction-format (ymm-ymm/mem-imm 16
- :default-printer
- '(:name :tab reg ", " vvvv ", " reg/mem ", " imm))
+ :default-printer '(:name :tab reg ", " vvvv ", " reg/mem ", " imm))
(op :field (byte 8 (+ start 0)))
(reg/mem :fields (list (byte 2 (+ start 14)) (byte 3 (+ start 8)))
:type 'ymmreg/mem)
(reg :field (byte 3 (+ start 11))
:type 'ymmreg)
- (imm :type 'imm-byte))
+ (imm :type 'imm-byte))
(define-vex-instruction-format (ymm-ymm/mem-ymm 24
- :default-printer
- '(:name :tab reg ", " vvvv ", " reg/mem ", " reg4))
+ :default-printer '(:name :tab reg ", " vvvv ", " reg/mem ", " reg4))
(op :field (byte 8 (+ start 0)))
(reg/mem :fields (list (byte 2 (+ start 14)) (byte 3 (+ start 8)))
:type 'ymmreg/mem)
@@ -153,32 +188,138 @@
;;; Same as ymm-ymm/mem etc., but with a direction bit.
(define-vex-instruction-format (ymm-ymm/mem-dir 16
:include ymm-ymm/mem
- :default-printer
- `(:name
- :tab
- (:if (reg/mem :test machine-ea-p)
- (:if (dir :constant 0)
- (reg ", " reg/mem)
- (reg/mem ", " reg))
- (reg ", " vvvv ", " reg/mem))))
+ :default-printer `(:name
+ :tab
+ (:if (reg/mem :test machine-ea-p)
+ (:if (dir :constant 0)
+ (reg ", " reg/mem)
+ (reg/mem ", " reg))
+ (reg ", " vvvv ", " reg/mem))))
(op :field (byte 7 (+ start 1)))
(dir :field (byte 1 (+ start 0))))
(define-vex-instruction-format (ymm-ymm-imm 16
- :default-printer
- '(:name :tab vvvv ", " reg ", " imm))
- (op :field (byte 8 (+ start 0)))
- (/i :field (byte 3 (+ start 11)))
- (b11 :field (byte 2 (+ start 14)) :value #b11)
- (reg :field (byte 3 (+ start 8)) :type 'ymmreg-b)
+ :default-printer '(:name :tab vvvv ", " reg ", " imm))
+ (op :field (byte 8 (+ start 0)))
+ (/i :field (byte 3 (+ start 11)))
+ (b11 :field (byte 2 (+ start 14))
+ :value #b11)
+ (reg :field (byte 3 (+ start 8))
+ :type 'ymmreg-b)
(imm :type 'imm-byte))
(define-vex-instruction-format (reg-ymm/mem 16
:include ymm-ymm/mem
- :default-printer
- '(:name :tab reg ", " reg/mem))
+ :default-printer '(:name :tab reg ", " reg/mem))
(reg :field (byte 3 (+ start 11))
:type 'reg))
+
+;;; EVEX instruction formats for disassembly
+;;; EVEX prefix is 4 bytes (32 bits):
+;;; Byte 0: #x62
+;;; Byte 1: R(7) X(6) B(5) R'(4) 00(3:2) mm(1:0)
+;;; Byte 2: W(7) vvvv(6:3) 1(2) pp(1:0)
+;;; Byte 3: z(7) L'(6) L(5) b(4) V'(3) aaa(2:0)
+
+(define-instruction-format (evex 32)
+ (evex-prefix :field (byte 8 0) :value #x62)
+ ;; Byte 1
+ (r :field (byte 1 15) :type 'vex-r)
+ (x :field (byte 1 14) :type 'vex-x)
+ (b :field (byte 1 13) :type 'vex-b)
+ (r-prime :field (byte 1 12) :type 'evex-r-prime)
+ (reserved :field (byte 2 10) :value #b00) ; distinguishes EVEX from BOUND
+ (mm :field (byte 2 8))
+ ;; Byte 2
+ (w :field (byte 1 23) :type 'evex-w)
+ (vvvv :field (byte 4 19) :type 'ymm-vvvv-reg)
+ (evex-fixed :field (byte 1 18) :value 1) ; must be 1 for EVEX
+ (pp :field (byte 2 16))
+ ;; Byte 3
+ (z-bit :field (byte 1 31))
+ (ll :field (byte 2 29) :type 'evex-ll)
+ (evex-b :field (byte 1 28))
+ (v-prime :field (byte 1 27) :type 'evex-v-prime)
+ (aaa :field (byte 3 24) :type 'opmask-reg))
+
+(defmacro define-evex-instruction-format ((format-name length-in-bits
+ &key default-printer include)
+ &body arg-specs)
+ `(define-instruction-format (,(symbolicate "EVEX-" format-name) (+ 32 ,length-in-bits)
+ :include ,(if include
+ (symbolicate "EVEX-" include)
+ 'evex)
+ :default-printer ,default-printer)
+ ,@(subst 32 'start arg-specs)))
+
+(define-evex-instruction-format (ymm-ymm/mem 16
+ :default-printer '(:name :tab reg ", " reg/mem))
+ (op :field (byte 8 (+ start 0)))
+ (reg/mem :fields (list (byte 2 (+ start 14)) (byte 3 (+ start 8)))
+ :type 'ymmreg/mem)
+ (reg :field (byte 3 (+ start 11))
+ :type 'ymmreg)
+ ;; optional fields
+ (imm))
+
+(define-evex-instruction-format (ymm-ymm/mem-imm 16
+ :default-printer '(:name :tab reg ", " vvvv ", " reg/mem ", " imm))
+ (op :field (byte 8 (+ start 0)))
+ (reg/mem :fields (list (byte 2 (+ start 14)) (byte 3 (+ start 8)))
+ :type 'ymmreg/mem)
+ (reg :field (byte 3 (+ start 11))
+ :type 'ymmreg)
+ (imm :type 'imm-byte))
+
+(define-evex-instruction-format (ymm-ymm/mem-dir 16
+ :include ymm-ymm/mem
+ :default-printer `(:name
+ :tab
+ (:if (reg/mem :test machine-ea-p)
+ (:if (dir :constant 0)
+ (reg ", " reg/mem)
+ (reg/mem ", " reg))
+ (reg ", " vvvv ", " reg/mem))))
+ (op :field (byte 7 (+ start 1)))
+ (dir :field (byte 1 (+ start 0))))
+
+(define-evex-instruction-format (ymm-ymm-imm 16
+ :default-printer '(:name :tab vvvv ", " reg ", " imm))
+ (op :field (byte 8 (+ start 0)))
+ (/i :field (byte 3 (+ start 11)))
+ (b11 :field (byte 2 (+ start 14))
+ :value #b11)
+ (reg :field (byte 3 (+ start 8))
+ :type 'ymmreg-b)
+ (imm :type 'imm-byte))
+
+(define-evex-instruction-format (reg-ymm/mem 16
+ :include ymm-ymm/mem
+ :default-printer '(:name :tab reg ", " reg/mem))
+ (reg :field (byte 3 (+ start 11))
+ :type 'reg))
+
+;;; Stub EVEX formats for VEX-only instruction format stems.
+(define-evex-instruction-format (ymm-ymm/mem-ymm 24
+ :default-printer '(:name :tab reg ", " vvvv ", " reg/mem ", " reg4))
+ (op :field (byte 8 (+ start 0)))
+ (reg/mem :fields (list (byte 2 (+ start 14)) (byte 3 (+ start 8)))
+ :type 'ymmreg/mem)
+ (reg :field (byte 3 (+ start 11))
+ :type 'ymmreg)
+ (reg4 :field (byte 4 (+ start 16 4))
+ :type 'ymm-reg-is4))
+
+(define-instruction-format (evex-vex-gpr (+ 32 16)
+ :include evex
+ :default-printer '(:name :tab reg ", " vvvv ", " reg/mem))
+ (op :field (byte 8 (+ 32 0)))
+ (vvvv :type 'vvvv-reg)
+ (reg/mem :fields (list (byte 2 (+ 32 14)) (byte 3 (+ 32 8)))
+ :type 'reg/mem)
+ (reg :field (byte 3 (+ 32 11))
+ :type 'reg))
+
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(defun vex-encode-pp (pp)
@@ -192,7 +333,13 @@
(ecase m-mmmm
(#x0F #b00001)
(#x0F38 #b00010)
- (#x0F3A #b00011))))
+ (#x0F3A #b00011)))
+
+ (defun evex-encode-mm (m-mmmm)
+ (ecase m-mmmm
+ (#x0F #b01)
+ (#x0F38 #b10)
+ (#x0F3A #b11))))
(defun emit-two-byte-vex (segment r vvvv l pp)
(emit-bytes segment
@@ -246,7 +393,7 @@
0)
(t
1))))
- (0)))
+ (t 0)))
(b
(reg-7-p
(cond ((ea-p thing)
@@ -256,7 +403,7 @@
0)))
((register-p thing)
(reg-id thing))
- (0)))))
+ (t 0)))))
(values l r x b))))
(defun emit-vex (segment vvvv thing reg prefix opcode-prefix l w)
@@ -270,14 +417,149 @@
(emit-three-byte-vex segment r x b opcode-prefix
w vvvv l prefix)))))
+;;; EVEX prefix encoding for AVX-512
+;;; EVEX is a 4-byte prefix: 62h | P1 | P2 | P3
+;;; P1: R(7) X(6) B(5) R'(4) 00(3:2) mm(1:0)
+;;; P2: W(7) vvvv(6:3) 1(2) pp(1:0)
+;;; P3: z(7) L'(6) L(5) b(4) V'(3) aaa(2:0)
+;;; R, X, B, R', V' are inverted. vvvv is inverted.
+
+(defun emit-evex (segment r x b r-prime opcode-prefix w vvvv pp z ll evex-b v-prime aaa)
+ (emit-bytes segment
+ #x62
+ ;; P1: R X B R' 00 mm
+ (logior (ash (logxor 1 r) 7)
+ (ash (logxor 1 x) 6)
+ (ash (logxor 1 b) 5)
+ (ash (logxor 1 r-prime) 4)
+ ;; bits 3:2 are reserved (0)
+ (evex-encode-mm opcode-prefix))
+ ;; P2: W vvvv 1 pp
+ (logior (ash w 7)
+ (ash (logxor vvvv #b1111) 3)
+ #b100 ; bit 2 always 1
+ (vex-encode-pp pp))
+ ;; P3: z L'L b V' aaa
+ (logior (ash z 7)
+ (ash ll 5)
+ (ash evex-b 4)
+ (ash (logxor 1 v-prime) 3)
+ aaa)))
+
+(defun determine-evex-flags (thing reg ll vvvv)
+ "Extract EVEX prefix flags from operands.
+Returns: ll, r, x, b, r-prime, v-prime.
+EVEX uses independent bit3 (R/B) and bit4 (R'/X) for 32-register encoding."
+ (flet ((reg-bit3 (reg-id)
+ ;; Extract bit 3 of 5-bit register number (for R, B in EVEX)
+ (if (logbitp 3 (reg-id-num reg-id)) 1 0))
+ (reg-bit4 (reg-id)
+ ;; Extract bit 4 of 5-bit register number (for R', V', X in EVEX)
+ (if (logbitp 4 (reg-id-num reg-id)) 1 0))
+ (fpr-size (r)
+ (cond ((is-zmm-id-p (reg-id r)) #b10)
+ ((is-ymm-id-p (reg-id r)) #b01)
+ ((xmm-register-p r) #b00))))
+ (let ((ll (cond (ll ll)
+ ;; Skip k-registers — they pass xmm-register-p but
+ ;; aren't XMM/YMM/ZMM, so fpr-size returns wrong value
+ ((and reg (xmm-register-p reg)
+ (not (is-kreg-id-p (reg-id reg))))
+ (fpr-size reg))
+ ((and (register-p thing) (xmm-register-p thing)
+ (not (is-kreg-id-p (reg-id thing))))
+ (fpr-size thing))
+ ;; Also check vvvv as fallback
+ ((and vvvv (register-p vvvv) (xmm-register-p vvvv))
+ (fpr-size vvvv))
+ (t #b00)))
+ ;; R from reg (ModR/M reg field) - bit 3
+ (r (if (null reg) 0 (reg-bit3 (reg-id reg))))
+ ;; R' from reg - bit 4
+ (r-prime (if (null reg) 0 (reg-bit4 (reg-id reg))))
+ ;; X from EA index, or bit 4 of r/m reg for register-direct
+ ;; In EVEX, X doubles as B' (bit 4 of r/m) when mod=11 (reg-direct)
+ (x (cond ((and (ea-p thing)
+ (ea-index thing))
+ (let ((index (ea-index thing)))
+ (cond ((gpr-p index)
+ (reg-bit3 (reg-id (tn-reg index))))
+ ((<= (tn-offset index) 7)
+ 0)
+ (t 1))))
+ ((register-p thing)
+ (reg-bit4 (reg-id thing)))
+ (t 0)))
+ ;; B from thing (ModR/M r/m field) - bit 3
+ (b (reg-bit3
+ (cond ((ea-p thing)
+ (let ((base (ea-base thing)))
+ (if (and base (neq base rip-tn))
+ (reg-id (tn-reg base))
+ 0)))
+ ((register-p thing)
+ (reg-id thing))
+ (t 0))))
+ ;; V' from vvvv - bit 4 of vvvv register number
+ (v-prime (if vvvv (reg-bit4 (reg-id vvvv)) 0)))
+ (values ll r x b r-prime v-prime))))
+
+(defun emit-avx512-inst (segment thing reg prefix opcode
+ &key (remaining-bytes 0)
+ ll
+ (opcode-prefix #x0F)
+ (w 0)
+ vvvv
+ (aaa 0)
+ (z 0)
+ (evex-b 0)
+ vm
+ (disp-n 0))
+ "Emit an EVEX-encoded instruction.
+DISP-N is the compressed displacement scale factor (Intel tuple N).
+Common values: 64 for full 512-bit loads, 32 for 256-bit or half-vector,
+16 for 128-bit or quarter-vector, 8 for qword, 4 for dword.
+Default is 0 (force disp32, never use disp8) for safety -- the CPU
+always applies compression to EVEX disp8, so using the wrong N
+produces silently wrong addresses."
+ (multiple-value-bind (ll r x b r-prime v-prime)
+ (determine-evex-flags thing reg ll vvvv)
+ (let ((vvvv-num (if vvvv (reg-id-num (reg-id vvvv)) 0)))
+ (emit-evex segment r x b r-prime opcode-prefix w
+ vvvv-num prefix z ll evex-b v-prime aaa))
+ (emit-bytes segment opcode)
+ (emit-ea segment thing reg
+ :remaining-bytes remaining-bytes
+ :xmm-index vm
+ :disp-n disp-n)))
+
(defun emit-avx2-inst (segment thing reg prefix opcode
&key (remaining-bytes 0)
l
(opcode-prefix #x0F)
(w 0)
+ evex-w
vvvv
is4
vm)
+ ;; Auto-detect ZMM operands and delegate to EVEX encoding
+ (when (or (and (register-p reg) (is-zmm-id-p (reg-id reg)))
+ (and (register-p thing) (is-zmm-id-p (reg-id thing)))
+ (and vvvv (register-p vvvv) (is-zmm-id-p (reg-id vvvv))))
+ (return-from emit-avx2-inst
+ (emit-avx512-inst segment thing reg prefix opcode
+ :remaining-bytes remaining-bytes
+ ;; Don't pass VEX L as EVEX L'L; let determine-evex-flags
+ ;; auto-detect the vector length from register types.
+ :ll nil
+ :opcode-prefix opcode-prefix
+ :w (or evex-w w)
+ :vvvv vvvv
+ :vm vm
+ ;; Force disp32 for auto-promoted VEX instructions:
+ ;; the correct N depends on tuple type which varies
+ ;; per instruction. disp-n=0 disables disp8 entirely.
+ :disp-n 0)))
(emit-vex segment vvvv thing reg prefix opcode-prefix l w)
(emit-bytes segment opcode)
(when is4
@@ -288,11 +570,39 @@
(when is4
(emit-byte segment (ash (reg-id-num (reg-id is4)) 4))))
+(defun emit-avx512-inst-imm (segment thing reg imm prefix opcode /i
+ &key ll
+ (w 0)
+ (opcode-prefix #x0F)
+ (aaa 0) (z 0) (evex-b 0))
+ "Emit EVEX-encoded instruction with /i field and immediate byte.
+THING is the destination (NDD, encoded in vvvv).
+REG is the source (encoded in ModR/M.r/m).
+/I is encoded in ModR/M.reg bits 5:3."
+ (aver (<= 0 /i 7))
+ ;; thing = destination → goes in vvvv (NDD encoding)
+ ;; reg = source → goes in r/m
+ (multiple-value-bind (ll r x b r-prime v-prime)
+ (determine-evex-flags reg nil ll thing)
+ (let ((vvvv-num (if thing (reg-id-num (reg-id thing)) 0)))
+ (emit-evex segment r x b r-prime opcode-prefix w
+ vvvv-num prefix z ll evex-b v-prime aaa)))
+ (emit-bytes segment opcode)
+ (emit-byte segment (logior (ash (logior #b11000 /i) 3)
+ (reg-encoding reg segment)))
+ (emit-byte segment imm))
+
(defun emit-avx2-inst-imm (segment thing reg imm prefix opcode /i
&key l
(w 0)
+ evex-w
(opcode-prefix #x0F))
(aver (<= 0 /i 7))
+ ;; Auto-detect ZMM operands and delegate to EVEX encoding
+ (when (and (register-p reg) (is-zmm-id-p (reg-id reg)))
+ (return-from emit-avx2-inst-imm
+ (emit-avx512-inst-imm segment thing reg imm prefix opcode /i
+ :ll l :w (or evex-w w) :opcode-prefix opcode-prefix)))
(emit-vex segment thing reg nil prefix opcode-prefix l w)
(emit-bytes segment opcode)
(emit-byte segment (logior (ash (logior #b11000 /i) 3)
@@ -301,6 +611,43 @@
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
+ (defun avx512-inst-printer-list (inst-format-stem prefix opcode
+ &key more-fields printer
+ (opcode-prefix #x0F)
+ reg-mem-size
+ xmmreg-mem-size
+ w
+ ll
+ nds)
+ (let ((fields `((pp ,(vex-encode-pp prefix))
+ (mm ,(evex-encode-mm opcode-prefix))
+ (op ,opcode)
+ ,@(and w `((w ,w)))
+ ,@(and ll `((ll ,ll)))
+ ,@(cond (xmmreg-mem-size
+ `((reg/mem nil :type ',(case xmmreg-mem-size
+ (:qword 'sized-xmmreg/mem-default-qword)
+ (:dword 'sized-dword-xmmreg/mem)
+ (:word 'sized-word-xmmreg/mem)
+ (:byte 'sized-byte-xmmreg/mem)
+ (:sized 'sized-xmmreg/mem)))))
+ (reg-mem-size
+ `((reg/mem nil :type ',(case reg-mem-size
+ (:qword 'sized-reg/mem-default-qword)
+ (:dword 'sized-dword-reg/mem)
+ (:word 'sized-word-reg/mem)
+ (:byte 'sized-byte-reg/mem)
+ (:sized 'sized-reg/mem))))))
+ ,@more-fields))
+ (inst-format (symbolicate "EVEX-" inst-format-stem)))
+ (list `(:printer ,inst-format ,fields
+ ,@(cond (printer
+ `(',printer))
+ ((eq nds 'to-mem)
+ `('(:name :tab reg/mem ", " vvvv ", " reg)))
+ (nds
+ `('(:name :tab reg ", " vvvv ", " reg/mem))))))))
+
(defun avx2-inst-printer-list (inst-format-stem prefix opcode
&key more-fields printer
(opcode-prefix #x0F)
@@ -334,15 +681,32 @@
(list (symbolicate "VEX3-" inst-format-stem))
(list (symbolicate "VEX2-" inst-format-stem)
(symbolicate "VEX3-" inst-format-stem)))))
- (mapcar (lambda (inst-format)
- `(:printer ,inst-format ,fields
- ,@(cond (printer
- `(',printer))
- ((eq nds 'to-mem)
- `('(:name :tab reg/mem ", " vvvv ", " reg)))
- (nds
- `('(:name :tab reg ", " vvvv ", " reg/mem))))))
- inst-formats))))
+ (append
+ (mapcar (lambda (inst-format)
+ `(:printer ,inst-format ,fields
+ ,@(cond (printer
+ `(',printer))
+ ((eq nds 'to-mem)
+ `('(:name :tab reg/mem ", " vvvv ", " reg)))
+ (nds
+ `('(:name :tab reg ", " vvvv ", " reg/mem))))))
+ inst-formats)
+ ;; Generate EVEX printer entries so VEX instructions auto-promoted
+ ;; to EVEX can be disassembled. Map 0F is always safe (no EVEX-only
+ ;; instructions reuse those opcodes). Map 0F38 has many conflicts
+ ;; (broadcasts, vmaskmov vs vscalef, etc.), so we only include the
+ ;; FMA range (#x96-#xBF) which is safe. Map 0F3A is skipped entirely.
+ (when (or (= opcode-prefix #x0F)
+ (and (= opcode-prefix #x0F38)
+ (<= #x96 opcode #xbf)))
+ (avx512-inst-printer-list inst-format-stem prefix opcode
+ :more-fields more-fields
+ :printer printer
+ :opcode-prefix opcode-prefix
+ :reg-mem-size reg-mem-size
+ :xmmreg-mem-size xmmreg-mem-size
+ :w w
+ :nds nds))))))
(macrolet
((def (name opcode /i)
@@ -356,7 +720,7 @@
(def vpsrldq #x73 3))
(macrolet
- ((def (name opcode vopcode /i)
+ ((def (name opcode vopcode /i &optional (evex-w 0))
`(define-instruction ,name (segment dst src src2/imm)
,@(avx2-inst-printer-list 'ymm-ymm-imm #x66 opcode
:more-fields `((/i ,/i)))
@@ -364,40 +728,42 @@
(:emitter
(if (integerp src2/imm)
(emit-avx2-inst-imm segment dst src src2/imm
- #x66 ,opcode ,/i)
+ #x66 ,opcode ,/i :evex-w ,evex-w)
(emit-avx2-inst segment src2/imm dst #x66 ,vopcode
+ :evex-w ,evex-w
:vvvv src))))))
(def vpsllw #x71 #xf1 6)
(def vpslld #x72 #xf2 6)
- (def vpsllq #x73 #xf3 6)
+ (def vpsllq #x73 #xf3 6 1) ; evex-w=1 for EVEX qword
(def vpsraw #x71 #xe1 4)
(def vpsrad #x72 #xe2 4)
(def vpsrlw #x71 #xd1 2)
(def vpsrld #x72 #xd2 2)
- (def vpsrlq #x73 #xd3 2))
+ (def vpsrlq #x73 #xd3 2 1)) ; evex-w=1 for EVEX qword
-(macrolet ((def (name prefix opcode &optional (opcode-prefix #x0F))
+(macrolet ((def (name prefix opcode &optional (opcode-prefix #x0F) (evex-w 0))
`(define-instruction ,name (segment dst src src2)
,@(avx2-inst-printer-list 'ymm-ymm/mem prefix opcode :nds t
:opcode-prefix opcode-prefix)
(:emitter
(emit-avx2-inst segment src2 dst ,prefix ,opcode
:opcode-prefix ,opcode-prefix
+ :evex-w ,evex-w
:vvvv src)))))
;; logical
- (def vandpd #x66 #x54)
+ (def vandpd #x66 #x54 #x0F 1) ; evex-w=1 for double-precision
(def vandps nil #x54)
- (def vandnpd #x66 #x55)
+ (def vandnpd #x66 #x55 #x0F 1)
(def vandnps nil #x55)
- (def vorpd #x66 #x56)
+ (def vorpd #x66 #x56 #x0F 1)
(def vorps nil #x56)
(def vpand #x66 #xdb)
(def vpandn #x66 #xdf)
(def vpor #x66 #xeb)
(def vpxor #x66 #xef)
- (def vxorpd #x66 #x57)
+ (def vxorpd #x66 #x57 #x0F 1)
(def vxorps nil #x57)
;; comparison
(def vcomisd #x66 #x2f)
@@ -412,11 +778,11 @@
(def vpcmpgtw #x66 #x65)
(def vpcmpgtd #x66 #x66)
;; max/min
- (def vmaxpd #x66 #x5f)
+ (def vmaxpd #x66 #x5f #x0F 1)
(def vmaxps nil #x5f)
(def vmaxsd #xf2 #x5f)
(def vmaxss #xf3 #x5f)
- (def vminpd #x66 #x5d)
+ (def vminpd #x66 #x5d #x0F 1)
(def vminps nil #x5d)
(def vminsd #xf2 #x5d)
(def vminss #xf3 #x5d)
@@ -426,13 +792,13 @@
(def vpminsw #x66 #xea)
(def vpminub #x66 #xda)
;; arithmetic
- (def vaddpd #x66 #x58)
+ (def vaddpd #x66 #x58 #x0F 1)
(def vaddps nil #x58)
(def vaddsd #xf2 #x58)
(def vaddss #xf3 #x58)
(def vaddsubpd #x66 #xd0)
(def vaddsubps #xf2 #xd0)
- (def vdivpd #x66 #x5e)
+ (def vdivpd #x66 #x5e #x0F 1)
(def vdivps nil #x5e)
(def vdivsd #xf2 #x5e)
(def vdivss #xf3 #x5e)
@@ -440,24 +806,24 @@
(def vhaddps #xf2 #x7c)
(def vhsubpd #x66 #x7d)
(def vhsubps #xf2 #x7d)
- (def vmulpd #x66 #x59)
+ (def vmulpd #x66 #x59 #x0F 1)
(def vmulps nil #x59)
(def vmulsd #xf2 #x59)
(def vmulss #xf3 #x59)
- (def vsubpd #x66 #x5c)
+ (def vsubpd #x66 #x5c #x0F 1)
(def vsubps nil #x5c)
(def vsubsd #xf2 #x5c)
(def vsubss #xf3 #x5c)
- (def vunpckhpd #x66 #x15)
+ (def vunpckhpd #x66 #x15 #x0F 1)
(def vunpckhps nil #x15)
- (def vunpcklpd #x66 #x14)
+ (def vunpcklpd #x66 #x14 #x0F 1)
(def vunpcklps nil #x14)
;; integer arithmetic
(def vpaddb #x66 #xfc)
(def vpaddw #x66 #xfd)
(def vpaddd #x66 #xfe)
- (def vpaddq #x66 #xd4)
+ (def vpaddq #x66 #xd4 #x0F 1) ; evex-w=1 for EVEX qword
(def vpaddsb #x66 #xec)
(def vpaddsw #x66 #xed)
(def vpaddusb #x66 #xdc)
@@ -468,13 +834,13 @@
(def vpmulhuw #x66 #xe4)
(def vpmulhw #x66 #xe5)
(def vpmullw #x66 #xd5)
- (def vpmuludq #x66 #xf4)
+ (def vpmuludq #x66 #xf4 #x0F 1) ; evex-w=1 for EVEX qword
(def vpsadbw #x66 #xf6)
(def vpsubb #x66 #xf8)
(def vpsubw #x66 #xf9)
(def vpsubd #x66 #xfa)
- (def vpsubq #x66 #xfb)
+ (def vpsubq #x66 #xfb #x0F 1) ; evex-w=1 for EVEX qword
(def vpsubsb #x66 #xe8)
(def vpsubsw #x66 #xe9)
(def vpsubusb #x66 #xd8)
@@ -529,7 +895,7 @@
(def vaesdeclast #x66 #xdf #x0f38))
;;; Two arg instructions
-(macrolet ((def (name prefix opcode &optional (opcode-prefix #x0F) l)
+(macrolet ((def (name prefix opcode &optional (opcode-prefix #x0F) l (evex-w 0))
`(define-instruction ,name (segment dst src)
,@(avx2-inst-printer-list 'ymm-ymm/mem prefix opcode
:opcode-prefix opcode-prefix
@@ -538,6 +904,7 @@
(:emitter
(emit-avx2-inst segment src dst ,prefix ,opcode
:opcode-prefix ,opcode-prefix
+ :evex-w ,evex-w
,@(and l
`(:l ,l)))))))
;; moves
@@ -549,7 +916,7 @@
(def vrcpss #xf3 #x53)
(def vrsqrtps nil #x52)
(def vrsqrtss #xf3 #x52)
- (def vsqrtpd #x66 #x51)
+ (def vsqrtpd #x66 #x51 #x0F nil 1) ; evex-w=1 for double-precision
(def vsqrtps nil #x51)
(def vsqrtsd #xf2 #x51)
(def vsqrtss #xf3 #x51)
@@ -650,7 +1017,7 @@
(def-two vaeskeygenassist #x66 #xdf))
(macrolet ((def (name prefix opcode
- name-suffix)
+ name-suffix &key (evex-w 0))
`(define-instruction ,name (segment condition dst src src2)
,@(avx2-inst-printer-list 'ymm-ymm/mem-imm prefix opcode
:more-fields `((imm nil :type 'avx-condition-code))
@@ -658,14 +1025,16 @@
:tab reg ", " vvvv ", " reg/mem))
(:emitter
(emit-avx2-inst segment src2 dst ,prefix ,opcode
- :vvvv src)
+ :evex-w ,evex-w
+ :vvvv src
+ :remaining-bytes 1)
(emit-byte segment (or (position condition +avx-conditions+)
(error "~s not one of ~s"
condition
+avx-conditions+)))))))
- (def vcmppd #x66 #xc2 "PD")
+ (def vcmppd #x66 #xc2 "PD" :evex-w 1)
(def vcmpps nil #xc2 "PS")
- (def vcmpsd #xf2 #xc2 "SD")
+ (def vcmpsd #xf2 #xc2 "SD" :evex-w 1)
(def vcmpss #xf3 #xc2 "SS"))
(macrolet ((def (name prefix op)
@@ -690,6 +1059,7 @@
reg-reg-name
l
(opcode-prefix #x0F)
+ (evex-w 0)
nds)
`(progn
,(when reg-reg-name
@@ -703,6 +1073,7 @@
'src)
,prefix ,opcode-from
:opcode-prefix ,opcode-prefix
+ :evex-w ,evex-w
:l ,l
,@(and nds
`(:vvvv src))))))
@@ -731,6 +1102,7 @@
dst
,prefix ,opcode-from
:opcode-prefix ,opcode-prefix
+ :evex-w ,evex-w
,@(and nds
`(:vvvv src))
:l ,l))))
@@ -742,19 +1114,20 @@
dst src
,prefix ,opcode-to
:opcode-prefix ,opcode-prefix
+ :evex-w ,evex-w
:l ,l))))))))
;; direction bit?
- (def vmovapd #x66 #x28 #x29)
+ (def vmovapd #x66 #x28 #x29 :evex-w 1)
(def vmovaps nil #x28 #x29)
(def vmovdqa #x66 #x6f #x7f)
(def vmovdqu #xf3 #x6f #x7f)
- (def vmovupd #x66 #x10 #x11)
+ (def vmovupd #x66 #x10 #x11 :evex-w 1)
(def vmovups nil #x10 #x11)
;; streaming
(def vmovntdq #x66 nil #xe7 :force-to-mem t)
(def vmovntdqa #x66 #x2a nil :force-to-mem t :opcode-prefix #x0F38)
- (def vmovntpd #x66 nil #x2b :force-to-mem t)
+ (def vmovntpd #x66 nil #x2b :force-to-mem t :evex-w 1)
(def vmovntps nil nil #x2b :force-to-mem t)
;; use vmovhps for vmovlhps and vmovlps for vmovhlps
@@ -932,7 +1305,7 @@
(emit-two-byte-vex segment 0 0 1 nil)
(emit-byte segment #x77)))
-(macrolet ((def (name opcode &optional l (mem-size :qword))
+(macrolet ((def (name opcode &optional l (mem-size :qword) (evex-w 0))
`(define-instruction ,name (segment dst src)
,@(avx2-inst-printer-list 'ymm-ymm/mem #x66 opcode
:opcode-prefix #x0f38
@@ -941,7 +1314,7 @@
(:emitter
(emit-avx2-inst segment src dst #x66 ,opcode
:opcode-prefix #x0f38
- :w 0 :l ,l)))))
+ :evex-w ,evex-w :l ,l)))))
(def vbroadcastss #x18 nil :dword)
(def vbroadcastsd #x19 1)
(def vbroadcastf128 #x1a 1)
@@ -949,7 +1322,7 @@
(def vpbroadcastb #x78 nil :byte)
(def vpbroadcastw #x79 nil :word)
(def vpbroadcastd #x58 nil :dword)
- (def vpbroadcastq #x59))
+ (def vpbroadcastq #x59 nil :qword 1)) ; evex-w=1 for EVEX qword
(macrolet ((def-insert (name prefix op)
`(define-instruction ,name (segment dst src src2 imm)
@@ -1236,6 +1609,34 @@
:opcode-prefix #x0f3a
:printer '(:name :tab reg/mem ", " reg ", " imm)))
+;;;; GFNI (Galois Field instructions)
+;;;; VEX-encoded; auto-promotes to EVEX for ZMM operands.
+
+;;; GF(2^8) multiplication (no immediate)
+(define-instruction vgf2p8mulb (segment dst src1 src2)
+ (:emitter
+ (emit-avx2-inst segment src2 dst #x66 #xcf
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w 0))
+ . #.(avx2-inst-printer-list 'ymm-ymm/mem #x66 #xcf
+ :opcode-prefix #x0f38 :w 0 :nds t))
+
+;;; GF(2^8) affine transformation and inverse (with immediate)
+(macrolet ((def (name opcode)
+ `(define-instruction ,name (segment dst src1 src2 imm)
+ ,@(avx2-inst-printer-list 'ymm-ymm/mem-imm #x66 opcode
+ :opcode-prefix #x0f3a :w 1)
+ (:emitter
+ (emit-avx2-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f3a
+ :vvvv src1
+ :w 1
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vgf2p8affineqb #xce)
+ (def vgf2p8affineinvqb #xcf))
+
(define-instruction xsave (segment dst)
(:printer ext-reg/mem-no-width ((op '(#xae 4))))
(:emitter
@@ -1289,3 +1690,61 @@
(aver (memq size '(:dword :qword)))
(emit-sse-inst-2byte segment dst src #xf3 #x38 #xf6
:operand-size size))))
+
+;;;; BMI2 instructions (VEX-encoded GPR operations)
+;;;; All use VEX.LZ (L=0). W=1 for 64-bit, W=0 for 32-bit.
+
+;;; Shifts with shift count in GPR (no flag side effects, not serialized on CL)
+;;; SHRX/SHLX/SARX r64a, r/m64, r64b
+;;; dst = reg field, src = r/m, count = vvvv
+(macrolet ((def (name prefix)
+ `(define-instruction ,name (segment &prefix prefix dst src count)
+ ,@(avx2-inst-printer-list 'vex-gpr prefix #xF7
+ :nds t
+ :opcode-prefix #x0f38)
+ (:emitter
+ (emit-avx2-inst segment src dst ,prefix #xF7
+ :opcode-prefix #x0f38
+ :vvvv count
+ :l 0
+ :w (ecase (pick-operand-size prefix dst src)
+ (:qword 1)
+ (:dword 0)))))))
+ (def shrx #xF2)
+ (def shlx #x66)
+ (def sarx #xF3))
+
+;;; PEXT/PDEP r64a, r64b, r/m64
+;;; dst = reg field, src = vvvv, mask = r/m
+(macrolet ((def (name prefix)
+ `(define-instruction ,name (segment &prefix prefix dst src mask)
+ ,@(avx2-inst-printer-list 'vex-gpr prefix #xF5
+ :nds t
+ :opcode-prefix #x0f38)
+ (:emitter
+ (emit-avx2-inst segment mask dst ,prefix #xF5
+ :opcode-prefix #x0f38
+ :vvvv src
+ :l 0
+ :w (ecase (pick-operand-size prefix dst mask)
+ (:qword 1)
+ (:dword 0)))))))
+ (def pext #xF3)
+ (def pdep #xF2))
+
+;;; RORX r64a, r/m64, imm8
+;;; dst = reg field, src = r/m, count = imm8, no vvvv
+(define-instruction rorx (segment &prefix prefix dst src imm)
+ (:emitter
+ (emit-avx2-inst segment src dst #xF2 #xF0
+ :opcode-prefix #x0f3a
+ :l 0
+ :w (ecase (pick-operand-size prefix dst src)
+ (:qword 1)
+ (:dword 0))
+ :remaining-bytes 1)
+ (emit-byte segment imm))
+ . #.(avx2-inst-printer-list 'vex-gpr #xF2 #xF0
+ :opcode-prefix #x0f3a
+ :printer '(:name :tab reg ", " reg/mem)))
+
diff --git a/src/compiler/x86-64/avx512-insts.lisp b/src/compiler/x86-64/avx512-insts.lisp
new file mode 100644
index 000000000..97e02a6f9
--- /dev/null
+++ b/src/compiler/x86-64/avx512-insts.lisp
@@ -0,0 +1,1087 @@
+(in-package "SB-X86-64-ASM")
+
+;;;; AVX-512 Instruction Support
+;;;;
+;;;; Implemented subsets:
+;;;; AVX-512F, AVX-512BW, AVX-512DQ, AVX-512IFMA,
+;;;; AVX-512VBMI, AVX-512VBMI2, AVX-512VPOPCNTDQ, AVX-512BITALG,
+;;;; GFNI (in avx2-insts.lisp),
+;;;; VPCLMULQDQ-256/512 (via VEX auto-promotion to EVEX)
+;;;;
+;;;; Not yet implemented:
+;;;; AVX-512CD - vpconflictd/q, vplzcntd/q
+;;;; AVX-512VL - EVEX 128/256-bit forms with masking/broadcast
+;;;; (auto-promotion handles basic ZMM; full VL needs
+;;;; explicit EVEX for XMM/YMM with masking)
+;;;; AVX-512ER - vexp2ps/pd, vrcp28*, vrsqrt28* (Xeon Phi, deprecated)
+;;;; AVX-512PF - gather/scatter prefetch (Xeon Phi, deprecated)
+;;;; AVX-512VNNI - vpdpbusd/s, vpdpwssd/s
+;;;; AVX-512BF16 - vcvtne2ps2bf16, vcvtneps2bf16, vdpbf16ps
+;;;; AVX-512FP16 - full FP16 arithmetic (~100 instructions)
+;;;; VAES-256/512 - wide forms of vaesenc/vaesdec
+;;;; VP2INTERSECT - vp2intersectd/q
+
+;;;; AVX-512 (EVEX-only) instruction definitions
+
+;;; EVEX-only aligned/unaligned moves
+(macrolet ((def (name prefix opcode-from opcode-to w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode-from
+ :w w)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode-to
+ :printer '(:name :tab reg/mem ", " reg)
+ :w w)
+ (:emitter
+ (cond ((xmm-register-p dst)
+ (emit-avx512-inst segment src dst ,prefix ,opcode-from
+ :opcode-prefix #x0F :w ,w))
+ (t
+ (aver (xmm-register-p src))
+ (emit-avx512-inst segment dst src ,prefix ,opcode-to
+ :opcode-prefix #x0F :w ,w)))))))
+ (def vmovdqa32 #x66 #x6f #x7f 0)
+ (def vmovdqa64 #x66 #x6f #x7f 1)
+ (def vmovdqu8 #xf2 #x6f #x7f 0)
+ (def vmovdqu16 #xf2 #x6f #x7f 1)
+ (def vmovdqu32 #xf3 #x6f #x7f 0)
+ (def vmovdqu64 #xf3 #x6f #x7f 1))
+
+;;; Ternary logic
+(macrolet ((def (name w)
+ `(define-instruction ,name (segment dst src1 src2 imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm #x66 #x25
+ :opcode-prefix #x0f3a :w w)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 #x25
+ :opcode-prefix #x0f3a
+ :vvvv src1
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vpternlogd 0)
+ (def vpternlogq 1))
+
+;;; Two-source permute
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vpermt2d #x7e 0)
+ (def vpermt2q #x7e 1)
+ (def vpermt2ps #x7f 0)
+ (def vpermt2pd #x7f 1))
+
+;;; Cross-lane shuffle with immediate
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2 imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm #x66 opcode
+ :opcode-prefix #x0f3a :w w)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f3a
+ :vvvv src1
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vshuff32x4 #x23 0)
+ (def vshuff64x2 #x23 1)
+ (def vshufi32x4 #x43 0)
+ (def vshufi64x2 #x43 1))
+
+;;; Blend with mask
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vblendmps #x65 0)
+ (def vblendmpd #x65 1)
+ (def vpblendmd #x64 0)
+ (def vpblendmq #x64 1))
+
+;;; Compress store
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix #x0f38 :w w
+ :printer '(:name :tab reg/mem ", " reg))
+ (:emitter
+ (emit-avx512-inst segment dst src ,prefix ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vcompressps #x66 #x8a 0)
+ (def vcompresspd #x66 #x8a 1)
+ (def vpcompressd #x66 #x8b 0)
+ (def vpcompressq #x66 #x8b 1))
+
+;;; Expand load
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix #x0f38 :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst ,prefix ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vexpandps #x66 #x88 0)
+ (def vexpandpd #x66 #x88 1)
+ (def vpexpandd #x66 #x89 0)
+ (def vpexpandq #x66 #x89 1))
+
+;;; Down-convert (pack and store)
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix #x0f38 :w w
+ :printer '(:name :tab reg/mem ", " reg))
+ (:emitter
+ (emit-avx512-inst segment dst src ,prefix ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vpmovqd #xf3 #x35 0)
+ (def vpmovqw #xf3 #x34 0)
+ (def vpmovqb #xf3 #x32 0)
+ (def vpmovdw #xf3 #x33 0)
+ (def vpmovdb #xf3 #x31 0)
+ (def vpmovwb #xf3 #x30 0))
+
+;;; Get exponent / mantissa
+(macrolet ((def (name opcode w &key (opcode-prefix #x0f38))
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix opcode-prefix :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst #x66 ,opcode
+ :opcode-prefix ,opcode-prefix
+ :w ,w))))
+ (def-imm (name opcode w)
+ `(define-instruction ,name (segment dst src imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm #x66 opcode
+ :opcode-prefix #x0f3a :w w
+ :printer '(:name :tab reg ", " reg/mem ", " imm))
+ (:emitter
+ (emit-avx512-inst segment src dst #x66 ,opcode
+ :opcode-prefix #x0f3a
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vgetexpps #x42 0)
+ (def vgetexppd #x42 1)
+ (def-imm vgetmantps #x26 0)
+ (def-imm vgetmantpd #x26 1))
+
+;;; Round to scale
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm #x66 opcode
+ :opcode-prefix #x0f3a :w w
+ :printer '(:name :tab reg ", " reg/mem ", " imm))
+ (:emitter
+ (emit-avx512-inst segment src dst #x66 ,opcode
+ :opcode-prefix #x0f3a
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vrndscaleps #x08 0)
+ (def vrndscalepd #x09 1)
+ (def vrndscaless #x0a 0)
+ (def vrndscalesd #x0b 1))
+
+;;; Fixup
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2 imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm #x66 opcode
+ :opcode-prefix #x0f3a :w w)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f3a
+ :vvvv src1
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vfixupimmps #x54 0)
+ (def vfixupimmpd #x54 1)
+ (def vfixupimmss #x55 0)
+ (def vfixupimmsd #x55 1))
+
+;;; Range
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2 imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm #x66 opcode
+ :opcode-prefix #x0f3a :w w)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f3a
+ :vvvv src1
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vrangeps #x50 0)
+ (def vrangepd #x50 1))
+
+;;; Reduce
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm #x66 opcode
+ :opcode-prefix #x0f3a :w w
+ :printer '(:name :tab reg ", " reg/mem ", " imm))
+ (:emitter
+ (emit-avx512-inst segment src dst #x66 ,opcode
+ :opcode-prefix #x0f3a
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vreduceps #x56 0)
+ (def vreducepd #x56 1))
+
+;;; Scale
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vscalefps #x2c 0)
+ (def vscalefpd #x2c 1)
+ (def vscalefss #x2d 0)
+ (def vscalefsd #x2d 1))
+
+;;; Opmask instructions
+;;; KMOV - Move to/from opmask registers
+;;; These use VEX encoding (not EVEX), with k registers in ModR/M fields
+(macrolet ((def (name prefix opcode-from opcode-to w)
+ `(define-instruction ,name (segment dst src)
+ (:emitter
+ (cond ((xmm-register-p dst)
+ ;; k <- k/m or k <- gpr
+ (emit-vex segment nil src dst ,prefix #x0F nil ,w)
+ (emit-bytes segment ,opcode-from)
+ (emit-ea segment src dst))
+ (t
+ ;; m <- k or gpr <- k
+ (emit-vex segment nil dst src ,prefix #x0F nil ,w)
+ (emit-bytes segment ,opcode-to)
+ (emit-ea segment dst src)))))))
+ (def kmovw nil #x90 #x91 0)
+ (def kmovb #x66 #x90 #x91 0)
+ (def kmovd #x66 #x90 #x91 1)
+ (def kmovq #xf2 #x90 #x91 1))
+
+;;; KAND, KOR, KXOR, etc. - Opmask logical operations (VEX.L1)
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ (:emitter
+ (emit-vex segment src1 src2 dst ,prefix #x0F 1 ,w)
+ (emit-bytes segment ,opcode)
+ (emit-ea segment src2 dst)))))
+ (def kandw nil #x41 0)
+ (def kandb #x66 #x41 0)
+ (def kandd #x66 #x41 1)
+ (def kandq #xf2 #x41 1)
+ (def kandnw nil #x42 0)
+ (def kandnb #x66 #x42 0)
+ (def kandnd #x66 #x42 1)
+ (def kandnq #xf2 #x42 1)
+ (def korw nil #x45 0)
+ (def korb #x66 #x45 0)
+ (def kord #x66 #x45 1)
+ (def korq #xf2 #x45 1)
+ (def kxorw nil #x47 0)
+ (def kxorb #x66 #x47 0)
+ (def kxord #x66 #x47 1)
+ (def kxorq #xf2 #x47 1)
+ (def kxnorw nil #x46 0)
+ (def kxnorb #x66 #x46 0)
+ (def kxnord #x66 #x46 1)
+ (def kxnorq #xf2 #x46 1))
+
+;;; KNOT, KTEST - single-source opmask operations
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src)
+ (:emitter
+ (emit-vex segment nil src dst ,prefix #x0F nil ,w)
+ (emit-bytes segment ,opcode)
+ (emit-ea segment src dst)))))
+ (def knotw nil #x44 0)
+ (def knotb #x66 #x44 0)
+ (def knotd #x66 #x44 1)
+ (def knotq #xf2 #x44 1)
+ (def ktestw nil #x99 0)
+ (def ktestb #x66 #x99 0)
+ (def ktestd #x66 #x99 1)
+ (def ktestq #xf2 #x99 1)
+ (def kortestw nil #x98 0)
+ (def kortestb #x66 #x98 0)
+ (def kortestd #x66 #x98 1)
+ (def kortestq #xf2 #x98 1))
+
+;;; KUNPCK - Unpack and interleave opmask (VEX.L1)
+(macrolet ((def (name prefix w)
+ `(define-instruction ,name (segment dst src1 src2)
+ (:emitter
+ (emit-vex segment src1 src2 dst ,prefix #x0F 1 ,w)
+ (emit-bytes segment #x4b)
+ (emit-ea segment src2 dst)))))
+ (def kunpckbw #x66 0)
+ (def kunpckwd nil 0)
+ (def kunpckdq nil 1))
+
+;;; EVEX insert/extract for 256-bit lanes in 512-bit
+(macrolet ((def-insert (name prefix op w)
+ `(define-instruction ,name (segment dst src src2 imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm prefix op
+ :w w
+ :opcode-prefix #x0f3a)
+ (:emitter
+ (emit-avx512-inst segment src2 dst ,prefix ,op
+ :opcode-prefix #x0f3a
+ :vvvv src
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm))))
+ (def-extract (name prefix op w)
+ `(define-instruction ,name (segment dst src imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm prefix op
+ :w w
+ :opcode-prefix #x0f3a
+ :printer '(:name :tab reg/mem ", " reg ", " imm))
+ (:emitter
+ (emit-avx512-inst segment dst src ,prefix ,op
+ :w ,w
+ :opcode-prefix #x0f3a
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def-insert vinsertf32x4 #x66 #x18 0)
+ (def-insert vinsertf64x2 #x66 #x18 1)
+ (def-insert vinsertf32x8 #x66 #x1a 0)
+ (def-insert vinsertf64x4 #x66 #x1a 1)
+ (def-insert vinserti32x4 #x66 #x38 0)
+ (def-insert vinserti64x2 #x66 #x38 1)
+ (def-insert vinserti32x8 #x66 #x3a 0)
+ (def-insert vinserti64x4 #x66 #x3a 1)
+ (def-extract vextractf32x4 #x66 #x19 0)
+ (def-extract vextractf64x2 #x66 #x19 1)
+ (def-extract vextractf32x8 #x66 #x1b 0)
+ (def-extract vextractf64x4 #x66 #x1b 1)
+ (def-extract vextracti32x4 #x66 #x39 0)
+ (def-extract vextracti64x2 #x66 #x39 1)
+ (def-extract vextracti32x8 #x66 #x3b 0)
+ (def-extract vextracti64x4 #x66 #x3b 1))
+
+;;;; ---- AVX-512F additional instructions ----
+
+;;; 3-operand NDS (dst, src1, src2)
+(macrolet ((def (name prefix opcode w &optional (opcode-prefix #x0f38))
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix opcode-prefix :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst ,prefix ,opcode
+ :opcode-prefix ,opcode-prefix :vvvv src1 :w ,w)))))
+ ;; Two-source permute
+ (def vpermi2d #x66 #x76 0)
+ (def vpermi2q #x66 #x76 1)
+ (def vpermi2ps #x66 #x77 0)
+ (def vpermi2pd #x66 #x77 1)
+ ;; Integer max/min 64-bit
+ (def vpmaxsq #x66 #x3d 1)
+ (def vpmaxuq #x66 #x3f 1)
+ (def vpminsq #x66 #x39 1)
+ (def vpminuq #x66 #x3b 1)
+ ;; Variable rotate
+ (def vprolvd #x66 #x15 0)
+ (def vprolvq #x66 #x15 1)
+ (def vprorvd #x66 #x14 0)
+ (def vprorvq #x66 #x14 1)
+ ;; Variable arithmetic shift 64-bit
+ (def vpsravq #x66 #x46 1)
+ ;; Integer logical (dword/qword granularity)
+ (def vpandd #x66 #xdb 0 #x0f)
+ (def vpandq #x66 #xdb 1 #x0f)
+ (def vpandnd #x66 #xdf 0 #x0f)
+ (def vpandnq #x66 #xdf 1 #x0f)
+ (def vpord #x66 #xeb 0 #x0f)
+ (def vporq #x66 #xeb 1 #x0f)
+ (def vpxord #x66 #xef 0 #x0f)
+ (def vpxorq #x66 #xef 1 #x0f))
+
+;;; 2-operand (dst, src)
+(macrolet ((def (name prefix opcode w &optional (opcode-prefix #x0f38))
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix opcode-prefix :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst ,prefix ,opcode
+ :opcode-prefix ,opcode-prefix :w ,w)))))
+ (def vpabsq #x66 #x1f 1)
+ (def vrcp14ps #x66 #x4c 0)
+ (def vrcp14pd #x66 #x4c 1)
+ (def vrsqrt14ps #x66 #x4e 0)
+ (def vrsqrt14pd #x66 #x4e 1))
+
+;;; Scalar reciprocal approximations (3-operand NDS)
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vrcp14ss #x4d 0)
+ (def vrcp14sd #x4d 1)
+ (def vrsqrt14ss #x4f 0)
+ (def vrsqrt14sd #x4f 1))
+
+;;; 3-operand NDS + imm8
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2 imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm #x66 opcode
+ :opcode-prefix #x0f3a :w w)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f3a
+ :vvvv src1
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def valignd #x03 0)
+ (def valignq #x03 1)
+ (def vrangess #x51 0)
+ (def vrangesd #x51 1)
+ (def vreducess #x57 0)
+ (def vreducesd #x57 1)
+ (def vgetmantss #x27 0)
+ (def vgetmantsd #x27 1))
+
+;;; Scalar getexp (3-operand NDS)
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vgetexpss #x43 0)
+ (def vgetexpsd #x43 1))
+
+;;; Immediate rotate via /i field
+(macrolet ((def (name opcode /i w)
+ `(define-instruction ,name (segment dst src imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm-imm #x66 opcode
+ :w w
+ :more-fields (list (list '/i /i)))
+ (:emitter
+ (emit-avx512-inst-imm segment dst src imm
+ #x66 ,opcode ,/i
+ :w ,w)))))
+ (def vprold #x72 1 0)
+ (def vprolq #x72 1 1)
+ (def vprord #x72 0 0)
+ (def vprorq #x72 0 1))
+
+;;; vpsraq — dual form (register + immediate)
+(define-instruction vpsraq (segment dst src src2/imm)
+ (:emitter
+ (if (integerp src2/imm)
+ (emit-avx512-inst-imm segment dst src src2/imm
+ #x66 #x72 4
+ :w 1)
+ (emit-avx512-inst segment src2/imm dst #x66 #xe2
+ :opcode-prefix #x0f38
+ :vvvv src
+ :w 1)))
+ . #.(append (avx512-inst-printer-list 'ymm-ymm-imm #x66 #x72
+ :w 1
+ :more-fields '((/i 4)))
+ (avx512-inst-printer-list 'ymm-ymm/mem #x66 #xe2
+ :opcode-prefix #x0f38 :w 1 :nds t)))
+
+;;; Unsigned conversions (2-operand)
+(macrolet ((def (name prefix opcode w &optional (opcode-prefix #x0f))
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix opcode-prefix :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst ,prefix ,opcode
+ :opcode-prefix ,opcode-prefix :w ,w)))))
+ (def vcvtps2udq nil #x79 0)
+ (def vcvtpd2udq nil #x79 1)
+ (def vcvttps2udq nil #x78 0)
+ (def vcvttpd2udq nil #x78 1)
+ (def vcvtudq2ps #xf2 #x7a 0)
+ (def vcvtudq2pd #xf3 #x7a 0))
+
+;;; Scalar unsigned conversions (2-operand, dst=gpr)
+(macrolet ((def (name prefix opcode)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'reg-ymm/mem prefix opcode :w 0)
+ ,@(avx512-inst-printer-list 'reg-ymm/mem prefix opcode :w 1)
+ (:emitter
+ (aver (gpr-p dst))
+ (let ((dst-size (operand-size dst)))
+ (aver (or (eq dst-size :qword) (eq dst-size :dword)))
+ (emit-avx512-inst segment src dst ,prefix ,opcode
+ :w (ecase dst-size
+ (:qword 1)
+ (:dword 0))))))))
+ (def vcvtss2usi #xf3 #x79)
+ (def vcvtsd2usi #xf2 #x79)
+ (def vcvttss2usi #xf3 #x78)
+ (def vcvttsd2usi #xf2 #x78))
+
+;;; Scalar unsigned convert to FP (3-operand NDS)
+(macrolet ((def (name prefix opcode)
+ `(define-instruction ,name (segment dst src src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :nds t)
+ (:emitter
+ (aver (xmm-register-p dst))
+ (let ((src-size (operand-size src2)))
+ (emit-avx512-inst segment src2 dst ,prefix ,opcode
+ :vvvv src
+ :w (case src-size
+ (:qword 1)
+ (:dword 0)
+ (t 1))))))))
+ (def vcvtusi2ss #xf3 #x7b)
+ (def vcvtusi2sd #xf2 #x7b))
+
+;;; Saturating truncations (reversed encoding: src in reg, dst in r/m)
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix #x0f38 :w w
+ :printer '(:name :tab reg/mem ", " reg))
+ (:emitter
+ (emit-avx512-inst segment dst src ,prefix ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vpmovsqd #xf3 #x25 0)
+ (def vpmovsqw #xf3 #x24 0)
+ (def vpmovsqb #xf3 #x22 0)
+ (def vpmovusqd #xf3 #x15 0)
+ (def vpmovusqw #xf3 #x14 0)
+ (def vpmovusqb #xf3 #x12 0)
+ (def vpmovsdw #xf3 #x23 0)
+ (def vpmovsdb #xf3 #x21 0)
+ (def vpmovusdw #xf3 #x13 0)
+ (def vpmovusdb #xf3 #x11 0)
+ (def vpmovswb #xf3 #x20 0)
+ (def vpmovuswb #xf3 #x10 0))
+
+;;; Broadcast-memory
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vbroadcastf32x4 #x1a 0)
+ (def vbroadcastf64x4 #x1b 1)
+ (def vbroadcasti32x4 #x5a 0)
+ (def vbroadcasti64x4 #x5b 1))
+
+;;; Broadcast from mask-register
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #xf3 opcode
+ :opcode-prefix #x0f38 :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst #xf3 ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vpbroadcastmb2q #x2a 1)
+ (def vpbroadcastmw2d #x3a 0))
+
+;;; Broadcast from GPR (EVEX.512.66.0F38 — separate opcodes from xmm-source forms)
+;;; vpbroadcastd zmm, r32 uses opcode #x7C W=0
+;;; vpbroadcastq zmm, r64 uses opcode #x7C W=1
+;;; Encoding: ModR/M.reg = ZMM dst, ModR/M.r/m = GPR src
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w
+ :reg-mem-size :qword
+ :printer '(:name :tab reg ", " reg/mem))
+ (:emitter
+ (emit-avx512-inst segment src dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vpbroadcastd-gpr #x7c 0)
+ (def vpbroadcastq-gpr #x7c 1))
+
+;;; VEX-encoded kshift (dst, src, imm8)
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src imm)
+ (:emitter
+ (emit-vex segment nil src dst ,prefix #x0F3A 0 ,w)
+ (emit-bytes segment ,opcode)
+ (emit-ea segment src dst :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def kshiftlb #x66 #x32 0)
+ (def kshiftlw #x66 #x32 1)
+ (def kshiftld #x66 #x33 0)
+ (def kshiftlq #x66 #x33 1)
+ (def kshiftrb #x66 #x30 0)
+ (def kshiftrw #x66 #x30 1)
+ (def kshiftrd #x66 #x31 0)
+ (def kshiftrq #x66 #x31 1))
+
+;;; VEX-encoded kadd (VEX.L1)
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ (:emitter
+ (emit-vex segment src1 src2 dst ,prefix #x0F 1 ,w)
+ (emit-bytes segment ,opcode)
+ (emit-ea segment src2 dst)))))
+ (def kaddb #x66 #x4a 0)
+ (def kaddw nil #x4a 0)
+ (def kaddd #x66 #x4a 1)
+ (def kaddq #xf2 #x4a 1))
+
+;;; Compare-to-k (kdst, src1, src2, imm8) — k-reg in ModR/M reg
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src1 src2 imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm prefix opcode
+ :opcode-prefix #x0f3a :w w
+ :more-fields '((reg nil :type 'opmask-reg)))
+ (:emitter
+ (emit-avx512-inst segment src2 dst ,prefix ,opcode
+ :opcode-prefix #x0f3a
+ :vvvv src1
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vpcmpd #x66 #x1f 0)
+ (def vpcmpud #x66 #x1e 0)
+ (def vpcmpq #x66 #x1f 1)
+ (def vpcmpuq #x66 #x1e 1))
+
+;;; Test-to-k (kdst, src1, src2) — k-reg in ModR/M reg
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix #x0f38 :w w :nds t
+ :more-fields '((reg nil :type 'opmask-reg)))
+ (:emitter
+ (emit-avx512-inst segment src2 dst ,prefix ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vptestmd #x66 #x27 0)
+ (def vptestmq #x66 #x27 1)
+ (def vptestnmd #xf3 #x27 0)
+ (def vptestnmq #xf3 #x27 1))
+
+;;;; ---- AVX-512BW instructions ----
+
+;;; Blend with mask (byte/word)
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vpblendmb #x66 0)
+ (def vpblendmw #x66 1))
+
+;;; Compare byte/word to k — k-reg in ModR/M reg
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src1 src2 imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm prefix opcode
+ :opcode-prefix #x0f3a :w w
+ :more-fields '((reg nil :type 'opmask-reg)))
+ (:emitter
+ (emit-avx512-inst segment src2 dst ,prefix ,opcode
+ :opcode-prefix #x0f3a
+ :vvvv src1
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vpcmpb #x66 #x3f 0)
+ (def vpcmpub #x66 #x3e 0)
+ (def vpcmpw #x66 #x3f 1)
+ (def vpcmpuw #x66 #x3e 1))
+
+;;; Test byte/word to k — k-reg in ModR/M reg
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix #x0f38 :w w :nds t
+ :more-fields '((reg nil :type 'opmask-reg)))
+ (:emitter
+ (emit-avx512-inst segment src2 dst ,prefix ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vptestmb #x66 #x26 0)
+ (def vptestmw #x66 #x26 1)
+ (def vptestnmb #xf3 #x26 0)
+ (def vptestnmw #xf3 #x26 1))
+
+;;; Move mask (byte/word to/from k)
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix #x0f38 :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst ,prefix ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vpmovb2m #xf3 #x29 0)
+ (def vpmovw2m #xf3 #x29 1)
+ (def vpmovm2b #xf3 #x28 0)
+ (def vpmovm2w #xf3 #x28 1))
+
+;;; Permute word
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vpermw #x8d 1)
+ (def vpermi2w #x75 1)
+ (def vpermt2w #x7d 1))
+
+;;; Variable shift word
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vpsllvw #x12 1)
+ (def vpsravw #x11 1)
+ (def vpsrlvw #x10 1))
+
+;;; Double-block packed SAD
+(define-instruction vdbpsadbw (segment dst src1 src2 imm)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 #x42
+ :opcode-prefix #x0f3a
+ :vvvv src1
+ :w 0
+ :remaining-bytes 1)
+ (emit-byte segment imm))
+ . #.(avx512-inst-printer-list 'ymm-ymm/mem-imm #x66 #x42
+ :opcode-prefix #x0f3a :w 0))
+
+;;;; ---- AVX-512DQ instructions ----
+
+;;; FP classify
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm #x66 opcode
+ :opcode-prefix #x0f3a :w w
+ :printer '(:name :tab reg ", " reg/mem ", " imm))
+ (:emitter
+ (emit-avx512-inst segment src dst #x66 ,opcode
+ :opcode-prefix #x0f3a
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vfpclassps #x66 0)
+ (def vfpclasspd #x66 1)
+ (def vfpclassss #x67 0)
+ (def vfpclasssd #x67 1))
+
+;;; Multiply low qword
+(define-instruction vpmullq (segment dst src1 src2)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 #x40
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w 1))
+ . #.(avx512-inst-printer-list 'ymm-ymm/mem #x66 #x40
+ :opcode-prefix #x0f38 :w 1 :nds t))
+
+;;; Convert packed integers to/from FP (DQ extensions)
+(macrolet ((def (name prefix opcode w &optional (opcode-prefix #x0f))
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix opcode-prefix :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst ,prefix ,opcode
+ :opcode-prefix ,opcode-prefix :w ,w)))))
+ (def vcvtps2qq #x66 #x7b 0)
+ (def vcvtpd2qq #x66 #x7b 1)
+ (def vcvtps2uqq #x66 #x79 0)
+ (def vcvtpd2uqq #x66 #x79 1)
+ (def vcvttps2qq #x66 #x7a 0)
+ (def vcvttpd2qq #x66 #x7a 1)
+ (def vcvttps2uqq #x66 #x78 0)
+ (def vcvttpd2uqq #x66 #x78 1)
+ (def vcvtqq2ps nil #x5b 1)
+ (def vcvtqq2pd #xf3 #xe6 1)
+ (def vcvtuqq2ps #xf2 #x7a 1)
+ (def vcvtuqq2pd #xf3 #x7a 1))
+
+;;; Move mask (dword/qword to/from k)
+(macrolet ((def (name prefix opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix #x0f38 :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst ,prefix ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vpmovd2m #xf3 #x39 0)
+ (def vpmovq2m #xf3 #x39 1)
+ (def vpmovm2d #xf3 #x38 0)
+ (def vpmovm2q #xf3 #x38 1))
+
+;;; DQ broadcast variants
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vbroadcastf32x2 #x19 0)
+ (def vbroadcastf64x2 #x1a 1)
+ (def vbroadcasti32x2 #x59 0)
+ (def vbroadcasti64x2 #x5a 1)
+ (def vbroadcastf32x8 #x1b 0)
+ (def vbroadcasti32x8 #x5b 0))
+
+;;;; ---- AVX-512IFMA instructions ----
+
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vpmadd52luq #xb4 1)
+ (def vpmadd52huq #xb5 1))
+
+;;;; ---- AVX-512VBMI instructions ----
+
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vpermb #x8d 0)
+ (def vpermi2b #x75 0)
+ (def vpermt2b #x7d 0)
+ (def vpmultishiftqb #x83 1))
+
+;;;; ---- AVX-512VBMI2 instructions ----
+
+;;; Compress byte/word (reversed encoding)
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w
+ :printer '(:name :tab reg/mem ", " reg))
+ (:emitter
+ (emit-avx512-inst segment dst src #x66 ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vpcompressb #x63 0)
+ (def vpcompressw #x63 1))
+
+;;; Expand byte/word
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vpexpandb #x62 0)
+ (def vpexpandw #x62 1))
+
+;;; Concatenate and shift (immediate)
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2 imm)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem-imm #x66 opcode
+ :opcode-prefix #x0f3a :w w)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f3a
+ :vvvv src1
+ :w ,w
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (def vpshldw #x70 1)
+ (def vpshldd #x71 0)
+ (def vpshldq #x71 1)
+ (def vpshrdw #x72 1)
+ (def vpshrdd #x73 0)
+ (def vpshrdq #x73 1))
+
+;;; Concatenate and shift (variable)
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src1 src2)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w ,w)))))
+ (def vpshldvw #x70 1)
+ (def vpshldvd #x71 0)
+ (def vpshldvq #x71 1)
+ (def vpshrdvw #x72 1)
+ (def vpshrdvd #x73 0)
+ (def vpshrdvq #x73 1))
+
+;;;; ---- AVX-512VPOPCNTDQ instructions ----
+
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vpopcntd #x55 0)
+ (def vpopcntq #x55 1))
+
+;;;; ---- AVX-512BITALG instructions ----
+
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst src)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem #x66 opcode
+ :opcode-prefix #x0f38 :w w)
+ (:emitter
+ (emit-avx512-inst segment src dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :w ,w)))))
+ (def vpopcntb #x54 0)
+ (def vpopcntw #x54 1))
+
+;;; Shuffle bits (result to k)
+(define-instruction vpshufbitqmb (segment dst src1 src2)
+ (:emitter
+ (emit-avx512-inst segment src2 dst #x66 #x8f
+ :opcode-prefix #x0f38
+ :vvvv src1
+ :w 0))
+ . #.(avx512-inst-printer-list 'ymm-ymm/mem #x66 #x8f
+ :opcode-prefix #x0f38 :w 0 :nds t))
+
+;;;; ---- Masked arithmetic (EVEX with opmask {k}) ----
+
+;;; 3-operand NDS with opmask: (inst name dst src1 src2 mask-reg-number)
+;;; mask-reg-number is 1-7 (k1-k7; k0 means no masking).
+;;; Merge-masking: destination elements not selected by mask are preserved.
+(macrolet ((def (name prefix opcode w &optional (opcode-prefix #x0f))
+ `(define-instruction ,name (segment dst src1 src2 mask)
+ ,@(avx512-inst-printer-list 'ymm-ymm/mem prefix opcode
+ :opcode-prefix opcode-prefix :w w :nds t)
+ (:emitter
+ (emit-avx512-inst segment src2 dst ,prefix ,opcode
+ :opcode-prefix ,opcode-prefix
+ :vvvv src1
+ :w ,w
+ :aaa mask)))))
+ ;; Integer arithmetic (qword)
+ (def vpaddq-masked #x66 #xd4 1)
+ (def vpsubq-masked #x66 #xfb 1)
+ ;; Integer arithmetic (dword)
+ (def vpaddd-masked #x66 #xfe 0)
+ (def vpsubd-masked #x66 #xfa 0)
+ ;; Integer logical (qword)
+ (def vpandq-masked #x66 #xdb 1)
+ (def vpandnq-masked #x66 #xdf 1)
+ (def vporq-masked #x66 #xeb 1)
+ (def vpxorq-masked #x66 #xef 1)
+ ;; FP arithmetic (double)
+ (def vaddpd-masked #x66 #x58 1)
+ (def vsubpd-masked #x66 #x5c 1)
+ (def vmulpd-masked #x66 #x59 1)
+ ;; FP arithmetic (single)
+ (def vaddps-masked nil #x58 0)
+ (def vsubps-masked nil #x5c 0)
+ (def vmulps-masked nil #x59 0))
+
+;;;; ---- EVEX gather/scatter (ZMM width) ----
+
+;;; EVEX gather: dst {k1}, vm (index in vector register, mask in k1-k7)
+;;; Usage: (inst vpgatherqq-z dst (ea disp base zmm-index scale) mask)
+;;; where mask is 1-7 (must be k1-k7; k0 not allowed for gather/scatter)
+;;; The CPU reads 8 qwords from [base + zmm-index[i]*scale + disp] for
+;;; each lane i where k1 bit i is set; lane's mask bit is cleared on load.
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment dst vm mask)
+ (:emitter
+ (aver (and (integerp mask) (<= 1 mask 7)))
+ (emit-avx512-inst segment vm dst #x66 ,opcode
+ :opcode-prefix #x0f38
+ :w ,w
+ :aaa mask
+ :vm t)))))
+ ;; Dword destinations (8 lanes, YMM dst; index is ZMM qword)
+ (def vpgatherqd-z #x91 0)
+ (def vgatherqps-z #x93 0)
+ ;; Qword destinations (8 lanes, ZMM dst; index is ZMM qword)
+ (def vpgatherqq-z #x91 1)
+ (def vgatherqpd-z #x93 1)
+ ;; Dword indices (16 lanes for W0, 8 for W1 with YMM index)
+ (def vpgatherdd-z #x90 0)
+ (def vgatherdps-z #x92 0)
+ (def vpgatherdq-z #x90 1)
+ (def vgatherdpd-z #x92 1))
+
+;;; EVEX scatter: vm {k1}, src (reverse direction)
+;;; Usage: (inst vpscatterqq-z (ea disp base zmm-index scale) src mask)
+(macrolet ((def (name opcode w)
+ `(define-instruction ,name (segment vm src mask)
+ (:emitter
+ (aver (and (integerp mask) (<= 1 mask 7)))
+ (emit-avx512-inst segment vm src #x66 ,opcode
+ :opcode-prefix #x0f38
+ :w ,w
+ :aaa mask
+ :vm t)))))
+ (def vpscatterqd-z #xa1 0)
+ (def vscatterqps-z #xa3 0)
+ (def vpscatterqq-z #xa1 1)
+ (def vscatterqpd-z #xa3 1)
+ (def vpscatterdd-z #xa0 0)
+ (def vscatterdps-z #xa2 0)
+ (def vpscatterdq-z #xa0 1)
+ (def vscatterdpd-z #xa2 1))
diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp
index faf7b0904..79ecc5a99 100644
--- a/src/compiler/x86-64/insts.lisp
+++ b/src/compiler/x86-64/insts.lisp
@@ -25,7 +25,8 @@
(import '(sb-vm::tn-byte-offset sb-vm::tn-reg sb-vm::reg-name
sb-vm::frame-byte-offset sb-vm::rip-tn sb-vm::rbp-tn
sb-vm::gpr-tn-p sb-vm::stack-tn-p sb-c::tn-reads sb-c::tn-writes
- sb-vm::ymm-reg
+ sb-vm::ymm-reg sb-vm::zmm-reg
+ sb-vm::int-avx512-reg sb-vm::double-avx512-reg sb-vm::single-avx512-reg
sb-vm::linkage-addr->name
sb-vm::registers sb-vm::float-registers sb-vm::stack))) ; SB names
@@ -126,7 +127,8 @@
(:dword 4)
(:qword 8)
(:oword 16)
- (:hword 32)))
+ (:hword 32)
+ (:zword 64)))
;;; If chopping IMM to 32 bits and sign-extending is equal to the original value,
;;; return the signed result, which the CPU will always extend to 64 bits.
@@ -997,12 +999,18 @@
1)))
(defun make-fpr-id (index size)
- (declare (type (mod 16) index))
+ (declare (type (mod 32) index))
(ecase size
(:xmm (logior (ash index 3) 1)) ; low bit = FPR, not GPR
- (:ymm (logior (ash index 3) 3))))
+ (:ymm (logior (ash index 3) 3))
+ (:zmm (logior (ash index 3) 5))
+ (:kreg (logior (ash index 3) 7))))
(defun is-ymm-id-p (reg-id)
(= (ldb (byte 3 0) reg-id) 3))
+(defun is-zmm-id-p (reg-id)
+ (= (ldb (byte 3 0) reg-id) 5))
+(defun is-kreg-id-p (reg-id)
+ (= (ldb (byte 3 0) reg-id) 7))
(declaim (inline is-gpr-id-p gpr-id-size-class reg-id-num))
(defun is-gpr-id-p (reg-id)
@@ -1041,6 +1049,12 @@
sb-vm::+byte-register-names+)
t)
(gpr-id-size-class id)))
+ ((is-kreg-id-p id)
+ #.(coerce (loop for i below 8 collect (format nil "K~D" i))
+ 'vector))
+ ((is-zmm-id-p id)
+ #.(coerce (loop for i below 32 collect (format nil "ZMM~D" i))
+ 'vector))
((is-ymm-id-p id)
#.(coerce (loop for i below 16 collect (format nil "YMM~D" i))
'vector))
@@ -1102,6 +1116,20 @@
collect (!make-reg (make-fpr-id i :ymm)))
'vector)
t)
+ number))
+ (:zmm
+ (svref (load-time-value
+ (coerce (loop for i from 0 below 32
+ collect (!make-reg (make-fpr-id i :zmm)))
+ 'vector)
+ t)
+ number))
+ (:kreg
+ (svref (load-time-value
+ (coerce (loop for i from 0 below 8
+ collect (!make-reg (make-fpr-id i :kreg)))
+ 'vector)
+ t)
number))))
;;; Given a TN which maps to a GPR, return the corresponding REG.
@@ -1127,6 +1155,12 @@
operand)
((eq (sb-name (sc-sb (tn-sc operand))) 'registers)
(tn-reg operand))
+ ((memq (sc-name (tn-sc operand))
+ '(zmm-reg
+ int-avx512-reg
+ double-avx512-reg
+ single-avx512-reg))
+ (get-fpr :zmm (tn-offset operand)))
((memq (sc-name (tn-sc operand))
'(ymm-reg
int-avx2-reg
@@ -1139,7 +1173,7 @@
operand)))
operands))
-(defun emit-ea (segment thing reg &key (remaining-bytes 0) xmm-index)
+(defun emit-ea (segment thing reg &key (remaining-bytes 0) xmm-index (disp-n 1))
(when (register-p reg)
(setq reg (reg-encoding reg segment)))
(etypecase thing
@@ -1186,9 +1220,23 @@
(scale (ea-scale thing))
(disp (ea-disp thing))
(base-encoding (when base (reg-encoding (tn-reg base) segment)))
+ ;; EVEX compressed displacement: the CPU multiplies disp8 by N
+ ;; (the tuple size), so we must encode disp/N. A displacement
+ ;; qualifies for disp8 if it's a multiple of N and the quotient
+ ;; fits in a signed byte. When disp-n=0, disp8 is disabled
+ ;; entirely (safe fallback for EVEX when tuple type is unknown).
+ (compressed-disp (and (fixnump disp)
+ (> disp-n 1)
+ (zerop (mod disp disp-n))
+ (let ((q (/ disp disp-n)))
+ (and (<= -128 q 127) q))))
(mod (cond ((or (null base) (and (eql disp 0) (/= base-encoding #b101)))
#b00)
- ((and (fixnump disp) (<= -128 disp 127))
+ (compressed-disp
+ #b01)
+ ;; For EVEX (disp-n > 0), skip normal disp8: the CPU
+ ;; would multiply the byte by N, giving wrong offset.
+ ((and (= disp-n 1) (fixnump disp) (<= -128 disp 127))
#b01)
(t
#b10)))
@@ -1212,7 +1260,7 @@
(base (if (null base) #b101 base-encoding)))
(emit-sib-byte segment ss index base)))
(cond ((= mod #b01)
- (emit-byte segment disp))
+ (emit-byte segment (or compressed-disp disp)))
((or (= mod #b10) (null base))
(cond ((not (fixup-p disp))
(emit-signed-dword segment disp))
@@ -3320,6 +3368,9 @@
((:hword :avx2)
(aver (integerp value))
(cons :hword value))
+ ((:zword :avx512)
+ (aver (integerp value))
+ (cons :zword value))
((:single-float)
(aver (typep value 'single-float))
(cons (if alignedp :oword :dword)
diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp
index ea75504aa..18d293fa3 100644
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -43,6 +43,14 @@
((single-avx2-reg double-avx2-reg)
(aver (xmm-tn-p src))
(inst vmovaps dst src))
+ #+sb-simd-pack-512
+ ((zmm-reg int-avx512-reg)
+ (aver (xmm-tn-p src))
+ (inst vmovdqu dst src))
+ #+sb-simd-pack-512
+ ((single-avx512-reg double-avx512-reg)
+ (aver (xmm-tn-p src))
+ (inst vmovups dst src))
(t
(if size
(inst mov size dst src)
diff --git a/src/compiler/x86-64/target-avx2-insts.lisp b/src/compiler/x86-64/target-avx2-insts.lisp
index 43e65b95d..79f78fffb 100644
--- a/src/compiler/x86-64/target-avx2-insts.lisp
+++ b/src/compiler/x86-64/target-avx2-insts.lisp
@@ -13,14 +13,32 @@
(defun print-ymmreg (value stream dstate)
(let* ((offset (etypecase value
- ((unsigned-byte 4) value)
- (reg (reg-num value))))
- (reg (get-fpr (if (dstate-getprop dstate +vex-l+) :ymm :xmm) offset))
+ ((unsigned-byte 4) value)
+ (reg (reg-num value))))
+ ;; For EVEX, R' provides bit 4 of the reg field (registers 16-31).
+ ;; This flag is set by the evex-r-prime prefilter.
+ (offset (if (dstate-getprop dstate +evex-r-prime+)
+ (+ offset 16)
+ offset))
+ (reg (get-fpr (cond ((dstate-getprop dstate +evex-l1+) :zmm)
+ ((dstate-getprop dstate +vex-l+) :ymm)
+ (t :xmm))
+ offset))
(name (reg-name reg)))
(if stream
(write-string name stream)
(operand name dstate))))
+(defun print-kreg (value stream dstate)
+ (declare (ignore dstate))
+ (let* ((offset (etypecase value
+ ((unsigned-byte 4) value)
+ (reg (reg-num value))))
+ (reg (get-fpr :kreg offset))
+ (name (reg-name reg)))
+ (when stream
+ (write-string name stream))))
+
(defun print-ymmreg/mem (value stream dstate)
(if (machine-ea-p value)
(print-mem-ref :ref value nil stream dstate)
@@ -61,3 +79,13 @@
(defun print-sized-xmmreg/mem-default-qword (value stream dstate)
(print-xmmreg/mem-with-width
value (inst-operand-size-default-qword dstate) t stream dstate))
+
+(defconstant-eqx +opmask-reg-names+
+ #("K0" "K1" "K2" "K3" "K4" "K5" "K6" "K7")
+ #'equalp)
+
+(defun print-opmask-reg (value stream dstate)
+ (declare (ignore dstate))
+ (let ((name (svref +opmask-reg-names+ (logand value 7))))
+ (if stream
+ (write-string name stream))))
diff --git a/src/compiler/x86-64/target-insts.lisp b/src/compiler/x86-64/target-insts.lisp
index ebccfbbf5..1a7fda132 100644
--- a/src/compiler/x86-64/target-insts.lisp
+++ b/src/compiler/x86-64/target-insts.lisp
@@ -345,7 +345,18 @@
ea))
(displacement ()
(case mod
- (#b01 (read-signed-suffix 8 dstate))
+ (#b01
+ (let ((disp8 (read-signed-suffix 8 dstate)))
+ ;; EVEX compressed displacement: the CPU multiplies disp8
+ ;; by N (tuple size). Scale for display so the shown offset
+ ;; matches the effective address. +evex-l1+ is only set by
+ ;; the EVEX L'L prefilter (never VEX), so it reliably
+ ;; identifies EVEX 512-bit where N=64 for Full tuple type.
+ ;; This is approximate (narrow-load instructions have
+ ;; smaller N) but covers the common case correctly.
+ (if (dstate-getprop dstate +evex-l1+)
+ (* disp8 64)
+ disp8)))
(#b10 (read-signed-suffix 32 dstate))))
(extend (bit-name reg)
(logior (if (dstate-getprop dstate bit-name) 8 0) reg)))
diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp
index d7ec0296c..a967bbb92 100644
--- a/src/compiler/x86-64/vm.lisp
+++ b/src/compiler/x86-64/vm.lisp
@@ -183,8 +183,29 @@
(defreg float13 13 :float)
(defreg float14 14 :float)
(defreg float15 15 :float)
+ (defreg float16 16 :float)
+ (defreg float17 17 :float)
+ (defreg float18 18 :float)
+ (defreg float19 19 :float)
+ (defreg float20 20 :float)
+ (defreg float21 21 :float)
+ (defreg float22 22 :float)
+ (defreg float23 23 :float)
+ (defreg float24 24 :float)
+ (defreg float25 25 :float)
+ (defreg float26 26 :float)
+ (defreg float27 27 :float)
+ (defreg float28 28 :float)
+ (defreg float29 29 :float)
+ (defreg float30 30 :float)
+ (defreg float31 31 :float)
(defregset *float-regs* float0 float1 float2 float3 float4 float5 float6 float7
float8 float9 float10 float11 float12 float13 float14 float15)
+ ;; ZMM16-31 are only accessible via EVEX encoding
+ (defregset *zmm-regs* float0 float1 float2 float3 float4 float5 float6 float7
+ float8 float9 float10 float11 float12 float13 float14 float15
+ float16 float17 float18 float19 float20 float21 float22 float23
+ float24 float25 float26 float27 float28 float29 float30 float31)
;; registers used to pass arguments
;;
@@ -204,7 +225,7 @@
(!define-storage-bases
(define-storage-base registers :finite :size 16)
-(define-storage-base float-registers :finite :size 16)
+(define-storage-base float-registers :finite :size 32)
;;; Start from 2, for the old RBP (aka OCFP) and return address
(define-storage-base stack :unbounded :size 2 :size-increment 1)
@@ -249,6 +270,12 @@
(double-avx2-stack stack :element-size 4)
#+sb-simd-pack-256
(single-avx2-stack stack :element-size 4)
+ #+sb-simd-pack-512
+ (int-avx512-stack stack :element-size 8)
+ #+sb-simd-pack-512
+ (double-avx512-stack stack :element-size 8)
+ #+sb-simd-pack-512
+ (single-avx512-stack stack :element-size 8)
;;
;; things that can go in the integer registers
@@ -370,6 +397,26 @@
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (single-avx2-stack))
+ ;; ZMM SCs use all 32 registers (16-31 require EVEX encoding)
+ (zmm-reg float-registers :locations #.*zmm-regs*)
+ #+sb-simd-pack-512
+ (int-avx512-reg float-registers
+ :locations #.*zmm-regs*
+ :constant-scs (fp-immediate)
+ :save-p t
+ :alternate-scs (int-avx512-stack))
+ #+sb-simd-pack-512
+ (double-avx512-reg float-registers
+ :locations #.*zmm-regs*
+ :constant-scs (fp-immediate)
+ :save-p t
+ :alternate-scs (double-avx512-stack))
+ #+sb-simd-pack-512
+ (single-avx512-reg float-registers
+ :locations #.*zmm-regs*
+ :constant-scs (fp-immediate)
+ :save-p t
+ :alternate-scs (single-avx512-stack))
(catch-block stack :element-size catch-block-size)
(unwind-block stack :element-size unwind-block-size)))
@@ -392,11 +439,19 @@
#+sb-simd-pack-256
(defparameter *hword-sc-names* '(ymm-reg int-avx2-reg single-avx2-reg double-avx2-reg
int-avx2-stack single-avx2-stack double-avx2-stack))
+(defparameter *zword-sc-names* '(zmm-reg
+ #+sb-simd-pack-512 int-avx512-reg
+ #+sb-simd-pack-512 single-avx512-reg
+ #+sb-simd-pack-512 double-avx512-reg
+ #+sb-simd-pack-512 int-avx512-stack
+ #+sb-simd-pack-512 single-avx512-stack
+ #+sb-simd-pack-512 double-avx512-stack))
) ; EVAL-WHEN
(!define-storage-classes
. #.(mapcar (lambda (class-spec)
(let ((size
(case (car class-spec)
+ (#.*zword-sc-names* :zword)
#+sb-simd-pack
(#.*oword-sc-names* :oword)
#+sb-simd-pack-256
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits