X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Finsts.lisp;h=35f1c6e080f0d76367b7649edc0ea79fdf0ffdd9;hb=1d68d81c3022715f83faeff6ccc9836975783462;hp=0a982cd03507f9bb58cf61438a5970099506a96b;hpb=7a2a31f9407a7da9d26cf1bc91c302461823719f;p=sbcl.git diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 0a982cd..35f1c6e 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -156,7 +156,7 @@ (type sb!disassem:disassem-state dstate)) (if (typep value 'full-reg) (print-reg-with-width value width stream dstate) - (print-mem-access value (and sized-p width) stream dstate))) + (print-mem-access value width sized-p stream dstate))) ;;; Print a register or a memory reference. The width is determined by ;;; calling INST-OPERAND-SIZE. @@ -219,7 +219,7 @@ (type sb!disassem:disassem-state dstate)) (if (typep value 'xmmreg) (print-xmmreg value stream dstate) - (print-mem-access value nil stream dstate))) + (print-mem-access value nil nil stream dstate))) ;;; This prefilter is used solely for its side effects, namely to put ;;; the bits found in the REX prefix into the DSTATE for use by other @@ -750,6 +750,12 @@ :default-printer '(:name :tab reg/mem ", " imm)) (imm :type 'signed-imm-data)) + +(sb!disassem:define-instruction-format (ext-reg/mem-no-width+imm8 24 + :include 'ext-reg/mem-no-width + :default-printer + '(:name :tab reg/mem ", " imm)) + (imm :type 'imm-byte)) ;;;; XMM instructions @@ -879,7 +885,8 @@ (op :field (byte 8 8)) (reg/mem :fields (list (byte 2 22) (byte 3 16)) :type 'sized-reg/mem) - (reg :field (byte 3 19) :type 'xmmreg)) + (reg :field (byte 3 19) :type 'xmmreg) + (imm)) (sb!disassem:define-instruction-format (ext-xmm-reg/mem 32 :default-printer @@ -889,7 +896,8 @@ (op :field (byte 8 16)) (reg/mem :fields (list (byte 2 30) (byte 3 24)) :type 'sized-reg/mem) - (reg :field (byte 3 27) :type 'xmmreg)) + (reg :field (byte 3 27) :type 'xmmreg) + (imm)) (sb!disassem:define-instruction-format (ext-rex-xmm-reg/mem 40 :default-printer @@ -901,7 +909,19 @@ (op :field (byte 8 24)) (reg/mem :fields (list (byte 2 38) (byte 3 32)) :type 'sized-reg/mem) - (reg :field (byte 3 35) :type 'xmmreg)) + (reg :field (byte 3 35) :type 'xmmreg) + (imm)) + +(sb!disassem:define-instruction-format (ext-2byte-xmm-reg/mem 40 + :default-printer + '(:name :tab reg ", " reg/mem)) + (prefix :field (byte 8 0)) + (x0f :field (byte 8 8) :value #x0f) + (op1 :field (byte 8 16)) + (op2 :field (byte 8 24)) + (reg/mem :fields (list (byte 2 38) (byte 3 32)) :type 'sized-reg/mem) + (reg :field (byte 3 35) :type 'xmmreg) + (imm)) ;;; Instructions having a general-purpose register as one operand and an ;;; XMM register or a memory location as the other operand. @@ -937,6 +957,107 @@ :type 'xmmreg/mem) (reg :field (byte 3 35) :type 'reg)) +;;; Instructions having a general-purpose register or a memory location +;;; as one operand and an a XMM register as the other operand. + +(sb!disassem:define-instruction-format (ext-reg/mem-xmm 32 + :default-printer + '(:name :tab reg/mem ", " reg)) + (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 'reg/mem) + (reg :field (byte 3 27) :type 'xmmreg) + (imm)) + +(sb!disassem:define-instruction-format (ext-rex-reg/mem-xmm 40 + :default-printer + '(:name :tab reg/mem ", " reg)) + (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 'reg/mem) + (reg :field (byte 3 35) :type 'xmmreg) + (imm)) + +(sb!disassem:define-instruction-format (ext-2byte-reg/mem-xmm 40 + :default-printer + '(:name :tab reg/mem ", " reg)) + (prefix :field (byte 8 0)) + (x0f :field (byte 8 8) :value #x0f) + (op1 :field (byte 8 16)) + (op2 :field (byte 8 24)) + (reg/mem :fields (list (byte 2 38) (byte 3 32)) :type 'reg/mem) + (reg :field (byte 3 35) :type 'xmmreg) + (imm)) + +(sb!disassem:define-instruction-format (ext-rex-2byte-reg/mem-xmm 48 + :default-printer + '(:name :tab reg/mem ", " reg)) + (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) + (op1 :field (byte 8 24)) + (op2 :field (byte 8 32)) + (reg/mem :fields (list (byte 2 46) (byte 3 40)) :type 'reg/mem) + (reg :field (byte 3 43) :type 'xmmreg) + (imm)) + +;;; Instructions having a general-purpose register as one operand and an a +;;; general-purpose register or a memory location as the other operand, +;;; and using a prefix byte. + +(sb!disassem:define-instruction-format (ext-prefix-reg-reg/mem 32 + :default-printer + '(:name :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 'sized-reg/mem) + (reg :field (byte 3 27) :type 'reg)) + +(sb!disassem:define-instruction-format (ext-rex-prefix-reg-reg/mem 40 + :default-printer + '(:name :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 'sized-reg/mem) + (reg :field (byte 3 35) :type 'reg)) + +(sb!disassem:define-instruction-format (ext-2byte-prefix-reg-reg/mem 40 + :default-printer + '(:name :tab reg ", " reg/mem)) + (prefix :field (byte 8 0)) + (x0f :field (byte 8 8) :value #x0f) + (op1 :field (byte 8 16)) ; #x38 or #x3a + (op2 :field (byte 8 24)) + (reg/mem :fields (list (byte 2 38) (byte 3 32)) + :type 'sized-reg/mem) + (reg :field (byte 3 35) :type 'reg)) + +(sb!disassem:define-instruction-format (ext-rex-2byte-prefix-reg-reg/mem 48 + :default-printer + '(:name :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) + (op1 :field (byte 8 24)) ; #x38 or #x3a + (op2 :field (byte 8 32)) + (reg/mem :fields (list (byte 2 46) (byte 3 40)) + :type 'sized-reg/mem) + (reg :field (byte 3 43) :type 'reg)) + ;; XMM comparison instruction (eval-when (:compile-toplevel :load-toplevel :execute) @@ -1024,6 +1145,36 @@ (op :field (byte 16 0)) (code :field (byte 8 16))) +;;; F3 escape map - Needs a ton more work. + +(sb!disassem:define-instruction-format (F3-escape 24) + (prefix1 :field (byte 8 0) :value #xF3) + (prefix2 :field (byte 8 8) :value #x0F) + (op :field (byte 8 16))) + +(sb!disassem:define-instruction-format (rex-F3-escape 32) + ;; F3 is a legacy prefix which was generalized to select an alternate opcode + ;; map. Legacy prefixes are encoded in the instruction before a REX prefix. + (prefix1 :field (byte 8 0) :value #xF3) + (rex :field (byte 4 12) :value 4) ; "prefix2" + (wrxb :field (byte 4 8) :type 'wrxb) + (prefix3 :field (byte 8 16) :value #x0F) + (op :field (byte 8 24))) + +(sb!disassem:define-instruction-format (F3-escape-reg-reg/mem 32 + :include 'F3-escape + :default-printer + '(:name :tab reg "," reg/mem)) + (reg/mem :fields (list (byte 2 30) (byte 3 24)) :type 'sized-reg/mem) + (reg :field (byte 3 27) :type 'reg)) + +(sb!disassem:define-instruction-format (rex-F3-escape-reg-reg/mem 40 + :include 'rex-F3-escape + :default-printer + '(:name :tab reg "," reg/mem)) + (reg/mem :fields (list (byte 2 38) (byte 3 32)) :type 'sized-reg/mem) + (reg :field (byte 3 35) :type 'reg)) + ;;;; primitive emitters @@ -1433,6 +1584,9 @@ ;; FIXME: might as well be COND instead of having to use #. readmacro ;; to hack up the code (case (sc-name (tn-sc thing)) + #!+sb-simd-pack + (#.*oword-sc-names* + :oword) (#.*qword-sc-names* :qword) (#.*dword-sc-names* @@ -2206,7 +2360,8 @@ (eval-when (:compile-toplevel :execute) (defun double-shift-inst-printer-list (op) `((ext-reg-reg/mem-no-width ((op ,(logior op #b100)) - (imm nil :type imm-byte))) + (imm nil :type imm-byte)) + (:name :tab reg/mem ", " reg ", " imm)) (ext-reg-reg/mem-no-width ((op ,(logior op #b101))) (:name :tab reg/mem ", " reg ", " 'cl))))) @@ -2416,33 +2571,20 @@ (eval-when (:compile-toplevel :execute) (defun bit-test-inst-printer-list (subop) - `((ext-reg/mem-imm ((op (#b1011101 ,subop)) - (reg/mem nil :type reg/mem) - (imm nil :type imm-byte) - (width 0))) - (ext-reg-reg/mem ((op ,(dpb subop (byte 3 2) #b1000001)) - (width 1)) - (:name :tab reg/mem ", " reg))))) - -(define-instruction bt (segment src index) - (:printer-list (bit-test-inst-printer-list #b100)) - (:emitter - (emit-bit-test-and-mumble segment src index #b100))) - -(define-instruction btc (segment src index) - (:printer-list (bit-test-inst-printer-list #b111)) - (:emitter - (emit-bit-test-and-mumble segment src index #b111))) - -(define-instruction btr (segment src index) - (:printer-list (bit-test-inst-printer-list #b110)) - (:emitter - (emit-bit-test-and-mumble segment src index #b110))) - -(define-instruction bts (segment src index) - (:printer-list (bit-test-inst-printer-list #b101)) - (:emitter - (emit-bit-test-and-mumble segment src index #b101))) + `((ext-reg/mem-no-width+imm8 ((op (#xBA ,subop)))) + (ext-reg-reg/mem-no-width ((op ,(dpb subop (byte 3 3) #b10000011)) + (reg/mem nil :type sized-reg/mem)) + (:name :tab reg/mem ", " reg))))) + +(macrolet ((define (inst opcode-extension) + `(define-instruction ,inst (segment src index) + (:printer-list (bit-test-inst-printer-list ,opcode-extension)) + (:emitter (emit-bit-test-and-mumble segment src index + ,opcode-extension))))) + (define bt 4) + (define bts 5) + (define btr 6) + (define btc 7)) ;;;; control transfer @@ -2910,6 +3052,10 @@ ',(sse-inst-printer-list 'xmm-xmm/mem prefix opcode)) (:emitter (emit-regular-sse-inst segment dst src ,prefix ,opcode))))) + ;; moves + (define-regular-sse-inst movshdup #xf3 #x16) + (define-regular-sse-inst movsldup #xf3 #x12) + (define-regular-sse-inst movddup #xf2 #x12) ;; logical (define-regular-sse-inst andpd #x66 #x54) (define-regular-sse-inst andps nil #x54) @@ -2954,10 +3100,16 @@ (define-regular-sse-inst addps nil #x58) (define-regular-sse-inst addsd #xf2 #x58) (define-regular-sse-inst addss #xf3 #x58) + (define-regular-sse-inst addsubpd #x66 #xd0) + (define-regular-sse-inst addsubps #xf2 #xd0) (define-regular-sse-inst divpd #x66 #x5e) (define-regular-sse-inst divps nil #x5e) (define-regular-sse-inst divsd #xf2 #x5e) (define-regular-sse-inst divss #xf3 #x5e) + (define-regular-sse-inst haddpd #x66 #x7c) + (define-regular-sse-inst haddps #xf2 #x7c) + (define-regular-sse-inst hsubpd #x66 #x7d) + (define-regular-sse-inst hsubps #xf2 #x7d) (define-regular-sse-inst mulpd #x66 #x59) (define-regular-sse-inst mulps nil #x59) (define-regular-sse-inst mulsd #xf2 #x59) @@ -3156,6 +3308,15 @@ (define-mov-sse-inst movupd #x66 #x10 #x11) (define-mov-sse-inst movups nil #x10 #x11)) +;;; MOVNTDQA +(define-instruction movntdqa (segment dst src) + (:printer-list + (2byte-sse-inst-printer-list '2byte-xmm-xmm/mem #x66 #x38 #x2a)) + (:emitter + (aver (and (xmm-register-p dst) + (not (xmm-register-p src)))) + (emit-regular-2byte-sse-inst segment dst src #x66 #x38 #x2a))) + ;;; MOVQ (define-instruction movq (segment dst src) (:printer-list @@ -3193,36 +3354,87 @@ (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))) +(macrolet ((define-extract-sse-instruction (name prefix op1 op2 &key explicit-qword) + `(define-instruction ,name (segment dst src imm) + (:printer + ,(if op2 (if explicit-qword + 'ext-rex-2byte-reg/mem-xmm + 'ext-2byte-reg/mem-xmm) + 'ext-reg/mem-xmm) + ((prefix '(,prefix)) + ,@(if op2 + `((op1 '(,op1)) (op2 '(,op2))) + `((op '(,op1)))) + (imm nil :type 'imm-byte)) + '(:name :tab reg/mem ", " reg ", " imm)) + (:emitter + (aver (and (xmm-register-p src) (not (xmm-register-p dst)))) + ,(if op2 + `(emit-sse-inst-2byte segment dst src ,prefix ,op1 ,op2 + :operand-size ,(if explicit-qword + :qword + :do-not-set) + :remaining-bytes 1) + `(emit-sse-inst segment dst src ,prefix ,op1 + :operand-size ,(if explicit-qword + :qword + :do-not-set) + :remaining-bytes 1)) + (emit-byte segment imm)))) + + (define-insert-sse-instruction (name prefix op1 op2) + `(define-instruction ,name (segment dst src imm) + (:printer + ,(if op2 'ext-2byte-xmm-reg/mem 'ext-xmm-reg/mem) + ((prefix '(,prefix)) + ,@(if op2 + `((op1 '(,op1)) (op2 '(,op2))) + `((op '(,op1)))) + (imm nil :type 'imm-byte)) + '(:name :tab reg ", " reg/mem ", " imm)) + (:emitter + (aver (and (xmm-register-p dst) (not (xmm-register-p src)))) + ,(if op2 + `(emit-sse-inst-2byte segment dst src ,prefix ,op1 ,op2 + :operand-size :do-not-set + :remaining-bytes 1) + `(emit-sse-inst segment dst src ,prefix ,op1 + :operand-size :do-not-set + :remaining-bytes 1)) + (emit-byte segment imm))))) + + + ;; pinsrq not encodable in 64-bit mode + (define-insert-sse-instruction pinsrb #x66 #x3a #x20) + (define-insert-sse-instruction pinsrw #x66 #xc4 nil) + (define-insert-sse-instruction pinsrd #x66 #x3a #x22) + (define-insert-sse-instruction insertps #x66 #x3a #x21) + + (define-extract-sse-instruction pextrb #x66 #x3a #x14) + (define-extract-sse-instruction pextrd #x66 #x3a #x16) + (define-extract-sse-instruction pextrq #x66 #x3a #x16 :explicit-qword t) + (define-extract-sse-instruction extractps #x66 #x3a #x17)) +;; PEXTRW has a new 2-byte encoding in SSE4.1 to allow dst to be +;; a memory address. (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))) + (append + (2byte-sse-inst-printer-list '2byte-reg/mem-xmm #x66 #x3a #x15 + :more-fields '((imm nil :type imm-byte)) + :printer + '(:name :tab reg/mem ", " reg ", " imm)) + (sse-inst-printer-list 'reg/mem-xmm #x66 #xc5 + :more-fields '((imm nil :type imm-byte)) + :printer + '(:name :tab reg/mem ", " reg ", " 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)) + (if (not (register-p dst)) + (emit-sse-inst-2byte segment dst src #x66 #x3a #x15 + :operand-size :do-not-set :remaining-bytes 1) + (emit-sse-inst segment dst src #x66 #xc5 + :operand-size :do-not-set :remaining-bytes 1)) (emit-byte segment imm))) (macrolet ((define-integer-source-sse-inst (name prefix opcode &key mem-only) @@ -3304,9 +3516,6 @@ (regular-2byte-sse-inst psignd #x66 #x38 #x0a) (regular-2byte-sse-inst pmulhrsw #x66 #x38 #x0b) - (regular-2byte-sse-inst pblendvb #x66 #x38 #x10) - (regular-2byte-sse-inst blendvps #x66 #x38 #x14) - (regular-2byte-sse-inst blendvpd #x66 #x38 #x15) (regular-2byte-sse-inst ptest #x66 #x38 #x17) (regular-2byte-sse-inst pabsb #x66 #x38 #x1c) (regular-2byte-sse-inst pabsw #x66 #x38 #x1d) @@ -3335,6 +3544,20 @@ (regular-2byte-sse-inst aesdec #x66 #x38 #xde) (regular-2byte-sse-inst aesdeclast #x66 #x38 #xdf) + (regular-2byte-sse-inst pmovsxbw #x66 #x38 #x20) + (regular-2byte-sse-inst pmovsxbd #x66 #x38 #x21) + (regular-2byte-sse-inst pmovsxbq #x66 #x38 #x22) + (regular-2byte-sse-inst pmovsxwd #x66 #x38 #x23) + (regular-2byte-sse-inst pmovsxwq #x66 #x38 #x24) + (regular-2byte-sse-inst pmovsxdq #x66 #x38 #x25) + + (regular-2byte-sse-inst pmovzxbw #x66 #x38 #x30) + (regular-2byte-sse-inst pmovzxbd #x66 #x38 #x31) + (regular-2byte-sse-inst pmovzxbq #x66 #x38 #x32) + (regular-2byte-sse-inst pmovzxwd #x66 #x38 #x33) + (regular-2byte-sse-inst pmovzxwq #x66 #x38 #x34) + (regular-2byte-sse-inst pmovzxdq #x66 #x38 #x35) + (regular-2byte-sse-inst-imm roundps #x66 #x3a #x08) (regular-2byte-sse-inst-imm roundpd #x66 #x3a #x09) (regular-2byte-sse-inst-imm roundss #x66 #x3a #x0a) @@ -3343,6 +3566,8 @@ (regular-2byte-sse-inst-imm blendpd #x66 #x3a #x0d) (regular-2byte-sse-inst-imm pblendw #x66 #x3a #x0e) (regular-2byte-sse-inst-imm palignr #x66 #x3a #x0f) + (regular-2byte-sse-inst-imm dpps #x66 #x3a #x40) + (regular-2byte-sse-inst-imm dppd #x66 #x3a #x41) (regular-2byte-sse-inst-imm mpsadbw #x66 #x3a #x42) (regular-2byte-sse-inst-imm pclmulqdq #x66 #x3a #x44) @@ -3356,6 +3581,22 @@ ;;; Other SSE instructions +;; Instructions implicitly using XMM0 as a mask +(macrolet ((define-sse-inst-implicit-mask (name prefix op1 op2) + `(define-instruction ,name (segment dst src mask) + (:printer-list + ',(2byte-sse-inst-printer-list + '2byte-xmm-xmm/mem prefix op1 op2 + :printer '(:name :tab reg ", " reg/mem ", XMM0"))) + (:emitter + (aver (xmm-register-p dst)) + (aver (and (xmm-register-p mask) (= (tn-offset mask) 0))) + (emit-regular-2byte-sse-inst segment dst src ,prefix ,op1 ,op2))))) + + (define-sse-inst-implicit-mask pblendvb #x66 #x38 #x10) + (define-sse-inst-implicit-mask blendvps #x66 #x38 #x14) + (define-sse-inst-implicit-mask blendvpd #x66 #x38 #x15)) + ;; FIXME: is that right!? (define-instruction movnti (segment dst src) (:printer ext-reg-reg/mem-no-width ((op #xc3))) @@ -3438,6 +3679,32 @@ (emit-byte segment #xae) (emit-ea segment dst 3))) +(define-instruction popcnt (segment dst src) + (:printer-list `((f3-escape-reg-reg/mem ((op #xB8))) + (rex-f3-escape-reg-reg/mem ((op #xB8))))) + (:emitter + (aver (register-p dst)) + (aver (and (register-p dst) (not (eq (operand-size dst) :byte)))) + (aver (not (eq (operand-size src) :byte))) + (emit-sse-inst segment dst src #xf3 #xb8))) + +(define-instruction crc32 (segment dst src) + (:printer-list + `(,@(mapcan (lambda (op2) + (mapcar (lambda (instfmt) + `(,instfmt ((prefix (#xf2)) (op1 (#x38)) + (op2 (,op2))))) + '(ext-rex-2byte-prefix-reg-reg/mem + ext-2byte-prefix-reg-reg/mem))) + '(#xf0 #xf1)))) + (:emitter + (let ((dst-size (operand-size dst))) + (aver (and (register-p dst) (not (or (eq dst-size :word) + (eq dst-size :byte))))) + (if (eq (operand-size src) :byte) + (emit-sse-inst-2byte segment dst src #xf2 #x38 #xf0) + (emit-sse-inst-2byte segment dst src #xf2 #x38 #xf1))))) + ;;;; Miscellany (define-instruction cpuid (segment) @@ -3466,7 +3733,13 @@ ((complex single-float) (setf constant (list :complex-single-float first))) ((complex double-float) - (setf constant (list :complex-double-float first))))) + (setf constant (list :complex-double-float first))) + #!+sb-simd-pack + (#+sb-xc-host nil + #-sb-xc-host simd-pack + (setf constant (list :sse (logior (%simd-pack-low first) + (ash (%simd-pack-high first) + 64))))))) (destructuring-bind (type value) constant (ecase type ((:byte :word :dword :qword)