;;; 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)
: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.
(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.
(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)
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)
(:byte 8)
(:word 16)
(:dword 32)
- (:qword 64)
- (:float 32)
- (:double 64)))
+ (:qword 64)))
) ; EVAL-WHEN
\f
(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
: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*
: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
(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))
: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))
'(:name :tab reg/mem ", " imm))
(imm :type 'signed-imm-data))
\f
-;;;; This section was added by jrd, for fp instructions.
+;;;; XMM instructions
+
+;;; 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).
-;;; regular fp inst to/from registers/memory
-(sb!disassem:define-instruction-format (floating-point 16
+;;; 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
: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)))
+
\f
;;;; primitive emitters
(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))
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)))
\f
;;;; 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))
(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)
(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)
(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?
((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
(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)
(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)))
(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)))
+
\f
;;;; utilities
;;; 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)))
(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
(#.*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*
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))))
\f
;;;; 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))
;; 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))))
(maybe-emit-operand-size-prefix segment size)
(cond ((register-p dst)
(cond ((integerp src)
- (maybe-emit-rex-prefix segment size nil nil dst)
- (cond ((and (eq size :qword)
- (typep src '(signed-byte 31)))
- ;; When loading small immediates to a qword register
- ;; using B8 wastes 3 bytes compared to C7.
- (emit-byte segment #b11000111)
- (emit-mod-reg-r/m-byte segment #b11
- #b000
- (reg-tn-encoding dst))
- (emit-sized-immediate segment :dword src nil))
+ (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
- (eq size :qword)))))
+ (emit-sized-immediate segment size src))))
(t
(maybe-emit-rex-for-ea segment src dst)
(emit-byte segment
#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))
;; 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)
(: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)
(: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))))
(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
(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))
(: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
(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
(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)
(: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)
;; 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))
(#.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)
(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
(:emitter
(emit-header-data segment return-pc-header-widetag)))
\f
-;;;; 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
(emit-byte segment #x0f)
(emit-byte segment #xae)
(emit-ea segment dst 3)))
-
projects / sbcl.git / blobdiff