(defparameter *dword-reg-names*
#(eax ecx edx ebx esp ebp esi edi))
+;;; Disassembling x86 code needs to take into account little things
+;;; like instructions that have a byte/word length bit in their
+;;; encoding, prefixes to change the default word length for a single
+;;; instruction, and so on. Unfortunately, there is no easy way with
+;;; this disassembler framework to handle prefixes that will work
+;;; correctly in all cases, so we copy the x86-64 version which at
+;;; least can handle the code output by the compiler.
+;;;
+;;; Width information for an instruction is stored as an inst-prop on
+;;; the dstate. The inst-props are cleared automatically after each
+;;; instruction, must be set by prefilters, and contain a single bit
+;;; of data each (presence/absence). As such, each instruction that
+;;; can emit an operand-size prefix (x66 prefix) needs to have a set
+;;; of printers declared for both the prefixed and non-prefixed
+;;; encodings.
+
+;;; Return the operand size based on the prefixes and width bit from
+;;; the 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 'operand-size-16)
+ :word)
+ (t
+ +default-operand-size+)))
+
+;;; Return the operand size for a "word-sized" operand based on the
+;;; prefixes from the dstate.
+(defun inst-word-operand-size (dstate)
+ (declare (type sb!disassem:disassem-state dstate))
+ (if (sb!disassem:dstate-get-inst-prop dstate 'operand-size-16)
+ :word
+ :dword))
+
(defun print-reg-with-width (value width stream dstate)
(declare (ignore dstate))
(princ (aref (ecase width
(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))
(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-word-operand-size dstate)
stream
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))))
+ (declare (type bit value)
+ (type sb!disassem:disassem-state dstate))
+ (when (zerop value)
+ (sb!disassem:dstate-put-inst-prop dstate 'operand-size-8))
+ value)
+
+;;; This prefilter is used solely for its side effect, namely to put
+;;; the property OPERAND-SIZE-16 into the DSTATE.
+(defun prefilter-x66 (value dstate)
+ (declare (type (eql #x66) value)
+ (ignore value)
+ (type sb!disassem:disassem-state dstate))
+ (sb!disassem:dstate-put-inst-prop dstate 'operand-size-16))
(defun read-address (value dstate)
(declare (ignore value)) ; always nil anyway
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(sb!disassem:read-suffix
- (width-bits (sb!disassem:dstate-get-prop dstate 'width))
+ (width-bits (inst-operand-size dstate))
dstate)))
(sb!disassem:define-arg-type signed-imm-data
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
- (let ((width (sb!disassem:dstate-get-prop dstate 'width)))
+ (let ((width (inst-operand-size dstate)))
(sb!disassem:read-signed-suffix (width-bits width) dstate))))
(sb!disassem:define-arg-type signed-imm-byte
(sb!disassem:define-arg-type imm-word
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
- (let ((width
- (or (sb!disassem:dstate-get-prop dstate 'word-width)
- +default-operand-size+)))
+ (let ((width (inst-word-operand-size dstate)))
(sb!disassem:read-suffix (width-bits width) dstate))))
(sb!disassem:define-arg-type signed-imm-word
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
- (let ((width
- (or (sb!disassem:dstate-get-prop dstate 'word-width)
- +default-operand-size+)))
+ (let ((width (inst-word-operand-size dstate)))
(sb!disassem:read-signed-suffix (width-bits width) dstate))))
;;; needed for the ret imm16 instruction
(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)))))
+ (declare (ignore value))
+ (princ (schar (symbol-name (inst-operand-size dstate)) 0)
+ stream)))
+
+;;; Used to capture the effect of the #x66 operand size override prefix.
+(sb!disassem:define-arg-type x66
+ :prefilter #'prefilter-x66)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *conditions*
(accum :type 'accum)
(imm))
+(sb!disassem:define-instruction-format (x66-simple 16)
+ (x66 :field (byte 8 0) :type 'x66 :value #x66)
+ (op :field (byte 7 9))
+ (width :field (byte 1 8) :type 'width)
+ ;; optional fields
+ (accum :type 'accum)
+ (imm))
+
+(sb!disassem:define-instruction-format (two-bytes 16
+ :default-printer '(:name))
+ (op :fields (list (byte 8 0) (byte 8 8))))
+
;;; Same as simple, but with direction bit
(sb!disassem:define-instruction-format (simple-dir 8 :include 'simple)
(op :field (byte 6 2))
(dir :field (byte 1 1)))
+(sb!disassem:define-instruction-format (x66-simple-dir 16 :include 'x66-simple)
+ (op :field (byte 6 10))
+ (dir :field (byte 1 9)))
+
;;; Same as simple, but with the immediate value occurring by default,
;;; and with an appropiate printer.
(sb!disassem:define-instruction-format (accum-imm 8
:tab accum ", " imm))
(imm :type 'imm-data))
+(sb!disassem:define-instruction-format (x66-accum-imm 16
+ :include 'x66-simple
+ :default-printer '(:name
+ :tab accum ", " imm))
+ (imm :type 'imm-data))
+
(sb!disassem:define-instruction-format (reg-no-width 8
:default-printer '(:name :tab reg))
(op :field (byte 5 3))
(accum :type 'word-accum)
(imm))
+(sb!disassem:define-instruction-format (x66-reg-no-width 16
+ :default-printer '(:name :tab reg))
+ (x66 :field (byte 8 0) :type 'x66 :value #x66)
+ (op :field (byte 5 11))
+ (reg :field (byte 3 8) :type 'word-reg)
+ ;; optional fields
+ (accum :type 'word-accum)
+ (imm))
+
;;; adds a width field to reg-no-width
(sb!disassem:define-instruction-format (reg 8
:default-printer '(:name :tab reg))
(imm)
)
+(sb!disassem:define-instruction-format (x66-reg 16
+ :default-printer '(:name :tab reg))
+ (x66 :field (byte 8 0) :type 'x66 :value #x66)
+ (op :field (byte 4 12))
+ (width :field (byte 1 11) :type 'width)
+ (reg :field (byte 3 8) :type 'reg)
+ ;; 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))
;; optional fields
(imm))
+(sb!disassem:define-instruction-format (x66-reg-reg/mem 24
+ :default-printer
+ `(:name :tab reg ", " reg/mem))
+ (x66 :field (byte 8 0) :type 'x66 :value #x66)
+ (op :field (byte 7 9))
+ (width :field (byte 1 8) :type 'width)
+ (reg/mem :fields (list (byte 2 22) (byte 3 16))
+ :type 'reg/mem)
+ (reg :field (byte 3 19) :type 'reg)
+ ;; optional fields
+ (imm))
+
;;; same as reg-reg/mem, but with direction bit
(sb!disassem:define-instruction-format (reg-reg/mem-dir 16
:include 'reg-reg/mem
(op :field (byte 6 2))
(dir :field (byte 1 1)))
+(sb!disassem:define-instruction-format (x66-reg-reg/mem-dir 24
+ :include 'x66-reg-reg/mem
+ :default-printer
+ `(:name
+ :tab
+ ,(swap-if 'dir 'reg/mem ", " 'reg)))
+ (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.
(sb!disassem:define-instruction-format (reg/mem 16
:default-printer '(:name :tab reg/mem))
;; optional fields
(imm))
+(sb!disassem:define-instruction-format (x66-reg/mem 24
+ :default-printer '(:name :tab reg/mem))
+ (x66 :field (byte 8 0) :type 'x66 :value #x66)
+ (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 with the immediate value occurring by default,
;;; and with an appropiate printer.
(sb!disassem:define-instruction-format (reg/mem-imm 16
(reg/mem :type 'sized-reg/mem)
(imm :type 'imm-data))
+(sb!disassem:define-instruction-format (x66-reg/mem-imm 24
+ :include 'x66-reg/mem
+ :default-printer
+ '(:name :tab reg/mem ", " imm))
+ (reg/mem :type 'sized-reg/mem)
+ (imm :type 'imm-data))
+
;;; Same as reg/mem, but with using the accumulator in the default printer
(sb!disassem:define-instruction-format
(accum-reg/mem 16
(reg/mem :type 'reg/mem) ; don't need a size
(accum :type 'accum))
+(sb!disassem:define-instruction-format (x66-accum-reg/mem 24
+ :include 'x66-reg/mem
+ :default-printer
+ '(:name :tab accum ", " reg/mem))
+ (reg/mem :type 'reg/mem) ; don't need a size
+ (accum :type 'accum))
+
;;; Same as reg-reg/mem, but with a prefix of #b00001111
(sb!disassem:define-instruction-format (ext-reg-reg/mem 24
:default-printer
;; optional fields
(imm))
+(sb!disassem:define-instruction-format (x66-ext-reg-reg/mem 32
+ :default-printer
+ `(:name :tab reg ", " reg/mem))
+ (x66 :field (byte 8 0) :type 'x66 :value #x66)
+ (prefix :field (byte 8 8) :value #b00001111)
+ (op :field (byte 7 17))
+ (width :field (byte 1 16) :type 'width)
+ (reg/mem :fields (list (byte 2 30) (byte 3 24))
+ :type 'reg/mem)
+ (reg :field (byte 3 27) :type 'reg)
+ ;; optional fields
+ (imm))
+
;;; Same as reg/mem, but with a prefix of #b00001111
(sb!disassem:define-instruction-format (ext-reg/mem 24
:default-printer '(:name :tab reg/mem))
;; optional fields
(imm))
+(sb!disassem:define-instruction-format (x66-ext-reg/mem 32
+ :default-printer '(:name :tab reg/mem))
+ (x66 :field (byte 8 0) :type 'x66 :value #x66)
+ (prefix :field (byte 8 8) :value #b00001111)
+ (op :fields (list (byte 7 17) (byte 3 27)))
+ (width :field (byte 1 16) :type 'width)
+ (reg/mem :fields (list (byte 2 30) (byte 3 22))
+ :type 'sized-reg/mem)
+ ;; optional fields
+ (imm))
+
(sb!disassem:define-instruction-format (ext-reg/mem-imm 24
:include 'ext-reg/mem
:default-printer
'(:name :tab reg/mem ", " imm))
(imm :type 'imm-data))
+
+(sb!disassem:define-instruction-format (x66-ext-reg/mem-imm 32
+ :include 'x66-ext-reg/mem
+ :default-printer
+ '(:name :tab reg/mem ", " imm))
+ (imm :type 'imm-data))
\f
;;;; This section was added by jrd, for fp instructions.
:include 'simple
:default-printer '(:name width)))
+(sb!disassem:define-instruction-format (x66-string-op 16
+ :include 'x66-simple
+ :default-printer '(:name width)))
+
(sb!disassem:define-instruction-format (short-cond-jump 16)
(op :field (byte 4 4))
(cc :field (byte 4 0) :type 'condition-code)
:type 'reg/mem)
(reg :field (byte 3 19) :type 'reg))
+(sb!disassem:define-instruction-format (x66-cond-move 32
+ :default-printer
+ '('cmov cc :tab reg ", " reg/mem))
+ (x66 :field (byte 8 0) :type 'x66 :value #x66)
+ (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
(emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing)))
(stack
;; Convert stack tns into an index off of EBP.
- (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes))))
+ (let ((disp (frame-byte-offset (tn-offset thing))))
(cond ((<= -128 disp 127)
(emit-mod-reg-r/m-byte segment #b01 reg #b101)
(emit-byte segment disp))
\f
;;;; general data transfer
-(define-instruction mov (segment dst src)
+(define-instruction mov (segment dst src &optional prefix)
;; immediate to register
(:printer reg ((op #b1011) (imm nil :type 'imm-data))
'(:name :tab reg ", " imm))
+ (:printer x66-reg ((op #b1011) (imm nil :type 'imm-data))
+ '(: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 "]"))))
+ (:printer x66-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 x66-reg-reg/mem-dir ((op #b100010)))
;; immediate to register/memory
(:printer reg/mem-imm ((op '(#b1100011 #b000))))
+ (:printer x66-reg/mem-imm ((op '(#b1100011 #b000))))
(:emitter
+ (emit-prefix segment prefix)
(let ((size (matching-operand-size dst src)))
(maybe-emit-operand-size-prefix segment size)
(cond ((register-p 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 ((op #b1011111)
+ (reg nil :type 'word-reg)
+ (reg/mem nil :type 'sized-reg/mem)))
+ (:printer x66-ext-reg-reg/mem ((op #b1011111)
+ (reg nil :type 'word-reg)
+ (reg/mem nil :type 'sized-reg/mem)))
(:emitter (emit-move-with-extension segment dst src #b10111110)))
(define-instruction movzx (segment dst src)
- (:printer ext-reg-reg/mem ((op #b1011011) (reg nil :type 'word-reg)))
+ (:printer ext-reg-reg/mem ((op #b1011011)
+ (reg nil :type 'word-reg)
+ (reg/mem nil :type 'sized-reg/mem)))
+ (:printer x66-ext-reg-reg/mem ((op #b1011011)
+ (reg nil :type 'word-reg)
+ (reg/mem nil :type 'sized-reg/mem)))
(:emitter (emit-move-with-extension segment dst src #b10110110)))
-(define-instruction push (segment src)
+(define-instruction push (segment src &optional prefix)
;; register
(:printer reg-no-width ((op #b01010)))
+ (:printer x66-reg-no-width ((op #b01010)))
;; register/memory
(:printer reg/mem ((op '(#b1111111 #b110)) (width 1)))
+ (:printer x66-reg/mem ((op '(#b1111111 #b110)) (width 1)))
;; immediate
(:printer byte ((op #b01101010) (imm nil :type 'signed-imm-byte))
'(:name :tab imm))
;; ### segment registers?
(:emitter
+ (emit-prefix segment prefix)
(cond ((integerp src)
(cond ((<= -128 src 127)
(emit-byte segment #b01101010)
(emit-byte segment #b01100000)))
(define-instruction pop (segment dst)
+ (:printer x66-reg-no-width ((op #b01011)))
(:printer reg-no-width ((op #b01011)))
+ (:printer x66-reg/mem ((op '(#b1000111 #b000)) (width 1)))
(:printer reg/mem ((op '(#b1000111 #b000)) (width 1)))
(:emitter
(let ((size (operand-size dst)))
(define-instruction xchg (segment operand1 operand2)
;; Register with accumulator.
(:printer reg-no-width ((op #b10010)) '(:name :tab accum ", " reg))
+ (:printer x66-reg-no-width ((op #b10010)) '(:name :tab accum ", " reg))
;; Register/Memory with Register.
(:printer reg-reg/mem ((op #b1000011)))
+ (:printer x66-reg-reg/mem ((op #b1000011)))
(:emitter
(let ((size (matching-operand-size operand1 operand2)))
(maybe-emit-operand-size-prefix segment size)
(emit-byte segment #b10001101)
(emit-ea segment src (reg-tn-encoding dst))))
-(define-instruction cmpxchg (segment dst src)
+(define-instruction cmpxchg (segment dst src &optional prefix)
;; Register/Memory with Register.
(:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg))
+ (:printer x66-ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg))
(:emitter
(aver (register-p src))
+ (emit-prefix segment prefix)
(let ((size (matching-operand-size src dst)))
(maybe-emit-operand-size-prefix segment size)
(emit-byte segment #b00001111)
(emit-ea segment dst (reg-tn-encoding src)))))
\f
+(defun emit-prefix (segment name)
+ (ecase name
+ ((nil))
+ (:lock
+ #!+sb-thread
+ (emit-byte segment #xf0))
+ (:fs
+ (emit-byte segment #x64))
+ (:gs
+ (emit-byte segment #x65))))
(define-instruction fs-segment-prefix (segment)
+ (:printer byte ((op #b01100100)))
+ (:emitter
+ (bug "FS emitted as a separate instruction!")))
+
+(define-instruction gs-segment-prefix (segment)
+ (:printer byte ((op #b01100101)))
(:emitter
- (emit-byte segment #x64)))
+ (bug "GS emitted as a separate instruction!")))
;;;; flag control instructions
;;;; arithmetic
(defun emit-random-arith-inst (name segment dst src opcode
- &optional allow-constants)
+ &optional allow-constants)
(let ((size (matching-operand-size dst src)))
(maybe-emit-operand-size-prefix segment size)
(cond
(eval-when (:compile-toplevel :execute)
(defun arith-inst-printer-list (subop)
`((accum-imm ((op ,(dpb subop (byte 3 2) #b0000010))))
+ (x66-accum-imm ((op ,(dpb subop (byte 3 2) #b0000010))))
(reg/mem-imm ((op (#b1000000 ,subop))))
+ (x66-reg/mem-imm ((op (#b1000000 ,subop))))
(reg/mem-imm ((op (#b1000001 ,subop))
(imm nil :type signed-imm-byte)))
- (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))))
+ (x66-reg/mem-imm ((op (#b1000001 ,subop))
+ (imm nil :type signed-imm-byte)))
+ (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))
+ (x66-reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))))
)
-(define-instruction add (segment dst src)
+(define-instruction add (segment dst src &optional prefix)
(:printer-list (arith-inst-printer-list #b000))
- (:emitter (emit-random-arith-inst "ADD" segment dst src #b000)))
+ (:emitter
+ (emit-prefix segment prefix)
+ (emit-random-arith-inst "ADD" segment dst src #b000)))
(define-instruction adc (segment dst src)
(:printer-list (arith-inst-printer-list #b010))
(:emitter (emit-random-arith-inst "ADC" segment dst src #b010)))
-(define-instruction sub (segment dst src)
+(define-instruction sub (segment dst src &optional prefix)
(:printer-list (arith-inst-printer-list #b101))
- (:emitter (emit-random-arith-inst "SUB" segment dst src #b101)))
+ (:emitter
+ (emit-prefix segment prefix)
+ (emit-random-arith-inst "SUB" segment dst src #b101)))
(define-instruction sbb (segment dst src)
(:printer-list (arith-inst-printer-list #b011))
(:emitter (emit-random-arith-inst "SBB" segment dst src #b011)))
-(define-instruction cmp (segment dst src)
+(define-instruction cmp (segment dst src &optional prefix)
(:printer-list (arith-inst-printer-list #b111))
- (:emitter (emit-random-arith-inst "CMP" segment dst src #b111 t)))
+ (:emitter
+ (emit-prefix segment prefix)
+ (emit-random-arith-inst "CMP" segment dst src #b111 t)))
(define-instruction inc (segment dst)
;; Register.
(:printer reg-no-width ((op #b01000)))
+ (:printer x66-reg-no-width ((op #b01000)))
;; Register/Memory
(:printer reg/mem ((op '(#b1111111 #b000))))
+ (:printer x66-reg/mem ((op '(#b1111111 #b000))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
(define-instruction dec (segment dst)
;; Register.
(:printer reg-no-width ((op #b01001)))
+ (:printer x66-reg-no-width ((op #b01001)))
;; Register/Memory
(:printer reg/mem ((op '(#b1111111 #b001))))
+ (:printer x66-reg/mem ((op '(#b1111111 #b001))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
(define-instruction neg (segment dst)
(:printer reg/mem ((op '(#b1111011 #b011))))
+ (:printer x66-reg/mem ((op '(#b1111011 #b011))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
(define-instruction mul (segment dst src)
(:printer accum-reg/mem ((op '(#b1111011 #b100))))
+ (:printer x66-accum-reg/mem ((op '(#b1111011 #b100))))
(:emitter
(let ((size (matching-operand-size dst src)))
(aver (accumulator-p dst))
(define-instruction imul (segment dst &optional src1 src2)
(:printer accum-reg/mem ((op '(#b1111011 #b101))))
+ (:printer x66-accum-reg/mem ((op '(#b1111011 #b101))))
(:printer ext-reg-reg/mem ((op #b1010111)))
+ (:printer x66-ext-reg-reg/mem ((op #b1010111)))
(:printer reg-reg/mem ((op #b0110100) (width 1)
(imm nil :type 'signed-imm-word))
'(:name :tab reg ", " reg/mem ", " imm))
+ (:printer x66-reg-reg/mem ((op #b0110100) (width 1)
+ (imm nil :type 'signed-imm-word))
+ '(: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 x66-reg-reg/mem ((op #b0110101) (width 1)
+ (imm nil :type 'signed-imm-byte))
+ '(:name :tab reg ", " reg/mem ", " imm))
(:emitter
(flet ((r/m-with-immed-to-reg (reg r/m immed)
(let* ((size (matching-operand-size reg r/m))
(define-instruction div (segment dst src)
(:printer accum-reg/mem ((op '(#b1111011 #b110))))
+ (:printer x66-accum-reg/mem ((op '(#b1111011 #b110))))
(:emitter
(let ((size (matching-operand-size dst src)))
(aver (accumulator-p dst))
(define-instruction idiv (segment dst src)
(:printer accum-reg/mem ((op '(#b1111011 #b111))))
+ (:printer x66-accum-reg/mem ((op '(#b1111011 #b111))))
(:emitter
(let ((size (matching-operand-size dst src)))
(aver (accumulator-p dst))
;;; CBW -- Convert Byte to Word. AX <- sign_xtnd(AL)
(define-instruction cbw (segment)
+ (:printer two-bytes ((op '(#b01100110 #b10011000))))
(:emitter
(maybe-emit-operand-size-prefix segment :word)
(emit-byte segment #b10011000)))
;;; CWDE -- Convert Word To Double Word Extened. EAX <- sign_xtnd(AX)
(define-instruction cwde (segment)
+ (:printer byte ((op #b10011000)))
(:emitter
(maybe-emit-operand-size-prefix segment :dword)
(emit-byte segment #b10011000)))
;;; CWD -- Convert Word to Double Word. DX:AX <- sign_xtnd(AX)
(define-instruction cwd (segment)
+ (:printer two-bytes ((op '(#b01100110 #b10011001))))
(:emitter
(maybe-emit-operand-size-prefix segment :word)
(emit-byte segment #b10011001)))
(maybe-emit-operand-size-prefix segment :dword)
(emit-byte segment #b10011001)))
-(define-instruction xadd (segment dst src)
+(define-instruction xadd (segment dst src &optional prefix)
;; Register/Memory with Register.
(:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg))
+ (:printer x66-ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg))
(:emitter
(aver (register-p src))
+ (emit-prefix segment prefix)
(let ((size (matching-operand-size src dst)))
(maybe-emit-operand-size-prefix segment size)
(emit-byte segment #b00001111)
(defun shift-inst-printer-list (subop)
`((reg/mem ((op (#b1101000 ,subop)))
(:name :tab reg/mem ", 1"))
+ (x66-reg/mem ((op (#b1101000 ,subop)))
+ (:name :tab reg/mem ", 1"))
(reg/mem ((op (#b1101001 ,subop)))
(:name :tab reg/mem ", " 'cl))
+ (x66-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 signed-imm-byte)))
+ (x66-reg/mem-imm ((op (#b1100000 ,subop))
+ (imm nil :type signed-imm-byte))))))
(define-instruction rol (segment dst amount)
(:printer-list
(ext-reg-reg/mem-imm ((op ,(logior op #b10))
(imm nil :type signed-imm-byte)))
(ext-reg-reg/mem ((op ,(logior op #b10)))
+ (:name :tab reg/mem ", " reg ", " 'cl))
+ (x66-ext-reg-reg/mem ((op ,(logior op #b10)))
(:name :tab reg/mem ", " reg ", " 'cl)))))
(define-instruction shld (segment dst src amt)
(define-instruction test (segment this that)
(:printer accum-imm ((op #b1010100)))
+ (:printer x66-accum-imm ((op #b1010100)))
(:printer reg/mem-imm ((op '(#b1111011 #b000))))
+ (:printer x66-reg/mem-imm ((op '(#b1111011 #b000))))
(:printer reg-reg/mem ((op #b1000010)))
+ (:printer x66-reg-reg/mem ((op #b1000010)))
(:emitter
(let ((size (matching-operand-size this that)))
(maybe-emit-operand-size-prefix segment size)
y))
((sc-is x control-stack)
(inst test (make-ea :byte :base ebp-tn
- :disp (- (* (1+ offset) n-word-bytes)))
+ :disp (frame-byte-offset offset))
y))
(t
(inst test x y)))))
(t
(inst test x y))))
-(define-instruction or (segment dst src)
+(define-instruction or (segment dst src &optional prefix)
(:printer-list
(arith-inst-printer-list #b001))
(:emitter
+ (emit-prefix segment prefix)
(emit-random-arith-inst "OR" segment dst src #b001)))
-(define-instruction xor (segment dst src)
+(define-instruction xor (segment dst src &optional prefix)
(:printer-list
(arith-inst-printer-list #b110))
(:emitter
+ (emit-prefix segment prefix)
(emit-random-arith-inst "XOR" segment dst src #b110)))
(define-instruction not (segment dst)
(:printer reg/mem ((op '(#b1111011 #b010))))
+ (:printer x66-reg/mem ((op '(#b1111011 #b010))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
(define-instruction cmps (segment size)
(:printer string-op ((op #b1010011)))
+ (:printer x66-string-op ((op #b1010011)))
(:emitter
(maybe-emit-operand-size-prefix segment size)
(emit-byte segment (if (eq size :byte) #b10100110 #b10100111))))
(define-instruction ins (segment acc)
(:printer string-op ((op #b0110110)))
+ (:printer x66-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 x66-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 x66-string-op ((op #b1010010)))
(:emitter
(maybe-emit-operand-size-prefix segment size)
(emit-byte segment (if (eq size :byte) #b10100100 #b10100101))))
(define-instruction outs (segment acc)
(:printer string-op ((op #b0110111)))
+ (:printer x66-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 x66-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 x66-string-op ((op #b1010101)))
(:emitter
(let ((size (operand-size acc)))
(aver (accumulator-p acc))
(define-instruction rep (segment)
(:emitter
- (emit-byte segment #b11110010)))
+ (emit-byte segment #b11110011)))
(define-instruction repe (segment)
(:printer byte ((op #b11110011)))
(define-instruction bsf (segment dst src)
(:printer ext-reg-reg/mem ((op #b1011110) (width 0)))
+ (:printer x66-ext-reg-reg/mem ((op #b1011110) (width 0)))
(:emitter
(let ((size (matching-operand-size dst src)))
(when (eq size :byte)
(define-instruction bsr (segment dst src)
(:printer ext-reg-reg/mem ((op #b1011110) (width 1)))
+ (:printer x66-ext-reg-reg/mem ((op #b1011110) (width 1)))
(:emitter
(let ((size (matching-operand-size dst src)))
(when (eq size :byte)
(reg/mem nil :type word-reg/mem)
(imm nil :type imm-data)
(width 0)))
+ (x66-ext-reg/mem-imm ((op (#b1011101 ,subop))
+ (reg/mem nil :type word-reg/mem)
+ (imm nil :type imm-data)
+ (width 0)))
(ext-reg-reg/mem ((op ,(dpb subop (byte 3 2) #b1000001))
(width 1))
- (:name :tab reg/mem ", " reg)))))
+ (:name :tab reg/mem ", " reg))
+ (x66-ext-reg-reg/mem ((op ,(dpb subop (byte 3 2) #b1000001))
+ (width 1))
+ (:name :tab reg/mem ", " reg)))))
(define-instruction bt (segment src index)
(:printer-list (bit-test-inst-printer-list #b100))
(:printer byte ((op #b11000010) (imm nil :type 'imm-word-16))
'(:name :tab imm))
(:emitter
- (cond (stack-delta
+ (cond ((and stack-delta (not (zerop stack-delta)))
(emit-byte segment #b11000010)
(emit-word segment stack-delta))
(t
;;;; conditional move
(define-instruction cmov (segment cond dst src)
(:printer cond-move ())
+ (:printer x66-cond-move ())
(:emitter
(aver (register-p dst))
(let ((size (matching-operand-size dst src)))
(:emitter
(emit-byte segment #b10011011)))
+;;; FIXME: It would be better to make the disassembler understand the prefix as part
+;;; of the instructions...
(define-instruction lock (segment)
(:printer byte ((op #b11110000)))
(:emitter
- (emit-byte segment #b11110000)))
+ (bug "LOCK prefix used as a standalone instruction")))
\f
;;;; miscellaneous hackery
(:emitter
(emit-byte segment #b11011001)
(emit-byte segment #b11101101)))
+
+;;;; Miscellany
+
+(define-instruction cpuid (segment)
+ (:printer two-bytes ((op '(#b00001111 #b10100010))))
+ (:emitter
+ (emit-byte segment #b00001111)
+ (emit-byte segment #b10100010)))
+
+(define-instruction rdtsc (segment)
+ (:printer two-bytes ((op '(#b00001111 #b00110001))))
+ (:emitter
+ (emit-byte segment #b00001111)
+ (emit-byte segment #b00110001)))
projects / sbcl.git / blobdiff