X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Finsts.lisp;h=b79d091cda0a67dcf12a46c170302ef161f1a4f9;hb=d306e2d23b38487488eb93881dad836e439e0c77;hp=f68a54195d277aa6c64dbac262033f09c3b159a7;hpb=cd12bb346dbbd1e077ed3e14a9db4e1cc227c244;p=sbcl.git diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index f68a541..b79d091 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -48,13 +48,11 @@ ;;; 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. +;;; Width information for an instruction and whether a segment +;;; override prefix was seen is stored as an inst-prop on the dstate. +;;; The inst-props are cleared automatically after each non-prefix +;;; instruction, must be set by prefilters, and contain a single bit of +;;; data each (presence/absence). ;;; Return the operand size based on the prefixes and width bit from ;;; the dstate. @@ -154,6 +152,12 @@ (declare (ignore dstate)) (sb!disassem:princ16 value stream)) +(defun maybe-print-segment-override (stream dstate) + (cond ((sb!disassem:dstate-get-inst-prop dstate 'fs-segment-prefix) + (princ "FS:" stream)) + ((sb!disassem:dstate-get-inst-prop dstate 'gs-segment-prefix) + (princ "GS:" stream)))) + ;;; Returns either an integer, meaning a register, or a list of ;;; (BASE-REG OFFSET INDEX-REG INDEX-SCALE), where any component ;;; may be missing or nil to indicate that it's not used or has the @@ -218,6 +222,16 @@ (type sb!disassem:disassem-state dstate)) (sb!disassem:dstate-put-inst-prop dstate 'operand-size-16)) +;;; This prefilter is used solely for its side effect, namely to put +;;; one of the properties [FG]S-SEGMENT-PREFIX into the DSTATE. +;;; Unlike PREFILTER-X66, this prefilter only catches the low bit of +;;; the prefix byte. +(defun prefilter-seg (value dstate) + (declare (type bit value) + (type sb!disassem:disassem-state dstate)) + (sb!disassem:dstate-put-inst-prop + dstate (elt '(fs-segment-prefix gs-segment-prefix) value))) + (defun read-address (value dstate) (declare (ignore value)) ; always nil anyway (sb!disassem:read-suffix (width-bits *default-address-size*) dstate)) @@ -281,6 +295,11 @@ (let ((width (inst-operand-size dstate))) (sb!disassem:read-signed-suffix (width-bits width) dstate)))) +(sb!disassem:define-arg-type imm-byte + :prefilter (lambda (value dstate) + (declare (ignore value)) ; always nil anyway + (sb!disassem:read-suffix 8 dstate))) + (sb!disassem:define-arg-type signed-imm-byte :prefilter (lambda (value dstate) (declare (ignore value)) ; always nil anyway @@ -349,6 +368,11 @@ (sb!disassem:define-arg-type x66 :prefilter #'prefilter-x66) +;;; Used to capture the effect of the #x64 and #x65 segment override +;;; prefixes. +(sb!disassem:define-arg-type seg + :prefilter #'prefilter-seg) + (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *conditions* '((:o . 0) @@ -400,6 +424,15 @@ (accum :type 'accum) (imm)) +;;; Prefix instructions + +(sb!disassem:define-instruction-format (x66 8) + (x66 :field (byte 8 0) :type 'x66 :value #x66)) + +(sb!disassem:define-instruction-format (seg 8) + (seg :field (byte 7 1) :value #x32) + (fsgs :field (byte 1 0) :type 'seg)) + (sb!disassem:define-instruction-format (simple 8) (op :field (byte 7 1)) (width :field (byte 1 0) :type 'width) @@ -407,14 +440,6 @@ (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)))) @@ -424,10 +449,6 @@ (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 @@ -436,12 +457,6 @@ :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)) @@ -450,15 +465,6 @@ (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)) @@ -470,17 +476,6 @@ (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)) @@ -501,18 +496,6 @@ ;; 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 @@ -523,15 +506,6 @@ (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)) @@ -542,16 +516,6 @@ ;; 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 @@ -561,13 +525,6 @@ (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 @@ -575,13 +532,6 @@ (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 @@ -595,19 +545,32 @@ ;; optional fields (imm)) -(sb!disassem:define-instruction-format (x66-ext-reg-reg/mem 32 +(sb!disassem:define-instruction-format (ext-reg-reg/mem-no-width 24 :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)) + (prefix :field (byte 8 0) :value #b00001111) + (op :field (byte 8 8)) + (reg/mem :fields (list (byte 2 22) (byte 3 16)) :type 'reg/mem) - (reg :field (byte 3 27) :type 'reg) + (reg :field (byte 3 19) :type 'reg) ;; optional fields (imm)) +(sb!disassem:define-instruction-format (ext-reg/mem-no-width 24 + :default-printer + `(:name :tab reg/mem)) + (prefix :field (byte 8 0) :value #b00001111) + (op :fields (list (byte 8 8) (byte 3 19))) + (reg/mem :fields (list (byte 2 22) (byte 3 16)) + :type 'reg/mem)) + +;;; reg-no-width with #x0f prefix +(sb!disassem:define-instruction-format (ext-reg-no-width 16 + :default-printer '(:name :tab reg)) + (prefix :field (byte 8 0) :value #b00001111) + (op :field (byte 5 11)) + (reg :field (byte 3 8) :type 'reg)) + ;;; 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)) @@ -619,28 +582,17 @@ ;; 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 +(sb!disassem:define-instruction-format (ext-reg/mem-no-width+imm8 24 + :include 'ext-reg/mem-no-width :default-printer '(:name :tab reg/mem ", " imm)) - (imm :type 'imm-data)) + (imm :type 'imm-byte)) ;;;; This section was added by jrd, for fp instructions. @@ -701,10 +653,6 @@ :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) @@ -756,17 +704,6 @@ :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 @@ -922,6 +859,11 @@ (r/m (cond (index #b100) ((null base) #b101) (t (reg-tn-encoding base))))) + (when (and (fixup-p disp) + (label-p (fixup-offset disp))) + (aver (null base)) + (aver (null index)) + (return-from emit-ea (emit-ea segment disp reg allow-constants))) (emit-mod-reg-r/m-byte segment mod reg r/m) (when (= r/m #b100) (let ((ss (1- (integer-length scale))) @@ -1058,25 +1000,66 @@ (:dword (emit-dword segment value)))) +;;;; prefixes + +(define-instruction x66 (segment) + (:printer x66 () nil :print-name nil) + (:emitter + (bug "#X66 prefix used as a standalone instruction"))) + +(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) + (:printer seg ((fsgs #b0)) nil :print-name nil) + (:emitter + (bug "FS prefix used as a standalone instruction"))) + +(define-instruction gs (segment) + (:printer seg ((fsgs #b1)) nil :print-name nil) + (:emitter + (bug "GS prefix used as a standalone instruction"))) + +(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 (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) @@ -1147,27 +1130,19 @@ (: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) (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 &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)) @@ -1204,9 +1179,7 @@ (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))) @@ -1226,10 +1199,8 @@ (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) @@ -1263,7 +1234,6 @@ (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) @@ -1273,28 +1243,12 @@ (emit-byte segment (if (eq size :byte) #b10110000 #b10110001)) (emit-ea segment dst (reg-tn-encoding src))))) - -(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))) +(define-instruction pause (segment) + (:printer two-bytes ((op '(#xf3 #x90)))) (:emitter - (bug "GS emitted as a separate instruction!"))) - + (emit-byte segment #xf3) + (emit-byte segment #x90))) + ;;;; flag control instructions ;;; CLC -- Clear Carry Flag. @@ -1405,16 +1359,10 @@ (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))) - (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)))))) - ) + (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)) @@ -1445,10 +1393,8 @@ (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) @@ -1461,10 +1407,8 @@ (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) @@ -1476,7 +1420,6 @@ (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) @@ -1505,7 +1448,6 @@ (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)) @@ -1515,21 +1457,13 @@ (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)) @@ -1558,7 +1492,6 @@ (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)) @@ -1568,7 +1501,6 @@ (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)) @@ -1588,6 +1520,12 @@ (emit-byte segment #b11010100) (emit-byte segment #b00001010))) +(define-instruction bswap (segment dst) + (:printer ext-reg-no-width ((op #b11001))) + (:emitter + (emit-byte segment #x0f) + (emit-byte-with-reg segment #b11001 (reg-tn-encoding dst)))) + ;;; CBW -- Convert Byte to Word. AX <- sign_xtnd(AL) (define-instruction cbw (segment) (:printer two-bytes ((op '(#b01100110 #b10011000)))) @@ -1619,7 +1557,6 @@ (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) @@ -1650,16 +1587,10 @@ (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))) - (x66-reg/mem-imm ((op (#b1100000 ,subop)) - (imm nil :type signed-imm-byte)))))) + (imm nil :type signed-imm-byte)))))) (define-instruction rol (segment dst amount) (:printer-list @@ -1719,12 +1650,10 @@ (eval-when (:compile-toplevel :execute) (defun double-shift-inst-printer-list (op) - `(#+nil - (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))) + `((ext-reg-reg/mem ((op ,(logior op #b10)) (width 0) + (imm nil :type signed-imm-byte)) + (:name :tab reg/mem ", " reg ", " imm)) + (ext-reg-reg/mem ((op ,(logior op #b10)) (width 1)) (:name :tab reg/mem ", " reg ", " 'cl))))) (define-instruction shld (segment dst src amt) @@ -1747,11 +1676,8 @@ (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) @@ -1796,7 +1722,7 @@ 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))))) @@ -1819,7 +1745,6 @@ (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) @@ -1830,14 +1755,12 @@ (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)) @@ -1846,7 +1769,6 @@ (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)) @@ -1855,14 +1777,12 @@ (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)) @@ -1871,7 +1791,6 @@ (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)) @@ -1880,7 +1799,6 @@ (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)) @@ -1892,26 +1810,11 @@ (:emitter (emit-byte segment #b11010111))) -(define-instruction rep (segment) - (:emitter - (emit-byte segment #b11110010))) - -(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 ((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) @@ -1923,7 +1826,6 @@ (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) @@ -1949,40 +1851,20 @@ (eval-when (:compile-toplevel :execute) (defun bit-test-inst-printer-list (subop) - `((ext-reg/mem-imm ((op (#b1011101 ,subop)) - (reg/mem nil :type word-reg/mem) - (imm nil :type imm-data) - (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)) - (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)) - (:emitter - (emit-bit-test-and-mumble segment src index #b100))) - -(define-instruction btc (segment src index) - (:printer-list (bit-test-inst-printer-list #b111)) - (:emitter - (emit-bit-test-and-mumble segment src index #b111))) - -(define-instruction btr (segment src index) - (:printer-list (bit-test-inst-printer-list #b110)) - (:emitter - (emit-bit-test-and-mumble segment src index #b110))) - -(define-instruction bts (segment src index) - (:printer-list (bit-test-inst-printer-list #b101)) - (:emitter - (emit-bit-test-and-mumble segment src index #b101))) + `((ext-reg/mem-no-width+imm8 ((op (#xBA ,subop)))) + (ext-reg-reg/mem-no-width ((op ,(dpb subop (byte 3 3) #b10000011)) + (reg/mem nil :type sized-reg/mem)) + (:name :tab reg/mem ", " reg))))) + +(macrolet ((define (inst opcode-extension) + `(define-instruction ,inst (segment src index) + (:printer-list (bit-test-inst-printer-list ,opcode-extension)) + (:emitter (emit-bit-test-and-mumble segment src index + ,opcode-extension))))) + (define bt 4) + (define bts 5) + (define btr 6) + (define btc 7)) ;;;; control transfer @@ -2078,7 +1960,7 @@ (: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 @@ -2111,7 +1993,6 @@ ;;;; 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))) @@ -2231,8 +2112,8 @@ ;; Lisp (with (DESCRIBE 'BYTE-IMM-CODE)) than to definitively deduce ;; from first principles whether it's defined in some way that genesis ;; can't grok. - (case #!-darwin (byte-imm-code chunk dstate) - #!+darwin (word-imm-code chunk dstate) + (case #!-ud2-breakpoints (byte-imm-code chunk dstate) + #!+ud2-breakpoints (word-imm-code chunk dstate) (#.error-trap (nt "error trap") (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) @@ -2250,17 +2131,17 @@ (define-instruction break (segment code) (:declare (type (unsigned-byte 8) code)) - #!-darwin (:printer byte-imm ((op #b11001100)) '(:name :tab code) - :control #'break-control) - #!+darwin (:printer word-imm ((op #b0000101100001111)) '(:name :tab code) - :control #'break-control) + #!-ud2-breakpoints (:printer byte-imm ((op #b11001100)) '(:name :tab code) + :control #'break-control) + #!+ud2-breakpoints (:printer word-imm ((op #b0000101100001111)) '(:name :tab code) + :control #'break-control) (:emitter - #!-darwin (emit-byte segment #b11001100) + #!-ud2-breakpoints (emit-byte segment #b11001100) ;; On darwin, trap handling via SIGTRAP is unreliable, therefore we ;; throw a sigill with 0x0b0f instead and check for this in the ;; SIGILL handler and pass it on to the sigtrap handler if ;; appropriate - #!+darwin (emit-word segment #b0000101100001111) + #!+ud2-breakpoints (emit-word segment #b0000101100001111) (emit-byte segment code))) (define-instruction int (segment number) @@ -2309,13 +2190,6 @@ (:printer byte ((op #b10011011))) (: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 - (bug "LOCK prefix used as a standalone instruction"))) ;;;; miscellaneous hackery @@ -2637,9 +2511,8 @@ (define-instruction fxch (segment source) (:printer floating-point-fp ((op '(#b001 #b001)))) (:emitter - (unless (and (tn-p source) - (eq (sb-name (sc-sb (tn-sc source))) 'float-registers)) - (cl:break)) + (aver (and (tn-p source) + (eq (sb-name (sc-sb (tn-sc source))) 'float-registers))) (emit-byte segment #b11011001) (emit-fp-op segment source #b001))) @@ -2990,3 +2863,64 @@ (:emitter (emit-byte segment #b00001111) (emit-byte segment #b00110001))) + +;;;; Late VM definitions +(defun canonicalize-inline-constant (constant) + (let ((first (car constant))) + (typecase first + (single-float (setf constant (list :single-float first))) + (double-float (setf constant (list :double-float first))))) + (destructuring-bind (type value) constant + (ecase type + ((:byte :word :dword) + (aver (integerp value)) + (cons type value)) + ((:base-char) + #!+sb-unicode (aver (base-char-p value)) + (cons :byte (char-code value))) + ((:character) + (aver (characterp value)) + (cons :dword (char-code value))) + ((:single-float) + (aver (typep value 'single-float)) + (cons :dword (ldb (byte 32 0) (single-float-bits value)))) + ((:double-float-bits) + (aver (integerp value)) + (cons :double-float (ldb (byte 64 0) value))) + ((:double-float) + (aver (typep value 'double-float)) + (cons :double-float + (ldb (byte 64 0) (logior (ash (double-float-high-bits value) 32) + (double-float-low-bits value)))))))) + +(defun inline-constant-value (constant) + (let ((label (gen-label)) + (size (ecase (car constant) + ((:byte :word :dword) (car constant)) + (:double-float :dword)))) + (values label (make-ea size + :disp (make-fixup nil :code-object label))))) + +(defun emit-constant-segment-header (segment constants optimize) + (declare (ignore segment constants)) + (loop repeat (if optimize 64 16) do (inst byte #x90))) + +(defun size-nbyte (size) + (ecase size + (:byte 1) + (:word 2) + (:dword 4) + (:double-float 8))) + +(defun sort-inline-constants (constants) + (stable-sort constants #'> :key (lambda (constant) + (size-nbyte (caar constant))))) + +(defun emit-inline-constant (constant label) + (let ((size (size-nbyte (car constant)))) + (emit-alignment (integer-length (1- size))) + (emit-label label) + (let ((val (cdr constant))) + (loop repeat size + do (inst byte (ldb (byte 8 0) val)) + (setf val (ash val -8))))))