X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Finsts.lisp;h=4179980b60c100e3297b36fee14b49df08719e05;hb=0e7a9105ae992fc4befa37846c42f298e12918c0;hp=a8d80e8ce55d38ce514289d16095cbc340841d7b;hpb=0d871fd7a98fc4af92a8b942a1154761466ad8c9;p=sbcl.git diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index a8d80e8..4179980 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -25,6 +25,9 @@ ;;; This includes legacy registers and R8-R15. (deftype full-reg () '(unsigned-byte 4)) +;;; The XMM registers XMM0 - XMM15. +(deftype xmmreg () '(unsigned-byte 4)) + ;;; Default word size for the chip: if the operand size /= :dword ;;; we need to output #x66 (or REX) prefix (def!constant +default-operand-size+ :dword) @@ -90,7 +93,7 @@ :word :qword)) -;;; Print to STREAM the name of the general purpose register encoded by +;;; Print to STREAM the name of the general-purpose register encoded by ;;; VALUE and of size WIDTH. For robustness, the high byte registers ;;; (AH, BH, CH, DH) are correctly detected, too, although the compiler ;;; does not use them. @@ -204,6 +207,30 @@ (declare (ignore dstate)) (sb!disassem:princ16 value stream)) +(defun print-xmmreg (value stream dstate) + (declare (type xmmreg value) + (type stream stream) + (ignore dstate)) + (format stream "XMM~d" value)) + +(defun print-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 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))) + ;;; 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 ;;; prefilters and by printers. @@ -230,6 +257,14 @@ (sb!disassem:dstate-put-inst-prop dstate 'operand-size-8)) value) +;;; This prefilter is used solely for its side effect, namely to put +;;; the property OPERAND-SIZE-16 into the DSTATE. +(defun prefilter-x66 (value dstate) + (declare (type (eql #x66) value) + (ignore value) + (type sb!disassem:disassem-state dstate)) + (sb!disassem:dstate-put-inst-prop dstate 'operand-size-16)) + ;;; A register field that can be extended by REX.R. (defun prefilter-reg-r (value dstate) (declare (type reg value) @@ -299,7 +334,7 @@ index-reg)) (ash 1 index-scale)))))) ((and (= mod #b00) (= r/m #b101)) - (list 'rip (sb!disassem:read-signed-suffix 32 dstate)) ) + (list 'rip (sb!disassem:read-signed-suffix 32 dstate))) ((= mod #b00) (list full-reg)) ((= mod #b01) @@ -316,9 +351,7 @@ (:byte 8) (:word 16) (:dword 32) - (:qword 64) - (:float 32) - (:double 64))) + (:qword 64))) ) ; EVAL-WHEN @@ -335,6 +368,10 @@ (princ (schar (symbol-name (inst-operand-size dstate)) 0) stream))) +;;; Used to capture the effect of the #x66 operand size override prefix. +(sb!disassem:define-arg-type x66 + :prefilter #'prefilter-x66) + (sb!disassem:define-arg-type displacement :sign-extend t :use-label #'offset-next @@ -440,19 +477,19 @@ :prefilter #'prefilter-reg/mem :printer #'print-sized-reg/mem-default-qword) -;;; added by jrd -(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) -(defun print-fp-reg (value stream dstate) - (declare (ignore dstate)) - (format stream "FR~D" value)) -(defun prefilter-fp-reg (value dstate) - ;; just return it - (declare (ignore dstate)) - value) -) ; EVAL-WHEN -(sb!disassem:define-arg-type fp-reg - :prefilter #'prefilter-fp-reg - :printer #'print-fp-reg) +;;; XMM registers +(sb!disassem:define-arg-type xmmreg + :prefilter #'prefilter-reg-r + :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* @@ -585,18 +622,6 @@ :default-printer '(:name :tab reg)) (reg :type 'reg-b-default-qword)) -(sb!disassem:define-instruction-format (modrm-reg-no-width 24 - :default-printer '(:name :tab reg)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (ff :field (byte 8 8) :value #b11111111) - (mod :field (byte 2 22)) - (modrm-reg :field (byte 3 19)) - (reg :field (byte 3 16) :type 'reg-b) - ;; optional fields - (accum :type 'accum) - (imm)) - ;;; 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 @@ -668,6 +693,34 @@ (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)) @@ -768,20 +821,6 @@ :type 'reg/mem) (reg :field (byte 3 27) :type 'reg)) -;;; Same as reg-reg/mem, but with a prefix of #xf2 0f -(sb!disassem:define-instruction-format (xmm-ext-reg-reg/mem 32 - :default-printer - `(:name :tab reg ", " reg/mem)) - (prefix :field (byte 8 0) :value #xf2) - (prefix2 :field (byte 8 8) :value #x0f) - (op :field (byte 7 17)) - (width :field (byte 1 16) :type 'width) - (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'reg/mem) - (reg :field (byte 3 27) :type 'reg) - ;; optional fields - (imm)) - ;;; reg-no-width with #x0f prefix (sb!disassem:define-instruction-format (ext-reg-no-width 16 :default-printer '(:name :tab reg)) @@ -806,60 +845,127 @@ '(:name :tab reg/mem ", " imm)) (imm :type 'signed-imm-data)) -;;;; This section was added by jrd, for fp instructions. +;;;; XMM instructions -;;; regular fp inst to/from registers/memory -(sb!disassem:define-instruction-format (floating-point 16 +;;; All XMM instructions use an extended opcode (#x0F as the first +;;; opcode byte). Therefore in the following "EXT" in the name of the +;;; instruction formats refers to the formats that have an additional +;;; prefix (#x66, #xF2 or #xF3). + +;;; Instructions having an XMM register as the destination operand +;;; and an XMM register or a memory location as the source operand. +;;; The size of the operands is implicitly given by the instruction. +(sb!disassem:define-instruction-format (xmm-xmm/mem 24 :default-printer - `(:name :tab reg/mem)) - (prefix :field (byte 5 3) :value #b11011) - (op :fields (list (byte 3 0) (byte 3 11))) - (reg/mem :fields (list (byte 2 14) (byte 3 8)) :type 'reg/mem)) - -;;; fp insn to/from fp reg -(sb!disassem:define-instruction-format (floating-point-fp 16 - :default-printer `(:name :tab fp-reg)) - (prefix :field (byte 5 3) :value #b11011) - (suffix :field (byte 2 14) :value #b11) - (op :fields (list (byte 3 0) (byte 3 11))) - (fp-reg :field (byte 3 8) :type 'fp-reg)) - -;;; fp insn to/from fp reg, with the reversed source/destination flag. -(sb!disassem:define-instruction-format - (floating-point-fp-d 16 - :default-printer `(:name :tab ,(swap-if 'd "ST0" ", " 'fp-reg))) - (prefix :field (byte 5 3) :value #b11011) - (suffix :field (byte 2 14) :value #b11) - (op :fields (list (byte 2 0) (byte 3 11))) - (d :field (byte 1 2)) - (fp-reg :field (byte 3 8) :type 'fp-reg)) - - -;;; (added by (?) pfw) -;;; fp no operand isns -(sb!disassem:define-instruction-format (floating-point-no 16 - :default-printer '(:name)) - (prefix :field (byte 8 0) :value #b11011001) - (suffix :field (byte 3 13) :value #b111) - (op :field (byte 5 8))) - -(sb!disassem:define-instruction-format (floating-point-3 16 - :default-printer '(:name)) - (prefix :field (byte 5 3) :value #b11011) - (suffix :field (byte 2 14) :value #b11) - (op :fields (list (byte 3 0) (byte 6 8)))) - -(sb!disassem:define-instruction-format (floating-point-5 16 - :default-printer '(:name)) - (prefix :field (byte 8 0) :value #b11011011) - (suffix :field (byte 3 13) :value #b111) - (op :field (byte 5 8))) - -(sb!disassem:define-instruction-format (floating-point-st 16 - :default-printer '(:name)) - (prefix :field (byte 8 0) :value #b11011111) - (suffix :field (byte 3 13) :value #b111) - (op :field (byte 5 8))) + '(: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 '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)) + +(sb!disassem:define-instruction-format (ext-xmm-xmm/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 'xmmreg/mem) + (reg :field (byte 3 27) :type 'xmmreg)) + +(sb!disassem:define-instruction-format (ext-rex-xmm-xmm/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 'xmmreg/mem) + (reg :field (byte 3 35) :type 'xmmreg)) + +;;; Same as xmm-xmm/mem etc., but with direction bit. + +(sb!disassem:define-instruction-format (ext-xmm-xmm/mem-dir 32 + :include 'ext-xmm-xmm/mem + :default-printer + `(:name + :tab + ,(swap-if 'dir 'reg ", " 'reg/mem))) + (op :field (byte 7 17)) + (dir :field (byte 1 16))) + +(sb!disassem:define-instruction-format (ext-rex-xmm-xmm/mem-dir 40 + :include 'ext-rex-xmm-xmm/mem + :default-printer + `(:name + :tab + ,(swap-if 'dir 'reg ", " 'reg/mem))) + (op :field (byte 7 25)) + (dir :field (byte 1 24))) + +;;; 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 (ext-xmm-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 'xmmreg)) + +(sb!disassem:define-instruction-format (ext-rex-xmm-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 'xmmreg)) + +;;; 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 (ext-reg-xmm/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-xmmreg/mem) + (reg :field (byte 3 27) :type 'reg)) + +(sb!disassem:define-instruction-format (ext-rex-reg-xmm/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-xmmreg/mem) + (reg :field (byte 3 35) :type 'reg)) (sb!disassem:define-instruction-format (string-op 8 :include 'simple @@ -946,6 +1052,14 @@ :default-printer '(:name :tab code)) (op :field (byte 8 0)) (code :field (byte 8 8))) + +;;; Two byte instruction with an immediate byte argument. +;;; +(sb!disassem:define-instruction-format (word-imm 24 + :default-printer '(:name :tab code)) + (op :field (byte 16 0)) + (code :field (byte 8 16))) + ;;;; primitive emitters @@ -955,6 +1069,17 @@ (define-bitfield-emitter emit-dword 32 (byte 32 0)) +;;; Most uses of dwords are as displacements or as immediate values in +;;; 64-bit operations. In these cases they are sign-extended to 64 bits. +;;; EMIT-DWORD is unsuitable there because it accepts values of type +;;; (OR (SIGNED-BYTE 32) (UNSIGNED-BYTE 32)), so we provide a more +;;; restricted emitter here. +(defun emit-signed-dword (segment value) + (declare (type segment segment) + (type (signed-byte 32) value)) + (declare (inline emit-dword)) + (emit-dword segment value)) + (define-bitfield-emitter emit-qword 64 (byte 64 0)) @@ -987,31 +1112,31 @@ 0)) other-pointer-lowtag))) (if quad-p - (emit-qword segment val ) - (emit-dword segment val ))))) + (emit-qword segment val) + (emit-signed-dword segment val))))) (if quad-p (emit-qword segment (or offset 0)) - (emit-dword segment (or offset 0)))))) + (emit-signed-dword segment (or offset 0)))))) (defun emit-relative-fixup (segment fixup) (note-fixup segment :relative fixup) - (emit-dword segment (or (fixup-offset fixup) 0))) + (emit-signed-dword segment (or (fixup-offset fixup) 0))) ;;;; the effective-address (ea) structure (defun reg-tn-encoding (tn) (declare (type tn tn)) - (aver (member (sb-name (sc-sb (tn-sc tn))) '(registers float-registers))) ;; ea only has space for three bits of register number: regs r8 ;; and up are selected by a REX prefix byte which caller is responsible ;; for having emitted where necessary already - (cond ((fp-reg-tn-p tn) - (mod (tn-offset tn) 8)) - (t - (let ((offset (mod (tn-offset tn) 16))) - (logior (ash (logand offset 1) 2) - (ash offset -1)))))) + (ecase (sb-name (sc-sb (tn-sc tn))) + (registers + (let ((offset (mod (tn-offset tn) 16))) + (logior (ash (logand offset 1) 2) + (ash offset -1)))) + (float-registers + (mod (tn-offset tn) 8)))) (defstruct (ea (:constructor make-ea (size &key base index scale disp)) (:copier nil)) @@ -1080,7 +1205,8 @@ (lambda (segment posn) ;; The addressing is relative to end of instruction, ;; i.e. the end of this dword. Hence the + 4. - (emit-dword segment (+ 4 (- (+ offset posn))))))) + (emit-signed-dword segment + (+ 4 (- (+ offset posn))))))) (values)) (defun emit-label-rip (segment fixup reg) @@ -1090,8 +1216,8 @@ (emit-back-patch segment 4 (lambda (segment posn) - (emit-dword segment (- (label-position label) - (+ posn 4)))))) + (emit-signed-dword segment (- (label-position label) + (+ posn 4)))))) (values)) (defun emit-ea (segment thing reg &optional allow-constants) @@ -1105,12 +1231,12 @@ (stack ;; Convert stack tns into an index off RBP. (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes)))) - (cond ((< -128 disp 127) + (cond ((<= -128 disp 127) (emit-mod-reg-r/m-byte segment #b01 reg #b101) (emit-byte segment disp)) (t (emit-mod-reg-r/m-byte segment #b10 reg #b101) - (emit-dword segment disp))))) + (emit-signed-dword segment disp))))) (constant (unless allow-constants ;; Why? @@ -1154,7 +1280,7 @@ ((or (= mod #b10) (null base)) (if (fixup-p disp) (emit-absolute-fixup segment disp) - (emit-dword segment disp)))))) + (emit-signed-dword segment disp)))))) (fixup (typecase (fixup-offset thing) (label @@ -1164,18 +1290,6 @@ (emit-sib-byte segment 0 #b100 #b101) (emit-absolute-fixup segment thing)))))) -(defun fp-reg-tn-p (thing) - (and (tn-p thing) - (eq (sb-name (sc-sb (tn-sc thing))) 'float-registers))) - -;;; like the above, but for fp-instructions--jrd -(defun emit-fp-op (segment thing op) - (if (fp-reg-tn-p thing) - (emit-byte segment (dpb op (byte 3 3) (dpb (tn-offset thing) - (byte 3 0) - #b11000000))) - (emit-ea segment thing op))) - (defun byte-reg-p (thing) (and (tn-p thing) (eq (sb-name (sc-sb (tn-sc thing))) 'registers) @@ -1227,6 +1341,7 @@ (and (member (sc-name (tn-sc thing)) *qword-sc-names*) t)) (t nil))) +;;; Return true if THING is a general-purpose register TN. (defun register-p (thing) (and (tn-p thing) (eq (sb-name (sc-sb (tn-sc thing))) 'registers))) @@ -1235,6 +1350,11 @@ (and (register-p thing) (= (tn-offset thing) 0))) +;;; Return true if THING is an XMM register TN. +(defun xmm-register-p (thing) + (and (tn-p thing) + (eq (sb-name (sc-sb (tn-sc thing))) 'float-registers))) + ;;;; utilities @@ -1268,25 +1388,25 @@ ;;; B can be address-sized (if it is the base register of an effective ;;; address), of OPERAND-SIZE (if the instruction operates on two ;;; registers) or of some different size (in the instructions that -;;; combine arguments of different sizes: MOVZX, MOVSX, MOVSXD). -;;; We don't distinguish between general purpose and floating point -;;; registers for this cause because only general purpose registers can -;;; be byte-sized at all. +;;; combine arguments of different sizes: MOVZX, MOVSX, MOVSXD and +;;; several SSE instructions, e.g. CVTSD2SI). We don't distinguish +;;; between general-purpose and floating point registers for this cause +;;; because only general-purpose registers can be byte-sized at all. (defun maybe-emit-rex-prefix (segment operand-size r x b) - (declare (type (member nil :byte :word :dword :qword :float :double - :do-not-set) + (declare (type (member nil :byte :word :dword :qword :do-not-set) operand-size) (type (or null tn) r x b)) (labels ((if-hi (r) (if (and r (> (tn-offset r) ;; offset of r8 is 16, offset of xmm8 is 8 - (if (fp-reg-tn-p r) + (if (eq (sb-name (sc-sb (tn-sc r))) + 'float-registers) 7 15))) 1 0)) (reg-4-7-p (r) - ;; Assuming R is a TN describing a general purpose + ;; Assuming R is a TN describing a general-purpose ;; register, return true if it references register ;; 4 upto 7. (<= 8 (tn-offset r) 15))) @@ -1320,8 +1440,7 @@ (defun maybe-emit-rex-for-ea (segment thing reg &key operand-size) (declare (type (or ea tn fixup) thing) (type (or null tn) reg) - (type (member nil :byte :word :dword :qword :float :double - :do-not-set) + (type (member nil :byte :word :dword :qword :do-not-set) operand-size)) (let ((ea-p (ea-p thing))) (maybe-emit-rex-prefix segment @@ -1350,6 +1469,13 @@ (#.*byte-sc-names* :byte) ;; added by jrd: float-registers is a separate size (?) + ;; The only place in the code where we are called with THING + ;; being a float-register is in MAYBE-EMIT-REX-PREFIX when it + ;; checks whether THING is a byte register. Thus our result in + ;; these cases could as well be :dword and :qword. I leave it as + ;; :float and :double which is more likely to trigger an aver + ;; instead of silently doing the wrong thing in case this + ;; situation should change. Lutz Euler, 2005-10-23. (#.*float-sc-names* :float) (#.*double-sc-names* @@ -1382,22 +1508,65 @@ src-size (error "can't tell the size of either ~S or ~S" dst src))))) -(defun emit-sized-immediate (segment size value &optional quad-p) +;;; Except in a very few cases (MOV instructions A1, A3 and B8 - BF) +;;; we expect dword data bytes even when 64 bit work is being done. +;;; But A1 and A3 are currently unused and B8 - BF use EMIT-QWORD +;;; directly, so we emit all quad constants as dwords, additionally +;;; making sure that they survive the sign-extension to 64 bits +;;; unchanged. +(defun emit-sized-immediate (segment size value) (ecase size (:byte (emit-byte segment value)) (:word (emit-word segment value)) - ((:dword :qword) - ;; except in a very few cases (MOV instructions A1,A3,B8) we expect - ;; dword data bytes even when 64 bit work is being done. So, mostly - ;; we treat quad constants as dwords. - (if (and quad-p (eq size :qword)) - (emit-qword segment value) - (emit-dword segment value))))) + (:dword + (emit-dword segment value)) + (:qword + (emit-signed-dword segment value)))) ;;;; general data transfer +;;; This is the part of the MOV instruction emitter that does moving +;;; of an immediate value into a qword register. We go to some length +;;; to achieve the shortest possible encoding. +(defun emit-immediate-move-to-qword-register (segment dst src) + (declare (type integer src)) + (cond ((typep src '(unsigned-byte 32)) + ;; We use the B8 - BF encoding with an operand size of 32 bits + ;; here and let the implicit zero-extension fill the upper half + ;; of the 64-bit destination register. Instruction size: five + ;; or six bytes. (A REX prefix will be emitted only if the + ;; destination is an extended register.) + (maybe-emit-rex-prefix segment :dword nil nil dst) + (emit-byte-with-reg segment #b10111 (reg-tn-encoding dst)) + (emit-dword segment src)) + (t + (maybe-emit-rex-prefix segment :qword nil nil dst) + (cond ((typep src '(signed-byte 32)) + ;; Use the C7 encoding that takes a 32-bit immediate and + ;; sign-extends it to 64 bits. Instruction size: seven + ;; bytes. + (emit-byte segment #b11000111) + (emit-mod-reg-r/m-byte segment #b11 #b000 + (reg-tn-encoding dst)) + (emit-signed-dword segment src)) + ((<= (- (expt 2 64) (expt 2 31)) + src + (1- (expt 2 64))) + ;; This triggers on positive integers of 64 bits length + ;; with the most significant 33 bits being 1. We use the + ;; same encoding as in the previous clause. + (emit-byte segment #b11000111) + (emit-mod-reg-r/m-byte segment #b11 #b000 + (reg-tn-encoding dst)) + (emit-signed-dword segment (- src (expt 2 64)))) + (t + ;; We need a full 64-bit immediate. Instruction size: + ;; ten bytes. + (emit-byte-with-reg segment #b10111 (reg-tn-encoding dst)) + (emit-qword segment src)))))) + (define-instruction mov (segment dst src) ;; immediate to register (:printer reg ((op #b1011) (imm nil :type 'signed-imm-data)) @@ -1410,6 +1579,8 @@ ;; 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)))) @@ -1419,13 +1590,17 @@ (maybe-emit-operand-size-prefix segment size) (cond ((register-p dst) (cond ((integerp src) - (maybe-emit-rex-prefix segment size nil nil dst) - (emit-byte-with-reg segment - (if (eq size :byte) - #b10110 - #b10111) - (reg-tn-encoding dst)) - (emit-sized-immediate segment size src (eq size :qword))) + (cond ((eq size :qword) + (emit-immediate-move-to-qword-register segment + dst src)) + (t + (maybe-emit-rex-prefix segment size nil nil dst) + (emit-byte-with-reg segment + (if (eq size :byte) + #b10110 + #b10111) + (reg-tn-encoding dst)) + (emit-sized-immediate segment size src)))) (t (maybe-emit-rex-for-ea segment src dst) (emit-byte segment @@ -1434,18 +1609,13 @@ #b10001011)) (emit-ea segment src (reg-tn-encoding dst) t)))) ((integerp src) - ;; C7 only deals with 32 bit immediates even if register is - ;; 64 bit: only b8-bf use 64 bit immediates + ;; C7 only deals with 32 bit immediates even if the + ;; destination is a 64-bit location. The value is + ;; sign-extended in this case. (maybe-emit-rex-for-ea segment dst nil) - (cond ((typep src '(or (signed-byte 32) (unsigned-byte 32))) - (emit-byte segment - (if (eq size :byte) #b11000110 #b11000111)) - (emit-ea segment dst #b000) - (emit-sized-immediate segment - (case size (:qword :dword) (t size)) - src)) - (t - (aver nil)))) + (emit-byte segment (if (eq size :byte) #b11000110 #b11000111)) + (emit-ea segment dst #b000) + (emit-sized-immediate segment size src)) ((register-p src) (maybe-emit-rex-for-ea segment dst src) (emit-byte segment (if (eq size :byte) #b10001000 #b10001001)) @@ -1570,10 +1740,10 @@ ;; defaults to 64 bits. The size of the immediate is 32 ;; bits and it is sign-extended. (emit-byte segment #b01101000) - (emit-dword segment src)))) + (emit-signed-dword segment src)))) (t (let ((size (operand-size src))) - (aver (not (eq size :byte))) + (aver (or (eq size :qword) (eq size :word))) (maybe-emit-operand-size-prefix segment size) (maybe-emit-rex-for-ea segment src nil :operand-size :do-not-set) (cond ((register-p src) @@ -1589,7 +1759,7 @@ (:printer rex-reg/mem-default-qword ((op '(#b10001111 #b000)))) (:emitter (let ((size (operand-size dst))) - (aver (not (eq size :byte))) + (aver (or (eq size :qword) (eq size :word))) (maybe-emit-operand-size-prefix segment size) (maybe-emit-rex-for-ea segment dst nil :operand-size :do-not-set) (cond ((register-p dst) @@ -1806,38 +1976,27 @@ (:printer-list (arith-inst-printer-list #b111)) (:emitter (emit-random-arith-inst "CMP" segment dst src #b111 t))) +;;; The one-byte encodings for INC and DEC are used as REX prefixes +;;; in 64-bit mode so we always use the two-byte form. (define-instruction inc (segment dst) - ;; Register - (:printer modrm-reg-no-width ((modrm-reg #b000))) - ;; Register/Memory - ;; (:printer rex-reg/mem ((op '(#b11111111 #b001)))) (: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) - (cond #+nil ; these opcodes become REX prefixes in x86-64 - ((and (not (eq size :byte)) (register-p dst)) - (emit-byte-with-reg segment #b01000 (reg-tn-encoding dst))) - (t - (maybe-emit-rex-for-ea segment dst nil) - (emit-byte segment (if (eq size :byte) #b11111110 #b11111111)) - (emit-ea segment dst #b000)))))) + (maybe-emit-rex-for-ea segment dst nil) + (emit-byte segment (if (eq size :byte) #b11111110 #b11111111)) + (emit-ea segment dst #b000)))) (define-instruction dec (segment dst) - ;; Register. - (:printer modrm-reg-no-width ((modrm-reg #b001))) - ;; Register/Memory (: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) - (cond #+nil - ((and (not (eq size :byte)) (register-p dst)) - (emit-byte-with-reg segment #b01001 (reg-tn-encoding dst))) - (t - (maybe-emit-rex-for-ea segment dst nil) - (emit-byte segment (if (eq size :byte) #b11111110 #b11111111)) - (emit-ea segment dst #b001)))))) + (maybe-emit-rex-for-ea segment dst nil) + (emit-byte segment (if (eq size :byte) #b11111110 #b11111111)) + (emit-ea segment dst #b001)))) (define-instruction neg (segment dst) (:printer reg/mem ((op '(#b1111011 #b011)))) @@ -1950,7 +2109,7 @@ (maybe-emit-operand-size-prefix segment :dword) (emit-byte segment #b10011000))) -;;; CDQE -- Convert Word To Double Word Extended. RAX <- sign_xtnd(EAX) +;;; CDQE -- Convert Double Word To Quad Word Extended. RAX <- sign_xtnd(EAX) (define-instruction cdqe (segment) (:printer rex-byte ((op #b10011000))) (:emitter @@ -2340,9 +2499,9 @@ (emit-back-patch segment 4 (lambda (segment posn) - (emit-dword segment - (- (label-position where) - (+ posn 4)))))) + (emit-signed-dword segment + (- (label-position where) + (+ posn 4)))))) (fixup (emit-byte segment #b11101000) (emit-relative-fixup segment where)) @@ -2365,7 +2524,7 @@ (:printer near-cond-jump () '('j cc :tab label)) ;; unconditional jumps (:printer short-jump ((op #b1011))) - (:printer near-jump ((op #b11101001)) ) + (:printer near-jump ((op #b11101001))) (:printer reg/mem-default-qword ((op '(#b11111111 #b100)))) (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b100)))) (:emitter @@ -2389,7 +2548,7 @@ (dpb (conditional-opcode cond) (byte 4 0) #b10000000)) - (emit-dword segment disp))))) + (emit-signed-dword segment disp))))) ((label-p (setq where cond)) (emit-chooser segment 5 0 @@ -2403,24 +2562,19 @@ (lambda (segment posn) (let ((disp (- (label-position where) (+ posn 5)))) (emit-byte segment #b11101001) - (emit-dword segment disp))))) + (emit-signed-dword segment disp))))) ((fixup-p where) (emit-byte segment #b11101001) (emit-relative-fixup segment where)) (t (unless (or (ea-p where) (tn-p where)) - (error "don't know what to do with ~A" where)) + (error "don't know what to do with ~A" where)) ;; near jump defaults to 64 bit ;; w-bit in rex prefix is unnecessary (maybe-emit-rex-for-ea segment where nil :operand-size :do-not-set) (emit-byte segment #b11111111) (emit-ea segment where #b100))))) -(define-instruction jmp-short (segment label) - (:emitter - (emit-byte segment #b11101011) - (emit-byte-displacement-backpatch segment label))) - (define-instruction ret (segment &optional stack-delta) (:printer byte ((op #b11000011))) (:printer byte ((op #b11000010) (imm nil :type 'imm-word-16)) @@ -2463,7 +2617,7 @@ (:emitter (aver (register-p dst)) (let ((size (matching-operand-size dst src))) - (aver (or (eq size :word) (eq size :dword) (eq size :qword) )) + (aver (or (eq size :word) (eq size :dword) (eq size :qword))) (maybe-emit-operand-size-prefix segment size)) (maybe-emit-rex-for-ea segment src dst) (emit-byte segment #b00001111) @@ -2544,7 +2698,8 @@ ;; 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 (byte-imm-code chunk dstate) + (case #!-darwin (byte-imm-code chunk dstate) + #!+darwin (word-imm-code chunk dstate) (#.error-trap (nt "error trap") (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) @@ -2558,14 +2713,25 @@ (#.halt-trap (nt "halt trap")) (#.fun-end-breakpoint-trap - (nt "function end breakpoint trap"))))) + (nt "function end breakpoint trap")) + (#.single-step-around-trap + (nt "single-step trap (around)")) + (#.single-step-before-trap + (nt "single-step trap (before)"))))) (define-instruction break (segment code) (:declare (type (unsigned-byte 8) code)) - (:printer byte-imm ((op #b11001100)) '(:name :tab code) - :control #'break-control) - (:emitter - (emit-byte segment #b11001100) + #!-darwin (:printer byte-imm ((op #b11001100)) '(:name :tab code) + :control #'break-control) + #!+darwin (:printer word-imm ((op #b0000101100001111)) '(:name :tab code) + :control #'break-control) + (:emitter + #!-darwin (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) (emit-byte segment code))) (define-instruction int (segment number) @@ -2579,21 +2745,6 @@ (emit-byte segment #b11001101) (emit-byte segment number))))) -(define-instruction into (segment) - (:printer byte ((op #b11001110))) - (:emitter - (emit-byte segment #b11001110))) - -(define-instruction bound (segment reg bounds) - (:emitter - (let ((size (matching-operand-size reg bounds))) - (when (eq size :byte) - (error "can't bounds-test bytes: ~S" reg)) - (maybe-emit-operand-size-prefix segment size) - (maybe-emit-rex-for-ea segment bounds reg) - (emit-byte segment #b01100010) - (emit-ea segment bounds (reg-tn-encoding reg))))) - (define-instruction iret (segment) (:printer byte ((op #b11001111))) (:emitter @@ -2654,984 +2805,156 @@ (:emitter (emit-header-data segment return-pc-header-widetag))) -;;;; fp instructions -;;;; -;;;; Note: We treat the single-precision and double-precision variants -;;;; as separate instructions. - -;;; Load single to st(0). -(define-instruction fld (segment source) - (:printer floating-point ((op '(#b001 #b000)))) - (:emitter - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011001) - (emit-fp-op segment source #b000))) - -;;; Load double to st(0). -(define-instruction fldd (segment source) - (:printer floating-point ((op '(#b101 #b000)))) - (:printer floating-point-fp ((op '(#b001 #b000)))) - (:emitter - (if (fp-reg-tn-p source) - (emit-byte segment #b11011001) - (progn - (maybe-emit-rex-for-ea segment source nil) - (emit-byte segment #b11011101))) - (emit-fp-op segment source #b000))) - -;;; Load long to st(0). -(define-instruction fldl (segment source) - (:printer floating-point ((op '(#b011 #b101)))) - (:emitter - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011011) - (emit-fp-op segment source #b101))) - -;;; Store single from st(0). -(define-instruction fst (segment dest) - (:printer floating-point ((op '(#b001 #b010)))) - (:emitter - (cond ((fp-reg-tn-p dest) - (emit-byte segment #b11011101) - (emit-fp-op segment dest #b010)) - (t - (maybe-emit-rex-for-ea segment dest nil) - (emit-byte segment #b11011001) - (emit-fp-op segment dest #b010))))) - -;;; Store double from st(0). -(define-instruction fstd (segment dest) - (:printer floating-point ((op '(#b101 #b010)))) - (:printer floating-point-fp ((op '(#b101 #b010)))) - (:emitter - (cond ((fp-reg-tn-p dest) - (emit-byte segment #b11011101) - (emit-fp-op segment dest #b010)) - (t - (maybe-emit-rex-for-ea segment dest nil) - (emit-byte segment #b11011101) - (emit-fp-op segment dest #b010))))) - -;;; Arithmetic ops are all done with at least one operand at top of -;;; stack. The other operand is is another register or a 32/64 bit -;;; memory loc. - -;;; dtc: I've tried to follow the Intel ASM386 conventions, but note -;;; that these conflict with the Gdb conventions for binops. To reduce -;;; the confusion I've added comments showing the mathamatical -;;; operation and the two syntaxes. By the ASM386 convention the -;;; instruction syntax is: -;;; -;;; Fop Source -;;; or Fop Destination, Source -;;; -;;; If only one operand is given then it is the source and the -;;; destination is ST(0). There are reversed forms of the fsub and -;;; fdiv instructions inducated by an 'R' suffix. -;;; -;;; The mathematical operation for the non-reverse form is always: -;;; destination = destination op source -;;; -;;; For the reversed form it is: -;;; destination = source op destination -;;; -;;; The instructions below only accept one operand at present which is -;;; usually the source. I've hack in extra instructions to implement -;;; the fops with a ST(i) destination, these have a -sti suffix and -;;; the operand is the destination with the source being ST(0). - -;;; Add single: -;;; st(0) = st(0) + memory or st(i). -(define-instruction fadd (segment source) - (:printer floating-point ((op '(#b000 #b000)))) - (:emitter - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011000) - (emit-fp-op segment source #b000))) - -;;; Add double: -;;; st(0) = st(0) + memory or st(i). -(define-instruction faddd (segment source) - (:printer floating-point ((op '(#b100 #b000)))) - (:printer floating-point-fp ((op '(#b000 #b000)))) - (:emitter - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (if (fp-reg-tn-p source) - (emit-byte segment #b11011000) - (emit-byte segment #b11011100)) - (emit-fp-op segment source #b000))) - -;;; Add double destination st(i): -;;; st(i) = st(0) + st(i). -(define-instruction fadd-sti (segment destination) - (:printer floating-point-fp ((op '(#b100 #b000)))) - (:emitter - (aver (fp-reg-tn-p destination)) - (emit-byte segment #b11011100) - (emit-fp-op segment destination #b000))) -;;; with pop -(define-instruction faddp-sti (segment destination) - (:printer floating-point-fp ((op '(#b110 #b000)))) - (:emitter - (aver (fp-reg-tn-p destination)) - (emit-byte segment #b11011110) - (emit-fp-op segment destination #b000))) - -;;; Subtract single: -;;; st(0) = st(0) - memory or st(i). -(define-instruction fsub (segment source) - (:printer floating-point ((op '(#b000 #b100)))) - (:emitter - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011000) - (emit-fp-op segment source #b100))) - -;;; Subtract single, reverse: -;;; st(0) = memory or st(i) - st(0). -(define-instruction fsubr (segment source) - (:printer floating-point ((op '(#b000 #b101)))) - (:emitter - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011000) - (emit-fp-op segment source #b101))) - -;;; Subtract double: -;;; st(0) = st(0) - memory or st(i). -(define-instruction fsubd (segment source) - (:printer floating-point ((op '(#b100 #b100)))) - (:printer floating-point-fp ((op '(#b000 #b100)))) - (:emitter - (if (fp-reg-tn-p source) - (emit-byte segment #b11011000) - (progn - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011100))) - (emit-fp-op segment source #b100))) - -;;; Subtract double, reverse: -;;; st(0) = memory or st(i) - st(0). -(define-instruction fsubrd (segment source) - (:printer floating-point ((op '(#b100 #b101)))) - (:printer floating-point-fp ((op '(#b000 #b101)))) - (:emitter - (if (fp-reg-tn-p source) - (emit-byte segment #b11011000) - (progn - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011100))) - (emit-fp-op segment source #b101))) - -;;; Subtract double, destination st(i): -;;; st(i) = st(i) - st(0). -;;; -;;; ASM386 syntax: FSUB ST(i), ST -;;; Gdb syntax: fsubr %st,%st(i) -(define-instruction fsub-sti (segment destination) - (:printer floating-point-fp ((op '(#b100 #b101)))) - (:emitter - (aver (fp-reg-tn-p destination)) - (emit-byte segment #b11011100) - (emit-fp-op segment destination #b101))) -;;; with a pop -(define-instruction fsubp-sti (segment destination) - (:printer floating-point-fp ((op '(#b110 #b101)))) - (:emitter - (aver (fp-reg-tn-p destination)) - (emit-byte segment #b11011110) - (emit-fp-op segment destination #b101))) - -;;; Subtract double, reverse, destination st(i): -;;; st(i) = st(0) - st(i). -;;; -;;; ASM386 syntax: FSUBR ST(i), ST -;;; Gdb syntax: fsub %st,%st(i) -(define-instruction fsubr-sti (segment destination) - (:printer floating-point-fp ((op '(#b100 #b100)))) - (:emitter - (aver (fp-reg-tn-p destination)) - (emit-byte segment #b11011100) - (emit-fp-op segment destination #b100))) -;;; with a pop -(define-instruction fsubrp-sti (segment destination) - (:printer floating-point-fp ((op '(#b110 #b100)))) - (:emitter - (aver (fp-reg-tn-p destination)) - (emit-byte segment #b11011110) - (emit-fp-op segment destination #b100))) - -;;; Multiply single: -;;; st(0) = st(0) * memory or st(i). -(define-instruction fmul (segment source) - (:printer floating-point ((op '(#b000 #b001)))) - (:emitter - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011000) - (emit-fp-op segment source #b001))) - -;;; Multiply double: -;;; st(0) = st(0) * memory or st(i). -(define-instruction fmuld (segment source) - (:printer floating-point ((op '(#b100 #b001)))) - (:printer floating-point-fp ((op '(#b000 #b001)))) - (:emitter - (if (fp-reg-tn-p source) - (emit-byte segment #b11011000) - (progn - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011100))) - (emit-fp-op segment source #b001))) - -;;; Multiply double, destination st(i): -;;; st(i) = st(i) * st(0). -(define-instruction fmul-sti (segment destination) - (:printer floating-point-fp ((op '(#b100 #b001)))) - (:emitter - (aver (fp-reg-tn-p destination)) - (emit-byte segment #b11011100) - (emit-fp-op segment destination #b001))) - -;;; Divide single: -;;; st(0) = st(0) / memory or st(i). -(define-instruction fdiv (segment source) - (:printer floating-point ((op '(#b000 #b110)))) - (:emitter - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011000) - (emit-fp-op segment source #b110))) - -;;; Divide single, reverse: -;;; st(0) = memory or st(i) / st(0). -(define-instruction fdivr (segment source) - (:printer floating-point ((op '(#b000 #b111)))) - (:emitter - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011000) - (emit-fp-op segment source #b111))) - -;;; Divide double: -;;; st(0) = st(0) / memory or st(i). -(define-instruction fdivd (segment source) - (:printer floating-point ((op '(#b100 #b110)))) - (:printer floating-point-fp ((op '(#b000 #b110)))) - (:emitter - (if (fp-reg-tn-p source) - (emit-byte segment #b11011000) - (progn - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011100))) - (emit-fp-op segment source #b110))) - -;;; Divide double, reverse: -;;; st(0) = memory or st(i) / st(0). -(define-instruction fdivrd (segment source) - (:printer floating-point ((op '(#b100 #b111)))) - (:printer floating-point-fp ((op '(#b000 #b111)))) - (:emitter - (if (fp-reg-tn-p source) - (emit-byte segment #b11011000) - (progn - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011100))) - (emit-fp-op segment source #b111))) - -;;; Divide double, destination st(i): -;;; st(i) = st(i) / st(0). -;;; -;;; ASM386 syntax: FDIV ST(i), ST -;;; Gdb syntax: fdivr %st,%st(i) -(define-instruction fdiv-sti (segment destination) - (:printer floating-point-fp ((op '(#b100 #b111)))) - (:emitter - (aver (fp-reg-tn-p destination)) - (emit-byte segment #b11011100) - (emit-fp-op segment destination #b111))) - -;;; Divide double, reverse, destination st(i): -;;; st(i) = st(0) / st(i). -;;; -;;; ASM386 syntax: FDIVR ST(i), ST -;;; Gdb syntax: fdiv %st,%st(i) -(define-instruction fdivr-sti (segment destination) - (:printer floating-point-fp ((op '(#b100 #b110)))) - (:emitter - (aver (fp-reg-tn-p destination)) - (emit-byte segment #b11011100) - (emit-fp-op segment destination #b110))) - -;;; Exchange fr0 with fr(n). (There is no double precision variant.) -(define-instruction fxch (segment source) - (:printer floating-point-fp ((op '(#b001 #b001)))) - (:emitter - (unless (and (tn-p source) - (eq (sb-name (sc-sb (tn-sc source))) 'float-registers)) - (cl:break)) - (emit-byte segment #b11011001) - (emit-fp-op segment source #b001))) - -;;; Push 32-bit integer to st0. -(define-instruction fild (segment source) - (:printer floating-point ((op '(#b011 #b000)))) - (:emitter - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011011) - (emit-fp-op segment source #b000))) - -;;; Push 64-bit integer to st0. -(define-instruction fildl (segment source) - (:printer floating-point ((op '(#b111 #b101)))) - (:emitter - (and (not (fp-reg-tn-p source)) - (maybe-emit-rex-for-ea segment source nil)) - (emit-byte segment #b11011111) - (emit-fp-op segment source #b101))) - -;;; Store 32-bit integer. -(define-instruction fist (segment dest) - (:printer floating-point ((op '(#b011 #b010)))) - (:emitter - (and (not (fp-reg-tn-p dest)) - (maybe-emit-rex-for-ea segment dest nil)) - (emit-byte segment #b11011011) - (emit-fp-op segment dest #b010))) - -;;; Store and pop 32-bit integer. -(define-instruction fistp (segment dest) - (:printer floating-point ((op '(#b011 #b011)))) - (:emitter - (and (not (fp-reg-tn-p dest)) - (maybe-emit-rex-for-ea segment dest nil)) - (emit-byte segment #b11011011) - (emit-fp-op segment dest #b011))) - -;;; Store and pop 64-bit integer. -(define-instruction fistpl (segment dest) - (:printer floating-point ((op '(#b111 #b111)))) - (:emitter - (and (not (fp-reg-tn-p dest)) - (maybe-emit-rex-for-ea segment dest nil)) - (emit-byte segment #b11011111) - (emit-fp-op segment dest #b111))) - -;;; Store single from st(0) and pop. -(define-instruction fstp (segment dest) - (:printer floating-point ((op '(#b001 #b011)))) - (:emitter - (cond ((fp-reg-tn-p dest) - (emit-byte segment #b11011101) - (emit-fp-op segment dest #b011)) - (t - (maybe-emit-rex-for-ea segment dest nil) - (emit-byte segment #b11011001) - (emit-fp-op segment dest #b011))))) - -;;; Store double from st(0) and pop. -(define-instruction fstpd (segment dest) - (:printer floating-point ((op '(#b101 #b011)))) - (:printer floating-point-fp ((op '(#b101 #b011)))) - (:emitter - (cond ((fp-reg-tn-p dest) - (emit-byte segment #b11011101) - (emit-fp-op segment dest #b011)) - (t - (maybe-emit-rex-for-ea segment dest nil) - (emit-byte segment #b11011101) - (emit-fp-op segment dest #b011))))) - -;;; Store long from st(0) and pop. -(define-instruction fstpl (segment dest) - (:printer floating-point ((op '(#b011 #b111)))) - (:emitter - (and (not (fp-reg-tn-p dest)) - (maybe-emit-rex-for-ea segment dest nil)) - (emit-byte segment #b11011011) - (emit-fp-op segment dest #b111))) - -;;; Decrement stack-top pointer. -(define-instruction fdecstp (segment) - (:printer floating-point-no ((op #b10110))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11110110))) - -;;; Increment stack-top pointer. -(define-instruction fincstp (segment) - (:printer floating-point-no ((op #b10111))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11110111))) - -;;; Free fp register. -(define-instruction ffree (segment dest) - (:printer floating-point-fp ((op '(#b101 #b000)))) - (:emitter - (and (not (fp-reg-tn-p dest)) - (maybe-emit-rex-for-ea segment dest nil)) - (emit-byte segment #b11011101) - (emit-fp-op segment dest #b000))) - -(define-instruction fabs (segment) - (:printer floating-point-no ((op #b00001))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11100001))) - -(define-instruction fchs (segment) - (:printer floating-point-no ((op #b00000))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11100000))) - -(define-instruction frndint(segment) - (:printer floating-point-no ((op #b11100))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11111100))) - -;;; Initialize NPX. -(define-instruction fninit(segment) - (:printer floating-point-5 ((op #b00011))) - (:emitter - (emit-byte segment #b11011011) - (emit-byte segment #b11100011))) - -;;; Store Status Word to AX. -(define-instruction fnstsw(segment) - (:printer floating-point-st ((op #b00000))) - (:emitter - (emit-byte segment #b11011111) - (emit-byte segment #b11100000))) - -;;; Load Control Word. -;;; -;;; src must be a memory location -(define-instruction fldcw(segment src) - (:printer floating-point ((op '(#b001 #b101)))) - (:emitter - (and (not (fp-reg-tn-p src)) - (maybe-emit-rex-for-ea segment src nil)) - (emit-byte segment #b11011001) - (emit-fp-op segment src #b101))) - -;;; Store Control Word. -(define-instruction fnstcw(segment dst) - (:printer floating-point ((op '(#b001 #b111)))) - (:emitter - (and (not (fp-reg-tn-p dst)) - (maybe-emit-rex-for-ea segment dst nil)) - (emit-byte segment #b11011001) - (emit-fp-op segment dst #b111))) - -;;; Store FP Environment. -(define-instruction fstenv(segment dst) - (:printer floating-point ((op '(#b001 #b110)))) - (:emitter - (and (not (fp-reg-tn-p dst)) - (maybe-emit-rex-for-ea segment dst nil)) - (emit-byte segment #b11011001) - (emit-fp-op segment dst #b110))) - -;;; Restore FP Environment. -(define-instruction fldenv(segment src) - (:printer floating-point ((op '(#b001 #b100)))) - (:emitter - (and (not (fp-reg-tn-p src)) - (maybe-emit-rex-for-ea segment src nil)) - (emit-byte segment #b11011001) - (emit-fp-op segment src #b100))) - -;;; Save FP State. -(define-instruction fsave(segment dst) - (:printer floating-point ((op '(#b101 #b110)))) - (:emitter - (and (not (fp-reg-tn-p dst)) - (maybe-emit-rex-for-ea segment dst nil)) - (emit-byte segment #b11011101) - (emit-fp-op segment dst #b110))) - -;;; Restore FP State. -(define-instruction frstor(segment src) - (:printer floating-point ((op '(#b101 #b100)))) - (:emitter - (and (not (fp-reg-tn-p src)) - (maybe-emit-rex-for-ea segment src nil)) - (emit-byte segment #b11011101) - (emit-fp-op segment src #b100))) - -;;; Clear exceptions. -(define-instruction fnclex(segment) - (:printer floating-point-5 ((op #b00010))) - (:emitter - (emit-byte segment #b11011011) - (emit-byte segment #b11100010))) - -;;; comparison -(define-instruction fcom (segment src) - (:printer floating-point ((op '(#b000 #b010)))) - (:emitter - (and (not (fp-reg-tn-p src)) - (maybe-emit-rex-for-ea segment src nil)) - (emit-byte segment #b11011000) - (emit-fp-op segment src #b010))) - -(define-instruction fcomd (segment src) - (:printer floating-point ((op '(#b100 #b010)))) - (:printer floating-point-fp ((op '(#b000 #b010)))) - (:emitter - (if (fp-reg-tn-p src) - (emit-byte segment #b11011000) - (progn - (maybe-emit-rex-for-ea segment src nil) - (emit-byte segment #b11011100))) - (emit-fp-op segment src #b010))) - -;;; Compare ST1 to ST0, popping the stack twice. -(define-instruction fcompp (segment) - (:printer floating-point-3 ((op '(#b110 #b011001)))) - (:emitter - (emit-byte segment #b11011110) - (emit-byte segment #b11011001))) - -;;; unordered comparison -(define-instruction fucom (segment src) - (:printer floating-point-fp ((op '(#b101 #b100)))) - (:emitter - (aver (fp-reg-tn-p src)) - (emit-byte segment #b11011101) - (emit-fp-op segment src #b100))) - -(define-instruction ftst (segment) - (:printer floating-point-no ((op #b00100))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11100100))) - -;;;; 80387 specials - -(define-instruction fsqrt(segment) - (:printer floating-point-no ((op #b11010))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11111010))) - -(define-instruction fscale(segment) - (:printer floating-point-no ((op #b11101))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11111101))) - -(define-instruction fxtract(segment) - (:printer floating-point-no ((op #b10100))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11110100))) - -(define-instruction fsin(segment) - (:printer floating-point-no ((op #b11110))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11111110))) - -(define-instruction fcos(segment) - (:printer floating-point-no ((op #b11111))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11111111))) - -(define-instruction fprem1(segment) - (:printer floating-point-no ((op #b10101))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11110101))) - -(define-instruction fprem(segment) - (:printer floating-point-no ((op #b11000))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11111000))) - -(define-instruction fxam (segment) - (:printer floating-point-no ((op #b00101))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11100101))) - -;;; These do push/pop to stack and need special handling -;;; in any VOPs that use them. See the book. - -;;; st0 <- st1*log2(st0) -(define-instruction fyl2x(segment) ; pops stack - (:printer floating-point-no ((op #b10001))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11110001))) - -(define-instruction fyl2xp1(segment) - (:printer floating-point-no ((op #b11001))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11111001))) - -(define-instruction f2xm1(segment) - (:printer floating-point-no ((op #b10000))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11110000))) - -(define-instruction fptan(segment) ; st(0) <- 1; st(1) <- tan - (:printer floating-point-no ((op #b10010))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11110010))) - -(define-instruction fpatan(segment) ; POPS STACK - (:printer floating-point-no ((op #b10011))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11110011))) - -;;;; loading constants - -(define-instruction fldz(segment) - (:printer floating-point-no ((op #b01110))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11101110))) - -(define-instruction fld1(segment) - (:printer floating-point-no ((op #b01000))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11101000))) - -(define-instruction fldpi(segment) - (:printer floating-point-no ((op #b01011))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11101011))) - -(define-instruction fldl2t(segment) - (:printer floating-point-no ((op #b01001))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11101001))) - -(define-instruction fldl2e(segment) - (:printer floating-point-no ((op #b01010))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11101010))) - -(define-instruction fldlg2(segment) - (:printer floating-point-no ((op #b01100))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11101100))) - -(define-instruction fldln2(segment) - (:printer floating-point-no ((op #b01101))) - (:emitter - (emit-byte segment #b11011001) - (emit-byte segment #b11101101))) - -;; new xmm insns required by sse float -;; movsd andpd comisd comiss +;;;; Instructions required to do floating point operations using SSE + +(defun emit-sse-inst (segment dst src prefix opcode &key operand-size) + (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 opcode) + (emit-ea segment src (reg-tn-encoding dst))) + +;;; 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) + (aver (xmm-register-p dst)) + (emit-sse-inst segment dst src prefix opcode + :operand-size :do-not-set)) + +;;; Instructions having an XMM register as the destination operand +;;; and an XMM register or a memory location as the source operand. +;;; The operand size is implicitly given by the instruction. + +(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))))) + (:emitter + (emit-regular-sse-inst segment dst src ,prefix ,opcode))))) + ;; logical + (define-regular-sse-inst andpd #x66 #x54) + (define-regular-sse-inst andps nil #x54) + (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) + ;; arithmetic + (define-regular-sse-inst addsd #xf2 #x58) + (define-regular-sse-inst addss #xf3 #x58) + (define-regular-sse-inst divsd #xf2 #x5e) + (define-regular-sse-inst divss #xf3 #x5e) + (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 sqrtsd #xf2 #x51) + (define-regular-sse-inst sqrtss #xf3 #x51) + ;; conversion + (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)) + +;;; 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))) + (:emitter + (cond ((xmm-register-p dst) + (emit-sse-inst segment dst src ,prefix #x10 + :operand-size :do-not-set)) + (t + (aver (xmm-register-p src)) + (emit-sse-inst segment src dst ,prefix #x11 + :operand-size :do-not-set))))))) + (define-movsd/ss-sse-inst movsd #xf2) + (define-movsd/ss-sse-inst movss #xf3)) -(define-instruction movsd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (cond ((typep src 'tn) - (emit-byte segment #xf2) - (maybe-emit-rex-for-ea segment dst src) - (emit-byte segment #x0f) - (emit-byte segment #x11) - (emit-ea segment dst (reg-tn-encoding src))) - (t - (emit-byte segment #xf2) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x10) - (emit-ea segment src (reg-tn-encoding dst)))))) - -(define-instruction movss (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (cond ((tn-p src) - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment dst src) - (emit-byte segment #x0f) - (emit-byte segment #x11) - (emit-ea segment dst (reg-tn-encoding src))) +;;; 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)) + (:emitter + (cond ((xmm-register-p dst) + (emit-sse-inst segment dst src #xf3 #x7e + :operand-size :do-not-set)) (t - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x10) - (emit-ea segment src (reg-tn-encoding dst)))))) - -(define-instruction andpd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #x66) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x54) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction andps (segment dst src) - (:emitter - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x54) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction comisd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #x66) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x2f) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction comiss (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x2f) - (emit-ea segment src (reg-tn-encoding dst)))) - -;; movd movq xorp xord - -;; we only do the xmm version of movd + (aver (xmm-register-p src)) + (emit-sse-inst segment src dst #x66 #xd6 + :operand-size :do-not-set))))) + +;;; Instructions having an XMM register as the destination operand +;;; and a general-purpose register or a memory location as the source +;;; operand. The operand size is calculated from the source operand. + +;;; MOVD - Move a 32- or 64-bit value from a general-purpose register or +;;; a memory location to the low order 32 or 64 bits of an XMM register +;;; with zero extension or vice versa. +;;; We do not support the MMX version of this instruction. (define-instruction movd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (cond ((fp-reg-tn-p dst) - (emit-byte segment #x66) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x6e) - (emit-ea segment src (reg-tn-encoding dst))) - (t - (aver (fp-reg-tn-p src)) - (emit-byte segment #x66) - (maybe-emit-rex-for-ea segment dst src) - (emit-byte segment #x0f) - (emit-byte segment #x7e) - (emit-ea segment dst (reg-tn-encoding src)))))) - -(define-instruction movq (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (cond ((fp-reg-tn-p dst) - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x7e) - (emit-ea segment src (reg-tn-encoding dst))) + (: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)) + (:emitter + (cond ((xmm-register-p dst) + (emit-sse-inst segment dst src #x66 #x6e)) (t - (aver (fp-reg-tn-p src)) - (emit-byte segment #x66) - (maybe-emit-rex-for-ea segment dst src) - (emit-byte segment #x0f) - (emit-byte segment #xd6) - (emit-ea segment dst (reg-tn-encoding src)))))) - -(define-instruction xorpd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #x66) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x57) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction xorps (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x57) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction cvtsd2si (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf2) - (maybe-emit-rex-for-ea segment src dst :operand-size :qword) - (emit-byte segment #x0f) - (emit-byte segment #x2d) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction cvtsd2ss (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf2) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x5a) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction cvtss2si (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment src dst :operand-size :qword) - (emit-byte segment #x0f) - (emit-byte segment #x2d) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction cvtss2sd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x5a) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction cvtsi2ss (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x2a) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction cvtsi2sd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf2) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x2a) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction cvtdq2pd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #xe6) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction cvtdq2ps (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x5b) - (emit-ea segment src (reg-tn-encoding dst)))) - -;; CVTTSD2SI CVTTSS2SI - -(define-instruction cvttsd2si (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf2) - (maybe-emit-rex-for-ea segment src dst :operand-size :qword) - (emit-byte segment #x0f) - (emit-byte segment #x2c) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction cvttss2si (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment src dst :operand-size :qword) - (emit-byte segment #x0f) - (emit-byte segment #x2c) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction addsd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf2) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x58) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction addss (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x58) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction divsd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf2) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x5e) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction divss (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x5e) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction mulsd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf2) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x59) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction mulss (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x59) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction subsd (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf2) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x5c) - (emit-ea segment src (reg-tn-encoding dst)))) - -(define-instruction subss (segment dst src) -; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong - (:emitter - (emit-byte segment #xf3) - (maybe-emit-rex-for-ea segment src dst) - (emit-byte segment #x0f) - (emit-byte segment #x5c) - (emit-ea segment src (reg-tn-encoding dst)))) + (aver (xmm-register-p src)) + (emit-sse-inst segment src dst #x66 #x7e))))) + +(macrolet ((define-integer-source-sse-inst (name prefix opcode) + `(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))) + (:emitter + (aver (xmm-register-p dst)) + (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)) + +;;; 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) + `(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))) + (:emitter + (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 ,prefix ,opcode + :operand-size dst-size)))))) + (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)) + +;;; Other SSE instructions (define-instruction ldmxcsr (segment src) (:emitter @@ -3644,4 +2967,3 @@ (emit-byte segment #x0f) (emit-byte segment #xae) (emit-ea segment dst 3))) -