insts.lisp

开源跨平台Lisp编译器

                                  nil))
                               (#b01
                                (sb!disassem:read-signed-suffix 8 dstate))
                               (#b10
                                (sb!disassem:read-signed-suffix 32 dstate)))))
                   (list (unless (and (= mod #b00) (= base-reg #b101))
                           (if (sb!disassem:dstate-get-inst-prop dstate 'rex-b)
                               (+ base-reg 8)
                               base-reg))
                         offset
                         (unless (= index-reg #b100)
                           (if (sb!disassem:dstate-get-inst-prop dstate 'rex-x)
                               (+ index-reg 8)
                               index-reg))
                         (ash 1 index-scale))))))
            ((and (= mod #b00) (= r/m #b101))
             (list 'rip (sb!disassem:read-signed-suffix 32 dstate)))
            ((= mod #b00)
             (list full-reg))
            ((= mod #b01)
           (list full-reg (sb!disassem:read-signed-suffix 8 dstate)))
          (t                            ; (= mod #b10)
           (list full-reg (sb!disassem:read-signed-suffix 32 dstate)))))))

(defun read-address (value dstate)
  (declare (ignore value))              ; always nil anyway
  (sb!disassem:read-suffix (width-bits (inst-operand-size dstate)) dstate))

(defun width-bits (width)
  (ecase width
    (:byte 8)
    (:word 16)
    (:dword 32)
    (:qword 64)))

) ; EVAL-WHEN

;;;; disassembler argument types

;;; Used to capture the lower four bits of the REX prefix.
(sb!disassem:define-arg-type wrxb
  :prefilter #'prefilter-wrxb)

(sb!disassem:define-arg-type width
  :prefilter #'prefilter-width
  :printer (lambda (value stream dstate)
             (declare (ignore value))
             (princ (schar (symbol-name (inst-operand-size dstate)) 0)
                    stream)))

;;; Used to capture the effect of the #x66 operand size override prefix.
(sb!disassem:define-arg-type x66
  :prefilter #'prefilter-x66)

(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-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-arg-type reg
  :prefilter #'prefilter-reg-r
  :printer #'print-reg)

(sb!disassem:define-arg-type reg-b
  :prefilter #'prefilter-reg-b
  :printer #'print-reg)

(sb!disassem:define-arg-type reg-b-default-qword
  :prefilter #'prefilter-reg-b
  :printer #'print-reg-default-qword)

(sb!disassem:define-arg-type imm-addr
  :prefilter #'read-address
  :printer #'print-label)

;;; Normally, immediate values for an operand size of :qword are of size
;;; :dword and are sign-extended to 64 bits. For an exception, see the
;;; argument type definition following this one.
(sb!disassem:define-arg-type signed-imm-data
  :prefilter (lambda (value dstate)
               (declare (ignore value)) ; always nil anyway
               (let ((width (width-bits (inst-operand-size dstate))))
                 (when (= width 64)
                   (setf width 32))
                 (sb!disassem:read-signed-suffix width dstate))))

;;; Used by the variant of the MOV instruction with opcode B8 which can
;;; move immediates of all sizes (i.e. including :qword) into a
;;; register.
(sb!disassem:define-arg-type signed-imm-data-upto-qword
  :prefilter (lambda (value dstate)
               (declare (ignore value)) ; always nil anyway
               (sb!disassem:read-signed-suffix
                (width-bits (inst-operand-size dstate))
                dstate)))

;;; Used by those instructions that have a default operand size of
;;; :qword. Nevertheless the immediate is at most of size :dword.
;;; The only instruction of this kind having a variant with an immediate
;;; argument is PUSH.
(sb!disassem:define-arg-type signed-imm-data-default-qword
  :prefilter (lambda (value dstate)
               (declare (ignore value)) ; always nil anyway
               (let ((width (width-bits
                             (inst-operand-size-default-qword dstate))))
                 (when (= width 64)
                   (setf width 32))
                 (sb!disassem:read-signed-suffix width dstate))))

(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-arg-type imm-byte
  :prefilter (lambda (value dstate)
               (declare (ignore value)) ; always nil anyway
               (sb!disassem:read-suffix 8 dstate)))

;;; needed for the ret imm16 instruction
(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-arg-type reg/mem
  :prefilter #'prefilter-reg/mem
  :printer #'print-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)

;;; Arguments of type reg/mem with a fixed size.
(sb!disassem:define-arg-type sized-byte-reg/mem
  :prefilter #'prefilter-reg/mem
  :printer #'print-sized-byte-reg/mem)
(sb!disassem:define-arg-type sized-word-reg/mem
  :prefilter #'prefilter-reg/mem
  :printer #'print-sized-word-reg/mem)
(sb!disassem:define-arg-type sized-dword-reg/mem
  :prefilter #'prefilter-reg/mem
  :printer #'print-sized-dword-reg/mem)

;;; Same as sized-reg/mem, but with a default operand size of :qword.
(sb!disassem:define-arg-type sized-reg/mem-default-qword
  :prefilter #'prefilter-reg/mem
  :printer #'print-sized-reg/mem-default-qword)

;;; XMM registers
(sb!disassem:define-arg-type xmmreg
  :prefilter #'prefilter-reg-r
  :printer #'print-xmmreg)

(sb!disassem:define-arg-type xmmreg/mem
  :prefilter #'prefilter-reg/mem
  :printer #'print-xmmreg/mem)

(sb!disassem:define-arg-type sized-xmmreg/mem
  :prefilter #'prefilter-reg/mem
  :printer #'print-sized-xmmreg/mem)


(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *conditions*
  '((:o . 0)
    (:no . 1)
    (:b . 2) (:nae . 2) (:c . 2)
    (:nb . 3) (:ae . 3) (:nc . 3)
    (:eq . 4) (:e . 4) (:z . 4)
    (:ne . 5) (:nz . 5)
    (:be . 6) (:na . 6)
    (:nbe . 7) (:a . 7)
    (:s . 8)
    (:ns . 9)
    (:p . 10) (:pe . 10)
    (:np . 11) (:po . 11)
    (:l . 12) (:nge . 12)
    (:nl . 13) (:ge . 13)
    (:le . 14) (:ng . 14)
    (:nle . 15) (:g . 15)))
(defparameter *condition-name-vec*
  (let ((vec (make-array 16 :initial-element nil)))
    (dolist (cond *conditions*)
      (when (null (aref vec (cdr cond)))
        (setf (aref vec (cdr cond)) (car cond))))
    vec))
) ; EVAL-WHEN

;;; Set assembler parameters. (In CMU CL, this was done with
;;; a call to a macro DEF-ASSEMBLER-PARAMS.)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf sb!assem:*assem-scheduler-p* nil))

(sb!disassem:define-arg-type condition-code
  :printer *condition-name-vec*)

(defun conditional-opcode (condition)
  (cdr (assoc condition *conditions* :test #'eq)))

;;;; disassembler instruction formats

(eval-when (:compile-toplevel :execute)
  (defun swap-if (direction field1 separator field2)
    `(:if (,direction :constant 0)
          (,field1 ,separator ,field2)
          (,field2 ,separator ,field1))))

(sb!disassem:define-instruction-format (byte 8 :default-printer '(:name))
  (op    :field (byte 8 0))
  ;; 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))))

;;; A one-byte instruction with a #x66 prefix, used to indicate an
;;; operand size of :word.
(sb!disassem:define-instruction-format (x66-byte 16
                                        :default-printer '(:name))
  (x66   :field (byte 8 0) :value #x66)
  (op    :field (byte 8 8)))

;;; A one-byte instruction with a REX prefix, used to indicate an
;;; operand size of :qword. REX.W must be 1, the other three bits are
;;; ignored.
(sb!disassem:define-instruction-format (rex-byte 16
                                        :default-printer '(:name))
  (rex   :field (byte 5 3) :value #b01001)
  (op    :field (byte 8 8)))

(sb!disassem:define-instruction-format (simple 8)
  (op    :field (byte 7 1))
  (width :field (byte 1 0) :type 'width)
  ;; optional fields
  (accum :type 'accum)
  (imm))

(sb!disassem:define-instruction-format (rex-simple 16)
  (rex     :field (byte 4 4)    :value #b0100)
  (wrxb    :field (byte 4 0)    :type 'wrxb)
  (op    :field (byte 7 9))
  (width :field (byte 1 8) :type 'width)
  ;; optional fields
  (accum :type 'accum)
  (imm))

;;; Same as simple, but with direction bit
(sb!disassem:define-instruction-format (simple-dir 8 :include 'simple)
  (op :field (byte 6 2))
  (dir :field (byte 1 1)))

;;; Same as simple, but with the immediate value occurring by default,
;;; and with an appropiate printer.
(sb!disassem:define-instruction-format (accum-imm 8
                                     :include 'simple
                                     :default-printer '(:name
                                                        :tab accum ", " imm))
  (imm :type 'signed-imm-data))

(sb!disassem:define-instruction-format (rex-accum-imm 16
                                     :include 'rex-simple
                                     :default-printer '(:name
                                                        :tab accum ", " imm))
  (imm :type 'signed-imm-data))

(sb!disassem:define-instruction-format (reg-no-width 8
                                     :default-printer '(:name :tab reg))
  (op    :field (byte 5 3))
  (reg   :field (byte 3 0) :type 'reg-b)
  ;; optional fields
  (accum :type 'accum)
  (imm))

(sb!disassem:define-instruction-format (rex-reg-no-width 16
                                     :default-printer '(:name :tab reg))
  (rex     :field (byte 4 4)    :value #b0100)
  (wrxb    :field (byte 4 0)    :type 'wrxb)
  (op      :field (byte 5 11))
  (reg     :field (byte 3 8)    :type 'reg-b)
  ;; optional fields
  (accum :type 'accum)
  (imm))

;;; Same as reg-no-width, but with a default operand size of :qword.
(sb!disassem:define-instruction-format (reg-no-width-default-qword 8
                                        :include 'reg-no-width
                                        :default-printer '(:name :tab reg))
  (reg   :type 'reg-b-default-qword))

;;; Same as rex-reg-no-width, but with a default operand size of :qword.
(sb!disassem:define-instruction-format (rex-reg-no-width-default-qword 16
                                        :include 'rex-reg-no-width
                                        :default-printer '(:name :tab reg))
  (reg     :type 'reg-b-default-qword))

;;; Adds a width field to reg-no-width. Note that we can't use
;;; :INCLUDE 'REG-NO-WIDTH here to save typing because that would put
;;; the WIDTH field last, but the prefilter for WIDTH must run before
;;; the one for IMM to be able to determine the correct size of IMM.
(sb!disassem:define-instruction-format (reg 8
                                        :default-printer '(:name :tab reg))
  (op    :field (byte 4 4))
  (width :field (byte 1 3) :type 'width)
  (reg   :field (byte 3 0) :type 'reg-b)
  ;; optional fields
  (accum :type 'accum)
  (imm))