;;; 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)
(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)
(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))))
(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
: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))
(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))
(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))
;; 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
(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))
;; 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
(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
(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
;; 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))
;; 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))
\f
;;;; This section was added by jrd, for fp instructions.
: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)
: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
(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)))
(:dword
(emit-dword segment value))))
\f
+;;;; 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)
(: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))
(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)))
(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)
(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)
(emit-byte segment (if (eq size :byte) #b10110000 #b10110001))
(emit-ea segment dst (reg-tn-encoding src)))))
-\f
-(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)))
+\f
;;;; flag control instructions
;;; CLC -- Clear Carry Flag.
(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))
(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)
(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)
(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)
(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))
(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))
(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))
(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))
(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))))
(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)
(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
(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)
(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)
(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)
(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))
(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))
(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))
(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))
(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))
(: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)))
-
\f
;;;; 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)
(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)
(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))
\f
;;;; control transfer
;;;; 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)))
;; 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))
(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)
(: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")))
\f
;;;; miscellaneous hackery
(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)))
(: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))))))
projects / sbcl.git / blobdiff