X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcompiler%2Fx86%2Finsts.lisp;h=b79d091cda0a67dcf12a46c170302ef161f1a4f9;hb=69e6aef5e6fb3bd682c7a2cbf774034d2ea58ee8;hp=e5373bd6275f2a0d4fe7a7146e8b91815deb1439;hpb=65bdee4ba534e82c352cff3eec16473daaf285dd;p=sbcl.git diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index e5373bd..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) @@ -405,6 +429,10 @@ (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) @@ -517,6 +545,25 @@ ;; optional fields (imm)) +(sb!disassem:define-instruction-format (ext-reg-reg/mem-no-width 24 + :default-printer + `(:name :tab reg ", " reg/mem)) + (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 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)) @@ -540,6 +587,12 @@ :default-printer '(:name :tab reg/mem ", " imm)) (imm :type 'imm-data)) + +(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-byte)) ;;;; This section was added by jrd, for fp instructions. @@ -965,6 +1018,16 @@ (: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 @@ -1186,16 +1249,6 @@ (emit-byte segment #xf3) (emit-byte segment #x90))) -(define-instruction fs-segment-prefix (segment) - (:printer byte ((op #b01100100))) - (:emitter - (bug "FS emitted as a separate instruction!"))) - -(define-instruction gs-segment-prefix (segment) - (:printer byte ((op #b01100101))) - (:emitter - (bug "GS emitted as a separate instruction!"))) - ;;;; flag control instructions ;;; CLC -- Clear Carry Flag. @@ -1598,7 +1651,8 @@ (eval-when (:compile-toplevel :execute) (defun double-shift-inst-printer-list (op) `((ext-reg-reg/mem ((op ,(logior op #b10)) (width 0) - (imm nil :type signed-imm-byte))) + (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))))) @@ -1797,33 +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))) - (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 @@ -2835,7 +2876,7 @@ (aver (integerp value)) (cons type value)) ((:base-char) - (aver (base-char-p value)) + #!+sb-unicode (aver (base-char-p value)) (cons :byte (char-code value))) ((:character) (aver (characterp value)) @@ -2860,8 +2901,8 @@ (values label (make-ea size :disp (make-fixup nil :code-object label))))) -(defun emit-constant-segment-header (constants optimize) - (declare (ignore constants)) +(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)