X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Finsts.lisp;h=5fc70d6547f0ec3ff0be34de8995cd04eb4f560a;hb=8a33bf220856487a5cde4b183476b6ab5103983a;hp=78ee46bc6238a966de3136dd5bf4a7c8ffa19ce2;hpb=a93f828030465bfc0fb85957693f1c3c2ab0a539;p=sbcl.git diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 78ee46b..5fc70d6 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -521,6 +521,20 @@ vec)) ) ; EVAL-WHEN +;;; SSE shuffle patterns. The names end in the number of bits of the +;;; immediate byte that are used to encode the pattern and the radix +;;; in which to print the value. +(macrolet ((define-sse-shuffle-arg-type (name format-string) + `(sb!disassem:define-arg-type ,name + :type 'imm-byte + :printer (lambda (value stream dstate) + (declare (type (unsigned-byte 8) value) + (type stream stream) + (ignore dstate)) + (format stream ,format-string value))))) + (define-sse-shuffle-arg-type sse-shuffle-pattern-2-2 "#b~2,'0B") + (define-sse-shuffle-arg-type sse-shuffle-pattern-8-4 "#4r~4,4,'0R")) + ;;; Set assembler parameters. (In CMU CL, this was done with ;;; a call to a macro DEF-ASSEMBLER-PARAMS.) (eval-when (:compile-toplevel :load-toplevel :execute) @@ -813,6 +827,55 @@ ;; optional fields (imm)) +(sb!disassem:define-instruction-format (x66-ext-reg-reg/mem 32 + :default-printer + `(:name :tab reg ", " reg/mem)) + (x66 :field (byte 8 0) :type 'x66 :value #x66) + (prefix :field (byte 8 8) :value #b00001111) + (op :field (byte 7 17)) + (width :field (byte 1 16) :type 'width) + (reg/mem :fields (list (byte 2 30) (byte 3 24)) + :type 'reg/mem) + (reg :field (byte 3 27) :type 'reg) + ;; optional fields + (imm)) + +(sb!disassem:define-instruction-format (rex-ext-reg-reg/mem 32 + :default-printer + `(:name :tab reg ", " reg/mem)) + (rex :field (byte 4 4) :value #b0100) + (wrxb :field (byte 4 0) :type 'wrxb) + (prefix :field (byte 8 8) :value #b00001111) + (op :field (byte 7 17)) + (width :field (byte 1 16) :type 'width) + (reg/mem :fields (list (byte 2 30) (byte 3 24)) + :type 'reg/mem) + (reg :field (byte 3 27) :type 'reg) + ;; optional fields + (imm)) + +(sb!disassem:define-instruction-format (x66-rex-ext-reg-reg/mem 40 + :default-printer + `(:name :tab reg ", " reg/mem)) + (x66 :field (byte 8 0) :type 'x66 :value #x66) + (rex :field (byte 4 12) :value #b0100) + (wrxb :field (byte 4 8) :type 'wrxb) + (prefix :field (byte 8 16) :value #b00001111) + (op :field (byte 7 25)) + (width :field (byte 1 24) :type 'width) + (reg/mem :fields (list (byte 2 38) (byte 3 32)) + :type 'reg/mem) + (reg :field (byte 3 35) :type 'reg) + ;; optional fields + (imm)) + +(eval-when (:compile-toplevel :execute) + (defun ext-reg-reg/mem-printer-list (op &optional printer) + `((ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer))) + (x66-ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer))) + (rex-ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer))) + (x66-rex-ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer)))))) + (sb!disassem:define-instruction-format (ext-reg-reg/mem-no-width 24 :default-printer `(:name :tab reg ", " reg/mem)) @@ -892,7 +955,9 @@ (op :field (byte 8 8)) (reg/mem :fields (list (byte 2 22) (byte 3 16)) :type 'xmmreg/mem) - (reg :field (byte 3 19) :type 'xmmreg)) + (reg :field (byte 3 19) :type 'xmmreg) + ;; optional fields + (imm)) (sb!disassem:define-instruction-format (rex-xmm-xmm/mem 32 :default-printer @@ -903,7 +968,8 @@ (op :field (byte 8 16)) (reg/mem :fields (list (byte 2 30) (byte 3 24)) :type 'xmmreg/mem) - (reg :field (byte 3 27) :type 'xmmreg)) + (reg :field (byte 3 27) :type 'xmmreg) + (imm)) (sb!disassem:define-instruction-format (ext-xmm-xmm/mem 32 :default-printer @@ -913,7 +979,8 @@ (op :field (byte 8 16)) (reg/mem :fields (list (byte 2 30) (byte 3 24)) :type 'xmmreg/mem) - (reg :field (byte 3 27) :type 'xmmreg)) + (reg :field (byte 3 27) :type 'xmmreg) + (imm)) (sb!disassem:define-instruction-format (ext-rex-xmm-xmm/mem 40 :default-printer @@ -925,7 +992,8 @@ (op :field (byte 8 24)) (reg/mem :fields (list (byte 2 38) (byte 3 32)) :type 'xmmreg/mem) - (reg :field (byte 3 35) :type 'xmmreg)) + (reg :field (byte 3 35) :type 'xmmreg) + (imm)) ;;; Same as xmm-xmm/mem etc., but with direction bit. @@ -1072,106 +1140,10 @@ (defparameter *sse-conditions* #(:eq :lt :le :unord :neq :nlt :nle :ord))) (sb!disassem:define-arg-type sse-condition-code + ;; Inherit the prefilter from IMM-BYTE to READ-SUFFIX the byte. + :type 'imm-byte :printer *sse-conditions*) -(sb!disassem:define-instruction-format (xmm-xmm/mem-cmp 32 - :default-printer - '(:name " " cc :tab reg ", " reg/mem)) - (x0f :field (byte 8 0) :value #x0f) - (op :field (byte 8 8)) - (reg/mem :fields (list (byte 2 22) (byte 3 16)) - :type 'xmmreg/mem) - (reg :field (byte 3 19) :type 'xmmreg) - (cc :field (byte 8 24) :type 'sse-condition-code)) - -(sb!disassem:define-instruction-format (rex-xmm-xmm/mem-cmp 40 - :default-printer - '(:name " " cc :tab reg ", " reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (x0f :field (byte 8 8) :value #x0f) - (op :field (byte 8 16)) - (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'xmmreg/mem) - (reg :field (byte 3 27) :type 'xmmreg) - (cc :field (byte 8 32) :type 'sse-condition-code)) - -(sb!disassem:define-instruction-format (ext-xmm-xmm/mem-cmp 40 - :default-printer - '(:name " " cc :tab reg ", " reg/mem)) - (prefix :field (byte 8 0)) - (x0f :field (byte 8 8) :value #x0f) - (op :field (byte 8 16)) - (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'xmmreg/mem) - (reg :field (byte 3 27) :type 'xmmreg) - (cc :field (byte 8 32) :type 'sse-condition-code)) - -(sb!disassem:define-instruction-format (ext-rex-xmm-xmm/mem-cmp 48 - :default-printer - '(:name " " cc :tab reg ", " reg/mem)) - (prefix :field (byte 8 0)) - (rex :field (byte 4 12) :value #b0100) - (wrxb :field (byte 4 8) :type 'wrxb) - (x0f :field (byte 8 16) :value #x0f) - (op :field (byte 8 24)) - (reg/mem :fields (list (byte 2 38) (byte 3 32)) - :type 'xmmreg/mem) - (reg :field (byte 3 35) :type 'xmmreg) - (cc :field (byte 8 40) :type 'sse-condition-code)) - -;;; XMM instructions with 8 bit immediate data - -(sb!disassem:define-instruction-format (xmm-xmm/mem-imm 24 - :default-printer - '(:name - :tab reg ", " reg/mem ", " imm)) - (x0f :field (byte 8 0) :value #x0f) - (op :field (byte 8 8)) - (reg/mem :fields (list (byte 2 22) (byte 3 16)) - :type 'xmmreg/mem) - (reg :field (byte 3 19) :type 'xmmreg) - (imm :type 'imm-byte)) - -(sb!disassem:define-instruction-format (rex-xmm-xmm/mem-imm 32 - :default-printer - '(:name - :tab reg ", " reg/mem ", " imm)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (x0f :field (byte 8 8) :value #x0f) - (op :field (byte 8 16)) - (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'xmmreg/mem) - (reg :field (byte 3 27) :type 'xmmreg) - (imm :type 'imm-byte)) - -(sb!disassem:define-instruction-format (ext-xmm-xmm/mem-imm 32 - :default-printer - '(:name - :tab reg ", " reg/mem ", " imm)) - (prefix :field (byte 8 0)) - (x0f :field (byte 8 8) :value #x0f) - (op :field (byte 8 16)) - (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'xmmreg/mem) - (reg :field (byte 3 27) :type 'xmmreg) - (imm :type 'imm-byte)) - -(sb!disassem:define-instruction-format (ext-rex-xmm-xmm/mem-imm 40 - :default-printer - '(:name - :tab reg ", " reg/mem ", " imm)) - (prefix :field (byte 8 0)) - (rex :field (byte 4 12) :value #b0100) - (wrxb :field (byte 4 8) :type 'wrxb) - (x0f :field (byte 8 16) :value #x0f) - (op :field (byte 8 24)) - (reg/mem :fields (list (byte 2 38) (byte 3 32)) - :type 'xmmreg/mem) - (reg :field (byte 3 35) :type 'xmmreg) - (imm :type 'imm-byte)) - (sb!disassem:define-instruction-format (string-op 8 :include 'simple :default-printer '(:name width))) @@ -1382,7 +1354,7 @@ (format stream "+~A" (ea-disp ea)))) (write-char #\] stream)))) -(defun emit-constant-tn-rip (segment constant-tn reg) +(defun emit-constant-tn-rip (segment constant-tn reg remaining-bytes) ;; AMD64 doesn't currently have a code object register to use as a ;; base register for constant access. Instead we use RIP-relative ;; addressing. The offset from the SIMPLE-FUN-HEADER to the instruction @@ -1411,21 +1383,23 @@ ;; The addressing is relative to end of instruction, ;; i.e. the end of this dword. Hence the + 4. (emit-signed-dword segment - (+ 4 (- (+ offset posn))))))) + (+ 4 remaining-bytes + (- (+ offset posn))))))) (values)) -(defun emit-label-rip (segment fixup reg) +(defun emit-label-rip (segment fixup reg remaining-bytes) (let ((label (fixup-offset fixup))) ;; RIP-relative addressing (emit-mod-reg-r/m-byte segment #b00 reg #b101) (emit-back-patch segment 4 (lambda (segment posn) - (emit-signed-dword segment (- (label-position label) - (+ posn 4)))))) + (emit-signed-dword segment + (- (label-position label) + (+ posn 4 remaining-bytes)))))) (values)) -(defun emit-ea (segment thing reg &optional allow-constants) +(defun emit-ea (segment thing reg &key allow-constants (remaining-bytes 0)) (etypecase thing (tn ;; this would be eleganter if we had a function that would create @@ -1447,7 +1421,7 @@ ;; Why? (error "Constant TNs can only be directly used in MOV, PUSH, and CMP.")) - (emit-constant-tn-rip segment thing reg)))) + (emit-constant-tn-rip segment thing reg remaining-bytes)))) (ea (let* ((base (ea-base thing)) (index (ea-index thing)) @@ -1468,7 +1442,9 @@ (label-p (fixup-offset disp))) (aver (null base)) (aver (null index)) - (return-from emit-ea (emit-ea segment disp reg allow-constants))) + (return-from emit-ea (emit-ea segment disp reg + :allow-constants allow-constants + :remaining-bytes remaining-bytes))) (when (and (= mod 0) (= r/m #b101)) ;; this is rip-relative in amd64, so we'll use a sib instead (setf r/m #b100 scale 1)) @@ -1494,7 +1470,7 @@ (fixup (typecase (fixup-offset thing) (label - (emit-label-rip segment thing reg)) + (emit-label-rip segment thing reg remaining-bytes)) (t (emit-mod-reg-r/m-byte segment #b00 reg #b100) (emit-sib-byte segment 0 #b100 #b101) @@ -1819,7 +1795,7 @@ (if (eq size :byte) #b10001010 #b10001011)) - (emit-ea segment src (reg-tn-encoding dst) t)))) + (emit-ea segment src (reg-tn-encoding dst) :allow-constants t)))) ((integerp src) ;; C7 only deals with 32 bit immediates even if the ;; destination is a 64-bit location. The value is @@ -1884,7 +1860,7 @@ (cond (ea-p (ea-base src)) ((tn-p src) src) (t nil))) - (emit-byte segment #x63) ;movsxd + (emit-byte segment (if signed-p #x63 #x8b)) ;movsxd or straight mov ;;(emit-byte segment opcode) (emit-ea segment src (reg-tn-encoding dst))))))))) @@ -1962,7 +1938,7 @@ (emit-byte-with-reg segment #b01010 (reg-tn-encoding src))) (t (emit-byte segment #b11111111) - (emit-ea segment src #b110 t)))))))) + (emit-ea segment src #b110 :allow-constants t)))))))) (define-instruction pop (segment dst) (:printer reg-no-width-default-qword ((op #b01011))) @@ -2024,7 +2000,8 @@ (define-instruction cmpxchg (segment dst src &optional prefix) ;; Register/Memory with Register. - (:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg)) + (:printer-list (ext-reg-reg/mem-printer-list #b1011000 + '(:name :tab reg/mem ", " reg))) (:emitter (aver (register-p src)) (emit-prefix segment prefix) @@ -2115,7 +2092,7 @@ (cond ((and (not (eq size :byte)) (<= -128 src 127)) (maybe-emit-rex-for-ea segment dst nil) (emit-byte segment #b10000011) - (emit-ea segment dst opcode allow-constants) + (emit-ea segment dst opcode :allow-constants allow-constants) (emit-byte segment src)) ((accumulator-p dst) (maybe-emit-rex-for-ea segment dst nil) @@ -2129,7 +2106,7 @@ (t (maybe-emit-rex-for-ea segment dst nil) (emit-byte segment (if (eq size :byte) #b10000000 #b10000001)) - (emit-ea segment dst opcode allow-constants) + (emit-ea segment dst opcode :allow-constants allow-constants) (emit-sized-immediate segment size src)))) ((register-p src) (maybe-emit-rex-for-ea segment dst src) @@ -2137,14 +2114,14 @@ (dpb opcode (byte 3 3) (if (eq size :byte) #b00000000 #b00000001))) - (emit-ea segment dst (reg-tn-encoding src) allow-constants)) + (emit-ea segment dst (reg-tn-encoding src) :allow-constants allow-constants)) ((register-p dst) (maybe-emit-rex-for-ea segment src dst) (emit-byte segment (dpb opcode (byte 3 3) (if (eq size :byte) #b00000010 #b00000011))) - (emit-ea segment src (reg-tn-encoding dst) allow-constants)) + (emit-ea segment src (reg-tn-encoding dst) :allow-constants allow-constants)) (t (error "bogus operands to ~A" name))))) @@ -2349,7 +2326,8 @@ (define-instruction xadd (segment dst src &optional prefix) ;; Register/Memory with Register. - (:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg)) + (:printer-list (ext-reg-reg/mem-printer-list #b1100000 + '(:name :tab reg/mem ", " reg))) (:emitter (aver (register-p src)) (emit-prefix segment prefix) @@ -2454,7 +2432,7 @@ (ext-reg-reg/mem-imm ((op ,(logior op #b100)) (imm nil :type signed-imm-byte))) (ext-reg-reg/mem ((op ,(logior op #b101))) - (:name :tab reg/mem ", " 'cl))))) + (:name :tab reg/mem ", " reg ", " 'cl))))) (define-instruction shld (segment dst src amt) (:declare (type (or (member :cl) (mod 32)) amt)) @@ -3028,7 +3006,28 @@ ;;;; Instructions required to do floating point operations using SSE -(defun emit-sse-inst (segment dst src prefix opcode &key operand-size) +;; Return a two-element list of printers for SSE instructions. One +;; printer is for the format without a REX prefix, the other one for the +;; one with. +(eval-when (:compile-toplevel :execute) + (defun sse-inst-printer-list (inst-format-stem prefix opcode + &key more-fields printer) + (let ((fields `(,@(when prefix + `((prefix ,prefix))) + (op ,opcode) + ,@more-fields)) + (inst-formats (if prefix + (list (symbolicate "EXT-" inst-format-stem) + (symbolicate "EXT-REX-" inst-format-stem)) + (list inst-format-stem + (symbolicate "REX-" inst-format-stem))))) + (mapcar (lambda (inst-format) + `(,inst-format ,fields ,@(when printer + (list printer)))) + inst-formats)))) + +(defun emit-sse-inst (segment dst src prefix opcode + &key operand-size (remaining-bytes 0)) (when prefix (emit-byte segment prefix)) (if operand-size @@ -3036,7 +3035,7 @@ (maybe-emit-rex-for-ea segment src dst)) (emit-byte segment #x0f) (emit-byte segment opcode) - (emit-ea segment src (reg-tn-encoding dst))) + (emit-ea segment src (reg-tn-encoding dst) :remaining-bytes remaining-bytes)) ;; 0110 0110:0000 1111:0111 00gg: 11 010 xmmreg:imm8 @@ -3056,32 +3055,35 @@ (macrolet ((define-imm-sse-instruction (name opcode /i) `(define-instruction ,name (segment dst/src imm) - (:printer ext-rex-xmm-imm ((prefix #x66) (op ,opcode) (/i ,/i))) - (:printer ext-xmm-imm ((prefix #x66) (op ,opcode) (/i ,/i))) + (:printer-list + ',(sse-inst-printer-list 'xmm-imm #x66 opcode + :more-fields `((/i ,/i)))) (:emitter (emit-sse-inst-with-imm segment dst/src imm #x66 ,opcode ,/i :operand-size :do-not-set))))) (define-imm-sse-instruction pslldq #x73 7) - (define-imm-sse-instruction psllw #x71 6) - (define-imm-sse-instruction pslld #x72 6) - (define-imm-sse-instruction psllq #x73 6) + (define-imm-sse-instruction psllw-imm #x71 6) + (define-imm-sse-instruction pslld-imm #x72 6) + (define-imm-sse-instruction psllq-imm #x73 6) (define-imm-sse-instruction psraw-imm #x71 4) (define-imm-sse-instruction psrad-imm #x72 4) (define-imm-sse-instruction psrldq #x73 3) - (define-imm-sse-instruction psrlw #x71 2) - (define-imm-sse-instruction psrld #x72 2) - (define-imm-sse-instruction psrlq #x73 2)) + (define-imm-sse-instruction psrlw-imm #x71 2) + (define-imm-sse-instruction psrld-imm #x72 2) + (define-imm-sse-instruction psrlq-imm #x73 2)) ;;; Emit an SSE instruction that has an XMM register as the destination ;;; operand and for which the size of the operands is implicitly given ;;; by the instruction. -(defun emit-regular-sse-inst (segment dst src prefix opcode) +(defun emit-regular-sse-inst (segment dst src prefix opcode + &key (remaining-bytes 0)) (aver (xmm-register-p dst)) (emit-sse-inst segment dst src prefix opcode - :operand-size :do-not-set)) + :operand-size :do-not-set + :remaining-bytes remaining-bytes)) ;;; Instructions having an XMM register as the destination operand ;;; and an XMM register or a memory location as the source operand. @@ -3089,13 +3091,8 @@ (macrolet ((define-regular-sse-inst (name prefix opcode) `(define-instruction ,name (segment dst src) - ,@(if prefix - `((:printer ext-xmm-xmm/mem - ((prefix ,prefix) (op ,opcode))) - (:printer ext-rex-xmm-xmm/mem - ((prefix ,prefix) (op ,opcode)))) - `((:printer xmm-xmm/mem ((op ,opcode))) - (:printer rex-xmm-xmm/mem ((op ,opcode))))) + (:printer-list + ',(sse-inst-printer-list 'xmm-xmm/mem prefix opcode)) (:emitter (emit-regular-sse-inst segment dst src ,prefix ,opcode))))) ;; logical @@ -3150,10 +3147,11 @@ (define-regular-sse-inst mulps nil #x59) (define-regular-sse-inst mulsd #xf2 #x59) (define-regular-sse-inst mulss #xf3 #x59) - (define-regular-sse-inst rccps nil #x53) + (define-regular-sse-inst rcpps nil #x53) (define-regular-sse-inst rcpss #xf3 #x53) (define-regular-sse-inst rsqrtps nil #x52) (define-regular-sse-inst rsqrtss #xf3 #x52) + (define-regular-sse-inst sqrtpd #x66 #x51) (define-regular-sse-inst sqrtps nil #x51) (define-regular-sse-inst sqrtsd #xf2 #x51) (define-regular-sse-inst sqrtss #xf3 #x51) @@ -3173,7 +3171,7 @@ (define-regular-sse-inst paddsb #x66 #xec) (define-regular-sse-inst paddsw #x66 #xed) (define-regular-sse-inst paddusb #x66 #xdc) - (define-regular-sse-inst padduwb #x66 #xdd) + (define-regular-sse-inst paddusw #x66 #xdd) (define-regular-sse-inst pavgb #x66 #xe0) (define-regular-sse-inst pavgw #x66 #xe3) (define-regular-sse-inst pmaddwd #x66 #xf5) @@ -3182,14 +3180,22 @@ (define-regular-sse-inst pmullw #x66 #xd5) (define-regular-sse-inst pmuludq #x66 #xf4) (define-regular-sse-inst psadbw #x66 #xf6) + (define-regular-sse-inst psllw #x66 #xf1) + (define-regular-sse-inst pslld #x66 #xf2) + (define-regular-sse-inst psllq #x66 #xf3) (define-regular-sse-inst psraw #x66 #xe1) (define-regular-sse-inst psrad #x66 #xe2) + (define-regular-sse-inst psrlw #x66 #xd1) + (define-regular-sse-inst psrld #x66 #xd2) + (define-regular-sse-inst psrlq #x66 #xd3) (define-regular-sse-inst psubb #x66 #xf8) (define-regular-sse-inst psubw #x66 #xf9) (define-regular-sse-inst psubd #x66 #xfa) (define-regular-sse-inst psubq #x66 #xfb) - (define-regular-sse-inst psubsb #x66 #xd8) - (define-regular-sse-inst psubsw #x66 #xd9) + (define-regular-sse-inst psubsb #x66 #xe8) + (define-regular-sse-inst psubsw #x66 #xe9) + (define-regular-sse-inst psubusb #x66 #xd8) + (define-regular-sse-inst psubusw #x66 #xd9) ;; conversion (define-regular-sse-inst cvtdq2pd #xf3 #xe6) (define-regular-sse-inst cvtdq2ps nil #x5b) @@ -3201,13 +3207,10 @@ (define-regular-sse-inst cvtss2sd #xf3 #x5a) (define-regular-sse-inst cvttpd2dq #x66 #xe6) (define-regular-sse-inst cvttps2dq #xf3 #x5b) - ;; moves - (define-regular-sse-inst movntdq #x66 #xe7) - (define-regular-sse-inst movntpd #x66 #x2b) - (define-regular-sse-inst movntps nil #x2b) ;; integer (define-regular-sse-inst packsswb #x66 #x63) (define-regular-sse-inst packssdw #x66 #x6b) + (define-regular-sse-inst packuswb #x66 #x67) (define-regular-sse-inst punpckhbw #x66 #x68) (define-regular-sse-inst punpckhwd #x66 #x69) (define-regular-sse-inst punpckhdq #x66 #x6a) @@ -3217,68 +3220,63 @@ (define-regular-sse-inst punpckldq #x66 #x62) (define-regular-sse-inst punpcklqdq #x66 #x6c)) -(macrolet ((define-xmm-shuffle-sse-inst (name prefix opcode) - `(define-instruction ,name (segment dst src pattern) - ,@(if prefix - `((:printer ext-xmm-xmm/mem-imm ; suboptimal - ((prefix ,prefix) (op ,opcode))) - (:printer ext-rex-xmm-xmm/mem-imm - ((prefix ,prefix) (op ,opcode)))) - `((:printer xmm-xmm/mem-imm ((op ,opcode))) - (:printer rex-xmm-xmm/mem-imm ((op ,opcode))))) - (:emitter - (aver (typep pattern '(unsigned-byte 8))) - (emit-regular-sse-inst segment dst src ,prefix ,opcode) - (emit-byte segment pattern))))) - (define-xmm-shuffle-sse-inst pshufd #x66 #x70) - (define-xmm-shuffle-sse-inst pshufhw #xf3 #x70) - (define-xmm-shuffle-sse-inst pshuflw #xf2 #x70) - (define-xmm-shuffle-sse-inst shufpd #x66 #xc6) - (define-xmm-shuffle-sse-inst shufps nil #xc6)) +(macrolet ((define-xmm-shuffle-sse-inst (name prefix opcode n-bits radix) + (let ((shuffle-pattern + (intern (format nil "SSE-SHUFFLE-PATTERN-~D-~D" + n-bits radix)))) + `(define-instruction ,name (segment dst src pattern) + (:printer-list + ',(sse-inst-printer-list + 'xmm-xmm/mem prefix opcode + :more-fields `((imm nil :type ,shuffle-pattern)) + :printer '(:name :tab reg ", " reg/mem ", " imm))) + + (:emitter + (aver (typep pattern '(unsigned-byte ,n-bits))) + (emit-regular-sse-inst segment dst src ,prefix ,opcode + :remaining-bytes 1) + (emit-byte segment pattern)))))) + (define-xmm-shuffle-sse-inst pshufd #x66 #x70 8 4) + (define-xmm-shuffle-sse-inst pshufhw #xf3 #x70 8 4) + (define-xmm-shuffle-sse-inst pshuflw #xf2 #x70 8 4) + (define-xmm-shuffle-sse-inst shufpd #x66 #xc6 2 2) + (define-xmm-shuffle-sse-inst shufps nil #xc6 8 4)) ;; MASKMOVDQU (dst is DS:RDI) (define-instruction maskmovdqu (segment src mask) - (:printer ext-xmm-xmm/mem - ((prefix #x66) (op #xf7))) - (:printer ext-rex-xmm-xmm/mem - ((prefix #x66) (op #xf7))) + (:printer-list + (sse-inst-printer-list 'xmm-xmm/mem #x66 #xf7)) (:emitter (aver (xmm-register-p src)) (aver (xmm-register-p mask)) (emit-regular-sse-inst segment src mask #x66 #xf7))) -(macrolet ((define-xmm-comparison-sse-inst (name prefix opcode &optional name-prefix name-suffix) - (let ((printer (when name-prefix - `'(,name-prefix cc ,name-suffix :tab reg ", " reg/mem)))) - `(define-instruction ,name (segment op x y) - ,@(if prefix - `((:printer ext-xmm-xmm/mem-cmp - ((prefix ,prefix) (op ,opcode)) - ,@(and printer `(,printer))) - (:printer ext-rex-xmm-xmm/mem-cmp - ((prefix ,prefix) (op ,opcode)) - ,@(and printer `(,printer)))) - `((:printer xmm-xmm/mem-cmp ((op ,opcode)) - ,@(and printer `(,printer))) - (:printer rex-xmm-xmm/mem-cmp ((op ,opcode)) - ,@(and printer `(,printer))))) - (:emitter - (let ((code (position op *sse-conditions*))) - (aver code) - (emit-regular-sse-inst segment x y ,prefix ,opcode) - (emit-byte segment code))))))) - (define-xmm-comparison-sse-inst cmppd #x66 #xc2 "CMP" "PD") - (define-xmm-comparison-sse-inst cmpps nil #xc2 "CMP" "PS") - (define-xmm-comparison-sse-inst cmpsd #xf2 #xc2 "CMP" "SD") - (define-xmm-comparison-sse-inst cmpss #xf3 #xc2 "CMP" "SS")) +(macrolet ((define-comparison-sse-inst (name prefix opcode + name-prefix name-suffix) + `(define-instruction ,name (segment op x y) + (:printer-list + ',(sse-inst-printer-list + 'xmm-xmm/mem prefix opcode + :more-fields '((imm nil :type sse-condition-code)) + :printer `(,name-prefix imm ,name-suffix + :tab reg ", " reg/mem))) + (:emitter + (let ((code (position op *sse-conditions*))) + (aver code) + (emit-regular-sse-inst segment x y ,prefix ,opcode + :remaining-bytes 1) + (emit-byte segment code)))))) + (define-comparison-sse-inst cmppd #x66 #xc2 "CMP" "PD") + (define-comparison-sse-inst cmpps nil #xc2 "CMP" "PS") + (define-comparison-sse-inst cmpsd #xf2 #xc2 "CMP" "SD") + (define-comparison-sse-inst cmpss #xf3 #xc2 "CMP" "SS")) ;;; MOVSD, MOVSS (macrolet ((define-movsd/ss-sse-inst (name prefix) `(define-instruction ,name (segment dst src) - (:printer ext-xmm-xmm/mem-dir ((prefix ,prefix) - (op #b0001000))) - (:printer ext-rex-xmm-xmm/mem-dir ((prefix ,prefix) - (op #b0001000))) + (:printer-list + ',(sse-inst-printer-list 'xmm-xmm/mem-dir + prefix #b0001000)) (:emitter (cond ((xmm-register-p dst) (emit-sse-inst segment dst src ,prefix #x10 @@ -3299,47 +3297,42 @@ (:emitter (aver (xmm-register-p dst)) (aver (xmm-register-p src)) - (emit-regular-sse-inst segment dst src ,prefix ,opcode-from)))) + (emit-regular-sse-inst segment dst src + ,prefix ,opcode-from)))) (define-instruction ,name (segment dst src) - ,@(if prefix - `((:printer ext-xmm-xmm/mem - ((prefix ,prefix) (op ,opcode-from))) - (:printer ext-rex-xmm-xmm/mem - ((prefix ,prefix) (op ,opcode-from))) - (:printer ext-xmm-xmm/mem - ((prefix ,prefix) (op ,opcode-to)) - '(:name :tab reg/mem ", " reg)) - (:printer ext-rex-xmm-xmm/mem - ((prefix ,prefix) (op ,opcode-to)) - '(:name :tab reg/mem ", " reg))) - `((:printer xmm-xmm/mem - ((op ,opcode-from))) - (:printer rex-xmm-xmm/mem - ((op ,opcode-from))) - (:printer xmm-xmm/mem - ((op ,opcode-to)) - '(:name :tab reg/mem ", " reg)) - (:printer rex-xmm-xmm/mem - ((op ,opcode-to)) - '(:name :tab reg/mem ", " reg)))) + (:printer-list + '(,@(when opcode-from + (sse-inst-printer-list + 'xmm-xmm/mem prefix opcode-from)) + ,@(sse-inst-printer-list + 'xmm-xmm/mem prefix opcode-to + :printer '(:name :tab reg/mem ", " reg)))) (:emitter - (cond ((xmm-register-p dst) - ,(when force-to-mem - `(aver (not (or (register-p src) - (xmm-register-p src))))) - (emit-regular-sse-inst segment dst src ,prefix ,opcode-from)) + (cond ,@(when opcode-from + `(((xmm-register-p dst) + ,(when force-to-mem + `(aver (not (or (register-p src) + (xmm-register-p src))))) + (emit-regular-sse-inst + segment dst src ,prefix ,opcode-from)))) (t (aver (xmm-register-p src)) ,(when force-to-mem `(aver (not (or (register-p dst) (xmm-register-p dst))))) - (emit-regular-sse-inst segment src dst ,prefix ,opcode-to)))))))) + (emit-regular-sse-inst segment src dst + ,prefix ,opcode-to)))))))) ;; direction bit? (define-mov-sse-inst movapd #x66 #x28 #x29) (define-mov-sse-inst movaps nil #x28 #x29) (define-mov-sse-inst movdqa #x66 #x6f #x7f) (define-mov-sse-inst movdqu #xf3 #x6f #x7f) + ;; streaming + (define-mov-sse-inst movntdq #x66 nil #xe7 :force-to-mem t) + (define-mov-sse-inst movntpd #x66 nil #x2b :force-to-mem t) + (define-mov-sse-inst movntps nil nil #x2b :force-to-mem t) + ;; use movhps for movlhps and movlps for movhlps (define-mov-sse-inst movhpd #x66 #x16 #x17 :force-to-mem t) (define-mov-sse-inst movhps nil #x16 #x17 :reg-reg-name movlhps) @@ -3350,12 +3343,11 @@ ;;; MOVQ (define-instruction movq (segment dst src) - (:printer ext-xmm-xmm/mem ((prefix #xf3) (op #x7e))) - (:printer ext-rex-xmm-xmm/mem ((prefix #xf3) (op #x7e))) - (:printer ext-xmm-xmm/mem ((prefix #x66) (op #xd6)) - '(:name :tab reg/mem ", " reg)) - (:printer ext-rex-xmm-xmm/mem ((prefix #x66) (op #xd6)) - '(:name :tab reg/mem ", " reg)) + (:printer-list + (append + (sse-inst-printer-list 'xmm-xmm/mem #xf3 #x7e) + (sse-inst-printer-list 'xmm-xmm/mem #x66 #xd6 + :printer '(:name :tab reg/mem ", " reg)))) (:emitter (cond ((xmm-register-p dst) (emit-sse-inst segment dst src #xf3 #x7e @@ -3374,12 +3366,11 @@ ;;; with zero extension or vice versa. ;;; We do not support the MMX version of this instruction. (define-instruction movd (segment dst src) - (:printer ext-xmm-reg/mem ((prefix #x66) (op #x6e))) - (:printer ext-rex-xmm-reg/mem ((prefix #x66) (op #x6e))) - (:printer ext-xmm-reg/mem ((prefix #x66) (op #x7e)) - '(:name :tab reg/mem ", " reg)) - (:printer ext-rex-xmm-reg/mem ((prefix #x66) (op #x7e)) - '(:name :tab reg/mem ", " reg)) + (:printer-list + (append + (sse-inst-printer-list 'xmm-reg/mem #x66 #x6e) + (sse-inst-printer-list 'xmm-reg/mem #x66 #x7e + :printer '(:name :tab reg/mem ", " reg)))) (:emitter (cond ((xmm-register-p dst) (emit-sse-inst segment dst src #x66 #x6e)) @@ -3387,14 +3378,42 @@ (aver (xmm-register-p src)) (emit-sse-inst segment src dst #x66 #x7e))))) +(define-instruction pinsrw (segment dst src imm) + (:printer-list + (sse-inst-printer-list + 'xmm-reg/mem #x66 #xc4 + :more-fields '((imm nil :type imm-byte)) + :printer '(:name :tab reg ", " reg/mem ", " imm))) + (:emitter + (aver (xmm-register-p dst)) + (let ((src-size (operand-size src))) + (aver (or (not (register-p src)) + (eq src-size :qword) (eq src-size :dword))) + (emit-sse-inst segment dst src #x66 #xc4 + :operand-size (if (register-p src) src-size :do-not-set) + :remaining-bytes 1)) + (emit-byte segment imm))) + +(define-instruction pextrw (segment dst src imm) + (:printer-list + (sse-inst-printer-list + 'reg-xmm/mem #x66 #xc5 + :more-fields '((imm nil :type imm-byte)) + :printer '(:name :tab reg ", " reg/mem ", " imm))) + (:emitter + (aver (xmm-register-p src)) + (aver (register-p dst)) + (let ((dst-size (operand-size dst))) + (aver (or (eq dst-size :qword) (eq dst-size :dword))) + (emit-sse-inst segment dst src #x66 #xc5 + :operand-size dst-size + :remaining-bytes 1)) + (emit-byte segment imm))) + (macrolet ((define-integer-source-sse-inst (name prefix opcode &key mem-only) `(define-instruction ,name (segment dst src) - ,@(if prefix - `((:printer ext-xmm-reg/mem ((prefix ,prefix) (op ,opcode))) - (:printer ext-rex-xmm-reg/mem ((prefix ,prefix) (op ,opcode)))) - `((:printer xmm-reg/mem ((op ,opcode))) - (:printer rex-xmm-reg/mem ((op ,opcode))))) - + (:printer-list + ',(sse-inst-printer-list 'xmm-reg/mem prefix opcode)) (:emitter (aver (xmm-register-p dst)) ,(when mem-only @@ -3416,11 +3435,8 @@ (macrolet ((define-gpr-destination-sse-inst (name prefix opcode &key reg-only) `(define-instruction ,name (segment dst src) - ,@(if prefix - `((:printer ext-reg-xmm/mem ((prefix ,prefix) (op ,opcode))) - (:printer ext-rex-reg-xmm/mem ((prefix ,prefix) (op ,opcode)))) - `((:printer reg-xmm/mem ((op ,opcode))) - (:printer rex-reg-xmm/mem ((op ,opcode))))) + (:printer-list + ',(sse-inst-printer-list 'reg-xmm/mem prefix opcode)) (:emitter (aver (register-p dst)) ,(when reg-only @@ -3489,7 +3505,7 @@ (aver (eq (operand-size src) :byte)) (maybe-emit-rex-for-ea segment src nil) (emit-byte segment #x0f) - (emit-byte segment #x18) + (emit-byte segment #xae) (emit-ea segment src 7))) (macrolet ((define-fence-instruction (name last-byte)