X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Finsts.lisp;h=23b3de535b6a76c6abc70dbab2acde6875475d7f;hb=69d60b456b07a0256f08df0d02484f361ce5737c;hp=3e0c6e213f753fa7de674ceb1180658e7d749dc8;hpb=6e89948ce34d63b35eea687ca7cde0f2876c3062;p=sbcl.git diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 3e0c6e2..23b3de5 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -43,6 +43,8 @@ (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* @@ -88,16 +90,24 @@ :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 ) @@ -495,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) @@ -640,8 +665,6 @@ `(: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))) @@ -705,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 @@ -890,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 @@ -973,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)) @@ -1204,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 @@ -1212,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) @@ -1375,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))) @@ -1428,7 +1528,14 @@ ((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))) @@ -1459,26 +1566,22 @@ (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))) @@ -1488,18 +1591,13 @@ (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)) @@ -1682,8 +1780,8 @@ ;; 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)))))) ) @@ -1743,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) @@ -1752,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)) @@ -1762,6 +1862,7 @@ (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) @@ -1807,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)) @@ -1817,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)) @@ -1835,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))) @@ -1858,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))) @@ -2041,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) @@ -2139,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) @@ -2151,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) @@ -2219,7 +2336,6 @@ (:emitter (typecase where (label - (maybe-emit-rex-for-ea segment where nil) (emit-byte segment #b11101000) ; 32 bit relative (emit-back-patch segment 4 @@ -2228,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))))) @@ -2297,7 +2412,7 @@ (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))))) @@ -2344,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))) @@ -2391,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