(type sb!disassem:disassem-state dstate))
(if (typep value 'full-reg)
(print-reg-with-width value width stream dstate)
- (print-mem-access value (and sized-p width) stream dstate)))
+ (print-mem-access value width sized-p stream dstate)))
;;; Print a register or a memory reference. The width is determined by
;;; calling INST-OPERAND-SIZE.
(type sb!disassem:disassem-state dstate))
(if (typep value 'xmmreg)
(print-xmmreg value stream dstate)
- (print-mem-access value nil stream dstate)))
-
-;; Same as print-xmmreg/mem, but prints an explicit size indicator for
-;; memory references.
-(defun print-sized-xmmreg/mem (value stream dstate)
- (declare (type (or list xmmreg) value)
- (type stream stream)
- (type sb!disassem:disassem-state dstate))
- (if (typep value 'xmmreg)
- (print-xmmreg value stream dstate)
- (print-mem-access value (inst-operand-size dstate) stream dstate)))
+ (print-mem-access value nil nil stream dstate)))
;;; This prefilter is used solely for its side effects, namely to put
;;; the bits found in the REX prefix into the DSTATE for use by other
(:dword 32)
(:qword 64)))
+(defun print-imm/asm-routine (value stream dstate)
+ (sb!disassem:maybe-note-assembler-routine value nil dstate)
+ (princ value stream))
) ; EVAL-WHEN
\f
;;;; disassembler argument types
(setf width 32))
(sb!disassem:read-signed-suffix width dstate))))
+(sb!disassem:define-arg-type signed-imm-data/asm-routine
+ :type 'signed-imm-data
+ :printer #'print-imm/asm-routine)
+
;;; Used by the variant of the MOV instruction with opcode B8 which can
;;; move immediates of all sizes (i.e. including :qword) into a
;;; register.
(width-bits (inst-operand-size dstate))
dstate)))
+(sb!disassem:define-arg-type signed-imm-data-upto-qword/asm-routine
+ :type 'signed-imm-data-upto-qword
+ :printer #'print-imm/asm-routine)
+
+
;;; Used by those instructions that have a default operand size of
;;; :qword. Nevertheless the immediate is at most of size :dword.
;;; The only instruction of this kind having a variant with an immediate
: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))
(op :fields (list (byte 8 0) (byte 8 8) (byte 8 16))))
+;;; Prefix instructions
+
+(sb!disassem:define-instruction-format (rex 8)
+ (rex :field (byte 4 4) :value #b0100)
+ (wrxb :field (byte 4 0) :type 'wrxb))
+
+(sb!disassem:define-instruction-format (x66 8)
+ (x66 :field (byte 8 0) :type 'x66 :value #x66))
+
;;; A one-byte instruction with a #x66 prefix, used to indicate an
;;; operand size of :word.
(sb!disassem:define-instruction-format (x66-byte 16
(accum :type 'accum)
(imm))
-(sb!disassem:define-instruction-format (rex-simple 16)
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (op :field (byte 7 9))
- (width :field (byte 1 8) :type 'width)
- ;; optional fields
- (accum :type 'accum)
- (imm))
-
;;; Same as simple, but with direction bit
(sb!disassem:define-instruction-format (simple-dir 8 :include 'simple)
(op :field (byte 6 2))
:tab accum ", " imm))
(imm :type 'signed-imm-data))
-(sb!disassem:define-instruction-format (rex-accum-imm 16
- :include 'rex-simple
- :default-printer '(:name
- :tab accum ", " imm))
- (imm :type 'signed-imm-data))
-
(sb!disassem:define-instruction-format (reg-no-width 8
:default-printer '(:name :tab reg))
(op :field (byte 5 3))
(accum :type 'accum)
(imm))
-(sb!disassem:define-instruction-format (rex-reg-no-width 16
- :default-printer '(:name :tab reg))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (op :field (byte 5 11))
- (reg :field (byte 3 8) :type 'reg-b)
- ;; optional fields
- (accum :type 'accum)
- (imm))
-
;;; Same as reg-no-width, but with a default operand size of :qword.
(sb!disassem:define-instruction-format (reg-no-width-default-qword 8
:include 'reg-no-width
:default-printer '(:name :tab reg))
(reg :type 'reg-b-default-qword))
-;;; Same as rex-reg-no-width, but with a default operand size of :qword.
-(sb!disassem:define-instruction-format (rex-reg-no-width-default-qword 16
- :include 'rex-reg-no-width
- :default-printer '(:name :tab reg))
- (reg :type 'reg-b-default-qword))
-
;;; Adds a width field to reg-no-width. Note that we can't use
;;; :INCLUDE 'REG-NO-WIDTH here to save typing because that would put
;;; the WIDTH field last, but the prefilter for WIDTH must run before
;; optional fields
(imm))
-(sb!disassem:define-instruction-format (rex-reg-reg/mem 24
- :default-printer
- `(:name :tab reg ", " reg/mem))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (width :field (byte 1 8) :type 'width)
- (op :field (byte 7 9))
- (reg/mem :fields (list (byte 2 22) (byte 3 16))
- :type 'reg/mem)
- (reg :field (byte 3 19) :type 'reg)
- ;; optional fields
- (imm))
-
;;; same as reg-reg/mem, but with direction bit
(sb!disassem:define-instruction-format (reg-reg/mem-dir 16
:include 'reg-reg/mem
(op :field (byte 6 2))
(dir :field (byte 1 1)))
-(sb!disassem:define-instruction-format (rex-reg-reg/mem-dir 24
- :include 'rex-reg-reg/mem
- :default-printer
- `(:name
- :tab
- ,(swap-if 'dir 'reg/mem ", " 'reg)))
- (op :field (byte 6 10))
- (dir :field (byte 1 9)))
-
-(sb!disassem:define-instruction-format (x66-reg-reg/mem-dir 24
- :default-printer
- `(:name
- :tab
- ,(swap-if 'dir 'reg/mem ", " 'reg)))
- (x66 :field (byte 8 0) :type 'x66 :value #x66)
- (op :field (byte 6 10))
- (dir :field (byte 1 9))
- (width :field (byte 1 8) :type 'width)
- (reg/mem :fields (list (byte 2 22) (byte 3 16))
- :type 'reg/mem)
- (reg :field (byte 3 19) :type 'reg))
-
-(sb!disassem:define-instruction-format (x66-rex-reg-reg/mem-dir 32
- :default-printer
- `(:name
- :tab
- ,(swap-if 'dir 'reg/mem ", " 'reg)))
- (x66 :field (byte 8 0) :type 'x66 :value #x66)
- (rex :field (byte 4 12) :value #b0100)
- (wrxb :field (byte 4 8) :type 'wrxb)
- (op :field (byte 6 18))
- (dir :field (byte 1 17))
- (width :field (byte 1 16) :type 'width)
- (reg/mem :fields (list (byte 2 30) (byte 3 24))
- :type 'reg/mem)
- (reg :field (byte 3 27) :type 'reg))
-
;;; Same as reg-reg/mem, but uses the reg field as a second op code.
(sb!disassem:define-instruction-format (reg/mem 16
:default-printer '(:name :tab reg/mem))
;; optional fields
(imm))
-(sb!disassem:define-instruction-format (rex-reg/mem 24
- :default-printer '(:name :tab reg/mem))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (op :fields (list (byte 7 9) (byte 3 19)))
- (width :field (byte 1 8) :type 'width)
- (reg/mem :fields (list (byte 2 22) (byte 3 16))
- :type 'sized-reg/mem)
- ;; optional fields
- (imm))
-
;;; Same as reg/mem, but without a width field and with a default
;;; operand size of :qword.
(sb!disassem:define-instruction-format (reg/mem-default-qword 16
(reg/mem :fields (list (byte 2 14) (byte 3 8))
:type 'sized-reg/mem-default-qword))
-(sb!disassem:define-instruction-format (rex-reg/mem-default-qword 24
- :default-printer '(:name :tab reg/mem))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (op :fields (list (byte 8 8) (byte 3 19)))
- (reg/mem :fields (list (byte 2 22) (byte 3 16))
- :type 'sized-reg/mem-default-qword))
-
;;; Same as reg/mem, but with the immediate value occurring by default,
;;; and with an appropiate printer.
(sb!disassem:define-instruction-format (reg/mem-imm 16
(reg/mem :type 'sized-reg/mem)
(imm :type 'signed-imm-data))
-(sb!disassem:define-instruction-format (rex-reg/mem-imm 24
- :include 'rex-reg/mem
+(sb!disassem:define-instruction-format (reg/mem-imm/asm-routine 16
+ :include 'reg/mem-imm
:default-printer
'(:name :tab reg/mem ", " imm))
(reg/mem :type 'sized-reg/mem)
- (imm :type 'signed-imm-data))
+ (imm :type 'signed-imm-data/asm-routine))
;;; Same as reg/mem, but with using the accumulator in the default printer
(sb!disassem:define-instruction-format
(reg/mem :type 'reg/mem) ; don't need a size
(accum :type 'accum))
-(sb!disassem:define-instruction-format (rex-accum-reg/mem 24
- :include 'rex-reg/mem
- :default-printer
- '(:name :tab accum ", " reg/mem))
- (reg/mem :type 'reg/mem) ; don't need a size
- (accum :type 'accum))
-
;;; Same as reg-reg/mem, but with a prefix of #b00001111
(sb!disassem:define-instruction-format (ext-reg-reg/mem 24
:default-printer
;; optional fields
(imm))
-(sb!disassem:define-instruction-format (x66-ext-reg-reg/mem 32
- :default-printer
- `(:name :tab reg ", " reg/mem))
- (x66 :field (byte 8 0) :type 'x66 :value #x66)
- (prefix :field (byte 8 8) :value #b00001111)
- (op :field (byte 7 17))
- (width :field (byte 1 16) :type 'width)
- (reg/mem :fields (list (byte 2 30) (byte 3 24))
- :type 'reg/mem)
- (reg :field (byte 3 27) :type 'reg)
- ;; optional fields
- (imm))
-
-(sb!disassem:define-instruction-format (rex-ext-reg-reg/mem 32
- :default-printer
- `(:name :tab reg ", " reg/mem))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (prefix :field (byte 8 8) :value #b00001111)
- (op :field (byte 7 17))
- (width :field (byte 1 16) :type 'width)
- (reg/mem :fields (list (byte 2 30) (byte 3 24))
- :type 'reg/mem)
- (reg :field (byte 3 27) :type 'reg)
- ;; optional fields
- (imm))
-
-(sb!disassem:define-instruction-format (x66-rex-ext-reg-reg/mem 40
- :default-printer
- `(:name :tab reg ", " reg/mem))
- (x66 :field (byte 8 0) :type 'x66 :value #x66)
- (rex :field (byte 4 12) :value #b0100)
- (wrxb :field (byte 4 8) :type 'wrxb)
- (prefix :field (byte 8 16) :value #b00001111)
- (op :field (byte 7 25))
- (width :field (byte 1 24) :type 'width)
- (reg/mem :fields (list (byte 2 38) (byte 3 32))
- :type 'reg/mem)
- (reg :field (byte 3 35) :type 'reg)
- ;; optional fields
- (imm))
-
-(eval-when (:compile-toplevel :execute)
- (defun ext-reg-reg/mem-printer-list (op &optional printer)
- `((ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer)))
- (x66-ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer)))
- (rex-ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer)))
- (x66-rex-ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer))))))
-
(sb!disassem:define-instruction-format (ext-reg-reg/mem-no-width 24
:default-printer
`(:name :tab reg ", " reg/mem))
(op :field (byte 8 8))
(reg/mem :fields (list (byte 2 22) (byte 3 16))
:type 'reg/mem)
- (reg :field (byte 3 19) :type 'reg))
-
-(sb!disassem:define-instruction-format (rex-ext-reg-reg/mem-no-width 32
- :default-printer
- `(:name :tab reg ", " reg/mem))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (prefix :field (byte 8 8) :value #b00001111)
- (op :field (byte 8 16))
- (reg/mem :fields (list (byte 2 30) (byte 3 24))
- :type 'reg/mem)
- (reg :field (byte 3 27) :type 'reg))
+ (reg :field (byte 3 19) :type 'reg)
+ ;; optional fields
+ (imm))
(sb!disassem:define-instruction-format (ext-reg/mem-no-width 24
:default-printer
(reg/mem :fields (list (byte 2 22) (byte 3 16))
:type 'reg/mem))
-(sb!disassem:define-instruction-format (rex-ext-reg/mem-no-width 32
- :default-printer
- `(:name :tab reg/mem))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (prefix :field (byte 8 8) :value #b00001111)
- (op :fields (list (byte 8 16) (byte 3 27)))
- (reg/mem :fields (list (byte 2 30) (byte 3 24))
- :type 'reg/mem))
-
;;; reg-no-width with #x0f prefix
(sb!disassem:define-instruction-format (ext-reg-no-width 16
:default-printer '(:name :tab reg))
:default-printer
'(:name :tab reg/mem ", " imm))
(imm :type 'signed-imm-data))
+
+(sb!disassem:define-instruction-format (ext-reg/mem-no-width+imm8 24
+ :include 'ext-reg/mem-no-width
+ :default-printer
+ '(:name :tab reg/mem ", " imm))
+ (imm :type 'imm-byte))
\f
;;;; XMM instructions
;; optional fields
(imm))
-(sb!disassem:define-instruction-format (rex-xmm-xmm/mem 32
- :default-printer
- '(:name :tab reg ", " reg/mem))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (x0f :field (byte 8 8) :value #x0f)
- (op :field (byte 8 16))
- (reg/mem :fields (list (byte 2 30) (byte 3 24))
- :type 'xmmreg/mem)
- (reg :field (byte 3 27) :type 'xmmreg)
- (imm))
-
(sb!disassem:define-instruction-format (ext-xmm-xmm/mem 32
:default-printer
'(:name :tab reg ", " reg/mem))
(reg :field (byte 3 35) :type 'xmmreg)
(imm))
+(sb!disassem:define-instruction-format (ext-2byte-xmm-xmm/mem 40
+ :default-printer
+ '(:name :tab reg ", " reg/mem))
+ (prefix :field (byte 8 0))
+ (x0f :field (byte 8 8) :value #x0f)
+ (op1 :field (byte 8 16)) ; #x38 or #x3a
+ (op2 :field (byte 8 24))
+ (reg/mem :fields (list (byte 2 38) (byte 3 32))
+ :type 'xmmreg/mem)
+ (reg :field (byte 3 35) :type 'xmmreg))
+
+(sb!disassem:define-instruction-format (ext-rex-2byte-xmm-xmm/mem 48
+ :default-printer
+ '(:name :tab reg ", " reg/mem))
+ (prefix :field (byte 8 0))
+ (rex :field (byte 4 12) :value #b0100)
+ (wrxb :field (byte 4 8) :type 'wrxb)
+ (x0f :field (byte 8 16) :value #x0f)
+ (op1 :field (byte 8 24)) ; #x38 or #x3a
+ (op2 :field (byte 8 32))
+ (reg/mem :fields (list (byte 2 46) (byte 3 40))
+ :type 'xmmreg/mem)
+ (reg :field (byte 3 43) :type 'xmmreg))
+
;;; Same as xmm-xmm/mem etc., but with direction bit.
(sb!disassem:define-instruction-format (ext-xmm-xmm/mem-dir 32
(op :field (byte 8 8))
(reg/mem :fields (list (byte 2 22) (byte 3 16))
:type 'sized-reg/mem)
- (reg :field (byte 3 19) :type 'xmmreg))
-
-(sb!disassem:define-instruction-format (rex-xmm-reg/mem 32
- :default-printer
- '(:name :tab reg ", " reg/mem))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (x0f :field (byte 8 8) :value #x0f)
- (op :field (byte 8 16))
- (reg/mem :fields (list (byte 2 30) (byte 3 24))
- :type 'sized-reg/mem)
- (reg :field (byte 3 27) :type 'xmmreg))
+ (reg :field (byte 3 19) :type 'xmmreg)
+ (imm))
(sb!disassem:define-instruction-format (ext-xmm-reg/mem 32
:default-printer
(op :field (byte 8 16))
(reg/mem :fields (list (byte 2 30) (byte 3 24))
:type 'sized-reg/mem)
- (reg :field (byte 3 27) :type 'xmmreg))
+ (reg :field (byte 3 27) :type 'xmmreg)
+ (imm))
(sb!disassem:define-instruction-format (ext-rex-xmm-reg/mem 40
:default-printer
(op :field (byte 8 24))
(reg/mem :fields (list (byte 2 38) (byte 3 32))
:type 'sized-reg/mem)
- (reg :field (byte 3 35) :type 'xmmreg))
+ (reg :field (byte 3 35) :type 'xmmreg)
+ (imm))
+
+(sb!disassem:define-instruction-format (ext-2byte-xmm-reg/mem 40
+ :default-printer
+ '(:name :tab reg ", " reg/mem))
+ (prefix :field (byte 8 0))
+ (x0f :field (byte 8 8) :value #x0f)
+ (op1 :field (byte 8 16))
+ (op2 :field (byte 8 24))
+ (reg/mem :fields (list (byte 2 38) (byte 3 32)) :type 'sized-reg/mem)
+ (reg :field (byte 3 35) :type 'xmmreg)
+ (imm))
;;; Instructions having a general-purpose register as one operand and an
;;; XMM register or a memory location as the other operand.
(x0f :field (byte 8 0) :value #x0f)
(op :field (byte 8 8))
(reg/mem :fields (list (byte 2 22) (byte 3 16))
- :type 'sized-xmmreg/mem)
+ :type 'xmmreg/mem)
(reg :field (byte 3 19) :type 'reg))
-(sb!disassem:define-instruction-format (rex-reg-xmm/mem 32
+(sb!disassem:define-instruction-format (ext-reg-xmm/mem 32
:default-printer
'(:name :tab reg ", " reg/mem))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (x0f :field (byte 8 8) :value #x0f)
+ (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)
+ :type 'xmmreg/mem)
(reg :field (byte 3 27) :type 'reg))
-(sb!disassem:define-instruction-format (ext-reg-xmm/mem 32
+(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 'xmmreg/mem)
+ (reg :field (byte 3 35) :type 'reg))
+
+;;; Instructions having a general-purpose register or a memory location
+;;; as one operand and an a XMM register as the other operand.
+
+(sb!disassem:define-instruction-format (ext-reg/mem-xmm 32
+ :default-printer
+ '(:name :tab reg/mem ", " reg))
+ (prefix :field (byte 8 0))
+ (x0f :field (byte 8 8) :value #x0f)
+ (op :field (byte 8 16))
+ (reg/mem :fields (list (byte 2 30) (byte 3 24))
+ :type 'reg/mem)
+ (reg :field (byte 3 27) :type 'xmmreg)
+ (imm))
+
+(sb!disassem:define-instruction-format (ext-rex-reg/mem-xmm 40
+ :default-printer
+ '(:name :tab reg/mem ", " reg))
+ (prefix :field (byte 8 0))
+ (rex :field (byte 4 12) :value #b0100)
+ (wrxb :field (byte 4 8) :type 'wrxb)
+ (x0f :field (byte 8 16) :value #x0f)
+ (op :field (byte 8 24))
+ (reg/mem :fields (list (byte 2 38) (byte 3 32))
+ :type 'reg/mem)
+ (reg :field (byte 3 35) :type 'xmmreg)
+ (imm))
+
+(sb!disassem:define-instruction-format (ext-2byte-reg/mem-xmm 40
+ :default-printer
+ '(:name :tab reg/mem ", " reg))
+ (prefix :field (byte 8 0))
+ (x0f :field (byte 8 8) :value #x0f)
+ (op1 :field (byte 8 16))
+ (op2 :field (byte 8 24))
+ (reg/mem :fields (list (byte 2 38) (byte 3 32)) :type 'reg/mem)
+ (reg :field (byte 3 35) :type 'xmmreg)
+ (imm))
+
+(sb!disassem:define-instruction-format (ext-rex-2byte-reg/mem-xmm 48
+ :default-printer
+ '(:name :tab reg/mem ", " reg))
+ (prefix :field (byte 8 0))
+ (rex :field (byte 4 12) :value #b0100)
+ (wrxb :field (byte 4 8) :type 'wrxb)
+ (x0f :field (byte 8 16) :value #x0f)
+ (op1 :field (byte 8 24))
+ (op2 :field (byte 8 32))
+ (reg/mem :fields (list (byte 2 46) (byte 3 40)) :type 'reg/mem)
+ (reg :field (byte 3 43) :type 'xmmreg)
+ (imm))
+
+;;; Instructions having a general-purpose register as one operand and an a
+;;; general-purpose register or a memory location as the other operand,
+;;; and using a prefix byte.
+
+(sb!disassem:define-instruction-format (ext-prefix-reg-reg/mem 32
:default-printer
'(:name :tab reg ", " reg/mem))
(prefix :field (byte 8 0))
(x0f :field (byte 8 8) :value #x0f)
(op :field (byte 8 16))
(reg/mem :fields (list (byte 2 30) (byte 3 24))
- :type 'sized-xmmreg/mem)
+ :type 'sized-reg/mem)
(reg :field (byte 3 27) :type 'reg))
-(sb!disassem:define-instruction-format (ext-rex-reg-xmm/mem 40
+(sb!disassem:define-instruction-format (ext-rex-prefix-reg-reg/mem 40
:default-printer
'(:name :tab reg ", " reg/mem))
(prefix :field (byte 8 0))
(x0f :field (byte 8 16) :value #x0f)
(op :field (byte 8 24))
(reg/mem :fields (list (byte 2 38) (byte 3 32))
- :type 'sized-xmmreg/mem)
+ :type 'sized-reg/mem)
+ (reg :field (byte 3 35) :type 'reg))
+
+(sb!disassem:define-instruction-format (ext-2byte-prefix-reg-reg/mem 40
+ :default-printer
+ '(:name :tab reg ", " reg/mem))
+ (prefix :field (byte 8 0))
+ (x0f :field (byte 8 8) :value #x0f)
+ (op1 :field (byte 8 16)) ; #x38 or #x3a
+ (op2 :field (byte 8 24))
+ (reg/mem :fields (list (byte 2 38) (byte 3 32))
+ :type 'sized-reg/mem)
(reg :field (byte 3 35) :type 'reg))
+(sb!disassem:define-instruction-format (ext-rex-2byte-prefix-reg-reg/mem 48
+ :default-printer
+ '(:name :tab reg ", " reg/mem))
+ (prefix :field (byte 8 0))
+ (rex :field (byte 4 12) :value #b0100)
+ (wrxb :field (byte 4 8) :type 'wrxb)
+ (x0f :field (byte 8 16) :value #x0f)
+ (op1 :field (byte 8 24)) ; #x38 or #x3a
+ (op2 :field (byte 8 32))
+ (reg/mem :fields (list (byte 2 46) (byte 3 40))
+ :type 'sized-reg/mem)
+ (reg :field (byte 3 43) :type 'reg))
+
;; XMM comparison instruction
(eval-when (:compile-toplevel :load-toplevel :execute)
:include 'simple
:default-printer '(:name width)))
-(sb!disassem:define-instruction-format (rex-string-op 16
- :include 'rex-simple
- :default-printer '(:name width)))
-
(sb!disassem:define-instruction-format (short-cond-jump 16)
(op :field (byte 4 4))
(cc :field (byte 4 0) :type 'condition-code)
:type 'reg/mem)
(reg :field (byte 3 19) :type 'reg))
-(sb!disassem:define-instruction-format (rex-cond-move 32
- :default-printer
- '('cmov cc :tab reg ", " reg/mem))
- (rex :field (byte 4 4) :value #b0100)
- (wrxb :field (byte 4 0) :type 'wrxb)
- (prefix :field (byte 8 8) :value #b00001111)
- (op :field (byte 4 20) :value #b0100)
- (cc :field (byte 4 16) :type 'condition-code)
- (reg/mem :fields (list (byte 2 30) (byte 3 24))
- :type 'reg/mem)
- (reg :field (byte 3 27) :type 'reg))
-
(sb!disassem:define-instruction-format (enter-format 32
:default-printer '(:name
:tab disp
(op :field (byte 16 0))
(code :field (byte 8 16)))
+;;; F3 escape map - Needs a ton more work.
+
+(sb!disassem:define-instruction-format (F3-escape 24)
+ (prefix1 :field (byte 8 0) :value #xF3)
+ (prefix2 :field (byte 8 8) :value #x0F)
+ (op :field (byte 8 16)))
+
+(sb!disassem:define-instruction-format (rex-F3-escape 32)
+ ;; F3 is a legacy prefix which was generalized to select an alternate opcode
+ ;; map. Legacy prefixes are encoded in the instruction before a REX prefix.
+ (prefix1 :field (byte 8 0) :value #xF3)
+ (rex :field (byte 4 12) :value 4) ; "prefix2"
+ (wrxb :field (byte 4 8) :type 'wrxb)
+ (prefix3 :field (byte 8 16) :value #x0F)
+ (op :field (byte 8 24)))
+
+(sb!disassem:define-instruction-format (F3-escape-reg-reg/mem 32
+ :include 'F3-escape
+ :default-printer
+ '(:name :tab reg "," reg/mem))
+ (reg/mem :fields (list (byte 2 30) (byte 3 24)) :type 'sized-reg/mem)
+ (reg :field (byte 3 27) :type 'reg))
+
+(sb!disassem:define-instruction-format (rex-F3-escape-reg-reg/mem 40
+ :include 'rex-F3-escape
+ :default-printer
+ '(:name :tab reg "," reg/mem))
+ (reg/mem :fields (list (byte 2 38) (byte 3 32)) :type 'sized-reg/mem)
+ (reg :field (byte 3 35) :type 'reg))
+
\f
;;;; primitive emitters
;; FIXME: might as well be COND instead of having to use #. readmacro
;; to hack up the code
(case (sc-name (tn-sc thing))
+ #!+sb-simd-pack
+ (#.*oword-sc-names*
+ :oword)
(#.*qword-sc-names*
:qword)
(#.*dword-sc-names*
(:qword
(emit-signed-dword segment value))))
\f
+;;;; prefixes
+
+(define-instruction rex (segment)
+ (:printer rex () nil :print-name nil)
+ (:emitter
+ (bug "REX prefix used as a standalone instruction")))
+
+(define-instruction x66 (segment)
+ (:printer x66 () nil :print-name nil)
+ (:emitter
+ (bug "#X66 prefix used as a standalone instruction")))
+
+(defun emit-prefix (segment name)
+ (declare (ignorable segment))
+ (ecase name
+ ((nil))
+ (:lock
+ #!+sb-thread
+ (emit-byte segment #xf0))))
+
+(define-instruction lock (segment)
+ (:printer byte ((op #b11110000)) nil)
+ (:emitter
+ (bug "LOCK prefix used as a standalone instruction")))
+
+(define-instruction rep (segment)
+ (:emitter
+ (emit-byte segment #b11110011)))
+
+(define-instruction repe (segment)
+ (:printer byte ((op #b11110011)) nil)
+ (:emitter
+ (emit-byte segment #b11110011)))
+
+(define-instruction repne (segment)
+ (:printer byte ((op #b11110010)) nil)
+ (:emitter
+ (emit-byte segment #b11110010)))
+
;;;; general data transfer
;;; This is the part of the MOV instruction emitter that does moving
(define-instruction mov (segment dst src)
;; immediate to register
- (:printer reg ((op #b1011) (imm nil :type 'signed-imm-data))
+ (:printer reg ((op #b1011) (imm nil :type 'signed-imm-data/asm-routine))
'(:name :tab reg ", " imm))
- (:printer rex-reg ((op #b1011) (imm nil :type 'signed-imm-data-upto-qword))
+ (:printer rex-reg ((op #b1011) (imm nil :type 'signed-imm-data-upto-qword/asm-routine))
'(:name :tab reg ", " imm))
;; absolute mem to/from accumulator
(:printer simple-dir ((op #b101000) (imm nil :type 'imm-addr))
`(:name :tab ,(swap-if 'dir 'accum ", " '("[" imm "]"))))
;; register to/from register/memory
(:printer reg-reg/mem-dir ((op #b100010)))
- (:printer rex-reg-reg/mem-dir ((op #b100010)))
- (:printer x66-reg-reg/mem-dir ((op #b100010)))
- (:printer x66-rex-reg-reg/mem-dir ((op #b100010)))
;; immediate to register/memory
- (:printer reg/mem-imm ((op '(#b1100011 #b000))))
- (:printer rex-reg/mem-imm ((op '(#b1100011 #b000))))
+ (:printer reg/mem-imm/asm-routine ((op '(#b1100011 #b000))))
(:emitter
(let ((size (matching-operand-size dst src)))
#b10111)
(reg-tn-encoding dst))
(emit-sized-immediate segment size src))))
+ ((and (fixup-p src)
+ (or (eq (fixup-flavor src) :foreign)
+ (eq (fixup-flavor src) :assembly-routine)))
+ (maybe-emit-rex-prefix segment :dword nil nil dst)
+ (emit-byte-with-reg segment #b10111 (reg-tn-encoding dst))
+ (emit-absolute-fixup segment src))
(t
(maybe-emit-rex-for-ea segment src dst)
(emit-byte segment
(t
(error "bogus arguments to MOV: ~S ~S" dst src))))))
+;;; Emit a sign-extending (if SIGNED-P is true) or zero-extending move.
+;;; To achieve the shortest possible encoding zero extensions into a
+;;; 64-bit destination are assembled as a straight 32-bit MOV (if the
+;;; source size is 32 bits) or as MOVZX with a 32-bit destination (if
+;;; the source size is 8 or 16 bits). Due to the implicit zero extension
+;;; to 64 bits this has the same effect as a MOVZX with 64-bit
+;;; destination but often needs no REX prefix.
(defun emit-move-with-extension (segment dst src signed-p)
(aver (register-p dst))
(let ((dst-size (operand-size dst))
(src-size (operand-size src))
- (opcode (if signed-p #b10111110 #b10110110)))
- (ecase dst-size
- (:word
- (aver (eq src-size :byte))
- (maybe-emit-operand-size-prefix segment :word)
- ;; REX prefix is needed if SRC is SIL, DIL, SPL or BPL.
- (maybe-emit-rex-for-ea segment src dst :operand-size :word)
- (emit-byte segment #b00001111)
- (emit-byte segment opcode)
- (emit-ea segment src (reg-tn-encoding dst)))
- ((:dword :qword)
- (ecase src-size
- (:byte
- (maybe-emit-rex-for-ea segment src dst :operand-size dst-size)
- (emit-byte segment #b00001111)
- (emit-byte segment opcode)
- (emit-ea segment src (reg-tn-encoding dst)))
- (:word
- (maybe-emit-rex-for-ea segment src dst :operand-size dst-size)
- (emit-byte segment #b00001111)
- (emit-byte segment (logior opcode 1))
- (emit-ea segment src (reg-tn-encoding dst)))
- (:dword
- (aver (eq dst-size :qword))
- ;; dst is in reg, src is in modrm
- (let ((ea-p (ea-p src)))
- (maybe-emit-rex-prefix segment (if signed-p :qword :dword) dst
- (and ea-p (ea-index src))
- (cond (ea-p (ea-base src))
- ((tn-p src) src)
- (t nil)))
- (emit-byte segment (if signed-p #x63 #x8b)) ;movsxd or straight mov
- ;;(emit-byte segment opcode)
- (emit-ea segment src (reg-tn-encoding dst)))))))))
+ (opcode (if signed-p #b10111110 #b10110110)))
+ (macrolet ((emitter (operand-size &rest bytes)
+ `(progn
+ (maybe-emit-rex-for-ea segment src dst
+ :operand-size ,operand-size)
+ ,@(mapcar (lambda (byte)
+ `(emit-byte segment ,byte))
+ bytes)
+ (emit-ea segment src (reg-tn-encoding dst)))))
+ (ecase dst-size
+ (:word
+ (aver (eq src-size :byte))
+ (maybe-emit-operand-size-prefix segment :word)
+ (emitter :word #b00001111 opcode))
+ ((:dword :qword)
+ (unless signed-p
+ (setf dst-size :dword))
+ (ecase src-size
+ (:byte
+ (emitter dst-size #b00001111 opcode))
+ (:word
+ (emitter dst-size #b00001111 (logior opcode 1)))
+ (:dword
+ (aver (or (not signed-p) (eq dst-size :qword)))
+ (emitter dst-size
+ (if signed-p #x63 #x8b))))))))) ; movsxd or straight mov
(define-instruction movsx (segment dst src)
(:printer ext-reg-reg/mem-no-width
((op #b10111110) (reg/mem nil :type 'sized-byte-reg/mem)))
- (:printer rex-ext-reg-reg/mem-no-width
- ((op #b10111110) (reg/mem nil :type 'sized-byte-reg/mem)))
(:printer ext-reg-reg/mem-no-width
((op #b10111111) (reg/mem nil :type 'sized-word-reg/mem)))
- (:printer rex-ext-reg-reg/mem-no-width
- ((op #b10111111) (reg/mem nil :type 'sized-word-reg/mem)))
(:emitter (emit-move-with-extension segment dst src :signed)))
(define-instruction movzx (segment dst src)
(:printer ext-reg-reg/mem-no-width
((op #b10110110) (reg/mem nil :type 'sized-byte-reg/mem)))
- (:printer rex-ext-reg-reg/mem-no-width
- ((op #b10110110) (reg/mem nil :type 'sized-byte-reg/mem)))
(:printer ext-reg-reg/mem-no-width
((op #b10110111) (reg/mem nil :type 'sized-word-reg/mem)))
- (:printer rex-ext-reg-reg/mem-no-width
- ((op #b10110111) (reg/mem nil :type 'sized-word-reg/mem)))
(:emitter (emit-move-with-extension segment dst src nil)))
;;; The regular use of MOVSXD is with an operand size of :qword. This
(define-instruction movsxd (segment dst src)
(:printer reg-reg/mem ((op #b0110001) (width 1)
(reg/mem nil :type 'sized-dword-reg/mem)))
- (:printer rex-reg-reg/mem ((op #b0110001) (width 1)
- (reg/mem nil :type 'sized-dword-reg/mem)))
(:emitter (emit-move-with-extension segment dst src :signed)))
;;; this is not a real amd64 instruction, of course
(define-instruction push (segment src)
;; register
(:printer reg-no-width-default-qword ((op #b01010)))
- (:printer rex-reg-no-width-default-qword ((op #b01010)))
;; register/memory
(:printer reg/mem-default-qword ((op '(#b11111111 #b110))))
- (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b110))))
;; immediate
(:printer byte ((op #b01101010) (imm nil :type 'signed-imm-byte))
'(:name :tab imm))
(define-instruction pop (segment dst)
(:printer reg-no-width-default-qword ((op #b01011)))
- (:printer rex-reg-no-width-default-qword ((op #b01011)))
(:printer reg/mem-default-qword ((op '(#b10001111 #b000))))
- (:printer rex-reg/mem-default-qword ((op '(#b10001111 #b000))))
(:emitter
(let ((size (operand-size dst)))
(aver (or (eq size :qword) (eq size :word)))
(:printer reg-no-width ((op #b10010)) '(:name :tab accum ", " reg))
;; Register/Memory with Register.
(:printer reg-reg/mem ((op #b1000011)))
- (:printer rex-reg-reg/mem ((op #b1000011)))
(:emitter
(let ((size (matching-operand-size operand1 operand2)))
(maybe-emit-operand-size-prefix segment size)
(error "bogus args to XCHG: ~S ~S" operand1 operand2)))))))
(define-instruction lea (segment dst src)
- (:printer rex-reg-reg/mem ((op #b1000110)))
(:printer reg-reg/mem ((op #b1000110) (width 1)))
(:emitter
(aver (or (dword-reg-p dst) (qword-reg-p dst)))
(maybe-emit-rex-for-ea segment src dst
- :operand-size :qword)
+ :operand-size (if (dword-reg-p dst) :dword :qword))
(emit-byte segment #b10001101)
(emit-ea segment src (reg-tn-encoding dst))))
(define-instruction cmpxchg (segment dst src &optional prefix)
;; Register/Memory with Register.
- (:printer-list (ext-reg-reg/mem-printer-list #b1011000
- '(:name :tab reg/mem ", " reg)))
+ (:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg))
(:emitter
(aver (register-p src))
(emit-prefix segment prefix)
(eval-when (:compile-toplevel :execute)
(defun arith-inst-printer-list (subop)
`((accum-imm ((op ,(dpb subop (byte 3 2) #b0000010))))
- (rex-accum-imm ((op ,(dpb subop (byte 3 2) #b0000010))))
(reg/mem-imm ((op (#b1000000 ,subop))))
- (rex-reg/mem-imm ((op (#b1000000 ,subop))))
;; The redundant encoding #x82 is invalid in 64-bit mode,
;; therefore we force WIDTH to 1.
(reg/mem-imm ((op (#b1000001 ,subop)) (width 1)
(imm nil :type signed-imm-byte)))
- (rex-reg/mem-imm ((op (#b1000001 ,subop)) (width 1)
- (imm nil :type signed-imm-byte)))
- (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))
- (rex-reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))))
- )
+ (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000)))))))
(define-instruction add (segment dst src &optional prefix)
(:printer-list (arith-inst-printer-list #b000))
;;; in 64-bit mode so we always use the two-byte form.
(define-instruction inc (segment dst)
(:printer reg/mem ((op '(#b1111111 #b000))))
- (:printer rex-reg/mem ((op '(#b1111111 #b000))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
(define-instruction dec (segment dst)
(:printer reg/mem ((op '(#b1111111 #b001))))
- (:printer rex-reg/mem ((op '(#b1111111 #b001))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
(define-instruction neg (segment dst)
(:printer reg/mem ((op '(#b1111011 #b011))))
- (:printer rex-reg/mem ((op '(#b1111011 #b011))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
(define-instruction mul (segment dst src)
(:printer accum-reg/mem ((op '(#b1111011 #b100))))
- (:printer rex-accum-reg/mem ((op '(#b1111011 #b100))))
(:emitter
(let ((size (matching-operand-size dst src)))
(aver (accumulator-p dst))
(define-instruction imul (segment dst &optional src1 src2)
(:printer accum-reg/mem ((op '(#b1111011 #b101))))
- (:printer rex-accum-reg/mem ((op '(#b1111011 #b101))))
(:printer ext-reg-reg/mem-no-width ((op #b10101111)))
- (:printer rex-ext-reg-reg/mem-no-width ((op #b10101111)))
(:printer reg-reg/mem ((op #b0110100) (width 1)
(imm nil :type 'signed-imm-data))
'(:name :tab reg ", " reg/mem ", " imm))
- (:printer rex-reg-reg/mem ((op #b0110100) (width 1)
- (imm nil :type 'signed-imm-data))
- '(:name :tab reg ", " reg/mem ", " imm))
(:printer reg-reg/mem ((op #b0110101) (width 1)
(imm nil :type 'signed-imm-byte))
'(:name :tab reg ", " reg/mem ", " imm))
- (:printer rex-reg-reg/mem ((op #b0110101) (width 1)
- (imm nil :type 'signed-imm-byte))
- '(:name :tab reg ", " reg/mem ", " imm))
(:emitter
(flet ((r/m-with-immed-to-reg (reg r/m immed)
(let* ((size (matching-operand-size reg r/m))
(define-instruction div (segment dst src)
(:printer accum-reg/mem ((op '(#b1111011 #b110))))
- (:printer rex-accum-reg/mem ((op '(#b1111011 #b110))))
(:emitter
(let ((size (matching-operand-size dst src)))
(aver (accumulator-p dst))
(define-instruction idiv (segment dst src)
(:printer accum-reg/mem ((op '(#b1111011 #b111))))
- (:printer rex-accum-reg/mem ((op '(#b1111011 #b111))))
(:emitter
(let ((size (matching-operand-size dst src)))
(aver (accumulator-p dst))
(define-instruction xadd (segment dst src &optional prefix)
;; Register/Memory with Register.
- (:printer-list (ext-reg-reg/mem-printer-list #b1100000
- '(:name :tab reg/mem ", " reg)))
+ (:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg))
(:emitter
(aver (register-p src))
(emit-prefix segment prefix)
(defun shift-inst-printer-list (subop)
`((reg/mem ((op (#b1101000 ,subop)))
(:name :tab reg/mem ", 1"))
- (rex-reg/mem ((op (#b1101000 ,subop)))
- (:name :tab reg/mem ", 1"))
(reg/mem ((op (#b1101001 ,subop)))
(:name :tab reg/mem ", " 'cl))
- (rex-reg/mem ((op (#b1101001 ,subop)))
- (:name :tab reg/mem ", " 'cl))
(reg/mem-imm ((op (#b1100000 ,subop))
- (imm nil :type imm-byte)))
- (rex-reg/mem-imm ((op (#b1100000 ,subop))
(imm nil :type imm-byte))))))
(define-instruction rol (segment dst amount)
(eval-when (:compile-toplevel :execute)
(defun double-shift-inst-printer-list (op)
- `(#+nil
- (ext-reg-reg/mem-imm ((op ,(logior op #b100))
- (imm nil :type signed-imm-byte)))
- (ext-reg-reg/mem ((op ,(logior op #b101)))
+ `((ext-reg-reg/mem-no-width ((op ,(logior op #b100))
+ (imm nil :type imm-byte))
+ (:name :tab reg/mem ", " reg ", " imm))
+ (ext-reg-reg/mem-no-width ((op ,(logior op #b101)))
(:name :tab reg/mem ", " reg ", " 'cl)))))
(define-instruction shld (segment dst src amt)
- (:declare (type (or (member :cl) (mod 32)) amt))
+ (:declare (type (or (member :cl) (mod 64)) amt))
(:printer-list (double-shift-inst-printer-list #b10100000))
(:emitter
(emit-double-shift segment #b0 dst src amt)))
(define-instruction shrd (segment dst src amt)
- (:declare (type (or (member :cl) (mod 32)) amt))
+ (:declare (type (or (member :cl) (mod 64)) amt))
(:printer-list (double-shift-inst-printer-list #b10101000))
(:emitter
(emit-double-shift segment #b1 dst src amt)))
(define-instruction test (segment this that)
(:printer accum-imm ((op #b1010100)))
- (:printer rex-accum-imm ((op #b1010100)))
(:printer reg/mem-imm ((op '(#b1111011 #b000))))
- (:printer rex-reg/mem-imm ((op '(#b1111011 #b000))))
(:printer reg-reg/mem ((op #b1000010)))
- (:printer rex-reg-reg/mem ((op #b1000010)))
(:emitter
(let ((size (matching-operand-size this that)))
(maybe-emit-operand-size-prefix segment size)
(t
(error "bogus operands for TEST: ~S and ~S" this that)))))))
+;;; Emit the most compact form of the test immediate instruction,
+;;; using an 8 bit test when the immediate is only 8 bits and the
+;;; value is one of the four low registers (rax, rbx, rcx, rdx) or the
+;;; control stack.
+(defun emit-optimized-test-inst (x y)
+ (typecase y
+ ((unsigned-byte 7)
+ (let ((offset (tn-offset x)))
+ (cond ((and (sc-is x any-reg descriptor-reg)
+ (or (= offset rax-offset) (= offset rbx-offset)
+ (= offset rcx-offset) (= offset rdx-offset)))
+ (inst test (reg-in-size x :byte) y))
+ ((sc-is x control-stack)
+ (inst test (make-ea :byte :base rbp-tn
+ :disp (frame-byte-offset offset))
+ y))
+ (t
+ (inst test x y)))))
+ (t
+ (inst test x y))))
+
(define-instruction or (segment dst src)
(:printer-list
(arith-inst-printer-list #b001))
(define-instruction not (segment dst)
(:printer reg/mem ((op '(#b1111011 #b010))))
- (:printer rex-reg/mem ((op '(#b1111011 #b010))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
(define-instruction cmps (segment size)
(:printer string-op ((op #b1010011)))
- (:printer rex-string-op ((op #b1010011)))
(:emitter
(maybe-emit-operand-size-prefix segment size)
(maybe-emit-rex-prefix segment size nil nil nil)
(define-instruction ins (segment acc)
(:printer string-op ((op #b0110110)))
- (:printer rex-string-op ((op #b0110110)))
(:emitter
(let ((size (operand-size acc)))
(aver (accumulator-p acc))
(define-instruction lods (segment acc)
(:printer string-op ((op #b1010110)))
- (:printer rex-string-op ((op #b1010110)))
(:emitter
(let ((size (operand-size acc)))
(aver (accumulator-p acc))
(define-instruction movs (segment size)
(:printer string-op ((op #b1010010)))
- (:printer rex-string-op ((op #b1010010)))
(:emitter
(maybe-emit-operand-size-prefix segment size)
(maybe-emit-rex-prefix segment size nil nil nil)
(define-instruction outs (segment acc)
(:printer string-op ((op #b0110111)))
- (:printer rex-string-op ((op #b0110111)))
(:emitter
(let ((size (operand-size acc)))
(aver (accumulator-p acc))
(define-instruction scas (segment acc)
(:printer string-op ((op #b1010111)))
- (:printer rex-string-op ((op #b1010111)))
(:emitter
(let ((size (operand-size acc)))
(aver (accumulator-p acc))
(define-instruction stos (segment acc)
(:printer string-op ((op #b1010101)))
- (:printer rex-string-op ((op #b1010101)))
(:emitter
(let ((size (operand-size acc)))
(aver (accumulator-p acc))
(:emitter
(emit-byte segment #b11010111)))
-(define-instruction rep (segment)
- (:emitter
- (emit-byte segment #b11110011)))
-
-(define-instruction repe (segment)
- (:printer byte ((op #b11110011)))
- (:emitter
- (emit-byte segment #b11110011)))
-
-(define-instruction repne (segment)
- (:printer byte ((op #b11110010)))
- (:emitter
- (emit-byte segment #b11110010)))
-
\f
;;;; bit manipulation
(define-instruction bsf (segment dst src)
(:printer ext-reg-reg/mem-no-width ((op #b10111100)))
- (:printer rex-ext-reg-reg/mem-no-width ((op #b10111100)))
(:emitter
(let ((size (matching-operand-size dst src)))
(when (eq size :byte)
(define-instruction bsr (segment dst src)
(:printer ext-reg-reg/mem-no-width ((op #b10111101)))
- (:printer rex-ext-reg-reg/mem-no-width ((op #b10111101)))
(:emitter
(let ((size (matching-operand-size dst src)))
(when (eq size :byte)
(eval-when (:compile-toplevel :execute)
(defun bit-test-inst-printer-list (subop)
- `((ext-reg/mem-imm ((op (#b1011101 ,subop))
- (reg/mem nil :type reg/mem)
- (imm nil :type imm-byte)
- (width 0)))
- (ext-reg-reg/mem ((op ,(dpb subop (byte 3 2) #b1000001))
- (width 1))
- (:name :tab reg/mem ", " reg)))))
-
-(define-instruction bt (segment src index)
- (:printer-list (bit-test-inst-printer-list #b100))
- (:emitter
- (emit-bit-test-and-mumble segment src index #b100)))
-
-(define-instruction btc (segment src index)
- (:printer-list (bit-test-inst-printer-list #b111))
- (:emitter
- (emit-bit-test-and-mumble segment src index #b111)))
-
-(define-instruction btr (segment src index)
- (:printer-list (bit-test-inst-printer-list #b110))
- (:emitter
- (emit-bit-test-and-mumble segment src index #b110)))
-
-(define-instruction bts (segment src index)
- (:printer-list (bit-test-inst-printer-list #b101))
- (:emitter
- (emit-bit-test-and-mumble segment src index #b101)))
+ `((ext-reg/mem-no-width+imm8 ((op (#xBA ,subop))))
+ (ext-reg-reg/mem-no-width ((op ,(dpb subop (byte 3 3) #b10000011))
+ (reg/mem nil :type sized-reg/mem))
+ (:name :tab reg/mem ", " reg)))))
+
+(macrolet ((define (inst opcode-extension)
+ `(define-instruction ,inst (segment src index)
+ (:printer-list (bit-test-inst-printer-list ,opcode-extension))
+ (:emitter (emit-bit-test-and-mumble segment src index
+ ,opcode-extension)))))
+ (define bt 4)
+ (define bts 5)
+ (define btr 6)
+ (define btc 7))
\f
;;;; control transfer
(define-instruction call (segment where)
(:printer near-jump ((op #b11101000)))
(:printer reg/mem-default-qword ((op '(#b11111111 #b010))))
- (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b010))))
(:emitter
(typecase where
(label
(:printer short-jump ((op #b1011)))
(:printer near-jump ((op #b11101001)))
(:printer reg/mem-default-qword ((op '(#b11111111 #b100))))
- (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b100))))
(:emitter
(cond (where
(emit-chooser
;;;; conditional move
(define-instruction cmov (segment cond dst src)
(:printer cond-move ())
- (:printer rex-cond-move ())
(:emitter
(aver (register-p dst))
(let ((size (matching-operand-size dst src)))
(define-instruction set (segment dst cond)
(:printer cond-set ())
(:emitter
- (maybe-emit-rex-for-ea segment dst nil)
+ (maybe-emit-rex-for-ea segment dst nil :operand-size :byte)
(emit-byte segment #b00001111)
(emit-byte segment (dpb (conditional-opcode cond) (byte 4 0) #b10010000))
(emit-ea segment dst #b000)))
(define-instruction nop (segment)
(:printer byte ((op #b10010000)))
+ ;; multi-byte NOP
+ (:printer ext-reg/mem-no-width ((op '(#x1f 0))) '(:name))
(:emitter
(emit-byte segment #b10010000)))
+;;; Emit a sequence of single- or multi-byte NOPs to fill AMOUNT many
+;;; bytes with the smallest possible number of such instructions.
+(defun emit-long-nop (segment amount)
+ (declare (type segment segment)
+ (type index amount))
+ ;; Pack all instructions into one byte vector to save space.
+ (let* ((bytes #.(coerce #(#x90
+ #x66 #x90
+ #x0f #x1f #x00
+ #x0f #x1f #x40 #x00
+ #x0f #x1f #x44 #x00 #x00
+ #x66 #x0f #x1f #x44 #x00 #x00
+ #x0f #x1f #x80 #x00 #x00 #x00 #x00
+ #x0f #x1f #x84 #x00 #x00 #x00 #x00 #x00
+ #x66 #x0f #x1f #x84 #x00 #x00 #x00 #x00 #x00)
+ '(vector (unsigned-byte 8))))
+ (max-length (isqrt (* 2 (length bytes)))))
+ (loop
+ (let* ((count (min amount max-length))
+ (start (ash (* count (1- count)) -1)))
+ (dotimes (i count)
+ (emit-byte segment (aref bytes (+ start i)))))
+ (if (> amount max-length)
+ (decf amount max-length)
+ (return)))))
+
(define-instruction wait (segment)
(:printer byte ((op #b10011011)))
(:emitter
(emit-byte segment #b10011011)))
-(defun emit-prefix (segment name)
- (declare (ignorable segment))
- (ecase name
- ((nil))
- (:lock
- #!+sb-thread
- (emit-byte segment #xf0))))
-
-;;; FIXME: It would be better to make the disassembler understand the prefix as part
-;;; of the instructions...
-(define-instruction lock (segment)
- (:printer byte ((op #b11110000)))
- (:emitter
- (bug "LOCK prefix used as a standalone instruction")))
\f
;;;; miscellaneous hackery
\f
;;;; Instructions required to do floating point operations using SSE
-;; Return a two-element list of printers for SSE instructions. One
-;; printer is for the format without a REX prefix, the other one for the
-;; one with.
+;; Return a one- or two-element list of printers for SSE instructions.
+;; The one-element list is used in the cases where the REX prefix is
+;; really a prefix and thus automatically supported, the two-element
+;; list is used when the REX prefix is used in an infix position.
(eval-when (:compile-toplevel :execute)
(defun sse-inst-printer-list (inst-format-stem prefix opcode
&key more-fields printer)
(inst-formats (if prefix
(list (symbolicate "EXT-" inst-format-stem)
(symbolicate "EXT-REX-" inst-format-stem))
- (list inst-format-stem
- (symbolicate "REX-" inst-format-stem)))))
+ (list inst-format-stem))))
+ (mapcar (lambda (inst-format)
+ `(,inst-format ,fields ,@(when printer
+ (list printer))))
+ inst-formats)))
+ (defun 2byte-sse-inst-printer-list (inst-format-stem prefix op1 op2
+ &key more-fields printer)
+ (let ((fields `(,@(when prefix
+ `((prefix, prefix)))
+ (op1 ,op1)
+ (op2 ,op2)
+ ,@more-fields))
+ (inst-formats (if prefix
+ (list (symbolicate "EXT-" inst-format-stem)
+ (symbolicate "EXT-REX-" inst-format-stem))
+ (list inst-format-stem))))
(mapcar (lambda (inst-format)
`(,inst-format ,fields ,@(when printer
(list printer))))
(aver (<= 0 /i 7))
(when prefix
(emit-byte segment prefix))
- (maybe-emit-rex-prefix segment operand-size dst/src nil nil)
+ ;; dst/src is encoded in the r/m field, not r; REX.B must be
+ ;; set to use extended XMM registers
+ (maybe-emit-rex-prefix segment operand-size nil nil dst/src)
(emit-byte segment #x0F)
(emit-byte segment opcode)
(emit-byte segment (logior (ash (logior #b11000 /i) 3)
(reg-tn-encoding dst/src)))
(emit-byte segment imm))
+(defun emit-sse-inst-2byte (segment dst src prefix op1 op2
+ &key operand-size (remaining-bytes 0))
+ (when prefix
+ (emit-byte segment prefix))
+ (if operand-size
+ (maybe-emit-rex-for-ea segment src dst :operand-size operand-size)
+ (maybe-emit-rex-for-ea segment src dst))
+ (emit-byte segment #x0f)
+ (emit-byte segment op1)
+ (emit-byte segment op2)
+ (emit-ea segment src (reg-tn-encoding dst) :remaining-bytes remaining-bytes))
+
(macrolet
((define-imm-sse-instruction (name opcode /i)
`(define-instruction ,name (segment dst/src imm)
:operand-size :do-not-set
:remaining-bytes remaining-bytes))
+(defun emit-regular-2byte-sse-inst (segment dst src prefix op1 op2
+ &key (remaining-bytes 0))
+ (aver (xmm-register-p dst))
+ (emit-sse-inst-2byte segment dst src prefix op1 op2
+ :operand-size :do-not-set
+ :remaining-bytes remaining-bytes))
+
;;; Instructions having an XMM register as the destination operand
;;; and an XMM register or a memory location as the source operand.
;;; The operand size is implicitly given by the instruction.
',(sse-inst-printer-list 'xmm-xmm/mem prefix opcode))
(:emitter
(emit-regular-sse-inst segment dst src ,prefix ,opcode)))))
+ ;; moves
+ (define-regular-sse-inst movshdup #xf3 #x16)
+ (define-regular-sse-inst movsldup #xf3 #x12)
+ (define-regular-sse-inst movddup #xf2 #x12)
;; logical
(define-regular-sse-inst andpd #x66 #x54)
(define-regular-sse-inst andps nil #x54)
(define-regular-sse-inst addps nil #x58)
(define-regular-sse-inst addsd #xf2 #x58)
(define-regular-sse-inst addss #xf3 #x58)
+ (define-regular-sse-inst addsubpd #x66 #xd0)
+ (define-regular-sse-inst addsubps #xf2 #xd0)
(define-regular-sse-inst divpd #x66 #x5e)
(define-regular-sse-inst divps nil #x5e)
(define-regular-sse-inst divsd #xf2 #x5e)
(define-regular-sse-inst divss #xf3 #x5e)
+ (define-regular-sse-inst haddpd #x66 #x7c)
+ (define-regular-sse-inst haddps #xf2 #x7c)
+ (define-regular-sse-inst hsubpd #x66 #x7d)
+ (define-regular-sse-inst hsubps #xf2 #x7d)
(define-regular-sse-inst mulpd #x66 #x59)
(define-regular-sse-inst mulps nil #x59)
(define-regular-sse-inst mulsd #xf2 #x59)
(define-mov-sse-inst movupd #x66 #x10 #x11)
(define-mov-sse-inst movups nil #x10 #x11))
+;;; MOVNTDQA
+(define-instruction movntdqa (segment dst src)
+ (:printer-list
+ (2byte-sse-inst-printer-list '2byte-xmm-xmm/mem #x66 #x38 #x2a))
+ (:emitter
+ (aver (and (xmm-register-p dst)
+ (not (xmm-register-p src))))
+ (emit-regular-2byte-sse-inst segment dst src #x66 #x38 #x2a)))
+
;;; MOVQ
(define-instruction movq (segment dst src)
(:printer-list
(aver (xmm-register-p src))
(emit-sse-inst segment src dst #x66 #x7e)))))
-(define-instruction pinsrw (segment dst src imm)
- (:printer-list
- (sse-inst-printer-list
- 'xmm-reg/mem #x66 #xc4
- :more-fields '((imm nil :type imm-byte))
- :printer '(:name :tab reg ", " reg/mem ", " imm)))
- (:emitter
- (aver (xmm-register-p dst))
- (let ((src-size (operand-size src)))
- (aver (or (not (register-p src))
- (eq src-size :qword) (eq src-size :dword)))
- (emit-sse-inst segment dst src #x66 #xc4
- :operand-size (if (register-p src) src-size :do-not-set)
- :remaining-bytes 1))
- (emit-byte segment imm)))
+(macrolet ((define-extract-sse-instruction (name prefix op1 op2 &key explicit-qword)
+ `(define-instruction ,name (segment dst src imm)
+ (:printer
+ ,(if op2 (if explicit-qword
+ 'ext-rex-2byte-reg/mem-xmm
+ 'ext-2byte-reg/mem-xmm)
+ 'ext-reg/mem-xmm)
+ ((prefix '(,prefix))
+ ,@(if op2
+ `((op1 '(,op1)) (op2 '(,op2)))
+ `((op '(,op1))))
+ (imm nil :type 'imm-byte))
+ '(:name :tab reg/mem ", " reg ", " imm))
+ (:emitter
+ (aver (and (xmm-register-p src) (not (xmm-register-p dst))))
+ ,(if op2
+ `(emit-sse-inst-2byte segment dst src ,prefix ,op1 ,op2
+ :operand-size ,(if explicit-qword
+ :qword
+ :do-not-set)
+ :remaining-bytes 1)
+ `(emit-sse-inst segment dst src ,prefix ,op1
+ :operand-size ,(if explicit-qword
+ :qword
+ :do-not-set)
+ :remaining-bytes 1))
+ (emit-byte segment imm))))
+
+ (define-insert-sse-instruction (name prefix op1 op2)
+ `(define-instruction ,name (segment dst src imm)
+ (:printer
+ ,(if op2 'ext-2byte-xmm-reg/mem 'ext-xmm-reg/mem)
+ ((prefix '(,prefix))
+ ,@(if op2
+ `((op1 '(,op1)) (op2 '(,op2)))
+ `((op '(,op1))))
+ (imm nil :type 'imm-byte))
+ '(:name :tab reg ", " reg/mem ", " imm))
+ (:emitter
+ (aver (and (xmm-register-p dst) (not (xmm-register-p src))))
+ ,(if op2
+ `(emit-sse-inst-2byte segment dst src ,prefix ,op1 ,op2
+ :operand-size :do-not-set
+ :remaining-bytes 1)
+ `(emit-sse-inst segment dst src ,prefix ,op1
+ :operand-size :do-not-set
+ :remaining-bytes 1))
+ (emit-byte segment imm)))))
+
+
+ ;; pinsrq not encodable in 64-bit mode
+ (define-insert-sse-instruction pinsrb #x66 #x3a #x20)
+ (define-insert-sse-instruction pinsrw #x66 #xc4 nil)
+ (define-insert-sse-instruction pinsrd #x66 #x3a #x22)
+ (define-insert-sse-instruction insertps #x66 #x3a #x21)
+ (define-extract-sse-instruction pextrb #x66 #x3a #x14)
+ (define-extract-sse-instruction pextrd #x66 #x3a #x16)
+ (define-extract-sse-instruction pextrq #x66 #x3a #x16 :explicit-qword t)
+ (define-extract-sse-instruction extractps #x66 #x3a #x17))
+
+;; PEXTRW has a new 2-byte encoding in SSE4.1 to allow dst to be
+;; a memory address.
(define-instruction pextrw (segment dst src imm)
(:printer-list
- (sse-inst-printer-list
- 'reg-xmm/mem #x66 #xc5
- :more-fields '((imm nil :type imm-byte))
- :printer '(:name :tab reg ", " reg/mem ", " imm)))
+ (append
+ (2byte-sse-inst-printer-list '2byte-reg/mem-xmm #x66 #x3a #x15
+ :more-fields '((imm nil :type imm-byte))
+ :printer
+ '(:name :tab reg/mem ", " reg ", " imm))
+ (sse-inst-printer-list 'reg/mem-xmm #x66 #xc5
+ :more-fields '((imm nil :type imm-byte))
+ :printer
+ '(:name :tab reg/mem ", " reg ", " imm))))
(:emitter
(aver (xmm-register-p src))
- (aver (register-p dst))
- (let ((dst-size (operand-size dst)))
- (aver (or (eq dst-size :qword) (eq dst-size :dword)))
- (emit-sse-inst segment dst src #x66 #xc5
- :operand-size dst-size
- :remaining-bytes 1))
+ (if (not (register-p dst))
+ (emit-sse-inst-2byte segment dst src #x66 #x3a #x15
+ :operand-size :do-not-set :remaining-bytes 1)
+ (emit-sse-inst segment dst src #x66 #xc5
+ :operand-size :do-not-set :remaining-bytes 1))
(emit-byte segment imm)))
(macrolet ((define-integer-source-sse-inst (name prefix opcode &key mem-only)
(define-gpr-destination-sse-inst movmskps nil #x50 :reg-only t)
(define-gpr-destination-sse-inst pmovmskb #x66 #xd7 :reg-only t))
+;;;; We call these "2byte" instructions due to their two opcode bytes.
+;;;; Intel and AMD call them three-byte instructions, as they count the
+;;;; 0x0f byte for determining the number of opcode bytes.
+
+;;; Instructions that take XMM-XMM/MEM and XMM-XMM/MEM-IMM arguments.
+
+(macrolet ((regular-2byte-sse-inst (name prefix op1 op2)
+ `(define-instruction ,name (segment dst src)
+ (:printer-list
+ ',(2byte-sse-inst-printer-list '2byte-xmm-xmm/mem prefix op1 op2))
+ (:emitter
+ (emit-regular-2byte-sse-inst segment dst src ,prefix ,op1 ,op2))))
+ (regular-2byte-sse-inst-imm (name prefix op1 op2)
+ `(define-instruction ,name (segment dst src imm)
+ (:printer-list
+ ',(2byte-sse-inst-printer-list '2byte-xmm-xmm/mem prefix op1 op2
+ :more-fields '((imm nil :type imm-byte))
+ :printer `(:name :tab reg ", " reg/mem ", " imm)))
+ (:emitter
+ (aver (typep imm '(unsigned-byte 8)))
+ (emit-regular-2byte-sse-inst segment dst src ,prefix ,op1 ,op2
+ :remaining-bytes 1)
+ (emit-byte segment imm)))))
+ (regular-2byte-sse-inst pshufb #x66 #x38 #x00)
+ (regular-2byte-sse-inst phaddw #x66 #x38 #x01)
+ (regular-2byte-sse-inst phaddd #x66 #x38 #x02)
+ (regular-2byte-sse-inst phaddsw #x66 #x38 #x03)
+ (regular-2byte-sse-inst pmaddubsw #x66 #x38 #x04)
+ (regular-2byte-sse-inst phsubw #x66 #x38 #x05)
+ (regular-2byte-sse-inst phsubd #x66 #x38 #x06)
+ (regular-2byte-sse-inst phsubsw #x66 #x38 #x07)
+ (regular-2byte-sse-inst psignb #x66 #x38 #x08)
+ (regular-2byte-sse-inst psignw #x66 #x38 #x09)
+ (regular-2byte-sse-inst psignd #x66 #x38 #x0a)
+ (regular-2byte-sse-inst pmulhrsw #x66 #x38 #x0b)
+
+ (regular-2byte-sse-inst ptest #x66 #x38 #x17)
+ (regular-2byte-sse-inst pabsb #x66 #x38 #x1c)
+ (regular-2byte-sse-inst pabsw #x66 #x38 #x1d)
+ (regular-2byte-sse-inst pabsd #x66 #x38 #x1e)
+
+ (regular-2byte-sse-inst pmuldq #x66 #x38 #x28)
+ (regular-2byte-sse-inst pcmpeqq #x66 #x38 #x29)
+ (regular-2byte-sse-inst packusdw #x66 #x38 #x2b)
+
+ (regular-2byte-sse-inst pcmpgtq #x66 #x38 #x37)
+ (regular-2byte-sse-inst pminsb #x66 #x38 #x38)
+ (regular-2byte-sse-inst pminsd #x66 #x38 #x39)
+ (regular-2byte-sse-inst pminuw #x66 #x38 #x3a)
+ (regular-2byte-sse-inst pminud #x66 #x38 #x3b)
+ (regular-2byte-sse-inst pmaxsb #x66 #x38 #x3c)
+ (regular-2byte-sse-inst pmaxsd #x66 #x38 #x3d)
+ (regular-2byte-sse-inst pmaxuw #x66 #x38 #x3e)
+ (regular-2byte-sse-inst pmaxud #x66 #x38 #x3f)
+
+ (regular-2byte-sse-inst pmulld #x66 #x38 #x40)
+ (regular-2byte-sse-inst phminposuw #x66 #x38 #x41)
+
+ (regular-2byte-sse-inst aesimc #x66 #x38 #xdb)
+ (regular-2byte-sse-inst aesenc #x66 #x38 #xdc)
+ (regular-2byte-sse-inst aesenclast #x66 #x38 #xdd)
+ (regular-2byte-sse-inst aesdec #x66 #x38 #xde)
+ (regular-2byte-sse-inst aesdeclast #x66 #x38 #xdf)
+
+ (regular-2byte-sse-inst pmovsxbw #x66 #x38 #x20)
+ (regular-2byte-sse-inst pmovsxbd #x66 #x38 #x21)
+ (regular-2byte-sse-inst pmovsxbq #x66 #x38 #x22)
+ (regular-2byte-sse-inst pmovsxwd #x66 #x38 #x23)
+ (regular-2byte-sse-inst pmovsxwq #x66 #x38 #x24)
+ (regular-2byte-sse-inst pmovsxdq #x66 #x38 #x25)
+
+ (regular-2byte-sse-inst pmovzxbw #x66 #x38 #x30)
+ (regular-2byte-sse-inst pmovzxbd #x66 #x38 #x31)
+ (regular-2byte-sse-inst pmovzxbq #x66 #x38 #x32)
+ (regular-2byte-sse-inst pmovzxwd #x66 #x38 #x33)
+ (regular-2byte-sse-inst pmovzxwq #x66 #x38 #x34)
+ (regular-2byte-sse-inst pmovzxdq #x66 #x38 #x35)
+
+ (regular-2byte-sse-inst-imm roundps #x66 #x3a #x08)
+ (regular-2byte-sse-inst-imm roundpd #x66 #x3a #x09)
+ (regular-2byte-sse-inst-imm roundss #x66 #x3a #x0a)
+ (regular-2byte-sse-inst-imm roundsd #x66 #x3a #x0b)
+ (regular-2byte-sse-inst-imm blendps #x66 #x3a #x0c)
+ (regular-2byte-sse-inst-imm blendpd #x66 #x3a #x0d)
+ (regular-2byte-sse-inst-imm pblendw #x66 #x3a #x0e)
+ (regular-2byte-sse-inst-imm palignr #x66 #x3a #x0f)
+ (regular-2byte-sse-inst-imm dpps #x66 #x3a #x40)
+ (regular-2byte-sse-inst-imm dppd #x66 #x3a #x41)
+
+ (regular-2byte-sse-inst-imm mpsadbw #x66 #x3a #x42)
+ (regular-2byte-sse-inst-imm pclmulqdq #x66 #x3a #x44)
+
+ (regular-2byte-sse-inst-imm pcmpestrm #x66 #x3a #x60)
+ (regular-2byte-sse-inst-imm pcmpestri #x66 #x3a #x61)
+ (regular-2byte-sse-inst-imm pcmpistrm #x66 #x3a #x62)
+ (regular-2byte-sse-inst-imm pcmpistri #x66 #x3a #x63)
+
+ (regular-2byte-sse-inst-imm aeskeygenassist #x66 #x3a #xdf))
+
;;; Other SSE instructions
+;; Instructions implicitly using XMM0 as a mask
+(macrolet ((define-sse-inst-implicit-mask (name prefix op1 op2)
+ `(define-instruction ,name (segment dst src mask)
+ (:printer-list
+ ',(2byte-sse-inst-printer-list
+ '2byte-xmm-xmm/mem prefix op1 op2
+ :printer '(:name :tab reg ", " reg/mem ", XMM0")))
+ (:emitter
+ (aver (xmm-register-p dst))
+ (aver (and (xmm-register-p mask) (= (tn-offset mask) 0)))
+ (emit-regular-2byte-sse-inst segment dst src ,prefix ,op1 ,op2)))))
+
+ (define-sse-inst-implicit-mask pblendvb #x66 #x38 #x10)
+ (define-sse-inst-implicit-mask blendvps #x66 #x38 #x14)
+ (define-sse-inst-implicit-mask blendvpd #x66 #x38 #x15))
+
;; FIXME: is that right!?
(define-instruction movnti (segment dst src)
(:printer ext-reg-reg/mem-no-width ((op #xc3)))
- (:printer rex-ext-reg-reg/mem-no-width ((op #xc3)))
(:emitter
(aver (not (or (register-p dst)
(xmm-register-p dst))))
'("PREFETCHT1" :tab reg/mem))
(:printer ext-reg/mem-no-width ((op '(#x18 3)))
'("PREFETCHT2" :tab reg/mem))
- (:printer rex-ext-reg/mem-no-width ((op '(#x18 0)))
- '("PREFETCHNTA" :tab reg/mem))
- (:printer rex-ext-reg/mem-no-width ((op '(#x18 1)))
- '("PREFETCHT0" :tab reg/mem))
- (:printer rex-ext-reg/mem-no-width ((op '(#x18 2)))
- '("PREFETCHT1" :tab reg/mem))
- (:printer rex-ext-reg/mem-no-width ((op '(#x18 3)))
- '("PREFETCHT2" :tab reg/mem))
(:emitter
(aver (not (or (register-p src)
(xmm-register-p src))))
(define-instruction clflush (segment src)
(:printer ext-reg/mem-no-width ((op '(#xae 7))))
- (:printer rex-ext-reg/mem-no-width ((op '(#xae 7))))
(:emitter
(aver (not (or (register-p src)
(xmm-register-p src))))
(define-instruction ldmxcsr (segment src)
(:printer ext-reg/mem-no-width ((op '(#xae 2))))
- (:printer rex-ext-reg/mem-no-width ((op '(#xae 2))))
(:emitter
(aver (not (or (register-p src)
(xmm-register-p src))))
(define-instruction stmxcsr (segment dst)
(:printer ext-reg/mem-no-width ((op '(#xae 3))))
- (:printer rex-ext-reg/mem-no-width ((op '(#xae 3))))
(:emitter
(aver (not (or (register-p dst)
(xmm-register-p dst))))
(emit-byte segment #xae)
(emit-ea segment dst 3)))
+(define-instruction popcnt (segment dst src)
+ (:printer-list `((f3-escape-reg-reg/mem ((op #xB8)))
+ (rex-f3-escape-reg-reg/mem ((op #xB8)))))
+ (:emitter
+ (aver (register-p dst))
+ (aver (and (register-p dst) (not (eq (operand-size dst) :byte))))
+ (aver (not (eq (operand-size src) :byte)))
+ (emit-sse-inst segment dst src #xf3 #xb8)))
+
+(define-instruction crc32 (segment dst src)
+ (:printer-list
+ `(,@(mapcan (lambda (op2)
+ (mapcar (lambda (instfmt)
+ `(,instfmt ((prefix (#xf2)) (op1 (#x38))
+ (op2 (,op2)))))
+ '(ext-rex-2byte-prefix-reg-reg/mem
+ ext-2byte-prefix-reg-reg/mem)))
+ '(#xf0 #xf1))))
+ (:emitter
+ (let ((dst-size (operand-size dst)))
+ (aver (and (register-p dst) (not (or (eq dst-size :word)
+ (eq dst-size :byte)))))
+ (if (eq (operand-size src) :byte)
+ (emit-sse-inst-2byte segment dst src #xf2 #x38 #xf0)
+ (emit-sse-inst-2byte segment dst src #xf2 #x38 #xf1)))))
+
;;;; Miscellany
(define-instruction cpuid (segment)
((complex single-float)
(setf constant (list :complex-single-float first)))
((complex double-float)
- (setf constant (list :complex-double-float first)))))
+ (setf constant (list :complex-double-float first)))
+ #!+sb-simd-pack
+ (#+sb-xc-host nil
+ #-sb-xc-host simd-pack
+ (setf constant (list :sse (logior (%simd-pack-low first)
+ (ash (%simd-pack-high first)
+ 64)))))))
(destructuring-bind (type value) constant
(ecase type
((:byte :word :dword :qword)
(values label (make-ea size
:disp (make-fixup nil :code-object label)))))
-(defun emit-constant-segment-header (constants optimize)
+(defun emit-constant-segment-header (segment constants optimize)
(declare (ignore constants))
- (loop repeat (if optimize 64 16) do (inst byte #x90)))
+ (emit-long-nop segment (if optimize 64 16)))
(defun size-nbyte (size)
(ecase size
projects / sbcl.git / blobdiff