insts.lisp

开源跨平台Lisp编译器

;;;; that part of the description of the x86-64 instruction set
;;;; which can live on the cross-compilation host

;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.

(in-package "SB!VM")
;;; FIXME: SB!DISASSEM: prefixes are used so widely in this file that
;;; I wonder whether the separation of the disassembler from the
;;; virtual machine is valid or adds value.

;;; Note: In CMU CL, this used to be a call to SET-DISASSEM-PARAMS.
(setf sb!disassem:*disassem-inst-alignment-bytes* 1)

;;; This type is used mostly in disassembly and represents legacy
;;; registers only. R8-R15 are handled separately.
(deftype reg () '(unsigned-byte 3))

;;; This includes legacy registers and R8-R15.
(deftype full-reg () '(unsigned-byte 4))

;;; The XMM registers XMM0 - XMM15.
(deftype xmmreg () '(unsigned-byte 4))

;;; Default word size for the chip: if the operand size /= :dword
;;; we need to output #x66 (or REX) prefix
(def!constant +default-operand-size+ :dword)

;;; The default address size for the chip. It could be overwritten
;;; to :dword with a #x67 prefix, but this is never needed by SBCL
;;; and thus not supported by this assembler/disassembler.
(def!constant +default-address-size+ :qword)

(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)

(defun offset-next (value dstate)
  (declare (type integer value)
           (type sb!disassem:disassem-state dstate))
  (+ (sb!disassem:dstate-next-addr dstate) value))

(defparameter *byte-reg-names*
  #(al cl dl bl spl bpl sil dil r8b r9b r10b r11b r12b r13b r14b r15b))
(defparameter *high-byte-reg-names*
  #(ah ch dh bh))
(defparameter *word-reg-names*
  #(ax cx dx bx sp bp si di r8w r9w r10w r11w r12w r13w r14w r15w))
(defparameter *dword-reg-names*
  #(eax ecx edx ebx esp ebp esi edi r8d r9d r10d r11d r12d r13d r14d r15d))
(defparameter *qword-reg-names*
  #(rax rcx rdx rbx rsp rbp rsi rdi r8 r9 r10 r11 r12 r13 r14 r15))

;;; The printers for registers, memory references and immediates need to
;;; take into account the width bit in the instruction, whether a #x66
;;; or a REX prefix was issued, and the contents of the REX prefix.
;;; This is implemented using prefilters to put flags into the slot
;;; INST-PROPERTIES of the DSTATE.  These flags are the following
;;; symbols:
;;;
;;; OPERAND-SIZE-8   The width bit was zero
;;; OPERAND-SIZE-16  The "operand size override" prefix (#x66) was found
;;; REX              A REX prefix was found
;;; REX-W            A REX prefix with the "operand width" bit set was
;;;                  found
;;; REX-R            A REX prefix with the "register" bit set was found
;;; REX-X            A REX prefix with the "index" bit set was found
;;; REX-B            A REX prefix with the "base" bit set was found

;;; Return the operand size depending on the prefixes and width bit as
;;; stored in DSTATE.
(defun inst-operand-size (dstate)
  (declare (type sb!disassem:disassem-state dstate))
  (cond ((sb!disassem:dstate-get-inst-prop dstate 'operand-size-8)
         :byte)
        ((sb!disassem:dstate-get-inst-prop dstate 'rex-w)
         :qword)
        ((sb!disassem:dstate-get-inst-prop dstate 'operand-size-16)
         :word)
        (t
         +default-operand-size+)))

;;; The same as INST-OPERAND-SIZE, but for those instructions (e.g.
;;; PUSH, JMP) that have a default operand size of :qword. It can only
;;; be overwritten to :word.
(defun inst-operand-size-default-qword (dstate)
  (declare (type sb!disassem:disassem-state dstate))
  (if (sb!disassem:dstate-get-inst-prop dstate 'operand-size-16)
      :word
      :qword))

;;; Print to STREAM the name of the general-purpose register encoded by
;;; VALUE and of size WIDTH. For robustness, the high byte registers
;;; (AH, BH, CH, DH) are correctly detected, too, although the compiler
;;; does not use them.
(defun print-reg-with-width (value width stream dstate)
  (declare (type full-reg value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (princ (if (and (eq width :byte)
                  (<= 4 value 7)
                  (not (sb!disassem:dstate-get-inst-prop dstate 'rex)))
             (aref *high-byte-reg-names* (- value 4))
             (aref (ecase width
                     (:byte *byte-reg-names*)
                     (:word *word-reg-names*)
                     (:dword *dword-reg-names*)
                     (:qword *qword-reg-names*))
                   value))
         stream)
  ;; XXX plus should do some source-var notes
  )

(defun print-reg (value stream dstate)
  (declare (type full-reg value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (print-reg-with-width value
                        (inst-operand-size dstate)
                        stream
                        dstate))

(defun print-reg-default-qword (value stream dstate)
  (declare (type full-reg value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (print-reg-with-width value
                        (inst-operand-size-default-qword dstate)
                        stream
                        dstate))

(defun print-byte-reg (value stream dstate)
  (declare (type full-reg value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (print-reg-with-width value :byte stream dstate))

(defun print-addr-reg (value stream dstate)
  (declare (type full-reg value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (print-reg-with-width value +default-address-size+ stream dstate))

;;; Print a register or a memory reference of the given WIDTH.
;;; If SIZED-P is true, add an explicit size indicator for memory
;;; references.
(defun print-reg/mem-with-width (value width sized-p stream dstate)
  (declare (type (or list full-reg) value)
           (type (member :byte :word :dword :qword) width)
           (type boolean sized-p)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (if (typep value 'full-reg)
      (print-reg-with-width value width stream dstate)
    (print-mem-access value (and sized-p width) stream dstate)))

;;; Print a register or a memory reference. The width is determined by
;;; calling INST-OPERAND-SIZE.
(defun print-reg/mem (value stream dstate)
  (declare (type (or list full-reg) value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (print-reg/mem-with-width
   value (inst-operand-size dstate) nil stream dstate))

;; Same as print-reg/mem, but prints an explicit size indicator for
;; memory references.
(defun print-sized-reg/mem (value stream dstate)
  (declare (type (or list full-reg) value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (print-reg/mem-with-width
   value (inst-operand-size dstate) t stream dstate))

;;; Same as print-sized-reg/mem, but with a default operand size of
;;; :qword.
(defun print-sized-reg/mem-default-qword (value stream dstate)
  (declare (type (or list full-reg) value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (print-reg/mem-with-width
   value (inst-operand-size-default-qword dstate) t stream dstate))

(defun print-sized-byte-reg/mem (value stream dstate)
  (declare (type (or list full-reg) value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (print-reg/mem-with-width value :byte t stream dstate))

(defun print-sized-word-reg/mem (value stream dstate)
  (declare (type (or list full-reg) value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (print-reg/mem-with-width value :word t stream dstate))

(defun print-sized-dword-reg/mem (value stream dstate)
  (declare (type (or list full-reg) value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (print-reg/mem-with-width value :dword t stream dstate))

(defun print-label (value stream dstate)
  (declare (ignore dstate))
  (sb!disassem:princ16 value stream))

(defun print-xmmreg (value stream dstate)
  (declare (type xmmreg value)
           (type stream stream)
           (ignore dstate))
  (format stream "XMM~d" value))

(defun print-xmmreg/mem (value stream dstate)
  (declare (type (or list xmmreg) value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (if (typep value 'xmmreg)
      (print-xmmreg value stream dstate)
    (print-mem-access value nil stream dstate)))

;; Same as print-xmmreg/mem, but prints an explicit size indicator for
;; memory references.
(defun print-sized-xmmreg/mem (value stream dstate)
  (declare (type (or list xmmreg) value)
           (type stream stream)
           (type sb!disassem:disassem-state dstate))
  (if (typep value 'xmmreg)
      (print-xmmreg value stream dstate)
    (print-mem-access value (inst-operand-size dstate) stream dstate)))

;;; This prefilter is used solely for its side effects, namely to put
;;; the bits found in the REX prefix into the DSTATE for use by other
;;; prefilters and by printers.
(defun prefilter-wrxb (value dstate)
  (declare (type (unsigned-byte 4) value)
           (type sb!disassem:disassem-state dstate))
  (sb!disassem:dstate-put-inst-prop dstate 'rex)
  (when (plusp (logand value #b1000))
    (sb!disassem:dstate-put-inst-prop dstate 'rex-w))
  (when (plusp (logand value #b0100))
    (sb!disassem:dstate-put-inst-prop dstate 'rex-r))
  (when (plusp (logand value #b0010))
    (sb!disassem:dstate-put-inst-prop dstate 'rex-x))
  (when (plusp (logand value #b0001))
    (sb!disassem:dstate-put-inst-prop dstate 'rex-b))
  value)

;;; This prefilter is used solely for its side effect, namely to put
;;; the property OPERAND-SIZE-8 into the DSTATE if VALUE is 0.
(defun prefilter-width (value dstate)
  (declare (type bit value)
           (type sb!disassem:disassem-state dstate))
  (when (zerop value)
    (sb!disassem:dstate-put-inst-prop dstate 'operand-size-8))
  value)

;;; This prefilter is used solely for its side effect, namely to put
;;; the property OPERAND-SIZE-16 into the DSTATE.
(defun prefilter-x66 (value dstate)
  (declare (type (eql #x66) value)
           (ignore value)
           (type sb!disassem:disassem-state dstate))
  (sb!disassem:dstate-put-inst-prop dstate 'operand-size-16))

;;; A register field that can be extended by REX.R.
(defun prefilter-reg-r (value dstate)
  (declare (type reg value)
           (type sb!disassem:disassem-state dstate))
  (if (sb!disassem::dstate-get-inst-prop dstate 'rex-r)
      (+ value 8)
      value))

;;; A register field that can be extended by REX.B.
(defun prefilter-reg-b (value dstate)
  (declare (type reg value)
           (type sb!disassem:disassem-state dstate))
  (if (sb!disassem::dstate-get-inst-prop dstate 'rex-b)
      (+ value 8)
      value))

;;; 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
;;; obvious default value (e.g., 1 for the index-scale). VALUE is a list
;;; of the mod and r/m field of the ModRM byte of the instruction.
;;; Depending on VALUE a SIB byte and/or an offset may be read. The
;;; REX.B bit from DSTATE is used to extend the sole register or the
;;; BASE-REG to a full register, the REX.X bit does the same for the
;;; INDEX-REG.
(defun prefilter-reg/mem (value dstate)
  (declare (type list value)
           (type sb!disassem:disassem-state dstate))
  (let ((mod (first value))
        (r/m (second value)))
    (declare (type (unsigned-byte 2) mod)
             (type (unsigned-byte 3) r/m))
    (let ((full-reg (if (sb!disassem:dstate-get-inst-prop dstate 'rex-b)
                        (+ r/m 8)
                        r/m)))
      (declare (type full-reg full-reg))
      (cond ((= mod #b11)
             ;; registers
             full-reg)
            ((= r/m #b100)
             ;; sib byte
             (let ((sib (sb!disassem:read-suffix 8 dstate)))
               (declare (type (unsigned-byte 8) sib))
               (let ((base-reg (ldb (byte 3 0) sib))
                     (index-reg (ldb (byte 3 3) sib))
                     (index-scale (ldb (byte 2 6) sib)))
                 (declare (type (unsigned-byte 3) base-reg index-reg)
                          (type (unsigned-byte 2) index-scale))
                 (let* ((offset
                         (case mod
                               (#b00
                                (if (= base-reg #b101)
                                    (sb!disassem:read-signed-suffix 32 dstate)