(defparameter *byte-reg-names*
#(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 r8w r9w r10w r11w r12w r13w r14w r15w))
(defparameter *dword-reg-names*
: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 (type full-reg value)
(type stream stream)
- (ignore dstate))
- (princ (aref (ecase width
- (:byte *byte-reg-names*)
- (:word *word-reg-names*)
- (:dword *dword-reg-names*)
- (:qword *qword-reg-names*))
- value)
+ (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
)
(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)
`(: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)))
(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
: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
(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))
(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
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)
(: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)))
((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 #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)))
(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-default-qword ((op #b01011)))
(:printer rex-reg-no-width-default-qword ((op #b01011)))
(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))
;; 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)))
+ (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))))))
)
(define-instruction neg (segment dst)
(:printer reg/mem ((op '(#b1111011 #b011))))
+ (:printer rex-reg/mem ((op '(#b1111011 #b011))))
(:emitter
(let ((size (operand-size dst)))
(maybe-emit-operand-size-prefix segment size)
(define-instruction mul (segment dst src)
(:printer accum-reg/mem ((op '(#b1111011 #b100))))
+ (:printer rex-accum-reg/mem ((op '(#b1111011 #b100))))
(:emitter
(let ((size (matching-operand-size dst src)))
(aver (accumulator-p dst))
(define-instruction imul (segment dst &optional src1 src2)
(:printer accum-reg/mem ((op '(#b1111011 #b101))))
+ (:printer rex-accum-reg/mem ((op '(#b1111011 #b101))))
(:printer ext-reg-reg/mem-no-width ((op #b10101111)))
(:printer rex-ext-reg-reg/mem-no-width ((op #b10101111)))
(:printer reg-reg/mem ((op #b0110100) (width 1)
(define-instruction div (segment dst src)
(:printer accum-reg/mem ((op '(#b1111011 #b110))))
+ (:printer rex-accum-reg/mem ((op '(#b1111011 #b110))))
(:emitter
(let ((size (matching-operand-size dst src)))
(aver (accumulator-p dst))
(define-instruction idiv (segment dst src)
(:printer accum-reg/mem ((op '(#b1111011 #b111))))
+ (:printer rex-accum-reg/mem ((op '(#b1111011 #b111))))
(:emitter
(let ((size (matching-operand-size dst src)))
(aver (accumulator-p dst))
;;; 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)))
(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)))
(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)
;;;; 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)
(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)
(: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)
+ (maybe-emit-rex-for-ea segment where nil :operand-size :do-not-set)
(emit-byte segment #b11111111)
(emit-ea segment where #b010)))))
(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)
+ (maybe-emit-rex-for-ea segment where nil :operand-size :do-not-set)
(emit-byte segment #b11111111)
(emit-ea segment where #b100)))))
;;;; 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)))
(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
projects / sbcl.git / blobdiff