-;;;; that part of the description of the x86 instruction set (for
-;;;; 80386 and above) which can live on the cross-compilation host
+;;;; that part of the description of the x86-64 instruction set
+;;;; which can live on the cross-compilation host
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;; Note: In CMU CL, this used to be a call to SET-DISASSEM-PARAMS.
(setf sb!disassem:*disassem-inst-alignment-bytes* 1)
-;;; this type is used mostly in disassembly and represents legacy
-;;; registers only. r8-15 are handled separately
+;;; This type is used mostly in disassembly and represents legacy
+;;; registers only. R8-R15 are handled separately.
(deftype reg () '(unsigned-byte 3))
-;;; default word size for the chip: if the operand size !=:dword
+;;; This includes legacy registers and R8-R15.
+(deftype full-reg () '(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)
+
+;;; The default address size for the chip. It could be overwritten
+;;; to :dword with a #x67 prefix, but this is never needed by SBCL
+;;; and thus not supported by this assembler/disassembler.
+(def!constant +default-address-size+ :qword)
\f
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(type sb!disassem:disassem-state dstate))
(+ (sb!disassem:dstate-next-addr dstate) value))
-(defparameter *default-address-size*
- ;; Again, this is the chip default, not the SBCL backend preference
- ;; which must be set with prefixes if it's different. It's :dword;
- ;; this is not negotiable
- :dword)
-
(defparameter *byte-reg-names*
- #(al cl dl bl ah ch dh bh))
+ #(al cl dl bl spl bpl sil dil r8b r9b r10b r11b r12b r13b r14b r15b))
(defparameter *word-reg-names*
- #(ax cx dx bx sp bp si di))
+ #(ax cx dx bx sp bp si di r8w r9w r10w r11w r12w r13w r14w r15w))
(defparameter *dword-reg-names*
- #(eax ecx edx ebx esp ebp esi edi))
+ #(eax ecx edx ebx esp ebp esi edi r8d r9d r10d r11d r12d r13d r14d r15d))
(defparameter *qword-reg-names*
#(rax rcx rdx rbx rsp rbp rsi rdi r8 r9 r10 r11 r12 r13 r14 r15))
+;;; The printers for registers, memory references and immediates need to
+;;; take into account the width bit in the instruction, whether a #x66
+;;; or a REX prefix was issued, and the contents of the REX prefix.
+;;; This is implemented using prefilters to put flags into the slot
+;;; INST-PROPERTIES of the DSTATE. These flags are the following
+;;; symbols:
+;;;
+;;; OPERAND-SIZE-8 The width bit was zero
+;;; OPERAND-SIZE-16 The "operand size override" prefix (#x66) was found
+;;; REX A REX prefix was found
+;;; REX-W A REX prefix with the "operand width" bit set was
+;;; found
+;;; REX-R A REX prefix with the "register" bit set was found
+;;; REX-X A REX prefix with the "index" bit set was found
+;;; REX-B A REX prefix with the "base" bit set was found
+
+;;; Return the operand size depending on the prefixes and width bit as
+;;; stored in DSTATE.
+(defun inst-operand-size (dstate)
+ (declare (type sb!disassem:disassem-state dstate))
+ (cond ((sb!disassem:dstate-get-inst-prop dstate 'operand-size-8)
+ :byte)
+ ((sb!disassem:dstate-get-inst-prop dstate 'rex-w)
+ :qword)
+ ((sb!disassem:dstate-get-inst-prop dstate 'operand-size-16)
+ :word)
+ (t
+ +default-operand-size+)))
+
+;;; The same as INST-OPERAND-SIZE, but for those instructions (e.g.
+;;; PUSH, JMP) that have a default operand size of :qword. It can only
+;;; be overwritten to :word.
+(defun inst-operand-size-default-qword (dstate)
+ (declare (type sb!disassem:disassem-state dstate))
+ (if (sb!disassem:dstate-get-inst-prop dstate 'operand-size-16)
+ :word
+ :qword))
+
(defun print-reg-with-width (value width stream dstate)
- (declare (ignore dstate))
+ (declare (type full-reg value)
+ (type stream stream)
+ (ignore dstate))
(princ (aref (ecase width
(:byte *byte-reg-names*)
(:word *word-reg-names*)
)
(defun print-reg (value stream dstate)
- (declare (type reg value)
+ (declare (type full-reg value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
(print-reg-with-width value
- (sb!disassem:dstate-get-prop dstate 'width)
+ (inst-operand-size dstate)
stream
dstate))
-(defun print-word-reg (value stream dstate)
- (declare (type reg value)
+(defun print-reg-default-qword (value stream dstate)
+ (declare (type full-reg value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
(print-reg-with-width value
- (or (sb!disassem:dstate-get-prop dstate 'word-width)
- +default-operand-size+)
+ (inst-operand-size-default-qword dstate)
stream
dstate))
(defun print-byte-reg (value stream dstate)
- (declare (type reg value)
+ (declare (type full-reg value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
(print-reg-with-width value :byte stream dstate))
(defun print-addr-reg (value stream dstate)
- (declare (type reg value)
+ (declare (type full-reg value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
- (print-reg-with-width value *default-address-size* stream dstate))
+ (print-reg-with-width value +default-address-size+ stream dstate))
+
+;;; Print a register or a memory reference of the given WIDTH.
+;;; If SIZED-P is true, add an explicit size indicator for memory
+;;; references.
+(defun print-reg/mem-with-width (value width sized-p stream dstate)
+ (declare (type (or list full-reg) value)
+ (type (member :byte :word :dword :qword) width)
+ (type boolean sized-p)
+ (type stream stream)
+ (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 a register or a memory reference. The width is determined by
+;;; calling INST-OPERAND-SIZE.
(defun print-reg/mem (value stream dstate)
- (declare (type (or list reg) value)
+ (declare (type (or list full-reg) value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
- (if (typep value 'reg)
- (print-reg value stream dstate)
- (print-mem-access value stream nil dstate)))
+ (print-reg/mem-with-width
+ value (inst-operand-size dstate) nil stream dstate))
;; Same as print-reg/mem, but prints an explicit size indicator for
;; memory references.
(defun print-sized-reg/mem (value stream dstate)
- (declare (type (or list reg) value)
+ (declare (type (or list full-reg) value)
+ (type stream stream)
+ (type sb!disassem:disassem-state dstate))
+ (print-reg/mem-with-width
+ value (inst-operand-size dstate) t stream dstate))
+
+;;; Same as print-sized-reg/mem, but with a default operand size of
+;;; :qword.
+(defun print-sized-reg/mem-default-qword (value stream dstate)
+ (declare (type (or list full-reg) value)
+ (type stream stream)
+ (type sb!disassem:disassem-state dstate))
+ (print-reg/mem-with-width
+ value (inst-operand-size-default-qword dstate) t stream dstate))
+
+(defun print-sized-byte-reg/mem (value stream dstate)
+ (declare (type (or list full-reg) value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
- (if (typep value 'reg)
- (print-reg value stream dstate)
- (print-mem-access value stream t dstate)))
+ (print-reg/mem-with-width value :byte t stream dstate))
-(defun print-byte-reg/mem (value stream dstate)
- (declare (type (or list reg) value)
+(defun print-sized-word-reg/mem (value stream dstate)
+ (declare (type (or list full-reg) value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
- (if (typep value 'reg)
- (print-byte-reg value stream dstate)
- (print-mem-access value stream t dstate)))
+ (print-reg/mem-with-width value :word t stream dstate))
-(defun print-word-reg/mem (value stream dstate)
- (declare (type (or list reg) value)
+(defun print-sized-dword-reg/mem (value stream dstate)
+ (declare (type (or list full-reg) value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
- (if (typep value 'reg)
- (print-word-reg value stream dstate)
- (print-mem-access value stream nil dstate)))
+ (print-reg/mem-with-width value :dword t stream dstate))
(defun print-label (value stream dstate)
(declare (ignore dstate))
(sb!disassem:princ16 value stream))
+;;; 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.
+(defun prefilter-wrxb (value dstate)
+ (declare (type (unsigned-byte 4) value)
+ (type sb!disassem:disassem-state dstate))
+ (sb!disassem:dstate-put-inst-prop dstate 'rex)
+ (when (plusp (logand value #b1000))
+ (sb!disassem:dstate-put-inst-prop dstate 'rex-w))
+ (when (plusp (logand value #b0100))
+ (sb!disassem:dstate-put-inst-prop dstate 'rex-r))
+ (when (plusp (logand value #b0010))
+ (sb!disassem:dstate-put-inst-prop dstate 'rex-x))
+ (when (plusp (logand value #b0001))
+ (sb!disassem:dstate-put-inst-prop dstate 'rex-b))
+ value)
+
+;;; This prefilter is used solely for its side effect, namely to put
+;;; the property OPERAND-SIZE-8 into the DSTATE if VALUE is 0.
+(defun prefilter-width (value dstate)
+ (declare (type bit value)
+ (type sb!disassem:disassem-state dstate))
+ (when (zerop value)
+ (sb!disassem:dstate-put-inst-prop dstate 'operand-size-8))
+ value)
+
+;;; A register field that can be extended by REX.R.
+(defun prefilter-reg-r (value dstate)
+ (declare (type reg value)
+ (type sb!disassem:disassem-state dstate))
+ (if (sb!disassem::dstate-get-inst-prop dstate 'rex-r)
+ (+ value 8)
+ value))
+
+;;; A register field that can be extended by REX.B.
+(defun prefilter-reg-b (value dstate)
+ (declare (type reg value)
+ (type sb!disassem:disassem-state dstate))
+ (if (sb!disassem::dstate-get-inst-prop dstate 'rex-b)
+ (+ value 8)
+ value))
+
;;; Returns either an integer, meaning a register, or a list of
;;; (BASE-REG OFFSET INDEX-REG INDEX-SCALE), where any component
;;; may be missing or nil to indicate that it's not used or has the
-;;; obvious default value (e.g., 1 for the index-scale).
+;;; obvious default value (e.g., 1 for the index-scale). VALUE is a list
+;;; of the mod and r/m field of the ModRM byte of the instruction.
+;;; Depending on VALUE a SIB byte and/or an offset may be read. The
+;;; REX.B bit from DSTATE is used to extend the sole register or the
+;;; BASE-REG to a full register, the REX.X bit does the same for the
+;;; INDEX-REG.
(defun prefilter-reg/mem (value dstate)
(declare (type list value)
(type sb!disassem:disassem-state dstate))
- (let ((mod (car value))
- (r/m (cadr value)))
+ (let ((mod (first value))
+ (r/m (second value)))
(declare (type (unsigned-byte 2) mod)
(type (unsigned-byte 3) r/m))
- (cond ((= mod #b11)
- ;; registers
- r/m)
- ((= r/m #b100)
- ;; sib byte
- (let ((sib (sb!disassem:read-suffix 8 dstate)))
- (declare (type (unsigned-byte 8) sib))
- (let ((base-reg (ldb (byte 3 0) sib))
- (index-reg (ldb (byte 3 3) sib))
- (index-scale (ldb (byte 2 6) sib)))
- (declare (type (unsigned-byte 3) base-reg index-reg)
- (type (unsigned-byte 2) index-scale))
- (let* ((offset
- (case mod
- (#b00
- (if (= base-reg #b101)
- (sb!disassem:read-signed-suffix 32 dstate)
- nil))
- (#b01
- (sb!disassem:read-signed-suffix 8 dstate))
- (#b10
- (sb!disassem:read-signed-suffix 32 dstate)))))
- (list (if (and (= mod #b00) (= base-reg #b101)) nil base-reg)
- offset
- (if (= index-reg #b100) nil index-reg)
- (ash 1 index-scale))))))
- ((and (= mod #b00) (= r/m #b101))
- (list nil (sb!disassem:read-signed-suffix 32 dstate)) )
- ((= mod #b00)
- (list r/m))
- ((= mod #b01)
- (list r/m (sb!disassem:read-signed-suffix 8 dstate)))
+ (let ((full-reg (if (sb!disassem:dstate-get-inst-prop dstate 'rex-b)
+ (+ r/m 8)
+ r/m)))
+ (declare (type full-reg full-reg))
+ (cond ((= mod #b11)
+ ;; registers
+ full-reg)
+ ((= r/m #b100)
+ ;; sib byte
+ (let ((sib (sb!disassem:read-suffix 8 dstate)))
+ (declare (type (unsigned-byte 8) sib))
+ (let ((base-reg (ldb (byte 3 0) sib))
+ (index-reg (ldb (byte 3 3) sib))
+ (index-scale (ldb (byte 2 6) sib)))
+ (declare (type (unsigned-byte 3) base-reg index-reg)
+ (type (unsigned-byte 2) index-scale))
+ (let* ((offset
+ (case mod
+ (#b00
+ (if (= base-reg #b101)
+ (sb!disassem:read-signed-suffix 32 dstate)
+ nil))
+ (#b01
+ (sb!disassem:read-signed-suffix 8 dstate))
+ (#b10
+ (sb!disassem:read-signed-suffix 32 dstate)))))
+ (list (unless (and (= mod #b00) (= base-reg #b101))
+ (if (sb!disassem:dstate-get-inst-prop dstate 'rex-b)
+ (+ base-reg 8)
+ base-reg))
+ offset
+ (unless (= index-reg #b100)
+ (if (sb!disassem:dstate-get-inst-prop dstate 'rex-x)
+ (+ index-reg 8)
+ index-reg))
+ (ash 1 index-scale))))))
+ ((and (= mod #b00) (= r/m #b101))
+ (list 'rip (sb!disassem:read-signed-suffix 32 dstate)) )
+ ((= mod #b00)
+ (list full-reg))
+ ((= mod #b01)
+ (list full-reg (sb!disassem:read-signed-suffix 8 dstate)))
(t ; (= mod #b10)
- (list r/m (sb!disassem:read-signed-suffix 32 dstate))))))
-
-
-;;; This is a sort of bogus prefilter that just stores the info globally for
-;;; other people to use; it probably never gets printed.
-(defun prefilter-width (value dstate)
- (setf (sb!disassem:dstate-get-prop dstate 'width)
- (if (zerop value)
- :byte
- (let ((word-width
- ;; set by a prefix instruction
- (or (sb!disassem:dstate-get-prop dstate 'word-width)
- +default-operand-size+)))
- (when (not (eql word-width +default-operand-size+))
- ;; Reset it.
- (setf (sb!disassem:dstate-get-prop dstate 'word-width)
- +default-operand-size+))
- word-width))))
+ (list full-reg (sb!disassem:read-signed-suffix 32 dstate)))))))
(defun read-address (value dstate)
(declare (ignore value)) ; always nil anyway
- (sb!disassem:read-suffix (width-bits *default-address-size*) dstate))
+ (sb!disassem:read-suffix (width-bits (inst-operand-size dstate)) dstate))
(defun width-bits (width)
(ecase width
(:byte 8)
(:word 16)
(:dword 32)
+ (:qword 64)
(:float 32)
(:double 64)))
\f
;;;; disassembler argument types
+;;; Used to capture the lower four bits of the REX prefix.
+(sb!disassem:define-arg-type wrxb
+ :prefilter #'prefilter-wrxb)
+
+(sb!disassem:define-arg-type width
+ :prefilter #'prefilter-width
+ :printer (lambda (value stream dstate)
+ (declare (ignore value))
+ (princ (schar (symbol-name (inst-operand-size dstate)) 0)
+ stream)))
+
(sb!disassem:define-arg-type displacement
:sign-extend t
:use-label #'offset-next
(type sb!disassem:disassem-state dstate))
(print-reg 0 stream dstate)))
-(sb!disassem:define-arg-type word-accum
- :printer (lambda (value stream dstate)
- (declare (ignore value)
- (type stream stream)
- (type sb!disassem:disassem-state dstate))
- (print-word-reg 0 stream dstate)))
-
(sb!disassem:define-arg-type reg
+ :prefilter #'prefilter-reg-r
:printer #'print-reg)
-(sb!disassem:define-arg-type addr-reg
- :printer #'print-addr-reg)
+(sb!disassem:define-arg-type reg-b
+ :prefilter #'prefilter-reg-b
+ :printer #'print-reg)
-(sb!disassem:define-arg-type word-reg
- :printer #'print-word-reg)
+(sb!disassem:define-arg-type reg-b-default-qword
+ :prefilter #'prefilter-reg-b
+ :printer #'print-reg-default-qword)
(sb!disassem:define-arg-type imm-addr
:prefilter #'read-address
:printer #'print-label)
-(sb!disassem:define-arg-type imm-data
+;;; Normally, immediate values for an operand size of :qword are of size
+;;; :dword and are sign-extended to 64 bits. For an exception, see the
+;;; argument type definition following this one.
+(sb!disassem:define-arg-type signed-imm-data
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
- (sb!disassem:read-suffix
- (width-bits (sb!disassem:dstate-get-prop dstate 'width))
- dstate)))
-
-(sb!disassem:define-arg-type signed-imm-data
+ (let ((width (width-bits (inst-operand-size dstate))))
+ (when (= width 64)
+ (setf width 32))
+ (sb!disassem:read-signed-suffix width dstate))))
+
+;;; 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.
+(sb!disassem:define-arg-type signed-imm-data-upto-qword
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
- (let ((width (sb!disassem:dstate-get-prop dstate 'width)))
- (sb!disassem:read-signed-suffix (width-bits width) dstate))))
+ (sb!disassem:read-signed-suffix
+ (width-bits (inst-operand-size dstate))
+ dstate)))
+
+;;; 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
+;;; argument is PUSH.
+(sb!disassem:define-arg-type signed-imm-data-default-qword
+ :prefilter (lambda (value dstate)
+ (declare (ignore value)) ; always nil anyway
+ (let ((width (width-bits
+ (inst-operand-size-default-qword dstate))))
+ (when (= width 64)
+ (setf width 32))
+ (sb!disassem:read-signed-suffix width dstate))))
(sb!disassem:define-arg-type signed-imm-byte
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(sb!disassem:read-signed-suffix 8 dstate)))
-(sb!disassem:define-arg-type signed-imm-dword
- :prefilter (lambda (value dstate)
- (declare (ignore value)) ; always nil anyway
- (sb!disassem:read-signed-suffix 32 dstate)))
-
-(sb!disassem:define-arg-type imm-word
+(sb!disassem:define-arg-type imm-byte
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
- (let ((width
- (or (sb!disassem:dstate-get-prop dstate 'word-width)
- +default-operand-size+)))
- (sb!disassem:read-suffix (width-bits width) dstate))))
+ (sb!disassem:read-suffix 8 dstate)))
;;; needed for the ret imm16 instruction
(sb!disassem:define-arg-type imm-word-16
;; memory references.
:prefilter #'prefilter-reg/mem
:printer #'print-sized-reg/mem)
-(sb!disassem:define-arg-type byte-reg/mem
+
+;;; Arguments of type reg/mem with a fixed size.
+(sb!disassem:define-arg-type sized-byte-reg/mem
:prefilter #'prefilter-reg/mem
- :printer #'print-byte-reg/mem)
-(sb!disassem:define-arg-type word-reg/mem
+ :printer #'print-sized-byte-reg/mem)
+(sb!disassem:define-arg-type sized-word-reg/mem
:prefilter #'prefilter-reg/mem
- :printer #'print-word-reg/mem)
+ :printer #'print-sized-word-reg/mem)
+(sb!disassem:define-arg-type sized-dword-reg/mem
+ :prefilter #'prefilter-reg/mem
+ :printer #'print-sized-dword-reg/mem)
+
+;;; Same as sized-reg/mem, but with a default operand size of :qword.
+(sb!disassem:define-arg-type sized-reg/mem-default-qword
+ :prefilter #'prefilter-reg/mem
+ :printer #'print-sized-reg/mem-default-qword)
;;; added by jrd
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
:prefilter #'prefilter-fp-reg
:printer #'print-fp-reg)
-(sb!disassem:define-arg-type width
- :prefilter #'prefilter-width
- :printer (lambda (value stream dstate)
- (if;; (zerop value)
- (or (null value)
- (and (numberp value) (zerop value))) ; zzz jrd
- (princ 'b stream)
- (let ((word-width
- ;; set by a prefix instruction
- (or (sb!disassem:dstate-get-prop dstate 'word-width)
- +default-operand-size+)))
- (princ (schar (symbol-name word-width) 0) stream)))))
-
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *conditions*
'((:o . 0)
(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))
:include 'simple
:default-printer '(:name
:tab accum ", " imm))
- (imm :type 'imm-data))
+ (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))
- (reg :field (byte 3 0) :type 'word-reg)
+ (reg :field (byte 3 0) :type 'reg-b)
+ ;; optional fields
+ (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))
+
+(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 'word-accum)
+ (accum :type 'accum)
(imm))
-;;; adds a width field to reg-no-width
+;;; 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
+;;; the one for IMM to be able to determine the correct size of IMM.
(sb!disassem:define-instruction-format (reg 8
:default-printer '(:name :tab reg))
(op :field (byte 4 4))
(width :field (byte 1 3) :type 'width)
- (reg :field (byte 3 0) :type 'reg)
+ (reg :field (byte 3 0) :type 'reg-b)
;; optional fields
(accum :type 'accum)
- (imm)
- )
+ (imm))
-;;; Same as reg, but with direction bit
-(sb!disassem:define-instruction-format (reg-dir 8 :include 'reg)
- (op :field (byte 3 5))
- (dir :field (byte 1 4)))
+(sb!disassem:define-instruction-format (rex-reg 16
+ :default-printer '(:name :tab reg))
+ (rex :field (byte 4 4) :value #b0100)
+ (wrxb :field (byte 4 0) :type 'wrxb)
+ (width :field (byte 1 11) :type 'width)
+ (op :field (byte 4 12))
+ (reg :field (byte 3 8) :type 'reg-b)
+ ;; optional fields
+ (accum :type 'accum)
+ (imm))
(sb!disassem:define-instruction-format (two-bytes 16
:default-printer '(:name))
;; 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)))
-;;; Same as reg-rem/mem, but uses the reg field as a second op code.
+(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)))
+ (rex :field (byte 4 4) :value #b0100)
+ (wrxb :field (byte 4 0) :type 'wrxb)
+ (op :field (byte 6 10))
+ (dir :field (byte 1 9)))
+
+;;; 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))
(op :fields (list (byte 7 1) (byte 3 11)))
;; 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
+ :default-printer '(:name :tab reg/mem))
+ (op :fields (list (byte 8 0) (byte 3 11)))
+ (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
:default-printer
'(:name :tab reg/mem ", " imm))
(reg/mem :type 'sized-reg/mem)
- (imm :type 'imm-data))
+ (imm :type 'signed-imm-data))
+
+(sb!disassem:define-instruction-format (rex-reg/mem-imm 24
+ :include 'rex-reg/mem
+ :default-printer
+ '(:name :tab reg/mem ", " imm))
+ (reg/mem :type 'sized-reg/mem)
+ (imm :type 'signed-imm-data))
;;; Same as reg/mem, but with using the accumulator in the default printer
(sb!disassem:define-instruction-format
;; optional fields
(imm))
+(sb!disassem:define-instruction-format (ext-reg-reg/mem-no-width 24
+ :default-printer
+ `(:name :tab reg ", " reg/mem))
+ (prefix :field (byte 8 0) :value #b00001111)
+ (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))
+
+;;; 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))
(prefix :field (byte 8 0) :value #b00001111)
(op :field (byte 5 11))
- (reg :field (byte 3 8) :type 'word-reg))
+ (reg :field (byte 3 8) :type 'reg-b))
;;; Same as reg/mem, but with a prefix of #b00001111
(sb!disassem:define-instruction-format (ext-reg/mem 24
:include 'ext-reg/mem
:default-printer
'(:name :tab reg/mem ", " imm))
- (imm :type 'imm-data))
+ (imm :type 'signed-imm-data))
\f
;;;; This section was added by jrd, for fp instructions.
: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)
(op :field (byte 4 12) :value #b1001)
(cc :field (byte 4 8) :type 'condition-code)
(reg/mem :fields (list (byte 2 22) (byte 3 16))
- :type 'byte-reg/mem)
+ :type 'sized-byte-reg/mem)
(reg :field (byte 3 19) :value #b000))
(sb!disassem:define-instruction-format (cond-move 24
(defun emit-relative-fixup (segment fixup)
(note-fixup segment :relative fixup)
(emit-dword segment (or (fixup-offset fixup) 0)))
+
\f
;;;; the effective-address (ea) structure
(defun reg-tn-encoding (tn)
(declare (type tn tn))
- (aver (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
+ (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
- (let ((offset (mod (tn-offset tn) 16)))
- (logior (ash (logand offset 1) 2)
- (ash offset -1))))
-
+ (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))))))
+
(defstruct (ea (:constructor make-ea (size &key base index scale disp))
(:copier nil))
;; note that we can represent an EA qith a QWORD size, but EMIT-EA
(format stream "+~A" (ea-disp ea))))
(write-char #\] stream))))
+(defun emit-constant-tn-rip (segment constant-tn reg)
+ ;; AMD64 doesn't currently have a code object register to use as a
+ ;; base register for constant access. Instead we use RIP-relative
+ ;; addressing. The offset from the SIMPLE-FUN-HEADER to the instruction
+ ;; is passed to the backpatch callback. In addition we need the offset
+ ;; from the start of the function header to the slot in the CODE-HEADER
+ ;; that stores the constant. Since we don't know where the code header
+ ;; starts, instead count backwards from the function header.
+ (let* ((2comp (component-info *component-being-compiled*))
+ (constants (ir2-component-constants 2comp))
+ (len (length constants))
+ ;; Both CODE-HEADER and SIMPLE-FUN-HEADER are 16-byte aligned.
+ ;; If there are an even amount of constants, there will be
+ ;; an extra qword of padding before the function header, which
+ ;; needs to be adjusted for. XXX: This will break if new slots
+ ;; are added to the code header.
+ (offset (* (- (+ len (if (evenp len)
+ 1
+ 2))
+ (tn-offset constant-tn))
+ n-word-bytes)))
+ ;; RIP-relative addressing
+ (emit-mod-reg-r/m-byte segment #b00 reg #b101)
+ (emit-back-patch segment
+ 4
+ (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)))))))
+ (values))
+
+(defun emit-label-rip (segment fixup reg)
+ (let ((label (fixup-offset fixup)))
+ ;; RIP-relative addressing
+ (emit-mod-reg-r/m-byte segment #b00 reg #b101)
+ (emit-back-patch segment
+ 4
+ (lambda (segment posn)
+ (emit-dword segment (- (label-position label)
+ (+ posn 4))))))
+ (values))
+
(defun emit-ea (segment thing reg &optional allow-constants)
(etypecase thing
(tn
;; this would be eleganter if we had a function that would create
;; an ea given a tn
(ecase (sb-name (sc-sb (tn-sc thing)))
- (registers
+ ((registers float-registers)
(emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing)))
(stack
;; Convert stack tns into an index off RBP.
(emit-dword segment disp)))))
(constant
(unless allow-constants
+ ;; Why?
(error
"Constant TNs can only be directly used in MOV, PUSH, and CMP."))
- (emit-mod-reg-r/m-byte segment #b00 reg #b100)
- (emit-sib-byte segment 1 4 5) ;no base, no index
- (emit-absolute-fixup segment
- (make-fixup nil
- :code-object
- (- (* (tn-offset thing) n-word-bytes)
- other-pointer-lowtag))))))
+ (emit-constant-tn-rip segment thing reg))))
(ea
(let* ((base (ea-base thing))
(index (ea-index thing))
(emit-absolute-fixup segment disp)
(emit-dword segment disp))))))
(fixup
- (emit-mod-reg-r/m-byte segment #b00 reg #b100)
- (emit-sib-byte segment 0 #b100 #b101)
- (emit-absolute-fixup segment thing))))
+ (typecase (fixup-offset thing)
+ (label
+ (emit-label-rip segment thing reg))
+ (t
+ (emit-mod-reg-r/m-byte segment #b00 reg #b100)
+ (emit-sib-byte segment 0 #b100 #b101)
+ (emit-absolute-fixup segment thing))))))
(defun fp-reg-tn-p (thing)
(and (tn-p thing)
(and (member (sc-name (tn-sc thing)) *qword-sc-names*) t))
(t nil)))
-
(defun register-p (thing)
(and (tn-p thing)
(eq (sb-name (sc-sb (tn-sc thing))) 'registers)))
(defun accumulator-p (thing)
(and (register-p thing)
(= (tn-offset thing) 0)))
+
\f
;;;; utilities
(emit-byte segment +operand-size-prefix-byte+)))
(defun maybe-emit-rex-prefix (segment operand-size r x b)
- (labels ((if-hi (r) ;; offset of r8 is 16
- (if (and r (> (tn-offset r) 15)) 1 0)))
+ (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)
+ 7
+ 15)))
+ 1
+ 0)))
(let ((rex-w (if (eq operand-size :qword) 1 0))
(rex-r (if-hi r))
(rex-x (if-hi x))
(rex-b (if-hi b)))
- (when (not (zerop (logior rex-w rex-r rex-x rex-b)))
+ (when (or (eq operand-size :byte) ;; REX needed to access SIL/DIL
+ (not (zerop (logior rex-w rex-r rex-x rex-b))))
(emit-rex-byte segment #b0100 rex-w rex-r rex-x rex-b)))))
-(defun maybe-emit-rex-for-ea (segment ea reg)
+(defun maybe-emit-rex-for-ea (segment ea reg &key operand-size)
(let ((ea-p (ea-p ea))) ;emit-ea can also be called with a tn
- (maybe-emit-rex-prefix segment (operand-size ea) reg
+ (maybe-emit-rex-prefix segment
+ (or operand-size (operand-size ea))
+ reg
(and ea-p (ea-index ea))
(cond (ea-p (ea-base ea))
((and (tn-p ea)
- (eql (sb-name (sc-sb (tn-sc ea)))
- 'registers))
+ (member (sb-name (sc-sb (tn-sc ea)))
+ '(float-registers registers)))
ea)
(t nil)))))
(error "can't tell the size of ~S ~S" thing (sc-name (tn-sc thing))))))
(ea
(ea-size thing))
+ (fixup
+ ;; GNA. Guess who spelt "flavor" correctly first time round?
+ ;; There's a strong argument in my mind to change all uses of
+ ;; "flavor" to "kind": and similarly with some misguided uses of
+ ;; "type" here and there. -- CSR, 2005-01-06.
+ (case (fixup-flavor thing)
+ ((:foreign-dataref) :qword)))
(t
nil)))
(define-instruction mov (segment dst src)
;; immediate to register
- (:printer reg ((op #b1011) (imm nil :type 'imm-data))
+ (:printer reg ((op #b1011) (imm nil :type 'signed-imm-data))
+ '(:name :tab reg ", " imm))
+ (:printer rex-reg ((op #b1011) (imm nil :type 'signed-imm-data-upto-qword))
'(: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)))
;; immediate to register/memory
(:printer reg/mem-imm ((op '(#b1100011 #b000))))
+ (:printer rex-reg/mem-imm ((op '(#b1100011 #b000))))
(:emitter
(let ((size (matching-operand-size dst src)))
#b10111)
(reg-tn-encoding dst))
(emit-sized-immediate segment size src (eq size :qword)))
- ((and (fixup-p src) (accumulator-p dst))
- (maybe-emit-rex-prefix segment (operand-size src)
- nil nil nil)
- (emit-byte segment
- (if (eq size :byte)
- #b10100000
- #b10100001))
- (emit-absolute-fixup segment src (eq size :qword)))
(t
(maybe-emit-rex-for-ea segment src dst)
(emit-byte segment
#b10001010
#b10001011))
(emit-ea segment src (reg-tn-encoding dst) t))))
- ((and (fixup-p dst) (accumulator-p src))
- (maybe-emit-rex-prefix segment size nil nil nil)
- (emit-byte segment (if (eq size :byte) #b10100010 #b10100011))
- (emit-absolute-fixup segment dst (eq size :qword)))
((integerp src)
;; C7 only deals with 32 bit immediates even if register is
;; 64 bit: only b8-bf use 64 bit immediates
(emit-byte segment (if (eq size :byte) #b10001000 #b10001001))
(emit-ea segment dst (reg-tn-encoding src)))
((fixup-p src)
+ ;; Generally we can't MOV a fixupped value into an EA, since
+ ;; MOV on non-registers can only take a 32-bit immediate arg.
+ ;; Make an exception for :FOREIGN fixups (pretty much just
+ ;; the runtime asm, since other foreign calls go through the
+ ;; the linkage table) and for linkage table references, since
+ ;; these should always end up in low memory.
+ (aver (or (eq (fixup-flavor src) :foreign)
+ (eq (fixup-flavor src) :foreign-dataref)
+ (eq (ea-size dst) :dword)))
(maybe-emit-rex-for-ea segment dst nil)
(emit-byte segment #b11000111)
(emit-ea segment dst #b000)
(ecase src-size
(:byte
(maybe-emit-operand-size-prefix segment :dword)
- (maybe-emit-rex-for-ea segment src dst)
+ (maybe-emit-rex-for-ea segment src dst
+ :operand-size (operand-size dst))
(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)
+ (maybe-emit-rex-for-ea segment src dst
+ :operand-size (operand-size dst))
(emit-byte segment #b00001111)
(emit-byte segment (logior opcode 1))
(emit-ea segment src (reg-tn-encoding dst)))
(emit-ea segment src (reg-tn-encoding dst)))))))))
(define-instruction movsx (segment dst src)
- (:printer ext-reg-reg/mem ((op #b1011111) (reg nil :type 'word-reg)))
+ (: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 ((op #b1011011) (reg nil :type 'word-reg)))
+ (: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)))
(define-instruction movsxd (segment dst src)
- (:printer reg-reg/mem ((op #x63) (reg nil :type 'word-reg)))
+ (: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 movzxd (segment dst src)
- (:printer reg-reg/mem ((op #x63) (reg nil :type 'word-reg)))
+ ; (:printer reg-reg/mem ((op #x63) (reg nil :type 'reg)))
(:emitter (emit-move-with-extension segment dst src nil)))
(define-instruction push (segment src)
;; register
- (:printer reg-no-width ((op #b01010)))
+ (:printer reg-no-width-default-qword ((op #b01010)))
+ (:printer rex-reg-no-width-default-qword ((op #b01010)))
;; register/memory
- (:printer reg/mem ((op '(#b1111111 #b110)) (width 1)))
+ (: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))
- (:printer byte ((op #b01101000) (imm nil :type 'imm-word))
+ (:printer byte ((op #b01101000)
+ (imm nil :type 'signed-imm-data-default-qword))
'(:name :tab imm))
;; ### segment registers?
;; whether it expects 32 or 64 bit immediate here
(emit-byte segment #b01101000)
(emit-dword segment src))))
- ((fixup-p src)
- ;; Interpret the fixup as an immediate dword to push.
- (emit-byte segment #b01101000)
- (emit-absolute-fixup segment src))
(t
(let ((size (operand-size src)))
(aver (not (eq size :byte)))
(emit-byte segment #b01100000)))
(define-instruction pop (segment dst)
- (:printer reg-no-width ((op #b01011)))
- (:printer reg/mem ((op '(#b1000111 #b000)) (width 1)))
+ (: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 (not (eq size :byte)))
(: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)
(labels ((xchg-acc-with-something (acc something)
(if (and (not (eq size :byte)) (register-p something))
- (emit-byte-with-reg segment
- #b10010
- (reg-tn-encoding something))
+ (progn
+ (maybe-emit-rex-for-ea segment acc something)
+ (emit-byte-with-reg segment
+ #b10010
+ (reg-tn-encoding something)))
(xchg-reg-with-something acc something)))
(xchg-reg-with-something (reg something)
+ (maybe-emit-rex-for-ea segment something reg)
(emit-byte segment (if (eq size :byte) #b10000110 #b10000111))
(emit-ea segment something (reg-tn-encoding reg))))
(cond ((accumulator-p operand1)
(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)
+ (aver (or (dword-reg-p dst) (qword-reg-p dst)))
+ (maybe-emit-rex-for-ea segment src dst
+ :operand-size :qword)
(emit-byte segment #b10001101)
(emit-ea segment src (reg-tn-encoding dst))))
(emit-byte segment #b10000011)
(emit-ea segment dst opcode allow-constants)
(emit-byte segment src))
- ((accumulator-p dst)
+ ((accumulator-p dst)
+ (maybe-emit-rex-for-ea segment dst nil)
(emit-byte segment
(dpb opcode
(byte 3 3)
(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))))
- (reg/mem-imm ((op (#b1000001 ,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))
(imm nil :type signed-imm-byte)))
- (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))))
+ (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))
+ (rex-reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))))
)
(define-instruction add (segment dst src)
(:emitter (emit-random-arith-inst "CMP" segment dst src #b111 t)))
(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))))
(:emitter
(let ((size (operand-size dst)))
(define-instruction dec (segment dst)
;; Register.
- (:printer reg-no-width ((op #b01001)))
+ (:printer modrm-reg-no-width ((modrm-reg #b001)))
;; Register/Memory
(:printer reg/mem ((op '(#b1111111 #b001))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
- (cond ((and (not (eq size :byte)) (register-p dst))
+ (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) #b11110110 #b11110111))
(emit-ea segment dst #b011))))
-(define-instruction aaa (segment)
- (:printer byte ((op #b00110111)))
- (:emitter
- (emit-byte segment #b00110111)))
-
-(define-instruction aas (segment)
- (:printer byte ((op #b00111111)))
- (:emitter
- (emit-byte segment #b00111111)))
-
-(define-instruction daa (segment)
- (:printer byte ((op #b00100111)))
- (:emitter
- (emit-byte segment #b00100111)))
-
-(define-instruction das (segment)
- (:printer byte ((op #b00101111)))
- (:emitter
- (emit-byte segment #b00101111)))
-
(define-instruction mul (segment dst src)
(:printer accum-reg/mem ((op '(#b1111011 #b100))))
(:emitter
(define-instruction imul (segment dst &optional src1 src2)
(:printer accum-reg/mem ((op '(#b1111011 #b101))))
- (:printer ext-reg-reg/mem ((op #b1010111)))
- (:printer reg-reg/mem ((op #b0110100) (width 1) (imm nil :type 'imm-word))
+ (: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))
(emit-byte segment #x0f)
(emit-byte-with-reg segment #b11001 (reg-tn-encoding dst)))))
-
-(define-instruction aad (segment)
- (:printer two-bytes ((op '(#b11010101 #b00001010))))
- (:emitter
- (emit-byte segment #b11010101)
- (emit-byte segment #b00001010)))
-
-(define-instruction aam (segment)
- (:printer two-bytes ((op '(#b11010100 #b00001010))))
- (:emitter
- (emit-byte segment #b11010100)
- (emit-byte segment #b00001010)))
-
;;; CBW -- Convert Byte to Word. AX <- sign_xtnd(AL)
(define-instruction cbw (segment)
(:emitter
;;; CQO -- Convert Quad or Octaword. RDX:RAX <- sign_xtnd(RAX)
(define-instruction cqo (segment)
- (:printer byte ((op #b10011001)))
(:emitter
(maybe-emit-rex-prefix segment :qword nil nil nil)
(emit-byte segment #b10011001)))
(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 signed-imm-byte))))))
+ (imm nil :type imm-byte)))
+ (rex-reg/mem-imm ((op (#b1100000 ,subop))
+ (imm nil :type imm-byte))))))
(define-instruction rol (segment dst amount)
(:printer-list
(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)
(flet ((test-immed-and-something (immed something)
(cond ((accumulator-p something)
+ (maybe-emit-rex-for-ea segment something nil)
(emit-byte segment
(if (eq size :byte) #b10101000 #b10101001))
(emit-sized-immediate segment size immed))
(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))
(eval-when (:compile-toplevel :execute)
(defun bit-test-inst-printer-list (subop)
`((ext-reg/mem-imm ((op (#b1011101 ,subop))
- (reg/mem nil :type word-reg/mem)
- (imm nil :type imm-data)
+ (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))
(define-instruction call (segment where)
(:printer near-jump ((op #b11101000)))
- (:printer reg/mem ((op '(#b1111111 #b010)) (width 1)))
+ (:printer reg/mem-default-qword ((op '(#b11111111 #b010))))
+ (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b010))))
(:emitter
(typecase where
(label
+ (maybe-emit-rex-for-ea segment where nil)
(emit-byte segment #b11101000) ; 32 bit relative
(emit-back-patch segment
4
(- (label-position where)
(+ posn 4))))))
(fixup
+ (maybe-emit-rex-for-ea segment where nil)
(emit-byte segment #b11101000)
(emit-relative-fixup segment where))
(t
+ (maybe-emit-rex-for-ea segment where nil)
(emit-byte segment #b11111111)
(emit-ea segment where #b010)))))
;; unconditional jumps
(:printer short-jump ((op #b1011)))
(:printer near-jump ((op #b11101001)) )
- (:printer reg/mem ((op '(#b1111111 #b100)) (width 1)))
+ (:printer reg/mem-default-qword ((op '(#b11111111 #b100))))
+ (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b100))))
(:emitter
(cond (where
(emit-chooser
(t
(unless (or (ea-p where) (tn-p 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 :dword)
(emit-byte segment #b11111111)
(emit-ea segment where #b100)))))
(:emitter
(emit-byte segment #b11011001)
(emit-byte segment #b11101101)))
-
\ No newline at end of file
+
+;; new xmm insns required by sse float
+;; movsd andpd comisd comiss
+
+(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)))
+ (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
+(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)))
+ (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))))
+
+(define-instruction ldmxcsr (segment src)
+ (:emitter
+ (emit-byte segment #x0f)
+ (emit-byte segment #xae)
+ (emit-ea segment src 2)))
+
+(define-instruction stmxcsr (segment dst)
+ (:emitter
+ (emit-byte segment #x0f)
+ (emit-byte segment #xae)
+ (emit-ea segment dst 3)))
+
projects / sbcl.git / blobdiff