X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Finsts.lisp;h=23b3de535b6a76c6abc70dbab2acde6875475d7f;hb=f3f677703e37f5a335b3be7fa64f7748ad969517;hp=da67010e1ee917715acdbfc82d30f6482ef31ca4;hpb=617d34501eec7d00a75818293642f62eb66807c1;p=sbcl.git diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index da67010..23b3de5 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -1,5 +1,5 @@ -;;;; 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. @@ -18,16 +18,21 @@ ;;; 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)) -;; This includes legacy records and r8-16 +;;; This includes legacy registers and R8-R15. (deftype full-reg () '(unsigned-byte 4)) -;;; default word size for the chip: if the operand size !=:dword +;;; 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) (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) @@ -36,30 +41,73 @@ (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 sil dil r8b r9b r10b r11b r14b r15b)) + #(al cl dl bl spl bpl sil dil r8b r9b r10b r11b r12b r13b r14b r15b)) +(defparameter *high-byte-reg-names* + #(ah ch dh bh)) (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)) + +;;; Print to STREAM the name of the general purpose register encoded by +;;; VALUE and of size WIDTH. For robustness, the high byte registers +;;; (AH, BH, CH, DH) are correctly detected, too, although the compiler +;;; does not use them. (defun print-reg-with-width (value width stream dstate) - (declare (ignore dstate) - (type full-reg value)) - (princ (aref (ecase width - (:byte *byte-reg-names*) - (:word *word-reg-names*) - (:dword *dword-reg-names*) - (:qword *qword-reg-names*)) - value) + (declare (type full-reg value) + (type stream stream) + (type sb!disassem:disassem-state dstate)) + (princ (if (and (eq width :byte) + (<= 4 value 7) + (not (sb!disassem:dstate-get-inst-prop dstate 'rex))) + (aref *high-byte-reg-names* (- value 4)) + (aref (ecase width + (:byte *byte-reg-names*) + (:word *word-reg-names*) + (:dword *dword-reg-names*) + (:qword *qword-reg-names*)) + value)) stream) ;; XXX plus should do some source-var notes ) @@ -69,21 +117,18 @@ (type stream stream) (type sb!disassem:disassem-state dstate)) (print-reg-with-width value - (or (sb!disassem:dstate-get-prop dstate 'reg-width) - *default-address-size*) + (inst-operand-size dstate) stream dstate)) -(defun print-word-reg (value stream dstate) - (declare (type (or full-reg list) 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 - (if (consp value) (car value) value) - (or (sb!disassem:dstate-get-prop dstate 'reg-width) - +default-operand-size+) - stream - dstate)) + (print-reg-with-width value + (inst-operand-size-default-qword dstate) + stream + dstate)) (defun print-byte-reg (value stream dstate) (declare (type full-reg value) @@ -95,26 +140,29 @@ (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 'reg-width) - *default-address-size*) - stream dstate)) + (print-reg-with-width value +default-address-size+ stream dstate)) -(defun print-rex-reg/mem (value 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 value stream dstate) - (print-mem-access value stream nil dstate))) + (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 full-reg) value) (type stream stream) (type sb!disassem:disassem-state dstate)) - (if (typep value 'full-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. @@ -122,71 +170,101 @@ (declare (type (or list full-reg) value) (type stream stream) (type sb!disassem:disassem-state dstate)) - (if (typep value 'full-reg) - (print-reg value stream dstate) - (print-mem-access value stream t dstate))) + (print-reg/mem-with-width + value (inst-operand-size dstate) t stream dstate)) -(defun print-byte-reg/mem (value 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)) - (if (typep value 'full-reg) - (print-byte-reg value stream dstate) - (print-mem-access value stream t dstate))) + (print-reg/mem-with-width + value (inst-operand-size-default-qword dstate) t stream dstate)) -(defun print-word-reg/mem (value 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 'full-reg) - (print-word-reg value stream dstate) - (print-mem-access value stream nil dstate))) + (print-reg/mem-with-width value :byte t stream dstate)) + +(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)) + (print-reg/mem-with-width value :word t stream dstate)) + +(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)) + (print-reg/mem-with-width value :dword t stream dstate)) (defun print-label (value stream dstate) (declare (ignore dstate)) (sb!disassem:princ16 value stream)) -(defun prefilter-word-reg (value dstate) - (declare (type (or full-reg list) value)) - (if (atom value) - value - (let ((reg (first value)) - (rex.wrxb (second value))) - (declare (type (or null (unsigned-byte 4)) rex.wrxb) - (type (unsigned-byte 3) reg)) - (setf (sb!disassem:dstate-get-prop dstate 'reg-width) - (if (and rex.wrxb (plusp (logand rex.wrxb #b1000))) - :qword - +default-operand-size+)) - (if (plusp (logand rex.wrxb #b0100)) - (+ 8 reg) - reg)))) - +;;; 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 (first value)) - (r/m (second value)) - (rex.wrxb (third value))) + (r/m (second value))) (declare (type (unsigned-byte 2) mod) - (type (unsigned-byte 3) r/m) - (type (or null (unsigned-byte 4)) rex.wrxb)) - - (setf (sb!disassem:dstate-get-prop dstate 'reg-width) - (if (and rex.wrxb (plusp (logand rex.wrxb #b1000))) - :qword - +default-operand-size+)) - - (let ((full-reg (if (and rex.wrxb (plusp (logand rex.wrxb #b0001))) - (progn - (setf (sb!disassem:dstate-get-prop dstate 'reg-width) - :qword) - (+ 8 r/m) ) - r/m))) + (type (unsigned-byte 3) r/m)) + (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 @@ -210,12 +288,18 @@ (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) + (list (unless (and (= mod #b00) (= base-reg #b101)) + (if (sb!disassem:dstate-get-inst-prop dstate 'rex-b) + (+ base-reg 8) + base-reg)) offset - (if (= index-reg #b100) nil index-reg) + (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 nil (sb!disassem:read-signed-suffix 32 dstate)) ) + (list 'rip (sb!disassem:read-signed-suffix 32 dstate)) ) ((= mod #b00) (list full-reg)) ((= mod #b01) @@ -223,27 +307,9 @@ (t ; (= mod #b10) (list full-reg (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) - (setf (sb!disassem:dstate-get-prop dstate 'reg-width) - :byte) - (let ((reg-width - ;; set by a prefix instruction - (or (sb!disassem:dstate-get-prop dstate 'reg-width) - +default-operand-size+))) - (when (not (eql reg-width +default-operand-size+)) - ;; Reset it. - (setf (sb!disassem:dstate-get-prop dstate 'reg-width) - +default-operand-size+)) - reg-width)))) - (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 @@ -258,6 +324,17 @@ ;;;; 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 @@ -272,62 +349,65 @@ (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 word-reg - :prefilter #'prefilter-word-reg - :printer (lambda (value stream dstate) - (print-word-reg value stream dstate))) +(sb!disassem:define-arg-type reg-b + :prefilter #'prefilter-reg-b + :printer #'print-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 - (or (sb!disassem:dstate-get-prop dstate 'width) - *default-address-size*)) - 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 (or (sb!disassem:dstate-get-prop dstate 'width) - *default-address-size*))) - (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 'reg-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 @@ -343,21 +423,22 @@ ;; 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) - -(sb!disassem:define-arg-type rex-reg/mem + :printer #'print-sized-word-reg/mem) +(sb!disassem:define-arg-type sized-dword-reg/mem :prefilter #'prefilter-reg/mem - :printer #'print-rex-reg/mem) -(sb!disassem:define-arg-type sized-rex-reg/mem - ;; Same as reg/mem, but prints an explicit size indicator for - ;; memory references. + :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) + :printer #'print-sized-reg/mem-default-qword) ;;; added by jrd (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) @@ -373,19 +454,6 @@ :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 ((reg-width - ;; set by a prefix instruction - (or (sb!disassem:dstate-get-prop dstate 'reg-width) - +default-operand-size+))) - (princ (schar (symbol-name reg-width) 0) stream))))) - (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *conditions* '((:o . 0) @@ -437,6 +505,21 @@ (accum :type 'accum) (imm)) +;;; A one-byte instruction with a #x66 prefix, used to indicate an +;;; operand size of :word. +(sb!disassem:define-instruction-format (x66-byte 16 + :default-printer '(:name)) + (x66 :field (byte 8 0) :value #x66) + (op :field (byte 8 8))) + +;;; A one-byte instruction with a REX prefix, used to indicate an +;;; operand size of :qword. REX.W must be 1, the other three bits are +;;; ignored. +(sb!disassem:define-instruction-format (rex-byte 16 + :default-printer '(:name)) + (rex :field (byte 5 3) :value #b01001) + (op :field (byte 8 8))) + (sb!disassem:define-instruction-format (simple 8) (op :field (byte 7 1)) (width :field (byte 1 0) :type 'width) @@ -445,8 +528,8 @@ (imm)) (sb!disassem:define-instruction-format (rex-simple 16) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0)) + (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 @@ -464,67 +547,79 @@ :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 'imm-data)) + (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 'word-accum) + (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) - (op :field (byte 5 11)) - (reg :fields (list (byte 3 8) (byte 4 0)) :type 'word-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 'word-accum) + (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) + (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 :fields (list (byte 3 16) (byte 4 0)) :type 'word-reg) + (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)) (sb!disassem:define-instruction-format (rex-reg 16 :default-printer '(:name :tab reg)) - (rex :field (byte 4 4) :value #b0100) - (op :field (byte 5 11)) - (reg :field (byte 3 8) :type '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) - ) - -;;; 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))) + (accum :type 'accum) + (imm)) (sb!disassem:define-instruction-format (two-bytes 16 :default-printer '(:name)) @@ -544,10 +639,12 @@ (sb!disassem:define-instruction-format (rex-reg-reg/mem 24 :default-printer `(:name :tab reg ", " reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (op :field (byte 8 8)) - (reg/mem :fields (list (byte 2 22) (byte 3 16) (byte 4 0)) - :type 'rex-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)) @@ -568,11 +665,10 @@ `(:name :tab ,(swap-if 'dir 'reg/mem ", " 'reg))) - (rex :field (byte 4 4) :value #b0100) (op :field (byte 6 10)) (dir :field (byte 1 9))) -;;; Same as reg-rem/mem, but uses the reg field as a second op code. +;;; 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))) @@ -584,12 +680,31 @@ (sb!disassem:define-instruction-format (rex-reg/mem 24 :default-printer '(:name :tab reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (op :fields (list (byte 8 8) (byte 3 19))) - (reg/mem :fields (list (byte 2 22) (byte 3 16) (byte 4 0)) :type 'sized-rex-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 @@ -597,14 +712,14 @@ :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-rex-reg/mem) - (imm :type 'imm-data)) + (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 @@ -613,6 +728,13 @@ (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 @@ -626,6 +748,26 @@ ;; 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 @@ -645,7 +787,7 @@ :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 @@ -662,7 +804,7 @@ :include 'ext-reg/mem :default-printer '(:name :tab reg/mem ", " imm)) - (imm :type 'imm-data)) + (imm :type 'signed-imm-data)) ;;;; This section was added by jrd, for fp instructions. @@ -765,7 +907,7 @@ (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 @@ -778,6 +920,18 @@ :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 @@ -861,7 +1015,7 @@ (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 + ;; note that we can represent an EA with a QWORD size, but EMIT-EA ;; can't actually emit it on its own: caller also needs to emit REX ;; prefix (size nil :type (member :byte :word :dword :qword)) @@ -1092,7 +1246,37 @@ (eq size +default-operand-size+)) (emit-byte segment +operand-size-prefix-byte+))) +;;; A REX prefix must be emitted if at least one of the following +;;; conditions is true: +;; 1. The operand size is :QWORD and the default operand size of the +;; instruction is not :QWORD. +;;; 2. The instruction references an extended register. +;;; 3. The instruction references one of the byte registers SIL, DIL, +;;; SPL or BPL. + +;;; Emit a REX prefix if necessary. OPERAND-SIZE is used to determine +;;; whether to set REX.W. Callers pass it explicitly as :DO-NOT-SET if +;;; this should not happen, for example because the instruction's +;;; default operand size is qword. R, X and B are NIL or TNs specifying +;;; registers the encodings of which are extended with the REX.R, REX.X +;;; and REX.B bit, respectively. To determine whether one of the byte +;;; registers is used that can only be accessed using a REX prefix, we +;;; need only to test R and B, because X is only used for the index +;;; register of an effective address and therefore never byte-sized. +;;; For R we can avoid to calculate the size of the TN because it is +;;; always OPERAND-SIZE. The size of B must be calculated here because +;;; B can be address-sized (if it is the base register of an effective +;;; address), of OPERAND-SIZE (if the instruction operates on two +;;; registers) or of some different size (in the instructions that +;;; combine arguments of different sizes: MOVZX, MOVSX, MOVSXD). +;;; We don't distinguish between general purpose and floating point +;;; registers for this cause because only general purpose registers can +;;; be byte-sized at all. (defun maybe-emit-rex-prefix (segment operand-size r x b) + (declare (type (member nil :byte :word :dword :qword :float :double + :do-not-set) + operand-size) + (type (or null tn) r x b)) (labels ((if-hi (r) (if (and r (> (tn-offset r) ;; offset of r8 is 16, offset of xmm8 is 8 @@ -1100,26 +1284,55 @@ 7 15))) 1 - 0))) + 0)) + (reg-4-7-p (r) + ;; Assuming R is a TN describing a general purpose + ;; register, return true if it references register + ;; 4 upto 7. + (<= 8 (tn-offset r) 15))) (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 (or (eq operand-size :byte) ;; REX needed to access SIL/DIL - (not (zerop (logior rex-w rex-r rex-x rex-b)))) + (when (or (not (zerop (logior rex-w rex-r rex-x rex-b))) + (and r + (eq operand-size :byte) + (reg-4-7-p r)) + (and b + (eq (operand-size b) :byte) + (reg-4-7-p b))) (emit-rex-byte segment #b0100 rex-w rex-r rex-x rex-b))))) -(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 +;;; Emit a REX prefix if necessary. The operand size is determined from +;;; THING or can be overwritten by OPERAND-SIZE. This and REG are always +;;; passed to MAYBE-EMIT-REX-PREFIX. Additionally, if THING is an EA we +;;; pass its index and base registers, if it is a register TN, we pass +;;; only itself. +;;; In contrast to EMIT-EA above, neither stack TNs nor fixups need to +;;; be treated specially here: If THING is a stack TN, neither it nor +;;; any of its components are passed to MAYBE-EMIT-REX-PREFIX which +;;; works correctly because stack references always use RBP as the base +;;; register and never use an index register so no extended registers +;;; need to be accessed. Fixups are assembled using an addressing mode +;;; of displacement-only or RIP-plus-displacement (see EMIT-EA), so may +;;; not reference an extended register. The displacement-only addressing +;;; mode requires that REX.X is 0, which is ensured here. +(defun maybe-emit-rex-for-ea (segment thing reg &key operand-size) + (declare (type (or ea tn fixup) thing) + (type (or null tn) reg) + (type (member nil :byte :word :dword :qword :float :double + :do-not-set) + operand-size)) + (let ((ea-p (ea-p thing))) (maybe-emit-rex-prefix segment - (or operand-size (operand-size ea)) + (or operand-size (operand-size thing)) reg - (and ea-p (ea-index ea)) - (cond (ea-p (ea-base ea)) - ((and (tn-p ea) - (member (sb-name (sc-sb (tn-sc ea))) + (and ea-p (ea-index thing)) + (cond (ea-p (ea-base thing)) + ((and (tn-p thing) + (member (sb-name (sc-sb (tn-sc thing))) '(float-registers registers))) - ea) + thing) (t nil))))) (defun operand-size (thing) @@ -1187,9 +1400,9 @@ (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 #b10111) (imm nil :type 'imm-data)) + (: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)) @@ -1263,21 +1476,20 @@ (: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-operand-size-prefix segment :dword) - (maybe-emit-rex-for-ea segment src dst - :operand-size (operand-size dst)) + (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 (operand-size dst)) + (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))) @@ -1295,33 +1507,56 @@ (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))) +;;; The regular use of MOVSXD is with an operand size of :qword. This +;;; sign-extends the dword source into the qword destination register. +;;; If the operand size is :dword the instruction zero-extends the dword +;;; source into the qword destination register, i.e. it does the same as +;;; a dword MOV into a register. (define-instruction movsxd (segment dst src) - (:printer reg-reg/mem ((op #x63) (reg nil :type 'word-reg))) + (: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 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 rex-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 rex-reg/mem ((op '(#b11111111 #b110)))) + (: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? @@ -1331,52 +1566,44 @@ (emit-byte segment #b01101010) (emit-byte segment src)) (t - ;; AMD64 manual says no REX needed but is unclear - ;; whether it expects 32 or 64 bit immediate here + ;; A REX-prefix is not needed because the operand size + ;; defaults to 64 bits. The size of the immediate is 32 + ;; bits and it is sign-extended. (emit-byte segment #b01101000) (emit-dword segment src)))) (t (let ((size (operand-size src))) (aver (not (eq size :byte))) (maybe-emit-operand-size-prefix segment size) - (maybe-emit-rex-for-ea segment src nil) + (maybe-emit-rex-for-ea segment src nil :operand-size :do-not-set) (cond ((register-p src) (emit-byte-with-reg segment #b01010 (reg-tn-encoding src))) (t (emit-byte segment #b11111111) (emit-ea segment src #b110 t)))))))) -(define-instruction pusha (segment) - (:printer byte ((op #b01100000))) - (:emitter - (emit-byte segment #b01100000))) - (define-instruction pop (segment dst) - (:printer reg-no-width ((op #b01011))) - (:printer rex-reg-no-width ((op #b01011))) - (:printer reg/mem ((op '(#b1000111 #b000)) (width 1))) - (:printer rex-reg/mem ((op '(#b10001111 #b000)))) + (: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))) (maybe-emit-operand-size-prefix segment size) - (maybe-emit-rex-for-ea segment dst nil) + (maybe-emit-rex-for-ea segment dst nil :operand-size :do-not-set) (cond ((register-p dst) (emit-byte-with-reg segment #b01011 (reg-tn-encoding dst))) (t (emit-byte segment #b10001111) (emit-ea segment dst #b000)))))) -(define-instruction popa (segment) - (:printer byte ((op #b01100001))) - (:emitter - (emit-byte segment #b01100001))) - (define-instruction xchg (segment operand1 operand2) ;; Register with accumulator. (: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) @@ -1404,7 +1631,7 @@ (error "bogus args to XCHG: ~S ~S" operand1 operand2))))))) (define-instruction lea (segment dst src) - (:printer rex-reg-reg/mem ((op #b10001101))) + (: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))) @@ -1548,11 +1775,13 @@ `((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 (#b10000001 ,subop)))) - (reg/mem-imm ((op (#b1000001 ,subop)) - (imm nil :type signed-imm-byte))) - (rex-reg/mem-imm ((op (#b10000011 ,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)))))) ) @@ -1612,6 +1841,7 @@ (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) @@ -1621,6 +1851,7 @@ (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)) @@ -1631,12 +1862,21 @@ (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 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)) @@ -1668,6 +1908,7 @@ (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)) @@ -1678,6 +1919,7 @@ (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)) @@ -1696,18 +1938,28 @@ ;;; CBW -- Convert Byte to Word. AX <- sign_xtnd(AL) (define-instruction cbw (segment) + (:printer x66-byte ((op #b10011000))) (:emitter (maybe-emit-operand-size-prefix segment :word) (emit-byte segment #b10011000))) -;;; CWDE -- Convert Word To Double Word Extened. EAX <- sign_xtnd(AX) +;;; CWDE -- Convert Word To Double Word Extended. EAX <- sign_xtnd(AX) (define-instruction cwde (segment) + (:printer byte ((op #b10011000))) (:emitter (maybe-emit-operand-size-prefix segment :dword) (emit-byte segment #b10011000))) +;;; CDQE -- Convert Word To Double Word Extended. RAX <- sign_xtnd(EAX) +(define-instruction cdqe (segment) + (:printer rex-byte ((op #b10011000))) + (:emitter + (maybe-emit-rex-prefix segment :qword nil nil nil) + (emit-byte segment #b10011000))) + ;;; CWD -- Convert Word to Double Word. DX:AX <- sign_xtnd(AX) (define-instruction cwd (segment) + (:printer x66-byte ((op #b10011001))) (:emitter (maybe-emit-operand-size-prefix segment :word) (emit-byte segment #b10011001))) @@ -1719,8 +1971,9 @@ (maybe-emit-operand-size-prefix segment :dword) (emit-byte segment #b10011001))) -;;; CQO -- Convert Quad or Octaword. RDX:RAX <- sign_xtnd(RAX) +;;; CQO -- Convert Quad Word to Octaword. RDX:RAX <- sign_xtnd(RAX) (define-instruction cqo (segment) + (:printer rex-byte ((op #b10011001))) (:emitter (maybe-emit-rex-prefix segment :qword nil nil nil) (emit-byte segment #b10011001))) @@ -1766,9 +2019,9 @@ (rex-reg/mem ((op (#b1101001 ,subop))) (:name :tab reg/mem ", " 'cl)) (reg/mem-imm ((op (#b1100000 ,subop)) - (imm nil :type signed-imm-byte))) - (rex-reg/mem-imm ((op (#b11000001 ,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 @@ -1855,9 +2108,9 @@ (:printer accum-imm ((op #b1010100))) (:printer rex-accum-imm ((op #b1010100))) (:printer reg/mem-imm ((op '(#b1111011 #b000)))) - (:printer rex-reg/mem-imm ((op '(#b11110111 #b000)))) + (:printer rex-reg/mem-imm ((op '(#b1111011 #b000)))) (:printer reg-reg/mem ((op #b1000010))) - (:printer rex-reg-reg/mem ((op #b10000101))) + (:printer rex-reg-reg/mem ((op #b1000010))) (:emitter (let ((size (matching-operand-size this that))) (maybe-emit-operand-size-prefix segment size) @@ -1902,6 +2155,7 @@ (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) @@ -2000,7 +2254,8 @@ ;;;; bit manipulation (define-instruction bsf (segment dst src) - (:printer ext-reg-reg/mem ((op #b1011110) (width 0))) + (: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) @@ -2012,7 +2267,8 @@ (emit-ea segment src (reg-tn-encoding dst))))) (define-instruction bsr (segment dst src) - (:printer ext-reg-reg/mem ((op #b1011110) (width 1))) + (: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) @@ -2043,8 +2299,8 @@ (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)) @@ -2075,12 +2331,11 @@ (define-instruction call (segment where) (:printer near-jump ((op #b11101000))) - (:printer rex-reg/mem ((op '(#b11111111 #b010)))) - (: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 @@ -2089,11 +2344,10 @@ (- (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) + (maybe-emit-rex-for-ea segment where nil :operand-size :do-not-set) (emit-byte segment #b11111111) (emit-ea segment where #b010))))) @@ -2112,7 +2366,8 @@ ;; 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 @@ -2155,7 +2410,9 @@ (t (unless (or (ea-p where) (tn-p where)) (error "don't know what to do with ~A" where)) - (maybe-emit-rex-for-ea segment where nil) + ;; near jump defaults to 64 bit + ;; w-bit in rex prefix is unnecessary + (maybe-emit-rex-for-ea segment where nil :operand-size :do-not-set) (emit-byte segment #b11111111) (emit-ea segment where #b100))))) @@ -2202,6 +2459,7 @@ ;;;; 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))) @@ -2249,10 +2507,8 @@ (cond (length-only (values 0 (1+ length) nil nil)) (t - (sb!kernel:copy-from-system-area sap (* n-byte-bits (1+ offset)) - vector (* n-word-bits - vector-data-offset) - (* length n-byte-bits)) + (sb!kernel:copy-ub8-from-system-area sap (1+ offset) + vector 0 length) (collect ((sc-offsets) (lengths)) (lengths 1) ; the length byte @@ -3166,13 +3422,14 @@ (define-instruction movd (segment dst src) ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (cond ((typep dst 'tn) + (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) @@ -3182,13 +3439,14 @@ (define-instruction movq (segment dst src) ; (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong (:emitter - (cond ((typep dst 'tn) + (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) @@ -3374,3 +3632,16 @@ (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))) +