X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Finsts.lisp;h=35f1c6e080f0d76367b7649edc0ea79fdf0ffdd9;hb=1d68d81c3022715f83faeff6ccc9836975783462;hp=75cf555dc280e52ae0f3cacb4cbf6b0899a5a82d;hpb=f866d5d986cc920a8823549df5045b8182e7d92d;p=sbcl.git diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 75cf555..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,17 +219,7 @@ (type sb!disassem:disassem-state dstate)) (if (typep value 'xmmreg) (print-xmmreg value stream dstate) - (print-mem-access value nil stream dstate))) - -;; Same as print-xmmreg/mem, but prints an explicit size indicator for -;; memory references. -(defun print-sized-xmmreg/mem (value stream dstate) - (declare (type (or list xmmreg) value) - (type stream stream) - (type sb!disassem:disassem-state dstate)) - (if (typep value 'xmmreg) - (print-xmmreg value stream dstate) - (print-mem-access value (inst-operand-size dstate) 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 @@ -482,14 +472,14 @@ :prefilter #'prefilter-reg-r :printer #'print-xmmreg) +(sb!disassem:define-arg-type xmmreg-b + :prefilter #'prefilter-reg-b + :printer #'print-xmmreg) + (sb!disassem:define-arg-type xmmreg/mem :prefilter #'prefilter-reg/mem :printer #'print-xmmreg/mem) -(sb!disassem:define-arg-type sized-xmmreg/mem - :prefilter #'prefilter-reg/mem - :printer #'print-sized-xmmreg/mem) - (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *conditions* @@ -517,6 +507,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) @@ -546,6 +550,19 @@ :default-printer '(:name)) (op :fields (list (byte 8 0) (byte 8 8)))) +(sb!disassem:define-instruction-format (three-bytes 24 + :default-printer '(:name)) + (op :fields (list (byte 8 0) (byte 8 8) (byte 8 16)))) + +;;; Prefix instructions + +(sb!disassem:define-instruction-format (rex 8) + (rex :field (byte 4 4) :value #b0100) + (wrxb :field (byte 4 0) :type 'wrxb)) + +(sb!disassem:define-instruction-format (x66 8) + (x66 :field (byte 8 0) :type 'x66 :value #x66)) + ;;; A one-byte instruction with a #x66 prefix, used to indicate an ;;; operand size of :word. (sb!disassem:define-instruction-format (x66-byte 16 @@ -568,15 +585,6 @@ (accum :type 'accum) (imm)) -(sb!disassem:define-instruction-format (rex-simple 16) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (op :field (byte 7 9)) - (width :field (byte 1 8) :type 'width) - ;; optional fields - (accum :type 'accum) - (imm)) - ;;; Same as simple, but with direction bit (sb!disassem:define-instruction-format (simple-dir 8 :include 'simple) (op :field (byte 6 2)) @@ -590,12 +598,6 @@ :tab accum ", " imm)) (imm :type 'signed-imm-data)) -(sb!disassem:define-instruction-format (rex-accum-imm 16 - :include 'rex-simple - :default-printer '(:name - :tab accum ", " imm)) - (imm :type 'signed-imm-data)) - (sb!disassem:define-instruction-format (reg-no-width 8 :default-printer '(:name :tab reg)) (op :field (byte 5 3)) @@ -604,28 +606,12 @@ (accum :type 'accum) (imm)) -(sb!disassem:define-instruction-format (rex-reg-no-width 16 - :default-printer '(:name :tab reg)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (op :field (byte 5 11)) - (reg :field (byte 3 8) :type 'reg-b) - ;; optional fields - (accum :type 'accum) - (imm)) - ;;; Same as reg-no-width, but with a default operand size of :qword. (sb!disassem:define-instruction-format (reg-no-width-default-qword 8 :include 'reg-no-width :default-printer '(:name :tab reg)) (reg :type 'reg-b-default-qword)) -;;; Same as rex-reg-no-width, but with a default operand size of :qword. -(sb!disassem:define-instruction-format (rex-reg-no-width-default-qword 16 - :include 'rex-reg-no-width - :default-printer '(:name :tab reg)) - (reg :type 'reg-b-default-qword)) - ;;; Adds a width field to reg-no-width. Note that we can't use ;;; :INCLUDE 'REG-NO-WIDTH here to save typing because that would put ;;; the WIDTH field last, but the prefilter for WIDTH must run before @@ -665,19 +651,6 @@ ;; optional fields (imm)) -(sb!disassem:define-instruction-format (rex-reg-reg/mem 24 - :default-printer - `(:name :tab reg ", " reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (width :field (byte 1 8) :type 'width) - (op :field (byte 7 9)) - (reg/mem :fields (list (byte 2 22) (byte 3 16)) - :type 'reg/mem) - (reg :field (byte 3 19) :type 'reg) - ;; optional fields - (imm)) - ;;; same as reg-reg/mem, but with direction bit (sb!disassem:define-instruction-format (reg-reg/mem-dir 16 :include 'reg-reg/mem @@ -688,43 +661,6 @@ (op :field (byte 6 2)) (dir :field (byte 1 1))) -(sb!disassem:define-instruction-format (rex-reg-reg/mem-dir 24 - :include 'rex-reg-reg/mem - :default-printer - `(:name - :tab - ,(swap-if 'dir 'reg/mem ", " 'reg))) - (op :field (byte 6 10)) - (dir :field (byte 1 9))) - -(sb!disassem:define-instruction-format (x66-reg-reg/mem-dir 24 - :default-printer - `(:name - :tab - ,(swap-if 'dir 'reg/mem ", " 'reg))) - (x66 :field (byte 8 0) :type 'x66 :value #x66) - (op :field (byte 6 10)) - (dir :field (byte 1 9)) - (width :field (byte 1 8) :type 'width) - (reg/mem :fields (list (byte 2 22) (byte 3 16)) - :type 'reg/mem) - (reg :field (byte 3 19) :type 'reg)) - -(sb!disassem:define-instruction-format (x66-rex-reg-reg/mem-dir 32 - :default-printer - `(:name - :tab - ,(swap-if 'dir 'reg/mem ", " 'reg))) - (x66 :field (byte 8 0) :type 'x66 :value #x66) - (rex :field (byte 4 12) :value #b0100) - (wrxb :field (byte 4 8) :type 'wrxb) - (op :field (byte 6 18)) - (dir :field (byte 1 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)) - ;;; Same as reg-reg/mem, but uses the reg field as a second op code. (sb!disassem:define-instruction-format (reg/mem 16 :default-printer '(:name :tab reg/mem)) @@ -735,17 +671,6 @@ ;; optional fields (imm)) -(sb!disassem:define-instruction-format (rex-reg/mem 24 - :default-printer '(:name :tab reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (op :fields (list (byte 7 9) (byte 3 19))) - (width :field (byte 1 8) :type 'width) - (reg/mem :fields (list (byte 2 22) (byte 3 16)) - :type 'sized-reg/mem) - ;; optional fields - (imm)) - ;;; Same as reg/mem, but without a width field and with a default ;;; operand size of :qword. (sb!disassem:define-instruction-format (reg/mem-default-qword 16 @@ -754,14 +679,6 @@ (reg/mem :fields (list (byte 2 14) (byte 3 8)) :type 'sized-reg/mem-default-qword)) -(sb!disassem:define-instruction-format (rex-reg/mem-default-qword 24 - :default-printer '(:name :tab reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (op :fields (list (byte 8 8) (byte 3 19))) - (reg/mem :fields (list (byte 2 22) (byte 3 16)) - :type 'sized-reg/mem-default-qword)) - ;;; Same as reg/mem, but with the immediate value occurring by default, ;;; and with an appropiate printer. (sb!disassem:define-instruction-format (reg/mem-imm 16 @@ -771,13 +688,6 @@ (reg/mem :type 'sized-reg/mem) (imm :type 'signed-imm-data)) -(sb!disassem:define-instruction-format (rex-reg/mem-imm 24 - :include 'rex-reg/mem - :default-printer - '(:name :tab reg/mem ", " imm)) - (reg/mem :type 'sized-reg/mem) - (imm :type 'signed-imm-data)) - ;;; Same as reg/mem, but with using the accumulator in the default printer (sb!disassem:define-instruction-format (accum-reg/mem 16 @@ -785,13 +695,6 @@ (reg/mem :type 'reg/mem) ; don't need a size (accum :type 'accum)) -(sb!disassem:define-instruction-format (rex-accum-reg/mem 24 - :include 'rex-reg/mem - :default-printer - '(:name :tab accum ", " reg/mem)) - (reg/mem :type 'reg/mem) ; don't need a size - (accum :type 'accum)) - ;;; Same as reg-reg/mem, but with a prefix of #b00001111 (sb!disassem:define-instruction-format (ext-reg-reg/mem 24 :default-printer @@ -812,18 +715,17 @@ (op :field (byte 8 8)) (reg/mem :fields (list (byte 2 22) (byte 3 16)) :type 'reg/mem) - (reg :field (byte 3 19) :type 'reg)) + (reg :field (byte 3 19) :type 'reg) + ;; optional fields + (imm)) -(sb!disassem:define-instruction-format (rex-ext-reg-reg/mem-no-width 32 +(sb!disassem:define-instruction-format (ext-reg/mem-no-width 24 :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 8 16)) - (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'reg/mem) - (reg :field (byte 3 27) :type 'reg)) + `(:name :tab reg/mem)) + (prefix :field (byte 8 0) :value #b00001111) + (op :fields (list (byte 8 8) (byte 3 19))) + (reg/mem :fields (list (byte 2 22) (byte 3 16)) + :type 'reg/mem)) ;;; reg-no-width with #x0f prefix (sb!disassem:define-instruction-format (ext-reg-no-width 16 @@ -848,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 @@ -866,18 +774,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)) - -(sb!disassem:define-instruction-format (rex-xmm-xmm/mem 32 - :default-printer - '(:name :tab reg ", " reg/mem)) - (x0f :field (byte 8 0) :value #x0f) - (rex :field (byte 4 12) :value #b0100) - (wrxb :field (byte 4 8) :type 'wrxb) - (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 19) :type 'xmmreg) + ;; optional fields + (imm)) (sb!disassem:define-instruction-format (ext-xmm-xmm/mem 32 :default-printer @@ -887,7 +786,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 @@ -899,8 +799,33 @@ (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)) + +(sb!disassem:define-instruction-format (ext-2byte-xmm-xmm/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 'xmmreg/mem) (reg :field (byte 3 35) :type 'xmmreg)) +(sb!disassem:define-instruction-format (ext-rex-2byte-xmm-xmm/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 'xmmreg/mem) + (reg :field (byte 3 43) :type 'xmmreg)) + ;;; Same as xmm-xmm/mem etc., but with direction bit. (sb!disassem:define-instruction-format (ext-xmm-xmm/mem-dir 32 @@ -921,9 +846,48 @@ (op :field (byte 7 25)) (dir :field (byte 1 24))) +;;; Instructions having an XMM register as one operand +;;; and a constant (unsigned) byte as the other. + +(sb!disassem:define-instruction-format (ext-xmm-imm 32 + :default-printer + '(:name :tab reg/mem ", " imm)) + (prefix :field (byte 8 0)) + (x0f :field (byte 8 8) :value #x0f) + (op :field (byte 8 16)) + (/i :field (byte 3 27)) + (b11 :field (byte 2 30) :value #b11) + (reg/mem :field (byte 3 24) + :type 'xmmreg-b) + (imm :type 'imm-byte)) + +(sb!disassem:define-instruction-format (ext-rex-xmm-imm 40 + :default-printer + '(:name :tab 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)) + (/i :field (byte 3 35)) + (b11 :field (byte 2 38) :value #b11) + (reg/mem :field (byte 3 32) + :type 'xmmreg-b) + (imm :type 'imm-byte)) + ;;; Instructions having an XMM register as one operand and a general- ;;; -purpose register or a memory location as the other operand. +(sb!disassem:define-instruction-format (xmm-reg/mem 24 + :default-printer + '(:name :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 'sized-reg/mem) + (reg :field (byte 3 19) :type 'xmmreg) + (imm)) + (sb!disassem:define-instruction-format (ext-xmm-reg/mem 32 :default-printer '(:name :tab reg ", " reg/mem)) @@ -932,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 @@ -944,11 +909,32 @@ (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. +(sb!disassem:define-instruction-format (reg-xmm/mem 24 + :default-printer + '(:name :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 'reg)) + (sb!disassem:define-instruction-format (ext-reg-xmm/mem 32 :default-printer '(:name :tab reg ", " reg/mem)) @@ -956,7 +942,7 @@ (x0f :field (byte 8 8) :value #x0f) (op :field (byte 8 16)) (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'sized-xmmreg/mem) + :type 'xmmreg/mem) (reg :field (byte 3 27) :type 'reg)) (sb!disassem:define-instruction-format (ext-rex-reg-xmm/mem 40 @@ -968,17 +954,124 @@ (x0f :field (byte 8 16) :value #x0f) (op :field (byte 8 24)) (reg/mem :fields (list (byte 2 38) (byte 3 32)) - :type 'sized-xmmreg/mem) + :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) + (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 (string-op 8 :include 'simple :default-printer '(:name width))) -(sb!disassem:define-instruction-format (rex-string-op 16 - :include 'rex-simple - :default-printer '(:name width))) - (sb!disassem:define-instruction-format (short-cond-jump 16) (op :field (byte 4 4)) (cc :field (byte 4 0) :type 'condition-code) @@ -1030,18 +1123,6 @@ :type 'reg/mem) (reg :field (byte 3 19) :type 'reg)) -(sb!disassem:define-instruction-format (rex-cond-move 32 - :default-printer - '('cmov cc :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 4 20) :value #b0100) - (cc :field (byte 4 16) :type 'condition-code) - (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'reg/mem) - (reg :field (byte 3 27) :type 'reg)) - (sb!disassem:define-instruction-format (enter-format 32 :default-printer '(:name :tab disp @@ -1064,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 @@ -1181,7 +1292,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 @@ -1210,21 +1321,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 @@ -1234,7 +1347,7 @@ (emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing))) (stack ;; Convert stack tns into an index off RBP. - (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes)))) + (let ((disp (frame-byte-offset (tn-offset thing)))) (cond ((<= -128 disp 127) (emit-mod-reg-r/m-byte segment #b01 reg #b101) (emit-byte segment disp)) @@ -1246,7 +1359,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)) @@ -1263,6 +1376,13 @@ (r/m (cond (index #b100) ((null base) #b101) (t (reg-tn-encoding base))))) + (when (and (fixup-p disp) + (label-p (fixup-offset disp))) + (aver (null base)) + (aver (null index)) + (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)) @@ -1288,7 +1408,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) @@ -1464,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* @@ -1484,6 +1607,8 @@ :float) (#.*double-sc-names* :double) + (#.*complex-sc-names* + :complex) (t (error "can't tell the size of ~S ~S" thing (sc-name (tn-sc thing)))))) (ea @@ -1529,6 +1654,45 @@ (:qword (emit-signed-dword segment value)))) +;;;; prefixes + +(define-instruction rex (segment) + (:printer rex () nil :print-name nil) + (:emitter + (bug "REX prefix used as a standalone instruction"))) + +(define-instruction x66 (segment) + (:printer x66 () nil :print-name nil) + (:emitter + (bug "#X66 prefix used as a standalone instruction"))) + +(defun emit-prefix (segment name) + (declare (ignorable segment)) + (ecase name + ((nil)) + (:lock + #!+sb-thread + (emit-byte segment #xf0)))) + +(define-instruction lock (segment) + (:printer byte ((op #b11110000)) nil) + (:emitter + (bug "LOCK prefix used as a standalone instruction"))) + +(define-instruction rep (segment) + (:emitter + (emit-byte segment #b11110011))) + +(define-instruction repe (segment) + (:printer byte ((op #b11110011)) nil) + (:emitter + (emit-byte segment #b11110011))) + +(define-instruction repne (segment) + (:printer byte ((op #b11110010)) nil) + (:emitter + (emit-byte segment #b11110010))) + ;;;; general data transfer ;;; This is the part of the MOV instruction emitter that does moving @@ -1582,12 +1746,8 @@ `(:name :tab ,(swap-if 'dir 'accum ", " '("[" imm "]")))) ;; register to/from register/memory (:printer reg-reg/mem-dir ((op #b100010))) - (:printer rex-reg-reg/mem-dir ((op #b100010))) - (:printer x66-reg-reg/mem-dir ((op #b100010))) - (:printer x66-rex-reg-reg/mem-dir ((op #b100010))) ;; immediate to register/memory (:printer reg/mem-imm ((op '(#b1100011 #b000)))) - (:printer rex-reg/mem-imm ((op '(#b1100011 #b000)))) (:emitter (let ((size (matching-operand-size dst src))) @@ -1611,7 +1771,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 @@ -1641,65 +1801,56 @@ (t (error "bogus arguments to MOV: ~S ~S" dst src)))))) +;;; Emit a sign-extending (if SIGNED-P is true) or zero-extending move. +;;; To achieve the shortest possible encoding zero extensions into a +;;; 64-bit destination are assembled as a straight 32-bit MOV (if the +;;; source size is 32 bits) or as MOVZX with a 32-bit destination (if +;;; the source size is 8 or 16 bits). Due to the implicit zero extension +;;; to 64 bits this has the same effect as a MOVZX with 64-bit +;;; destination but often needs no REX prefix. (defun emit-move-with-extension (segment dst src signed-p) (aver (register-p dst)) (let ((dst-size (operand-size dst)) (src-size (operand-size src)) - (opcode (if signed-p #b10111110 #b10110110))) - (ecase dst-size - (:word - (aver (eq src-size :byte)) - (maybe-emit-operand-size-prefix segment :word) - ;; REX prefix is needed if SRC is SIL, DIL, SPL or BPL. - (maybe-emit-rex-for-ea segment src dst :operand-size :word) - (emit-byte segment #b00001111) - (emit-byte segment opcode) - (emit-ea segment src (reg-tn-encoding dst))) - ((:dword :qword) - (ecase src-size - (:byte - (maybe-emit-rex-for-ea segment src dst :operand-size dst-size) - (emit-byte segment #b00001111) - (emit-byte segment opcode) - (emit-ea segment src (reg-tn-encoding dst))) - (:word - (maybe-emit-rex-for-ea segment src dst :operand-size dst-size) - (emit-byte segment #b00001111) - (emit-byte segment (logior opcode 1)) - (emit-ea segment src (reg-tn-encoding dst))) - (:dword - (aver (eq dst-size :qword)) - ;; dst is in reg, src is in modrm - (let ((ea-p (ea-p src))) - (maybe-emit-rex-prefix segment (if signed-p :qword :dword) dst - (and ea-p (ea-index src)) - (cond (ea-p (ea-base src)) - ((tn-p src) src) - (t nil))) - (emit-byte segment #x63) ;movsxd - ;;(emit-byte segment opcode) - (emit-ea segment src (reg-tn-encoding dst))))))))) + (opcode (if signed-p #b10111110 #b10110110))) + (macrolet ((emitter (operand-size &rest bytes) + `(progn + (maybe-emit-rex-for-ea segment src dst + :operand-size ,operand-size) + ,@(mapcar (lambda (byte) + `(emit-byte segment ,byte)) + bytes) + (emit-ea segment src (reg-tn-encoding dst))))) + (ecase dst-size + (:word + (aver (eq src-size :byte)) + (maybe-emit-operand-size-prefix segment :word) + (emitter :word #b00001111 opcode)) + ((:dword :qword) + (unless signed-p + (setf dst-size :dword)) + (ecase src-size + (:byte + (emitter dst-size #b00001111 opcode)) + (:word + (emitter dst-size #b00001111 (logior opcode 1))) + (:dword + (aver (or (not signed-p) (eq dst-size :qword))) + (emitter dst-size + (if signed-p #x63 #x8b))))))))) ; movsxd or straight mov (define-instruction movsx (segment dst src) (:printer ext-reg-reg/mem-no-width ((op #b10111110) (reg/mem nil :type 'sized-byte-reg/mem))) - (:printer rex-ext-reg-reg/mem-no-width - ((op #b10111110) (reg/mem nil :type 'sized-byte-reg/mem))) (:printer ext-reg-reg/mem-no-width ((op #b10111111) (reg/mem nil :type 'sized-word-reg/mem))) - (:printer rex-ext-reg-reg/mem-no-width - ((op #b10111111) (reg/mem nil :type 'sized-word-reg/mem))) (:emitter (emit-move-with-extension segment dst src :signed))) (define-instruction movzx (segment dst src) (:printer ext-reg-reg/mem-no-width ((op #b10110110) (reg/mem nil :type 'sized-byte-reg/mem))) - (:printer rex-ext-reg-reg/mem-no-width - ((op #b10110110) (reg/mem nil :type 'sized-byte-reg/mem))) (:printer ext-reg-reg/mem-no-width ((op #b10110111) (reg/mem nil :type 'sized-word-reg/mem))) - (:printer rex-ext-reg-reg/mem-no-width - ((op #b10110111) (reg/mem nil :type 'sized-word-reg/mem))) (:emitter (emit-move-with-extension segment dst src nil))) ;;; The regular use of MOVSXD is with an operand size of :qword. This @@ -1710,8 +1861,6 @@ (define-instruction movsxd (segment dst src) (:printer reg-reg/mem ((op #b0110001) (width 1) (reg/mem nil :type 'sized-dword-reg/mem))) - (:printer rex-reg-reg/mem ((op #b0110001) (width 1) - (reg/mem nil :type 'sized-dword-reg/mem))) (:emitter (emit-move-with-extension segment dst src :signed))) ;;; this is not a real amd64 instruction, of course @@ -1722,10 +1871,8 @@ (define-instruction push (segment src) ;; register (:printer reg-no-width-default-qword ((op #b01010))) - (:printer rex-reg-no-width-default-qword ((op #b01010))) ;; register/memory (:printer reg/mem-default-qword ((op '(#b11111111 #b110)))) - (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b110)))) ;; immediate (:printer byte ((op #b01101010) (imm nil :type 'signed-imm-byte)) '(:name :tab imm)) @@ -1754,13 +1901,11 @@ (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))) - (:printer rex-reg-no-width-default-qword ((op #b01011))) (:printer reg/mem-default-qword ((op '(#b10001111 #b000)))) - (:printer rex-reg/mem-default-qword ((op '(#b10001111 #b000)))) (:emitter (let ((size (operand-size dst))) (aver (or (eq size :qword) (eq size :word))) @@ -1777,7 +1922,6 @@ (:printer reg-no-width ((op #b10010)) '(:name :tab accum ", " reg)) ;; Register/Memory with Register. (:printer reg-reg/mem ((op #b1000011))) - (:printer rex-reg-reg/mem ((op #b1000011))) (:emitter (let ((size (matching-operand-size operand1 operand2))) (maybe-emit-operand-size-prefix segment size) @@ -1805,20 +1949,20 @@ (error "bogus args to XCHG: ~S ~S" operand1 operand2))))))) (define-instruction lea (segment dst src) - (:printer rex-reg-reg/mem ((op #b1000110))) (:printer reg-reg/mem ((op #b1000110) (width 1))) (:emitter (aver (or (dword-reg-p dst) (qword-reg-p dst))) (maybe-emit-rex-for-ea segment src dst - :operand-size :qword) + :operand-size (if (dword-reg-p dst) :dword :qword)) (emit-byte segment #b10001101) (emit-ea segment src (reg-tn-encoding dst)))) -(define-instruction cmpxchg (segment dst src) +(define-instruction cmpxchg (segment dst src &optional prefix) ;; Register/Memory with Register. (:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg)) (:emitter (aver (register-p src)) + (emit-prefix segment prefix) (let ((size (matching-operand-size src dst))) (maybe-emit-operand-size-prefix segment size) (maybe-emit-rex-for-ea segment dst src) @@ -1827,11 +1971,6 @@ (emit-ea segment dst (reg-tn-encoding src))))) - -(define-instruction fs-segment-prefix (segment) - (:emitter - (emit-byte segment #x64))) - ;;;; flag control instructions ;;; CLC -- Clear Carry Flag. @@ -1911,7 +2050,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) @@ -1925,7 +2064,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) @@ -1933,36 +2072,32 @@ (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))))) (eval-when (:compile-toplevel :execute) (defun arith-inst-printer-list (subop) `((accum-imm ((op ,(dpb subop (byte 3 2) #b0000010)))) - (rex-accum-imm ((op ,(dpb subop (byte 3 2) #b0000010)))) (reg/mem-imm ((op (#b1000000 ,subop)))) - (rex-reg/mem-imm ((op (#b1000000 ,subop)))) ;; The redundant encoding #x82 is invalid in 64-bit mode, ;; therefore we force WIDTH to 1. (reg/mem-imm ((op (#b1000001 ,subop)) (width 1) (imm nil :type signed-imm-byte))) - (rex-reg/mem-imm ((op (#b1000001 ,subop)) (width 1) - (imm nil :type signed-imm-byte))) - (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000)))) - (rex-reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000)))))) - ) + (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))))) -(define-instruction add (segment dst src) +(define-instruction add (segment dst src &optional prefix) (:printer-list (arith-inst-printer-list #b000)) - (:emitter (emit-random-arith-inst "ADD" segment dst src #b000))) + (:emitter + (emit-prefix segment prefix) + (emit-random-arith-inst "ADD" segment dst src #b000))) (define-instruction adc (segment dst src) (:printer-list (arith-inst-printer-list #b010)) @@ -1984,7 +2119,6 @@ ;;; in 64-bit mode so we always use the two-byte form. (define-instruction inc (segment dst) (:printer reg/mem ((op '(#b1111111 #b000)))) - (:printer rex-reg/mem ((op '(#b1111111 #b000)))) (:emitter (let ((size (operand-size dst))) (maybe-emit-operand-size-prefix segment size) @@ -1994,7 +2128,6 @@ (define-instruction dec (segment dst) (:printer reg/mem ((op '(#b1111111 #b001)))) - (:printer rex-reg/mem ((op '(#b1111111 #b001)))) (:emitter (let ((size (operand-size dst))) (maybe-emit-operand-size-prefix segment size) @@ -2004,7 +2137,6 @@ (define-instruction neg (segment dst) (:printer reg/mem ((op '(#b1111011 #b011)))) - (:printer rex-reg/mem ((op '(#b1111011 #b011)))) (:emitter (let ((size (operand-size dst))) (maybe-emit-operand-size-prefix segment size) @@ -2014,7 +2146,6 @@ (define-instruction mul (segment dst src) (:printer accum-reg/mem ((op '(#b1111011 #b100)))) - (:printer rex-accum-reg/mem ((op '(#b1111011 #b100)))) (:emitter (let ((size (matching-operand-size dst src))) (aver (accumulator-p dst)) @@ -2025,21 +2156,13 @@ (define-instruction imul (segment dst &optional src1 src2) (:printer accum-reg/mem ((op '(#b1111011 #b101)))) - (:printer rex-accum-reg/mem ((op '(#b1111011 #b101)))) (:printer ext-reg-reg/mem-no-width ((op #b10101111))) - (:printer rex-ext-reg-reg/mem-no-width ((op #b10101111))) (:printer reg-reg/mem ((op #b0110100) (width 1) (imm nil :type 'signed-imm-data)) '(:name :tab reg ", " reg/mem ", " imm)) - (:printer rex-reg-reg/mem ((op #b0110100) (width 1) - (imm nil :type 'signed-imm-data)) - '(:name :tab reg ", " reg/mem ", " imm)) (:printer reg-reg/mem ((op #b0110101) (width 1) (imm nil :type 'signed-imm-byte)) '(:name :tab reg ", " reg/mem ", " imm)) - (:printer rex-reg-reg/mem ((op #b0110101) (width 1) - (imm nil :type 'signed-imm-byte)) - '(:name :tab reg ", " reg/mem ", " imm)) (:emitter (flet ((r/m-with-immed-to-reg (reg r/m immed) (let* ((size (matching-operand-size reg r/m)) @@ -2071,7 +2194,6 @@ (define-instruction div (segment dst src) (:printer accum-reg/mem ((op '(#b1111011 #b110)))) - (:printer rex-accum-reg/mem ((op '(#b1111011 #b110)))) (:emitter (let ((size (matching-operand-size dst src))) (aver (accumulator-p dst)) @@ -2082,7 +2204,6 @@ (define-instruction idiv (segment dst src) (:printer accum-reg/mem ((op '(#b1111011 #b111)))) - (:printer rex-accum-reg/mem ((op '(#b1111011 #b111)))) (:emitter (let ((size (matching-operand-size dst src))) (aver (accumulator-p dst)) @@ -2141,11 +2262,12 @@ (maybe-emit-rex-prefix segment :qword nil nil nil) (emit-byte segment #b10011001))) -(define-instruction xadd (segment dst src) +(define-instruction xadd (segment dst src &optional prefix) ;; Register/Memory with Register. (:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg)) (:emitter (aver (register-p src)) + (emit-prefix segment prefix) (let ((size (matching-operand-size src dst))) (maybe-emit-operand-size-prefix segment size) (maybe-emit-rex-for-ea segment dst src) @@ -2175,15 +2297,9 @@ (defun shift-inst-printer-list (subop) `((reg/mem ((op (#b1101000 ,subop))) (:name :tab reg/mem ", 1")) - (rex-reg/mem ((op (#b1101000 ,subop))) - (:name :tab reg/mem ", 1")) (reg/mem ((op (#b1101001 ,subop))) (:name :tab reg/mem ", " 'cl)) - (rex-reg/mem ((op (#b1101001 ,subop))) - (:name :tab reg/mem ", " 'cl)) (reg/mem-imm ((op (#b1100000 ,subop)) - (imm nil :type imm-byte))) - (rex-reg/mem-imm ((op (#b1100000 ,subop)) (imm nil :type imm-byte)))))) (define-instruction rol (segment dst amount) @@ -2243,20 +2359,20 @@ (eval-when (:compile-toplevel :execute) (defun double-shift-inst-printer-list (op) - `(#+nil - (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))))) + `((ext-reg-reg/mem-no-width ((op ,(logior op #b100)) + (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))))) (define-instruction shld (segment dst src amt) - (:declare (type (or (member :cl) (mod 32)) amt)) + (:declare (type (or (member :cl) (mod 64)) amt)) (:printer-list (double-shift-inst-printer-list #b10100000)) (:emitter (emit-double-shift segment #b0 dst src amt))) (define-instruction shrd (segment dst src amt) - (:declare (type (or (member :cl) (mod 32)) amt)) + (:declare (type (or (member :cl) (mod 64)) amt)) (:printer-list (double-shift-inst-printer-list #b10101000)) (:emitter (emit-double-shift segment #b1 dst src amt))) @@ -2269,11 +2385,8 @@ (define-instruction test (segment this that) (:printer accum-imm ((op #b1010100))) - (:printer rex-accum-imm ((op #b1010100))) (:printer reg/mem-imm ((op '(#b1111011 #b000)))) - (:printer rex-reg/mem-imm ((op '(#b1111011 #b000)))) (:printer reg-reg/mem ((op #b1000010))) - (:printer rex-reg-reg/mem ((op #b1000010))) (:emitter (let ((size (matching-operand-size this that))) (maybe-emit-operand-size-prefix segment size) @@ -2304,6 +2417,27 @@ (t (error "bogus operands for TEST: ~S and ~S" this that))))))) +;;; Emit the most compact form of the test immediate instruction, +;;; using an 8 bit test when the immediate is only 8 bits and the +;;; value is one of the four low registers (rax, rbx, rcx, rdx) or the +;;; control stack. +(defun emit-optimized-test-inst (x y) + (typecase y + ((unsigned-byte 7) + (let ((offset (tn-offset x))) + (cond ((and (sc-is x any-reg descriptor-reg) + (or (= offset rax-offset) (= offset rbx-offset) + (= offset rcx-offset) (= offset rdx-offset))) + (inst test (reg-in-size x :byte) y)) + ((sc-is x control-stack) + (inst test (make-ea :byte :base rbp-tn + :disp (frame-byte-offset offset)) + y)) + (t + (inst test x y))))) + (t + (inst test x y)))) + (define-instruction or (segment dst src) (:printer-list (arith-inst-printer-list #b001)) @@ -2318,7 +2452,6 @@ (define-instruction not (segment dst) (:printer reg/mem ((op '(#b1111011 #b010)))) - (:printer rex-reg/mem ((op '(#b1111011 #b010)))) (:emitter (let ((size (operand-size dst))) (maybe-emit-operand-size-prefix segment size) @@ -2330,7 +2463,6 @@ (define-instruction cmps (segment size) (:printer string-op ((op #b1010011))) - (:printer rex-string-op ((op #b1010011))) (:emitter (maybe-emit-operand-size-prefix segment size) (maybe-emit-rex-prefix segment size nil nil nil) @@ -2338,7 +2470,6 @@ (define-instruction ins (segment acc) (:printer string-op ((op #b0110110))) - (:printer rex-string-op ((op #b0110110))) (:emitter (let ((size (operand-size acc))) (aver (accumulator-p acc)) @@ -2348,7 +2479,6 @@ (define-instruction lods (segment acc) (:printer string-op ((op #b1010110))) - (:printer rex-string-op ((op #b1010110))) (:emitter (let ((size (operand-size acc))) (aver (accumulator-p acc)) @@ -2358,7 +2488,6 @@ (define-instruction movs (segment size) (:printer string-op ((op #b1010010))) - (:printer rex-string-op ((op #b1010010))) (:emitter (maybe-emit-operand-size-prefix segment size) (maybe-emit-rex-prefix segment size nil nil nil) @@ -2366,7 +2495,6 @@ (define-instruction outs (segment acc) (:printer string-op ((op #b0110111))) - (:printer rex-string-op ((op #b0110111))) (:emitter (let ((size (operand-size acc))) (aver (accumulator-p acc)) @@ -2376,7 +2504,6 @@ (define-instruction scas (segment acc) (:printer string-op ((op #b1010111))) - (:printer rex-string-op ((op #b1010111))) (:emitter (let ((size (operand-size acc))) (aver (accumulator-p acc)) @@ -2386,7 +2513,6 @@ (define-instruction stos (segment acc) (:printer string-op ((op #b1010101))) - (:printer rex-string-op ((op #b1010101))) (:emitter (let ((size (operand-size acc))) (aver (accumulator-p acc)) @@ -2399,26 +2525,11 @@ (:emitter (emit-byte segment #b11010111))) -(define-instruction rep (segment) - (:emitter - (emit-byte segment #b11110010))) - -(define-instruction repe (segment) - (:printer byte ((op #b11110011))) - (:emitter - (emit-byte segment #b11110011))) - -(define-instruction repne (segment) - (:printer byte ((op #b11110010))) - (:emitter - (emit-byte segment #b11110010))) - ;;;; bit manipulation (define-instruction bsf (segment dst src) (:printer ext-reg-reg/mem-no-width ((op #b10111100))) - (:printer rex-ext-reg-reg/mem-no-width ((op #b10111100))) (:emitter (let ((size (matching-operand-size dst src))) (when (eq size :byte) @@ -2431,7 +2542,6 @@ (define-instruction bsr (segment dst src) (:printer ext-reg-reg/mem-no-width ((op #b10111101))) - (:printer rex-ext-reg-reg/mem-no-width ((op #b10111101))) (:emitter (let ((size (matching-operand-size dst src))) (when (eq size :byte) @@ -2461,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 @@ -2495,7 +2592,6 @@ (define-instruction call (segment where) (:printer near-jump ((op #b11101000))) (:printer reg/mem-default-qword ((op '(#b11111111 #b010)))) - (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b010)))) (:emitter (typecase where (label @@ -2530,7 +2626,6 @@ (:printer short-jump ((op #b1011))) (:printer near-jump ((op #b11101001))) (:printer reg/mem-default-qword ((op '(#b11111111 #b100)))) - (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b100)))) (:emitter (cond (where (emit-chooser @@ -2584,7 +2679,7 @@ (:printer byte ((op #b11000010) (imm nil :type 'imm-word-16)) '(:name :tab imm)) (:emitter - (cond (stack-delta + (cond ((and stack-delta (not (zerop stack-delta))) (emit-byte segment #b11000010) (emit-word segment stack-delta)) (t @@ -2617,7 +2712,6 @@ ;;;; conditional move (define-instruction cmov (segment cond dst src) (:printer cond-move ()) - (:printer rex-cond-move ()) (:emitter (aver (register-p dst)) (let ((size (matching-operand-size dst src))) @@ -2697,13 +2791,13 @@ (defun break-control (chunk inst stream dstate) (declare (ignore inst)) (flet ((nt (x) (if stream (sb!disassem:note x dstate)))) - ;; FIXME: Make sure that BYTE-IMM-CODE is defined. The genesis - ;; map has it undefined; and it should be easier to look in the target - ;; Lisp (with (DESCRIBE 'BYTE-IMM-CODE)) than to definitively deduce - ;; from first principles whether it's defined in some way that genesis - ;; can't grok. - (case #!-darwin (byte-imm-code chunk dstate) - #!+darwin (word-imm-code chunk dstate) + ;; XXX: {BYTE,WORD}-IMM-CODE below is a macro defined by the + ;; DEFINE-INSTRUCTION-FORMAT for {BYTE,WORD}-IMM above. Due to + ;; the spectacular design for DEFINE-INSTRUCTION-FORMAT (involving + ;; a call to EVAL in order to define the macros at compile-time + ;; only) they do not even show up as symbols in the target core. + (case #!-ud2-breakpoints (byte-imm-code chunk dstate) + #!+ud2-breakpoints (word-imm-code chunk dstate) (#.error-trap (nt "error trap") (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) @@ -2725,17 +2819,17 @@ (define-instruction break (segment code) (:declare (type (unsigned-byte 8) code)) - #!-darwin (:printer byte-imm ((op #b11001100)) '(:name :tab code) - :control #'break-control) - #!+darwin (:printer word-imm ((op #b0000101100001111)) '(:name :tab code) - :control #'break-control) + #!-ud2-breakpoints (:printer byte-imm ((op #b11001100)) '(:name :tab code) + :control #'break-control) + #!+ud2-breakpoints (:printer word-imm ((op #b0000101100001111)) '(:name :tab code) + :control #'break-control) (:emitter - #!-darwin (emit-byte segment #b11001100) + #!-ud2-breakpoints (emit-byte segment #b11001100) ;; On darwin, trap handling via SIGTRAP is unreliable, therefore we ;; throw a sigill with 0x0b0f instead and check for this in the ;; SIGILL handler and pass it on to the sigtrap handler if ;; appropriate - #!+darwin (emit-word segment #b0000101100001111) + #!+ud2-breakpoints (emit-word segment #b0000101100001111) (emit-byte segment code))) (define-instruction int (segment number) @@ -2763,18 +2857,42 @@ (define-instruction nop (segment) (:printer byte ((op #b10010000))) + ;; multi-byte NOP + (:printer ext-reg/mem-no-width ((op '(#x1f 0))) '(:name)) (:emitter (emit-byte segment #b10010000))) +;;; Emit a sequence of single- or multi-byte NOPs to fill AMOUNT many +;;; bytes with the smallest possible number of such instructions. +(defun emit-long-nop (segment amount) + (declare (type segment segment) + (type index amount)) + ;; Pack all instructions into one byte vector to save space. + (let* ((bytes #.(coerce #(#x90 + #x66 #x90 + #x0f #x1f #x00 + #x0f #x1f #x40 #x00 + #x0f #x1f #x44 #x00 #x00 + #x66 #x0f #x1f #x44 #x00 #x00 + #x0f #x1f #x80 #x00 #x00 #x00 #x00 + #x0f #x1f #x84 #x00 #x00 #x00 #x00 #x00 + #x66 #x0f #x1f #x84 #x00 #x00 #x00 #x00 #x00) + '(vector (unsigned-byte 8)))) + (max-length (isqrt (* 2 (length bytes))))) + (loop + (let* ((count (min amount max-length)) + (start (ash (* count (1- count)) -1))) + (dotimes (i count) + (emit-byte segment (aref bytes (+ start i))))) + (if (> amount max-length) + (decf amount max-length) + (return))))) + (define-instruction wait (segment) (:printer byte ((op #b10011011))) (:emitter (emit-byte segment #b10011011))) -(define-instruction lock (segment) - (:printer byte ((op #b11110000))) - (:emitter - (emit-byte segment #b11110000))) ;;;; miscellaneous hackery @@ -2811,7 +2929,43 @@ ;;;; Instructions required to do floating point operations using SSE -(defun emit-sse-inst (segment dst src prefix opcode &key operand-size) +;; Return a one- or two-element list of printers for SSE instructions. +;; The one-element list is used in the cases where the REX prefix is +;; really a prefix and thus automatically supported, the two-element +;; list is used when the REX prefix is used in an infix position. +(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)))) + (mapcar (lambda (inst-format) + `(,inst-format ,fields ,@(when printer + (list printer)))) + inst-formats))) + (defun 2byte-sse-inst-printer-list (inst-format-stem prefix op1 op2 + &key more-fields printer) + (let ((fields `(,@(when prefix + `((prefix, prefix))) + (op1 ,op1) + (op2 ,op2) + ,@more-fields)) + (inst-formats (if prefix + (list (symbolicate "EXT-" inst-format-stem) + (symbolicate "EXT-REX-" inst-format-stem)) + (list 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 @@ -2819,15 +2973,74 @@ (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 + +(defun emit-sse-inst-with-imm (segment dst/src imm + prefix opcode /i + &key operand-size) + (aver (<= 0 /i 7)) + (when prefix + (emit-byte segment prefix)) + (maybe-emit-rex-prefix segment operand-size dst/src nil nil) + (emit-byte segment #x0F) + (emit-byte segment opcode) + (emit-byte segment (logior (ash (logior #b11000 /i) 3) + (reg-tn-encoding dst/src))) + (emit-byte segment imm)) + +(defun emit-sse-inst-2byte (segment dst src prefix op1 op2 + &key operand-size (remaining-bytes 0)) + (when prefix + (emit-byte segment prefix)) + (if operand-size + (maybe-emit-rex-for-ea segment src dst :operand-size operand-size) + (maybe-emit-rex-for-ea segment src dst)) + (emit-byte segment #x0f) + (emit-byte segment op1) + (emit-byte segment op2) + (emit-ea segment src (reg-tn-encoding dst) :remaining-bytes remaining-bytes)) + +(macrolet + ((define-imm-sse-instruction (name opcode /i) + `(define-instruction ,name (segment dst/src imm) + (: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-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-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)) + +(defun emit-regular-2byte-sse-inst (segment dst src prefix op1 op2 + &key (remaining-bytes 0)) + (aver (xmm-register-p dst)) + (emit-sse-inst-2byte segment dst src prefix op1 op2 + :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. @@ -2835,47 +3048,202 @@ (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))))) + ;; 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) + (define-regular-sse-inst andnpd #x66 #x55) + (define-regular-sse-inst andnps nil #x55) + (define-regular-sse-inst orpd #x66 #x56) + (define-regular-sse-inst orps nil #x56) + (define-regular-sse-inst pand #x66 #xdb) + (define-regular-sse-inst pandn #x66 #xdf) + (define-regular-sse-inst por #x66 #xeb) + (define-regular-sse-inst pxor #x66 #xef) (define-regular-sse-inst xorpd #x66 #x57) (define-regular-sse-inst xorps nil #x57) ;; comparison (define-regular-sse-inst comisd #x66 #x2f) (define-regular-sse-inst comiss nil #x2f) + (define-regular-sse-inst ucomisd #x66 #x2e) + (define-regular-sse-inst ucomiss nil #x2e) + ;; integer comparison + (define-regular-sse-inst pcmpeqb #x66 #x74) + (define-regular-sse-inst pcmpeqw #x66 #x75) + (define-regular-sse-inst pcmpeqd #x66 #x76) + (define-regular-sse-inst pcmpgtb #x66 #x64) + (define-regular-sse-inst pcmpgtw #x66 #x65) + (define-regular-sse-inst pcmpgtd #x66 #x66) + ;; max/min + (define-regular-sse-inst maxpd #x66 #x5f) + (define-regular-sse-inst maxps nil #x5f) + (define-regular-sse-inst maxsd #xf2 #x5f) + (define-regular-sse-inst maxss #xf3 #x5f) + (define-regular-sse-inst minpd #x66 #x5d) + (define-regular-sse-inst minps nil #x5d) + (define-regular-sse-inst minsd #xf2 #x5d) + (define-regular-sse-inst minss #xf3 #x5d) + ;; integer max/min + (define-regular-sse-inst pmaxsw #x66 #xee) + (define-regular-sse-inst pmaxub #x66 #xde) + (define-regular-sse-inst pminsw #x66 #xea) + (define-regular-sse-inst pminub #x66 #xda) ;; arithmetic + (define-regular-sse-inst addpd #x66 #x58) + (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) (define-regular-sse-inst mulss #xf3 #x59) - (define-regular-sse-inst subsd #xf2 #x5c) - (define-regular-sse-inst subss #xf3 #x5c) + (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) + (define-regular-sse-inst subpd #x66 #x5c) + (define-regular-sse-inst subps nil #x5c) + (define-regular-sse-inst subsd #xf2 #x5c) + (define-regular-sse-inst subss #xf3 #x5c) + (define-regular-sse-inst unpckhpd #x66 #x15) + (define-regular-sse-inst unpckhps nil #x15) + (define-regular-sse-inst unpcklpd #x66 #x14) + (define-regular-sse-inst unpcklps nil #x14) + ;; integer arithmetic + (define-regular-sse-inst paddb #x66 #xfc) + (define-regular-sse-inst paddw #x66 #xfd) + (define-regular-sse-inst paddd #x66 #xfe) + (define-regular-sse-inst paddq #x66 #xd4) + (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 paddusw #x66 #xdd) + (define-regular-sse-inst pavgb #x66 #xe0) + (define-regular-sse-inst pavgw #x66 #xe3) + (define-regular-sse-inst pmaddwd #x66 #xf5) + (define-regular-sse-inst pmulhuw #x66 #xe4) + (define-regular-sse-inst pmulhw #x66 #xe5) + (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 #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) + (define-regular-sse-inst cvtpd2dq #xf2 #xe6) + (define-regular-sse-inst cvtpd2ps #x66 #x5a) + (define-regular-sse-inst cvtps2dq #x66 #x5b) + (define-regular-sse-inst cvtps2pd nil #x5a) (define-regular-sse-inst cvtsd2ss #xf2 #x5a) (define-regular-sse-inst cvtss2sd #xf3 #x5a) - (define-regular-sse-inst cvtdq2pd #xf3 #xe6) - (define-regular-sse-inst cvtdq2ps nil #x5b)) + (define-regular-sse-inst cvttpd2dq #x66 #xe6) + (define-regular-sse-inst cvttps2dq #xf3 #x5b) + ;; 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) + (define-regular-sse-inst punpckhqdq #x66 #x6d) + (define-regular-sse-inst punpcklbw #x66 #x60) + (define-regular-sse-inst punpcklwd #x66 #x61) + (define-regular-sse-inst punpckldq #x66 #x62) + (define-regular-sse-inst punpcklqdq #x66 #x6c)) + +(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-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-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 @@ -2887,14 +3255,75 @@ (define-movsd/ss-sse-inst movsd #xf2) (define-movsd/ss-sse-inst movss #xf3)) +;;; Packed MOVs +(macrolet ((define-mov-sse-inst (name prefix opcode-from opcode-to + &key force-to-mem reg-reg-name) + `(progn + ,(when reg-reg-name + `(define-instruction ,reg-reg-name (segment dst src) + (:emitter + (aver (xmm-register-p dst)) + (aver (xmm-register-p src)) + (emit-regular-sse-inst segment dst src + ,prefix ,opcode-from)))) + (define-instruction ,name (segment dst src) + (: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 ,@(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)))))))) + ;; 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) + (define-mov-sse-inst movlpd #x66 #x12 #x13 :force-to-mem t) + (define-mov-sse-inst movlps nil #x12 #x13 :reg-reg-name movhlps) + (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 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 @@ -2913,12 +3342,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)) @@ -2926,29 +3354,120 @@ (aver (xmm-register-p src)) (emit-sse-inst segment src dst #x66 #x7e))))) -(macrolet ((define-integer-source-sse-inst (name prefix opcode) +(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 + (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)) + (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) `(define-instruction ,name (segment dst src) - (:printer ext-xmm-reg/mem ((prefix ,prefix) (op ,opcode))) - (:printer ext-rex-xmm-reg/mem ((prefix ,prefix) (op ,opcode))) + (:printer-list + ',(sse-inst-printer-list 'xmm-reg/mem prefix opcode)) (:emitter (aver (xmm-register-p dst)) + ,(when mem-only + `(aver (not (or (register-p src) + (xmm-register-p src))))) (let ((src-size (operand-size src))) (aver (or (eq src-size :qword) (eq src-size :dword)))) (emit-sse-inst segment dst src ,prefix ,opcode))))) (define-integer-source-sse-inst cvtsi2sd #xf2 #x2a) - (define-integer-source-sse-inst cvtsi2ss #xf3 #x2a)) + (define-integer-source-sse-inst cvtsi2ss #xf3 #x2a) + ;; FIXME: memory operand is always a QWORD + (define-integer-source-sse-inst cvtpi2pd #x66 #x2a :mem-only t) + (define-integer-source-sse-inst cvtpi2ps nil #x2a :mem-only t)) ;;; Instructions having a general-purpose register as the destination ;;; operand and an XMM register or a memory location as the source ;;; operand. The operand size is calculated from the destination ;;; operand. -(macrolet ((define-gpr-destination-sse-inst (name prefix opcode) +(macrolet ((define-gpr-destination-sse-inst (name prefix opcode &key reg-only) `(define-instruction ,name (segment dst src) - (:printer ext-reg-xmm/mem ((prefix ,prefix) (op ,opcode))) - (:printer ext-rex-reg-xmm/mem ((prefix ,prefix) (op ,opcode))) + (:printer-list + ',(sse-inst-printer-list 'reg-xmm/mem prefix opcode)) (:emitter (aver (register-p dst)) + ,(when reg-only + `(aver (xmm-register-p src))) (let ((dst-size (operand-size dst))) (aver (or (eq dst-size :qword) (eq dst-size :dword))) (emit-sse-inst segment dst src ,prefix ,opcode @@ -2956,22 +3475,236 @@ (define-gpr-destination-sse-inst cvtsd2si #xf2 #x2d) (define-gpr-destination-sse-inst cvtss2si #xf3 #x2d) (define-gpr-destination-sse-inst cvttsd2si #xf2 #x2c) - (define-gpr-destination-sse-inst cvttss2si #xf3 #x2c)) + (define-gpr-destination-sse-inst cvttss2si #xf3 #x2c) + (define-gpr-destination-sse-inst movmskpd #x66 #x50 :reg-only t) + (define-gpr-destination-sse-inst movmskps nil #x50 :reg-only t) + (define-gpr-destination-sse-inst pmovmskb #x66 #xd7 :reg-only t)) + +;;;; We call these "2byte" instructions due to their two opcode bytes. +;;;; Intel and AMD call them three-byte instructions, as they count the +;;;; 0x0f byte for determining the number of opcode bytes. + +;;; Instructions that take XMM-XMM/MEM and XMM-XMM/MEM-IMM arguments. + +(macrolet ((regular-2byte-sse-inst (name prefix op1 op2) + `(define-instruction ,name (segment dst src) + (:printer-list + ',(2byte-sse-inst-printer-list '2byte-xmm-xmm/mem prefix op1 op2)) + (:emitter + (emit-regular-2byte-sse-inst segment dst src ,prefix ,op1 ,op2)))) + (regular-2byte-sse-inst-imm (name prefix op1 op2) + `(define-instruction ,name (segment dst src imm) + (:printer-list + ',(2byte-sse-inst-printer-list '2byte-xmm-xmm/mem prefix op1 op2 + :more-fields '((imm nil :type imm-byte)) + :printer `(:name :tab reg ", " reg/mem ", " imm))) + (:emitter + (aver (typep imm '(unsigned-byte 8))) + (emit-regular-2byte-sse-inst segment dst src ,prefix ,op1 ,op2 + :remaining-bytes 1) + (emit-byte segment imm))))) + (regular-2byte-sse-inst pshufb #x66 #x38 #x00) + (regular-2byte-sse-inst phaddw #x66 #x38 #x01) + (regular-2byte-sse-inst phaddd #x66 #x38 #x02) + (regular-2byte-sse-inst phaddsw #x66 #x38 #x03) + (regular-2byte-sse-inst pmaddubsw #x66 #x38 #x04) + (regular-2byte-sse-inst phsubw #x66 #x38 #x05) + (regular-2byte-sse-inst phsubd #x66 #x38 #x06) + (regular-2byte-sse-inst phsubsw #x66 #x38 #x07) + (regular-2byte-sse-inst psignb #x66 #x38 #x08) + (regular-2byte-sse-inst psignw #x66 #x38 #x09) + (regular-2byte-sse-inst psignd #x66 #x38 #x0a) + (regular-2byte-sse-inst pmulhrsw #x66 #x38 #x0b) + + (regular-2byte-sse-inst ptest #x66 #x38 #x17) + (regular-2byte-sse-inst pabsb #x66 #x38 #x1c) + (regular-2byte-sse-inst pabsw #x66 #x38 #x1d) + (regular-2byte-sse-inst pabsd #x66 #x38 #x1e) + + (regular-2byte-sse-inst pmuldq #x66 #x38 #x28) + (regular-2byte-sse-inst pcmpeqq #x66 #x38 #x29) + (regular-2byte-sse-inst packusdw #x66 #x38 #x2b) + + (regular-2byte-sse-inst pcmpgtq #x66 #x38 #x37) + (regular-2byte-sse-inst pminsb #x66 #x38 #x38) + (regular-2byte-sse-inst pminsd #x66 #x38 #x39) + (regular-2byte-sse-inst pminuw #x66 #x38 #x3a) + (regular-2byte-sse-inst pminud #x66 #x38 #x3b) + (regular-2byte-sse-inst pmaxsb #x66 #x38 #x3c) + (regular-2byte-sse-inst pmaxsd #x66 #x38 #x3d) + (regular-2byte-sse-inst pmaxuw #x66 #x38 #x3e) + (regular-2byte-sse-inst pmaxud #x66 #x38 #x3f) + + (regular-2byte-sse-inst pmulld #x66 #x38 #x40) + (regular-2byte-sse-inst phminposuw #x66 #x38 #x41) + + (regular-2byte-sse-inst aesimc #x66 #x38 #xdb) + (regular-2byte-sse-inst aesenc #x66 #x38 #xdc) + (regular-2byte-sse-inst aesenclast #x66 #x38 #xdd) + (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) + (regular-2byte-sse-inst-imm roundsd #x66 #x3a #x0b) + (regular-2byte-sse-inst-imm blendps #x66 #x3a #x0c) + (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) + + (regular-2byte-sse-inst-imm pcmpestrm #x66 #x3a #x60) + (regular-2byte-sse-inst-imm pcmpestri #x66 #x3a #x61) + (regular-2byte-sse-inst-imm pcmpistrm #x66 #x3a #x62) + (regular-2byte-sse-inst-imm pcmpistri #x66 #x3a #x63) + + (regular-2byte-sse-inst-imm aeskeygenassist #x66 #x3a #xdf)) ;;; 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))) + (:emitter + (aver (not (or (register-p dst) + (xmm-register-p dst)))) + (aver (register-p src)) + (maybe-emit-rex-for-ea segment src dst) + (emit-byte segment #x0f) + (emit-byte segment #xc3) + (emit-ea segment dst (reg-tn-encoding src)))) + +(define-instruction prefetch (segment type src) + (:printer ext-reg/mem-no-width ((op '(#x18 0))) + '("PREFETCHNTA" :tab reg/mem)) + (:printer ext-reg/mem-no-width ((op '(#x18 1))) + '("PREFETCHT0" :tab reg/mem)) + (:printer ext-reg/mem-no-width ((op '(#x18 2))) + '("PREFETCHT1" :tab reg/mem)) + (:printer ext-reg/mem-no-width ((op '(#x18 3))) + '("PREFETCHT2" :tab reg/mem)) + (:emitter + (aver (not (or (register-p src) + (xmm-register-p src)))) + (aver (eq (operand-size src) :byte)) + (let ((type (position type #(:nta :t0 :t1 :t2)))) + (aver type) + (maybe-emit-rex-for-ea segment src nil) + (emit-byte segment #x0f) + (emit-byte segment #x18) + (emit-ea segment src type)))) + +(define-instruction clflush (segment src) + (:printer ext-reg/mem-no-width ((op '(#xae 7)))) + (:emitter + (aver (not (or (register-p src) + (xmm-register-p src)))) + (aver (eq (operand-size src) :byte)) + (maybe-emit-rex-for-ea segment src nil) + (emit-byte segment #x0f) + (emit-byte segment #xae) + (emit-ea segment src 7))) + +(macrolet ((define-fence-instruction (name last-byte) + `(define-instruction ,name (segment) + (:printer three-bytes ((op '(#x0f #xae ,last-byte)))) + (:emitter + (emit-byte segment #x0f) + (emit-byte segment #xae) + (emit-byte segment ,last-byte))))) + (define-fence-instruction lfence #b11101000) + (define-fence-instruction mfence #b11110000) + (define-fence-instruction sfence #b11111000)) + +(define-instruction pause (segment) + (:printer two-bytes ((op '(#xf3 #x90)))) + (:emitter + (emit-byte segment #xf3) + (emit-byte segment #x90))) + (define-instruction ldmxcsr (segment src) + (:printer ext-reg/mem-no-width ((op '(#xae 2)))) (:emitter + (aver (not (or (register-p src) + (xmm-register-p src)))) + (aver (eq (operand-size src) :dword)) + (maybe-emit-rex-for-ea segment src nil) (emit-byte segment #x0f) (emit-byte segment #xae) (emit-ea segment src 2))) (define-instruction stmxcsr (segment dst) + (:printer ext-reg/mem-no-width ((op '(#xae 3)))) (:emitter + (aver (not (or (register-p dst) + (xmm-register-p dst)))) + (aver (eq (operand-size dst) :dword)) + (maybe-emit-rex-for-ea segment dst nil) (emit-byte segment #x0f) (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) @@ -2985,3 +3718,97 @@ (:emitter (emit-byte segment #b00001111) (emit-byte segment #b00110001))) + +;;;; Late VM definitions + +(defun canonicalize-inline-constant (constant &aux (alignedp nil)) + (let ((first (car constant))) + (when (eql first :aligned) + (setf alignedp t) + (pop constant) + (setf first (car constant))) + (typecase first + (single-float (setf constant (list :single-float first))) + (double-float (setf constant (list :double-float first))) + ((complex single-float) + (setf constant (list :complex-single-float first))) + ((complex double-float) + (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) + (aver (integerp value)) + (cons type value)) + ((:base-char) + (aver (base-char-p value)) + (cons :byte (char-code value))) + ((:character) + (aver (characterp value)) + (cons :dword (char-code value))) + ((:single-float) + (aver (typep value 'single-float)) + (cons (if alignedp :oword :dword) + (ldb (byte 32 0) (single-float-bits value)))) + ((:double-float) + (aver (typep value 'double-float)) + (cons (if alignedp :oword :qword) + (ldb (byte 64 0) (logior (ash (double-float-high-bits value) 32) + (double-float-low-bits value))))) + ((:complex-single-float) + (aver (typep value '(complex single-float))) + (cons (if alignedp :oword :qword) + (ldb (byte 64 0) + (logior (ash (single-float-bits (imagpart value)) 32) + (ldb (byte 32 0) + (single-float-bits (realpart value))))))) + ((:oword :sse) + (aver (integerp value)) + (cons :oword value)) + ((:complex-double-float) + (aver (typep value '(complex double-float))) + (cons :oword + (logior (ash (double-float-high-bits (imagpart value)) 96) + (ash (double-float-low-bits (imagpart value)) 64) + (ash (ldb (byte 32 0) + (double-float-high-bits (realpart value))) + 32) + (double-float-low-bits (realpart value)))))))) + +(defun inline-constant-value (constant) + (let ((label (gen-label)) + (size (ecase (car constant) + ((:byte :word :dword :qword) (car constant)) + ((:oword) :qword)))) + (values label (make-ea size + :disp (make-fixup nil :code-object label))))) + +(defun emit-constant-segment-header (segment constants optimize) + (declare (ignore constants)) + (emit-long-nop segment (if optimize 64 16))) + +(defun size-nbyte (size) + (ecase size + (:byte 1) + (:word 2) + (:dword 4) + (:qword 8) + (:oword 16))) + +(defun sort-inline-constants (constants) + (stable-sort constants #'> :key (lambda (constant) + (size-nbyte (caar constant))))) + +(defun emit-inline-constant (constant label) + (let ((size (size-nbyte (car constant)))) + (emit-alignment (integer-length (1- size))) + (emit-label label) + (let ((val (cdr constant))) + (loop repeat size + do (inst byte (ldb (byte 8 0) val)) + (setf val (ash val -8))))))