(setf sb!disassem:*disassem-inst-alignment-bytes* 1)
(deftype reg () '(unsigned-byte 3))
+
+(def!constant +default-operand-size+ :dword)
\f
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(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))
\f
;;;; disassembler argument types
-(sb!disassem:define-argument-type displacement
+(sb!disassem:define-arg-type displacement
:sign-extend t
:use-label #'offset-next
:printer (lambda (value stream dstate)
(sb!disassem:maybe-note-assembler-routine value nil dstate)
(print-label value stream dstate)))
-(sb!disassem:define-argument-type accum
+(sb!disassem:define-arg-type accum
:printer (lambda (value stream dstate)
(declare (ignore value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
(print-reg 0 stream dstate)))
-(sb!disassem:define-argument-type word-accum
+(sb!disassem:define-arg-type word-accum
:printer (lambda (value stream dstate)
(declare (ignore value)
(type stream stream)
(type sb!disassem:disassem-state dstate))
(print-word-reg 0 stream dstate)))
-(sb!disassem:define-argument-type reg
+(sb!disassem:define-arg-type reg
:printer #'print-reg)
-(sb!disassem:define-argument-type addr-reg
+(sb!disassem:define-arg-type addr-reg
:printer #'print-addr-reg)
-(sb!disassem:define-argument-type word-reg
+(sb!disassem:define-arg-type word-reg
:printer #'print-word-reg)
-(sb!disassem:define-argument-type imm-addr
+(sb!disassem:define-arg-type imm-addr
:prefilter #'read-address
:printer #'print-label)
-(sb!disassem:define-argument-type imm-data
+(sb!disassem:define-arg-type imm-data
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(sb!disassem:read-suffix
(width-bits (sb!disassem:dstate-get-prop dstate 'width))
dstate)))
-(sb!disassem:define-argument-type signed-imm-data
+(sb!disassem:define-arg-type signed-imm-data
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(let ((width (sb!disassem:dstate-get-prop dstate 'width)))
(sb!disassem:read-signed-suffix (width-bits width) dstate))))
-(sb!disassem:define-argument-type signed-imm-byte
+(sb!disassem:define-arg-type signed-imm-byte
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(sb!disassem:read-signed-suffix 8 dstate)))
-(sb!disassem:define-argument-type signed-imm-dword
+(sb!disassem:define-arg-type signed-imm-dword
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(sb!disassem:read-signed-suffix 32 dstate)))
-(sb!disassem:define-argument-type imm-word
+(sb!disassem:define-arg-type imm-word
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(let ((width
(sb!disassem:read-suffix (width-bits width) dstate))))
;;; needed for the ret imm16 instruction
-(sb!disassem:define-argument-type imm-word-16
+(sb!disassem:define-arg-type imm-word-16
:prefilter (lambda (value dstate)
(declare (ignore value)) ; always nil anyway
(sb!disassem:read-suffix 16 dstate)))
-(sb!disassem:define-argument-type reg/mem
+(sb!disassem:define-arg-type reg/mem
:prefilter #'prefilter-reg/mem
:printer #'print-reg/mem)
-(sb!disassem:define-argument-type sized-reg/mem
+(sb!disassem:define-arg-type sized-reg/mem
;; Same as reg/mem, but prints an explicit size indicator for
;; memory references.
:prefilter #'prefilter-reg/mem
:printer #'print-sized-reg/mem)
-(sb!disassem:define-argument-type byte-reg/mem
+(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))
(declare (ignore dstate))
value)
) ; EVAL-WHEN
-(sb!disassem:define-argument-type fp-reg
- :prefilter #'prefilter-fp-reg
- :printer #'print-fp-reg)
+(sb!disassem:define-arg-type fp-reg
+ :prefilter #'prefilter-fp-reg
+ :printer #'print-fp-reg)
-(sb!disassem:define-argument-type width
+(sb!disassem:define-arg-type width
:prefilter #'prefilter-width
:printer (lambda (value stream dstate)
(if;; (zerop value)
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf sb!assem:*assem-scheduler-p* nil))
-(sb!disassem:define-argument-type condition-code
+(sb!disassem:define-arg-type condition-code
:printer *condition-name-vec*)
(defun conditional-opcode (condition)
: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.
\f
;;;; utilities
-(defconstant +operand-size-prefix-byte+ #b01100110)
-
-(defconstant +default-operand-size+ :dword)
+(def!constant +operand-size-prefix-byte+ #b01100110)
(defun maybe-emit-operand-size-prefix (segment size)
(unless (or (eq size :byte) (eq size +default-operand-size+))
(emit-ea segment dst (reg-tn-encoding src)))))
\f
+
+(define-instruction fs-segment-prefix (segment)
+ (:emitter
+ (emit-byte segment #x64)))
+
;;;; flag control instructions
;;; CLC -- Clear Carry Flag.
((integerp src)
(cond ((and (not (eq size :byte)) (<= -128 src 127))
(emit-byte segment #b10000011)
- (emit-ea segment dst opcode)
+ (emit-ea segment dst opcode allow-constants)
(emit-byte segment src))
((accumulator-p dst)
(emit-byte segment
(emit-sized-immediate segment size src))
(t
(emit-byte segment (if (eq size :byte) #b10000000 #b10000001))
- (emit-ea segment dst opcode)
+ (emit-ea segment dst opcode allow-constants)
(emit-sized-immediate segment size src))))
((register-p src)
(emit-byte segment
;;;; 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)))
(lengths))
(lengths 1) ; the length byte
(let* ((index 0)
- (error-number (sb!c::read-var-integer vector index)))
+ (error-number (sb!c:read-var-integer vector index)))
(lengths index)
(loop
(when (>= index length)
(return))
(let ((old-index index))
- (sc-offsets (sb!c::read-var-integer vector index))
+ (sc-offsets (sb!c:read-var-integer vector index))
(lengths (- index old-index))))
(values error-number
(1+ length)
;;; 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)