X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Finsts.lisp;h=f7af0919ffa20b405112c7bf30939bde277ce773;hb=b916eedb42ae51b5069f8e2b210649b897b2ec24;hp=09b7834ba12dd12db232b49ecfbcc36fd2a25682;hpb=b83ac6ca16d5c9ee7aa6f261959035accf697681;p=sbcl.git diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 09b7834..f7af091 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -221,16 +221,6 @@ (print-xmmreg value stream dstate) (print-mem-access value nil stream dstate))) -;; Same as print-xmmreg/mem, but prints an explicit size indicator for -;; memory references. -(defun print-sized-xmmreg/mem (value stream dstate) - (declare (type (or list xmmreg) value) - (type stream stream) - (type sb!disassem:disassem-state dstate)) - (if (typep value 'xmmreg) - (print-xmmreg value stream dstate) - (print-mem-access value (inst-operand-size dstate) stream dstate))) - ;;; 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. @@ -490,10 +480,6 @@ :prefilter #'prefilter-reg/mem :printer #'print-xmmreg/mem) -(sb!disassem:define-arg-type sized-xmmreg/mem - :prefilter #'prefilter-reg/mem - :printer #'print-sized-xmmreg/mem) - (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *conditions* @@ -568,6 +554,15 @@ :default-printer '(:name)) (op :fields (list (byte 8 0) (byte 8 8) (byte 8 16)))) +;;; Prefix instructions + +(sb!disassem:define-instruction-format (rex 8) + (rex :field (byte 4 4) :value #b0100) + (wrxb :field (byte 4 0) :type 'wrxb)) + +(sb!disassem:define-instruction-format (x66 8) + (x66 :field (byte 8 0) :type 'x66 :value #x66)) + ;;; A one-byte instruction with a #x66 prefix, used to indicate an ;;; operand size of :word. (sb!disassem:define-instruction-format (x66-byte 16 @@ -590,15 +585,6 @@ (accum :type 'accum) (imm)) -(sb!disassem:define-instruction-format (rex-simple 16) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (op :field (byte 7 9)) - (width :field (byte 1 8) :type 'width) - ;; optional fields - (accum :type 'accum) - (imm)) - ;;; Same as simple, but with direction bit (sb!disassem:define-instruction-format (simple-dir 8 :include 'simple) (op :field (byte 6 2)) @@ -612,12 +598,6 @@ :tab accum ", " imm)) (imm :type 'signed-imm-data)) -(sb!disassem:define-instruction-format (rex-accum-imm 16 - :include 'rex-simple - :default-printer '(:name - :tab accum ", " imm)) - (imm :type 'signed-imm-data)) - (sb!disassem:define-instruction-format (reg-no-width 8 :default-printer '(:name :tab reg)) (op :field (byte 5 3)) @@ -626,28 +606,12 @@ (accum :type 'accum) (imm)) -(sb!disassem:define-instruction-format (rex-reg-no-width 16 - :default-printer '(:name :tab reg)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (op :field (byte 5 11)) - (reg :field (byte 3 8) :type 'reg-b) - ;; optional fields - (accum :type 'accum) - (imm)) - ;;; Same as reg-no-width, but with a default operand size of :qword. (sb!disassem:define-instruction-format (reg-no-width-default-qword 8 :include 'reg-no-width :default-printer '(:name :tab reg)) (reg :type 'reg-b-default-qword)) -;;; Same as rex-reg-no-width, but with a default operand size of :qword. -(sb!disassem:define-instruction-format (rex-reg-no-width-default-qword 16 - :include 'rex-reg-no-width - :default-printer '(:name :tab reg)) - (reg :type 'reg-b-default-qword)) - ;;; 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 @@ -687,19 +651,6 @@ ;; optional fields (imm)) -(sb!disassem:define-instruction-format (rex-reg-reg/mem 24 - :default-printer - `(:name :tab reg ", " reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (width :field (byte 1 8) :type 'width) - (op :field (byte 7 9)) - (reg/mem :fields (list (byte 2 22) (byte 3 16)) - :type 'reg/mem) - (reg :field (byte 3 19) :type 'reg) - ;; optional fields - (imm)) - ;;; same as reg-reg/mem, but with direction bit (sb!disassem:define-instruction-format (reg-reg/mem-dir 16 :include 'reg-reg/mem @@ -710,43 +661,6 @@ (op :field (byte 6 2)) (dir :field (byte 1 1))) -(sb!disassem:define-instruction-format (rex-reg-reg/mem-dir 24 - :include 'rex-reg-reg/mem - :default-printer - `(:name - :tab - ,(swap-if 'dir 'reg/mem ", " 'reg))) - (op :field (byte 6 10)) - (dir :field (byte 1 9))) - -(sb!disassem:define-instruction-format (x66-reg-reg/mem-dir 24 - :default-printer - `(:name - :tab - ,(swap-if 'dir 'reg/mem ", " 'reg))) - (x66 :field (byte 8 0) :type 'x66 :value #x66) - (op :field (byte 6 10)) - (dir :field (byte 1 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)) - -(sb!disassem:define-instruction-format (x66-rex-reg-reg/mem-dir 32 - :default-printer - `(:name - :tab - ,(swap-if 'dir 'reg/mem ", " 'reg))) - (x66 :field (byte 8 0) :type 'x66 :value #x66) - (rex :field (byte 4 12) :value #b0100) - (wrxb :field (byte 4 8) :type 'wrxb) - (op :field (byte 6 18)) - (dir :field (byte 1 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)) - ;;; 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)) @@ -757,17 +671,6 @@ ;; optional fields (imm)) -(sb!disassem:define-instruction-format (rex-reg/mem 24 - :default-printer '(:name :tab reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (op :fields (list (byte 7 9) (byte 3 19))) - (width :field (byte 1 8) :type 'width) - (reg/mem :fields (list (byte 2 22) (byte 3 16)) - :type 'sized-reg/mem) - ;; optional fields - (imm)) - ;;; Same as reg/mem, but without a width field and with a default ;;; operand size of :qword. (sb!disassem:define-instruction-format (reg/mem-default-qword 16 @@ -776,14 +679,6 @@ (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 @@ -793,13 +688,6 @@ (reg/mem :type 'sized-reg/mem) (imm :type 'signed-imm-data)) -(sb!disassem:define-instruction-format (rex-reg/mem-imm 24 - :include 'rex-reg/mem - :default-printer - '(:name :tab reg/mem ", " imm)) - (reg/mem :type 'sized-reg/mem) - (imm :type 'signed-imm-data)) - ;;; Same as reg/mem, but with using the accumulator in the default printer (sb!disassem:define-instruction-format (accum-reg/mem 16 @@ -807,13 +695,6 @@ (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 @@ -827,55 +708,6 @@ ;; 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)) - -(sb!disassem:define-instruction-format (rex-ext-reg-reg/mem 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 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)) - -(sb!disassem:define-instruction-format (x66-rex-ext-reg-reg/mem 40 - :default-printer - `(:name :tab reg ", " reg/mem)) - (x66 :field (byte 8 0) :type 'x66 :value #x66) - (rex :field (byte 4 12) :value #b0100) - (wrxb :field (byte 4 8) :type 'wrxb) - (prefix :field (byte 8 16) :value #b00001111) - (op :field (byte 7 25)) - (width :field (byte 1 24) :type 'width) - (reg/mem :fields (list (byte 2 38) (byte 3 32)) - :type 'reg/mem) - (reg :field (byte 3 35) :type 'reg) - ;; optional fields - (imm)) - -(eval-when (:compile-toplevel :execute) - (defun ext-reg-reg/mem-printer-list (op &optional printer) - `((ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer))) - (x66-ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer))) - (rex-ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer))) - (x66-rex-ext-reg-reg/mem ((op ,op)) ,@(when printer (list printer)))))) - (sb!disassem:define-instruction-format (ext-reg-reg/mem-no-width 24 :default-printer `(:name :tab reg ", " reg/mem)) @@ -887,17 +719,6 @@ ;; optional fields (imm)) -(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)) - (sb!disassem:define-instruction-format (ext-reg/mem-no-width 24 :default-printer `(:name :tab reg/mem)) @@ -906,16 +727,6 @@ (reg/mem :fields (list (byte 2 22) (byte 3 16)) :type 'reg/mem)) -(sb!disassem:define-instruction-format (rex-ext-reg/mem-no-width 32 - :default-printer - `(:name :tab reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (prefix :field (byte 8 8) :value #b00001111) - (op :fields (list (byte 8 16) (byte 3 27))) - (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'reg/mem)) - ;;; reg-no-width with #x0f prefix (sb!disassem:define-instruction-format (ext-reg-no-width 16 :default-printer '(:name :tab reg)) @@ -961,18 +772,6 @@ ;; optional fields (imm)) -(sb!disassem:define-instruction-format (rex-xmm-xmm/mem 32 - :default-printer - '(:name :tab reg ", " reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (x0f :field (byte 8 8) :value #x0f) - (op :field (byte 8 16)) - (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'xmmreg/mem) - (reg :field (byte 3 27) :type 'xmmreg) - (imm)) - (sb!disassem:define-instruction-format (ext-xmm-xmm/mem 32 :default-printer '(:name :tab reg ", " reg/mem)) @@ -1058,17 +857,6 @@ :type 'sized-reg/mem) (reg :field (byte 3 19) :type 'xmmreg)) -(sb!disassem:define-instruction-format (rex-xmm-reg/mem 32 - :default-printer - '(:name :tab reg ", " reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (x0f :field (byte 8 8) :value #x0f) - (op :field (byte 8 16)) - (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'sized-reg/mem) - (reg :field (byte 3 27) :type 'xmmreg)) - (sb!disassem:define-instruction-format (ext-xmm-reg/mem 32 :default-printer '(:name :tab reg ", " reg/mem)) @@ -1100,20 +888,9 @@ (x0f :field (byte 8 0) :value #x0f) (op :field (byte 8 8)) (reg/mem :fields (list (byte 2 22) (byte 3 16)) - :type 'sized-xmmreg/mem) + :type 'xmmreg/mem) (reg :field (byte 3 19) :type 'reg)) -(sb!disassem:define-instruction-format (rex-reg-xmm/mem 32 - :default-printer - '(:name :tab reg ", " reg/mem)) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) - (x0f :field (byte 8 8) :value #x0f) - (op :field (byte 8 16)) - (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'sized-xmmreg/mem) - (reg :field (byte 3 27) :type 'reg)) - (sb!disassem:define-instruction-format (ext-reg-xmm/mem 32 :default-printer '(:name :tab reg ", " reg/mem)) @@ -1121,7 +898,7 @@ (x0f :field (byte 8 8) :value #x0f) (op :field (byte 8 16)) (reg/mem :fields (list (byte 2 30) (byte 3 24)) - :type 'sized-xmmreg/mem) + :type 'xmmreg/mem) (reg :field (byte 3 27) :type 'reg)) (sb!disassem:define-instruction-format (ext-rex-reg-xmm/mem 40 @@ -1133,7 +910,7 @@ (x0f :field (byte 8 16) :value #x0f) (op :field (byte 8 24)) (reg/mem :fields (list (byte 2 38) (byte 3 32)) - :type 'sized-xmmreg/mem) + :type 'xmmreg/mem) (reg :field (byte 3 35) :type 'reg)) ;; XMM comparison instruction @@ -1150,10 +927,6 @@ :include 'simple :default-printer '(:name width))) -(sb!disassem:define-instruction-format (rex-string-op 16 - :include 'rex-simple - :default-printer '(:name width))) - (sb!disassem:define-instruction-format (short-cond-jump 16) (op :field (byte 4 4)) (cc :field (byte 4 0) :type 'condition-code) @@ -1205,18 +978,6 @@ :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 @@ -1715,6 +1476,45 @@ (:qword (emit-signed-dword segment value)))) +;;;; prefixes + +(define-instruction rex (segment) + (:printer rex () nil :print-name nil) + (:emitter + (bug "REX prefix used as a standalone instruction"))) + +(define-instruction x66 (segment) + (:printer x66 () nil :print-name nil) + (:emitter + (bug "#X66 prefix used as a standalone instruction"))) + +(defun emit-prefix (segment name) + (declare (ignorable segment)) + (ecase name + ((nil)) + (:lock + #!+sb-thread + (emit-byte segment #xf0)))) + +(define-instruction lock (segment) + (:printer byte ((op #b11110000)) nil) + (:emitter + (bug "LOCK prefix used as a standalone instruction"))) + +(define-instruction rep (segment) + (:emitter + (emit-byte segment #b11110011))) + +(define-instruction repe (segment) + (:printer byte ((op #b11110011)) nil) + (:emitter + (emit-byte segment #b11110011))) + +(define-instruction repne (segment) + (:printer byte ((op #b11110010)) nil) + (:emitter + (emit-byte segment #b11110010))) + ;;;; general data transfer ;;; This is the part of the MOV instruction emitter that does moving @@ -1768,12 +1568,8 @@ `(:name :tab ,(swap-if 'dir 'accum ", " '("[" imm "]")))) ;; register to/from register/memory (:printer reg-reg/mem-dir ((op #b100010))) - (:printer rex-reg-reg/mem-dir ((op #b100010))) - (:printer x66-reg-reg/mem-dir ((op #b100010))) - (:printer x66-rex-reg-reg/mem-dir ((op #b100010))) ;; immediate to register/memory (:printer reg/mem-imm ((op '(#b1100011 #b000)))) - (:printer rex-reg/mem-imm ((op '(#b1100011 #b000)))) (:emitter (let ((size (matching-operand-size dst src))) @@ -1827,65 +1623,56 @@ (t (error "bogus arguments to MOV: ~S ~S" dst src)))))) +;;; Emit a sign-extending (if SIGNED-P is true) or zero-extending move. +;;; To achieve the shortest possible encoding zero extensions into a +;;; 64-bit destination are assembled as a straight 32-bit MOV (if the +;;; source size is 32 bits) or as MOVZX with a 32-bit destination (if +;;; the source size is 8 or 16 bits). Due to the implicit zero extension +;;; to 64 bits this has the same effect as a MOVZX with 64-bit +;;; destination but often needs no REX prefix. (defun emit-move-with-extension (segment dst src signed-p) (aver (register-p dst)) (let ((dst-size (operand-size dst)) (src-size (operand-size src)) - (opcode (if signed-p #b10111110 #b10110110))) - (ecase dst-size - (: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-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 dst-size) - (emit-byte segment #b00001111) - (emit-byte segment (logior opcode 1)) - (emit-ea segment src (reg-tn-encoding dst))) - (:dword - (aver (eq dst-size :qword)) - ;; dst is in reg, src is in modrm - (let ((ea-p (ea-p src))) - (maybe-emit-rex-prefix segment (if signed-p :qword :dword) dst - (and ea-p (ea-index src)) - (cond (ea-p (ea-base src)) - ((tn-p src) src) - (t nil))) - (emit-byte segment (if signed-p #x63 #x8b)) ;movsxd or straight mov - ;;(emit-byte segment opcode) - (emit-ea segment src (reg-tn-encoding dst))))))))) + (opcode (if signed-p #b10111110 #b10110110))) + (macrolet ((emitter (operand-size &rest bytes) + `(progn + (maybe-emit-rex-for-ea segment src dst + :operand-size ,operand-size) + ,@(mapcar (lambda (byte) + `(emit-byte segment ,byte)) + bytes) + (emit-ea segment src (reg-tn-encoding dst))))) + (ecase dst-size + (:word + (aver (eq src-size :byte)) + (maybe-emit-operand-size-prefix segment :word) + (emitter :word #b00001111 opcode)) + ((:dword :qword) + (unless signed-p + (setf dst-size :dword)) + (ecase src-size + (:byte + (emitter dst-size #b00001111 opcode)) + (:word + (emitter dst-size #b00001111 (logior opcode 1))) + (:dword + (aver (or (not signed-p) (eq dst-size :qword))) + (emitter dst-size + (if signed-p #x63 #x8b))))))))) ; movsxd or straight mov (define-instruction movsx (segment dst src) (: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-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 @@ -1896,8 +1683,6 @@ (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))) ;;; this is not a real amd64 instruction, of course @@ -1908,10 +1693,8 @@ (define-instruction push (segment src) ;; register (:printer reg-no-width-default-qword ((op #b01010))) - (:printer rex-reg-no-width-default-qword ((op #b01010))) ;; register/memory (: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)) @@ -1944,9 +1727,7 @@ (define-instruction pop (segment dst) (: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 (or (eq size :qword) (eq size :word))) @@ -1963,7 +1744,6 @@ (: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) @@ -1991,7 +1771,6 @@ (error "bogus args to XCHG: ~S ~S" operand1 operand2))))))) (define-instruction lea (segment dst src) - (:printer rex-reg-reg/mem ((op #b1000110) (width 1))) (:printer reg-reg/mem ((op #b1000110) (width 1))) (:emitter (aver (or (dword-reg-p dst) (qword-reg-p dst))) @@ -2002,8 +1781,7 @@ (define-instruction cmpxchg (segment dst src &optional prefix) ;; Register/Memory with Register. - (:printer-list (ext-reg-reg/mem-printer-list #b1011000 - '(:name :tab reg/mem ", " reg))) + (:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg)) (:emitter (aver (register-p src)) (emit-prefix segment prefix) @@ -2130,18 +1908,12 @@ (eval-when (:compile-toplevel :execute) (defun arith-inst-printer-list (subop) `((accum-imm ((op ,(dpb subop (byte 3 2) #b0000010)))) - (rex-accum-imm ((op ,(dpb subop (byte 3 2) #b0000010)))) (reg/mem-imm ((op (#b1000000 ,subop)))) - (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)))))) - ) + (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))))) (define-instruction add (segment dst src &optional prefix) (:printer-list (arith-inst-printer-list #b000)) @@ -2169,7 +1941,6 @@ ;;; in 64-bit mode so we always use the two-byte form. (define-instruction inc (segment dst) (:printer reg/mem ((op '(#b1111111 #b000)))) - (:printer rex-reg/mem ((op '(#b1111111 #b000)))) (:emitter (let ((size (operand-size dst))) (maybe-emit-operand-size-prefix segment size) @@ -2179,7 +1950,6 @@ (define-instruction dec (segment dst) (:printer reg/mem ((op '(#b1111111 #b001)))) - (:printer rex-reg/mem ((op '(#b1111111 #b001)))) (:emitter (let ((size (operand-size dst))) (maybe-emit-operand-size-prefix segment size) @@ -2189,7 +1959,6 @@ (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) @@ -2199,7 +1968,6 @@ (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)) @@ -2210,21 +1978,13 @@ (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) (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)) @@ -2256,7 +2016,6 @@ (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)) @@ -2267,7 +2026,6 @@ (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)) @@ -2328,8 +2086,7 @@ (define-instruction xadd (segment dst src &optional prefix) ;; Register/Memory with Register. - (:printer-list (ext-reg-reg/mem-printer-list #b1100000 - '(:name :tab reg/mem ", " reg))) + (:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg)) (:emitter (aver (register-p src)) (emit-prefix segment prefix) @@ -2362,15 +2119,9 @@ (defun shift-inst-printer-list (subop) `((reg/mem ((op (#b1101000 ,subop))) (:name :tab reg/mem ", 1")) - (rex-reg/mem ((op (#b1101000 ,subop))) - (:name :tab reg/mem ", 1")) (reg/mem ((op (#b1101001 ,subop))) (:name :tab reg/mem ", " 'cl)) - (rex-reg/mem ((op (#b1101001 ,subop))) - (:name :tab reg/mem ", " 'cl)) (reg/mem-imm ((op (#b1100000 ,subop)) - (imm nil :type imm-byte))) - (rex-reg/mem-imm ((op (#b1100000 ,subop)) (imm nil :type imm-byte)))))) (define-instruction rol (segment dst amount) @@ -2455,11 +2206,8 @@ (define-instruction test (segment this that) (:printer accum-imm ((op #b1010100))) - (:printer rex-accum-imm ((op #b1010100))) (:printer reg/mem-imm ((op '(#b1111011 #b000)))) - (:printer rex-reg/mem-imm ((op '(#b1111011 #b000)))) (:printer reg-reg/mem ((op #b1000010))) - (:printer rex-reg-reg/mem ((op #b1000010))) (:emitter (let ((size (matching-operand-size this that))) (maybe-emit-operand-size-prefix segment size) @@ -2504,7 +2252,6 @@ (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) @@ -2516,7 +2263,6 @@ (define-instruction cmps (segment size) (:printer string-op ((op #b1010011))) - (:printer rex-string-op ((op #b1010011))) (:emitter (maybe-emit-operand-size-prefix segment size) (maybe-emit-rex-prefix segment size nil nil nil) @@ -2524,7 +2270,6 @@ (define-instruction ins (segment acc) (:printer string-op ((op #b0110110))) - (:printer rex-string-op ((op #b0110110))) (:emitter (let ((size (operand-size acc))) (aver (accumulator-p acc)) @@ -2534,7 +2279,6 @@ (define-instruction lods (segment acc) (:printer string-op ((op #b1010110))) - (:printer rex-string-op ((op #b1010110))) (:emitter (let ((size (operand-size acc))) (aver (accumulator-p acc)) @@ -2544,7 +2288,6 @@ (define-instruction movs (segment size) (:printer string-op ((op #b1010010))) - (:printer rex-string-op ((op #b1010010))) (:emitter (maybe-emit-operand-size-prefix segment size) (maybe-emit-rex-prefix segment size nil nil nil) @@ -2552,7 +2295,6 @@ (define-instruction outs (segment acc) (:printer string-op ((op #b0110111))) - (:printer rex-string-op ((op #b0110111))) (:emitter (let ((size (operand-size acc))) (aver (accumulator-p acc)) @@ -2562,7 +2304,6 @@ (define-instruction scas (segment acc) (:printer string-op ((op #b1010111))) - (:printer rex-string-op ((op #b1010111))) (:emitter (let ((size (operand-size acc))) (aver (accumulator-p acc)) @@ -2572,7 +2313,6 @@ (define-instruction stos (segment acc) (:printer string-op ((op #b1010101))) - (:printer rex-string-op ((op #b1010101))) (:emitter (let ((size (operand-size acc))) (aver (accumulator-p acc)) @@ -2585,26 +2325,11 @@ (:emitter (emit-byte segment #b11010111))) -(define-instruction rep (segment) - (:emitter - (emit-byte segment #b11110011))) - -(define-instruction repe (segment) - (:printer byte ((op #b11110011))) - (:emitter - (emit-byte segment #b11110011))) - -(define-instruction repne (segment) - (:printer byte ((op #b11110010))) - (:emitter - (emit-byte segment #b11110010))) - ;;;; bit manipulation (define-instruction bsf (segment dst src) (: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) @@ -2617,7 +2342,6 @@ (define-instruction bsr (segment dst src) (: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) @@ -2681,7 +2405,6 @@ (define-instruction call (segment where) (:printer near-jump ((op #b11101000))) (:printer reg/mem-default-qword ((op '(#b11111111 #b010)))) - (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b010)))) (:emitter (typecase where (label @@ -2716,7 +2439,6 @@ (:printer short-jump ((op #b1011))) (:printer near-jump ((op #b11101001))) (:printer reg/mem-default-qword ((op '(#b11111111 #b100)))) - (:printer rex-reg/mem-default-qword ((op '(#b11111111 #b100)))) (:emitter (cond (where (emit-chooser @@ -2803,7 +2525,6 @@ ;;;; 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))) @@ -2949,28 +2670,42 @@ (define-instruction nop (segment) (:printer byte ((op #b10010000))) + ;; multi-byte NOP + (:printer ext-reg/mem-no-width ((op '(#x1f 0))) '(:name)) (:emitter (emit-byte segment #b10010000))) +;;; Emit a sequence of single- or multi-byte NOPs to fill AMOUNT many +;;; bytes with the smallest possible number of such instructions. +(defun emit-long-nop (segment amount) + (declare (type segment segment) + (type index amount)) + ;; Pack all instructions into one byte vector to save space. + (let* ((bytes #.(coerce #(#x90 + #x66 #x90 + #x0f #x1f #x00 + #x0f #x1f #x40 #x00 + #x0f #x1f #x44 #x00 #x00 + #x66 #x0f #x1f #x44 #x00 #x00 + #x0f #x1f #x80 #x00 #x00 #x00 #x00 + #x0f #x1f #x84 #x00 #x00 #x00 #x00 #x00 + #x66 #x0f #x1f #x84 #x00 #x00 #x00 #x00 #x00) + '(vector (unsigned-byte 8)))) + (max-length (isqrt (* 2 (length bytes))))) + (loop + (let* ((count (min amount max-length)) + (start (ash (* count (1- count)) -1))) + (dotimes (i count) + (emit-byte segment (aref bytes (+ start i))))) + (if (> amount max-length) + (decf amount max-length) + (return))))) + (define-instruction wait (segment) (:printer byte ((op #b10011011))) (:emitter (emit-byte segment #b10011011))) -(defun emit-prefix (segment name) - (declare (ignorable segment)) - (ecase name - ((nil)) - (:lock - #!+sb-thread - (emit-byte segment #xf0)))) - -;;; 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 - (bug "LOCK prefix used as a standalone instruction"))) ;;;; miscellaneous hackery @@ -3007,9 +2742,10 @@ ;;;; Instructions required to do floating point operations using SSE -;; Return a two-element list of printers for SSE instructions. One -;; printer is for the format without a REX prefix, the other one for the -;; one with. +;; Return a one- or two-element list of printers for SSE instructions. +;; The one-element list is used in the cases where the REX prefix is +;; really a prefix and thus automatically supported, the two-element +;; list is used when the REX prefix is used in an infix position. (eval-when (:compile-toplevel :execute) (defun sse-inst-printer-list (inst-format-stem prefix opcode &key more-fields printer) @@ -3020,8 +2756,7 @@ (inst-formats (if prefix (list (symbolicate "EXT-" inst-format-stem) (symbolicate "EXT-REX-" inst-format-stem)) - (list inst-format-stem - (symbolicate "REX-" inst-format-stem))))) + (list inst-format-stem)))) (mapcar (lambda (inst-format) `(,inst-format ,fields ,@(when printer (list printer)))) @@ -3459,7 +3194,6 @@ ;; FIXME: is that right!? (define-instruction movnti (segment dst src) (:printer ext-reg-reg/mem-no-width ((op #xc3))) - (:printer rex-ext-reg-reg/mem-no-width ((op #xc3))) (:emitter (aver (not (or (register-p dst) (xmm-register-p dst)))) @@ -3478,14 +3212,6 @@ '("PREFETCHT1" :tab reg/mem)) (:printer ext-reg/mem-no-width ((op '(#x18 3))) '("PREFETCHT2" :tab reg/mem)) - (:printer rex-ext-reg/mem-no-width ((op '(#x18 0))) - '("PREFETCHNTA" :tab reg/mem)) - (:printer rex-ext-reg/mem-no-width ((op '(#x18 1))) - '("PREFETCHT0" :tab reg/mem)) - (:printer rex-ext-reg/mem-no-width ((op '(#x18 2))) - '("PREFETCHT1" :tab reg/mem)) - (:printer rex-ext-reg/mem-no-width ((op '(#x18 3))) - '("PREFETCHT2" :tab reg/mem)) (:emitter (aver (not (or (register-p src) (xmm-register-p src)))) @@ -3499,7 +3225,6 @@ (define-instruction clflush (segment src) (:printer ext-reg/mem-no-width ((op '(#xae 7)))) - (:printer rex-ext-reg/mem-no-width ((op '(#xae 7)))) (:emitter (aver (not (or (register-p src) (xmm-register-p src)))) @@ -3528,7 +3253,6 @@ (define-instruction ldmxcsr (segment src) (:printer ext-reg/mem-no-width ((op '(#xae 2)))) - (:printer rex-ext-reg/mem-no-width ((op '(#xae 2)))) (:emitter (aver (not (or (register-p src) (xmm-register-p src)))) @@ -3540,7 +3264,6 @@ (define-instruction stmxcsr (segment dst) (:printer ext-reg/mem-no-width ((op '(#xae 3)))) - (:printer rex-ext-reg/mem-no-width ((op '(#xae 3)))) (:emitter (aver (not (or (register-p dst) (xmm-register-p dst))))