;;; 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.
(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
(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))
(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
(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)
(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)
;; 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))
: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))
\f
;;;; This section was added by jrd, for fp instructions.
(: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
(emit-byte segment #xf3)
(emit-byte segment #x90)))
\f
-(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.
(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)))))
(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))
\f
;;;; control transfer
(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)
projects / sbcl.git / blobdiff