(accum :type 'accum)
(imm))
+(sb!disassem:define-instruction-format (two-bytes 16
+ :default-printer '(:name))
+ (op :fields (list (byte 8 0) (byte 8 8))))
+
;;; Same as simple, but with direction bit
(sb!disassem:define-instruction-format (simple-dir 8 :include 'simple)
(op :field (byte 6 2))
(emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing)))
(stack
;; Convert stack tns into an index off of EBP.
- (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes))))
+ (let ((disp (frame-byte-offset (tn-offset thing))))
(cond ((<= -128 disp 127)
(emit-mod-reg-r/m-byte segment #b01 reg #b101)
(emit-byte segment disp))
(emit-word segment value))
(:dword
(emit-dword segment value))))
+
+(defun toggle-word-width (chunk inst stream dstate)
+ (declare (ignore chunk inst stream))
+ (let ((word-width (or (sb!disassem:dstate-get-prop dstate 'word-width)
+ +default-operand-size+)))
+ (setf (sb!disassem:dstate-get-prop dstate 'word-width)
+ (ecase word-width
+ (:word :dword)
+ (:dword :word)))))
+
+;;; This is a "prefix" instruction, which means that it modifies the
+;;; following instruction in some way without having an actual
+;;; mnemonic of its own.
+(define-instruction operand-size-prefix (segment)
+ (:printer byte ((op +operand-size-prefix-byte+))
+ nil ; don't actually print it
+ :control #'toggle-word-width))
\f
;;;; general data transfer
-(define-instruction mov (segment dst src)
+(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 reg/mem-imm ((op '(#b1100011 #b000))))
(:emitter
+ (emit-prefix segment prefix)
(let ((size (matching-operand-size dst src)))
(maybe-emit-operand-size-prefix segment size)
(cond ((register-p dst)
(:printer ext-reg-reg/mem ((op #b1011011) (reg nil :type 'word-reg)))
(:emitter (emit-move-with-extension segment dst src #b10110110)))
-(define-instruction push (segment src)
+(define-instruction push (segment src &optional prefix)
;; register
(:printer reg-no-width ((op #b01010)))
;; register/memory
;; ### segment registers?
(:emitter
+ (emit-prefix segment prefix)
(cond ((integerp src)
(cond ((<= -128 src 127)
(emit-byte segment #b01101010)
(emit-byte segment #b10001101)
(emit-ea segment src (reg-tn-encoding dst))))
-(define-instruction cmpxchg (segment dst src)
+(define-instruction cmpxchg (segment dst src &optional prefix)
;; Register/Memory with Register.
(:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg))
(:emitter
(aver (register-p src))
+ (emit-prefix segment prefix)
(let ((size (matching-operand-size src dst)))
(maybe-emit-operand-size-prefix segment size)
(emit-byte segment #b00001111)
(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
- (emit-byte segment #x64)))
+ (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
;;;; arithmetic
(defun emit-random-arith-inst (name segment dst src opcode
- &optional allow-constants)
+ &optional allow-constants)
(let ((size (matching-operand-size dst src)))
(maybe-emit-operand-size-prefix segment size)
(cond
(reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))))
)
-(define-instruction add (segment dst src)
+(define-instruction add (segment dst src &optional prefix)
(:printer-list (arith-inst-printer-list #b000))
- (:emitter (emit-random-arith-inst "ADD" segment dst src #b000)))
+ (:emitter
+ (emit-prefix segment prefix)
+ (emit-random-arith-inst "ADD" segment dst src #b000)))
(define-instruction adc (segment dst src)
(:printer-list (arith-inst-printer-list #b010))
(:emitter (emit-random-arith-inst "ADC" segment dst src #b010)))
-(define-instruction sub (segment dst src)
+(define-instruction sub (segment dst src &optional prefix)
(:printer-list (arith-inst-printer-list #b101))
- (:emitter (emit-random-arith-inst "SUB" segment dst src #b101)))
+ (:emitter
+ (emit-prefix segment prefix)
+ (emit-random-arith-inst "SUB" segment dst src #b101)))
(define-instruction sbb (segment dst src)
(:printer-list (arith-inst-printer-list #b011))
(:emitter (emit-random-arith-inst "SBB" segment dst src #b011)))
-(define-instruction cmp (segment dst src)
+(define-instruction cmp (segment dst src &optional prefix)
(:printer-list (arith-inst-printer-list #b111))
- (:emitter (emit-random-arith-inst "CMP" segment dst src #b111 t)))
+ (:emitter
+ (emit-prefix segment prefix)
+ (emit-random-arith-inst "CMP" segment dst src #b111 t)))
(define-instruction inc (segment dst)
;; Register.
(maybe-emit-operand-size-prefix segment :dword)
(emit-byte segment #b10011001)))
-(define-instruction xadd (segment dst src)
+(define-instruction xadd (segment dst src &optional prefix)
;; Register/Memory with Register.
(:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg))
(:emitter
(aver (register-p src))
+ (emit-prefix segment prefix)
(let ((size (matching-operand-size src dst)))
(maybe-emit-operand-size-prefix segment size)
(emit-byte segment #b00001111)
(t
(error "bogus operands for TEST: ~S and ~S" this that)))))))
-(define-instruction or (segment dst src)
+;;; Emit the most compact form of the test immediate instruction,
+;;; using an 8 bit test when the immediate is only 8 bits and the
+;;; value is one of the four low registers (eax, ebx, ecx, edx) or the
+;;; control stack.
+(defun emit-optimized-test-inst (x y)
+ (typecase y
+ ((unsigned-byte 7)
+ (let ((offset (tn-offset x)))
+ (cond ((and (sc-is x any-reg descriptor-reg)
+ (or (= offset eax-offset) (= offset ebx-offset)
+ (= offset ecx-offset) (= offset edx-offset)))
+ (inst test (make-random-tn :kind :normal
+ :sc (sc-or-lose 'byte-reg)
+ :offset offset)
+ y))
+ ((sc-is x control-stack)
+ (inst test (make-ea :byte :base ebp-tn
+ :disp (- (* (1+ offset) n-word-bytes)))
+ y))
+ (t
+ (inst test x y)))))
+ (t
+ (inst test x y))))
+
+(define-instruction or (segment dst src &optional prefix)
(:printer-list
(arith-inst-printer-list #b001))
(:emitter
+ (emit-prefix segment prefix)
(emit-random-arith-inst "OR" segment dst src #b001)))
-(define-instruction xor (segment dst src)
+(define-instruction xor (segment dst src &optional prefix)
(:printer-list
(arith-inst-printer-list #b110))
(:emitter
+ (emit-prefix segment prefix)
(emit-random-arith-inst "XOR" segment dst src #b110)))
(define-instruction not (segment dst)
;; 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 #!-darwin (byte-imm-code chunk dstate)
+ #!+darwin (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)
+ #!-darwin (:printer byte-imm ((op #b11001100)) '(:name :tab code)
:control #'break-control)
- #+darwin (:printer word-imm ((op #b0000101100001111)) '(:name :tab code)
+ #!+darwin (:printer word-imm ((op #b0000101100001111)) '(:name :tab code)
:control #'break-control)
(:emitter
- #-darwin (emit-byte segment #b11001100)
+ #!-darwin (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)
+ #!+darwin (emit-word segment #b0000101100001111)
(emit-byte segment code)))
(define-instruction int (segment number)
(: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
- (emit-byte segment #b11110000)))
+ (bug "LOCK prefix used as a standalone instruction")))
\f
;;;; miscellaneous hackery
(:emitter
(emit-byte segment #b11011001)
(emit-byte segment #b11101101)))
+
+;;;; Miscellany
+
+(define-instruction cpuid (segment)
+ (:printer two-bytes ((op '(#b00001111 #b10100010))))
+ (:emitter
+ (emit-byte segment #b00001111)
+ (emit-byte segment #b10100010)))
+
+(define-instruction rdtsc (segment)
+ (:printer two-bytes ((op '(#b00001111 #b00110001))))
+ (:emitter
+ (emit-byte segment #b00001111)
+ (emit-byte segment #b00110001)))
projects / sbcl.git / blobdiff