(print-byte-reg value stream dstate)
(print-mem-access value stream t dstate)))
+(defun print-word-reg/mem (value stream dstate)
+ (declare (type (or list reg) value)
+ (type stream stream)
+ (type sb!disassem:disassem-state dstate))
+ (if (typep value 'reg)
+ (print-word-reg value stream dstate)
+ (print-mem-access value stream nil dstate)))
+
(defun print-label (value stream dstate)
(declare (ignore dstate))
(sb!disassem:princ16 value stream))
+default-operand-size+)))
(sb!disassem:read-suffix (width-bits width) dstate))))
+(sb!disassem:define-arg-type signed-imm-word
+ :prefilter (lambda (value dstate)
+ (declare (ignore value)) ; always nil anyway
+ (let ((width
+ (or (sb!disassem:dstate-get-prop dstate 'word-width)
+ +default-operand-size+)))
+ (sb!disassem:read-signed-suffix (width-bits width) dstate))))
+
;;; needed for the ret imm16 instruction
(sb!disassem:define-arg-type imm-word-16
:prefilter (lambda (value dstate)
(sb!disassem:define-arg-type byte-reg/mem
:prefilter #'prefilter-reg/mem
:printer #'print-byte-reg/mem)
+(sb!disassem:define-arg-type word-reg/mem
+ :prefilter #'prefilter-reg/mem
+ :printer #'print-word-reg/mem)
;;; added by jrd
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(defun print-fp-reg (value stream dstate)
(declare (ignore dstate))
(format stream "FR~D" value))
: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))
\f
;;;; This section was added by jrd, for fp instructions.
:type 'byte-reg/mem)
(reg :field (byte 3 19) :value #b000))
+(sb!disassem:define-instruction-format (cond-move 24
+ :default-printer
+ '('cmov cc :tab reg ", " reg/mem))
+ (prefix :field (byte 8 0) :value #b00001111)
+ (op :field (byte 4 12) :value #b0100)
+ (cc :field (byte 4 8) :type 'condition-code)
+ (reg/mem :fields (list (byte 2 22) (byte 3 16))
+ :type 'reg/mem)
+ (reg :field (byte 3 19) :type 'reg))
+
(sb!disassem:define-instruction-format (enter-format 32
:default-printer '(:name
:tab disp
(disp :field (byte 16 8))
(level :field (byte 8 24)))
+(sb!disassem:define-instruction-format (prefetch 24
+ :default-printer
+ '(:name ", " reg/mem))
+ (prefix :field (byte 8 0) :value #b00001111)
+ (op :field (byte 8 8) :value #b00011000)
+ (reg/mem :fields (list (byte 2 22) (byte 3 16)) :type 'byte-reg/mem)
+ (reg :field (byte 3 19) :type 'reg))
+
;;; Single byte instruction with an immediate byte argument.
(sb!disassem:define-instruction-format (byte-imm 16
:default-printer '(:name :tab code))
(let ((offset (fixup-offset fixup)))
(if (label-p offset)
(emit-back-patch segment
- 4 ; FIXME: sb!vm:n-word-bytes
+ 4 ; FIXME: n-word-bytes
(lambda (segment posn)
(declare (ignore posn))
(emit-dword segment
(base nil :type (or tn null))
(index nil :type (or tn null))
(scale 1 :type (member 1 2 4 8))
- (disp 0 :type (or (signed-byte 32) fixup)))
+ (disp 0 :type (or (unsigned-byte 32) (signed-byte 32) fixup)))
(def!method print-object ((ea ea) stream)
(cond ((or *print-escape* *print-readably*)
(print-unreadable-object (ea stream :type t)
(define-instruction imul (segment dst &optional src1 src2)
(:printer accum-reg/mem ((op '(#b1111011 #b101))))
(:printer ext-reg-reg/mem ((op #b1010111)))
- (:printer reg-reg/mem ((op #b0110100) (width 1) (imm nil :type 'imm-word))
+ (:printer 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))
(eval-when (:compile-toplevel :execute)
(defun double-shift-inst-printer-list (op)
`(#+nil
- (ext-reg-reg/mem-imm ((op ,(logior op #b100))
+ (ext-reg-reg/mem-imm ((op ,(logior op #b10))
(imm nil :type signed-imm-byte)))
- (ext-reg-reg/mem ((op ,(logior op #b101)))
- (:name :tab reg/mem ", " 'cl)))))
+ (ext-reg-reg/mem ((op ,(logior op #b10)))
+ (:name :tab reg/mem ", " reg ", " 'cl)))))
(define-instruction shld (segment dst src amt)
(:declare (type (or (member :cl) (mod 32)) amt))
- (:printer-list (double-shift-inst-printer-list #b10100000))
+ (:printer-list (double-shift-inst-printer-list #b1010000))
(:emitter
(emit-double-shift segment #b0 dst src amt)))
(define-instruction shrd (segment dst src amt)
(:declare (type (or (member :cl) (mod 32)) amt))
- (:printer-list (double-shift-inst-printer-list #b10101000))
+ (:printer-list (double-shift-inst-printer-list #b1010100))
(:emitter
(emit-double-shift segment #b1 dst src amt)))
;;;; bit manipulation
(define-instruction bsf (segment dst src)
+ (:printer ext-reg-reg/mem ((op #b1011110) (width 0)))
(:emitter
(let ((size (matching-operand-size dst src)))
(when (eq size :byte)
(emit-ea segment src (reg-tn-encoding dst)))))
(define-instruction bsr (segment dst src)
+ (:printer ext-reg-reg/mem ((op #b1011110) (width 1)))
(:emitter
(let ((size (matching-operand-size dst src)))
(when (eq size :byte)
(emit-byte segment (dpb opcode (byte 3 3) #b10000011))
(emit-ea segment src (reg-tn-encoding index))))))
+(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)))
(emit-byte segment #b11100000)
(emit-byte-displacement-backpatch segment target)))
\f
+;;;; conditional move
+(define-instruction cmov (segment cond dst src)
+ (:printer cond-move ())
+ (:emitter
+ (aver (register-p dst))
+ (let ((size (matching-operand-size dst src)))
+ (aver (or (eq size :word) (eq size :dword)))
+ (maybe-emit-operand-size-prefix segment size))
+ (emit-byte segment #b00001111)
+ (emit-byte segment (dpb (conditional-opcode cond) (byte 4 0) #b01000000))
+ (emit-ea segment src (reg-tn-encoding dst))))
+
;;;; conditional byte set
(define-instruction set (segment dst cond)
(:emitter
(emit-byte segment #b11001001)))
\f
+;;;; prefetch
+(define-instruction prefetchnta (segment ea)
+ (:printer prefetch ((op #b00011000) (reg #b000)))
+ (:emitter
+ (aver (typep ea 'ea))
+ (aver (eq :byte (ea-size ea)))
+ (emit-byte segment #b00001111)
+ (emit-byte segment #b00011000)
+ (emit-ea segment ea #b000)))
+
+(define-instruction prefetcht0 (segment ea)
+ (:printer prefetch ((op #b00011000) (reg #b001)))
+ (:emitter
+ (aver (typep ea 'ea))
+ (aver (eq :byte (ea-size ea)))
+ (emit-byte segment #b00001111)
+ (emit-byte segment #b00011000)
+ (emit-ea segment ea #b001)))
+
+(define-instruction prefetcht1 (segment ea)
+ (:printer prefetch ((op #b00011000) (reg #b010)))
+ (:emitter
+ (aver (typep ea 'ea))
+ (aver (eq :byte (ea-size ea)))
+ (emit-byte segment #b00001111)
+ (emit-byte segment #b00011000)
+ (emit-ea segment ea #b010)))
+
+(define-instruction prefetcht2 (segment ea)
+ (:printer prefetch ((op #b00011000) (reg #b011)))
+ (:emitter
+ (aver (typep ea 'ea))
+ (aver (eq :byte (ea-size ea)))
+ (emit-byte segment #b00001111)
+ (emit-byte segment #b00011000)
+ (emit-ea segment ea #b011)))
+\f
;;;; interrupt instructions
(defun snarf-error-junk (sap offset &optional length-only)
(cond (length-only
(values 0 (1+ length) nil nil))
(t
- (sb!kernel:copy-from-system-area sap (* n-byte-bits (1+ offset))
- vector (* n-word-bits
- vector-data-offset)
- (* length n-byte-bits))
+ (sb!kernel:copy-ub8-from-system-area sap (1+ offset)
+ vector 0 length)
(collect ((sc-offsets)
(lengths))
(lengths 1) ; the length byte
;;; unordered comparison
(define-instruction fucom (segment src)
- ;; XX Printer conflicts with frstor
- ;; (:printer floating-point ((op '(#b101 #b100))))
+ (:printer floating-point-fp ((op '(#b101 #b100))))
(:emitter
(aver (fp-reg-tn-p src))
(emit-byte segment #b11011101)
projects / sbcl.git / blobdiff