insts.lisp

开源跨平台Lisp编译器

(sb!disassem:define-instruction-format
    (format-2-immed 32 :default-printer '(:name :tab immed ", " rd))
  (op    :field (byte 2 30) :value 0)
  (rd    :field (byte 5 25) :type 'reg)
  (op2   :field (byte 3 22))
  (immed :field (byte 22 0)))



(sb!disassem:define-instruction-format
    (format-2-branch 32 :default-printer `(:name (:unless (:constant ,branch-cond-true) cond)
                                           (:unless (a :constant 0) "," 'A)
                                           :tab
                                           disp))
  (op   :field (byte 2 30) :value 0)
  (a    :field (byte 1 29) :value 0)
  (cond :field (byte 4 25) :type 'branch-condition)
  (op2  :field (byte 3 22))
  (disp :field (byte 22 0) :type 'relative-label))

;; Branch with prediction instruction for V9

;; Currently only %icc and %xcc are used of the four possible values

(defconstant-eqx integer-condition-registers
  '(:icc :reserved :xcc :reserved)
  #'equalp)

(defconstant-eqx integer-cond-reg-name-vec
  (coerce integer-condition-registers 'vector)
  #'equalp)

(deftype integer-condition-register ()
  `(member ,@(remove :reserved integer-condition-registers)))

(defparameter integer-condition-reg-symbols
  (map 'vector
       (lambda (name)
           (make-symbol (concatenate 'string "%" (string name))))
       integer-condition-registers))

(sb!disassem:define-arg-type integer-condition-register
    :printer (lambda (value stream dstate)
                 (declare (stream stream) (fixnum value) (ignore dstate))
                 (let ((regname (aref integer-condition-reg-symbols value)))
                   (princ regname stream))))

(defconstant-eqx branch-predictions
  '(:pn :pt)
  #'equalp)

(sb!disassem:define-arg-type branch-prediction
    :printer (coerce branch-predictions 'vector))

(defun integer-condition (condition-reg)
  (declare (type (member :icc :xcc) condition-reg))
  (or (position condition-reg integer-condition-registers)
      (error "Unknown integer condition register:  ~S~%"
             condition-reg)))

(defun branch-prediction (pred)
  (or (position pred branch-predictions)
      (error "Unknown branch prediction:  ~S~%Must be one of: ~S~%"
             pred branch-predictions)))

(defconstant-eqx branch-pred-printer
  `(:name (:unless (:constant ,branch-cond-true) cond)
          (:unless (a :constant 0) "," 'A)
          (:unless (p :constant 1) "," 'pn)
          :tab
          cc
          ", "
          disp)
  #'equalp)

(sb!disassem:define-instruction-format
    (format-2-branch-pred 32 :default-printer branch-pred-printer)
  (op   :field (byte 2 30) :value 0)
  (a    :field (byte 1 29) :value 0)
  (cond :field (byte 4 25) :type 'branch-condition)
  (op2  :field (byte 3 22))
  (cc   :field (byte 2 20) :type 'integer-condition-register)
  (p    :field (byte 1 19))
  (disp :field (byte 19 0) :type 'relative-label))

(defconstant-eqx fp-condition-registers
  '(:fcc0 :fcc1 :fcc2 :fcc3)
  #'equalp)

(defconstant-eqx fp-cond-reg-name-vec
  (coerce fp-condition-registers 'vector)
  #'equalp)

(defparameter fp-condition-reg-symbols
  (map 'vector
       (lambda (name)
           (make-symbol (concatenate 'string "%" (string name))))
       fp-condition-registers))

(sb!disassem:define-arg-type fp-condition-register
    :printer (lambda (value stream dstate)
                 (declare (stream stream) (fixnum value) (ignore dstate))
                 (let ((regname (aref fp-condition-reg-symbols value)))
                   (princ regname stream))))

(sb!disassem:define-arg-type fp-condition-register-shifted
    :printer (lambda (value stream dstate)
                 (declare (stream stream) (fixnum value) (ignore dstate))
                 (let ((regname (aref fp-condition-reg-symbols (ash value -1))))
                   (princ regname stream))))

(defun fp-condition (condition-reg)
  (or (position condition-reg fp-condition-registers)
      (error "Unknown integer condition register:  ~S~%"
             condition-reg)))

(defconstant-eqx fp-branch-pred-printer
  `(:name (:unless (:constant ,branch-cond-true) cond)
          (:unless (a :constant 0) "," 'A)
          (:unless (p :constant 1) "," 'pn)
          :tab
          fcc
          ", "
          disp)
  #'equalp)

(sb!disassem:define-instruction-format
    (format-2-fp-branch-pred 32 :default-printer fp-branch-pred-printer)
  (op   :field (byte 2 30) :value 0)
  (a    :field (byte 1 29) :value 0)
  (cond :field (byte 4 25) :type 'branch-fp-condition)
  (op2  :field (byte 3 22))
  (fcc  :field (byte 2 20) :type 'fp-condition-register)
  (p    :field (byte 1 19))
  (disp :field (byte 19 0) :type 'relative-label))



(sb!disassem:define-instruction-format
    (format-2-unimp 32 :default-printer '(:name :tab data))
  (op     :field (byte 2 30) :value 0)
  (ignore :field (byte 5 25) :value 0)
  (op2    :field (byte 3 22) :value 0)
  (data   :field (byte 22 0)))

(defconstant-eqx f3-printer
  '(:name :tab
          (:unless (:same-as rd) rs1 ", ")
          (:choose rs2 immed) ", "
          rd)
  #'equalp)

(sb!disassem:define-instruction-format
    (format-3-reg 32 :default-printer f3-printer)
  (op  :field (byte 2 30))
  (rd  :field (byte 5 25) :type 'reg)
  (op3 :field (byte 6 19))
  (rs1 :field (byte 5 14) :type 'reg)
  (i   :field (byte 1 13) :value 0)
  (asi :field (byte 8 5)  :value 0)
  (rs2 :field (byte 5 0)  :type 'reg))

(sb!disassem:define-instruction-format
    (format-3-immed 32 :default-printer f3-printer)
  (op    :field (byte 2 30))
  (rd    :field (byte 5 25) :type 'reg)
  (op3   :field (byte 6 19))
  (rs1   :field (byte 5 14) :type 'reg)
  (i     :field (byte 1 13) :value 1)
  (immed :field (byte 13 0) :sign-extend t))    ; usually sign extended

(sb!disassem:define-instruction-format
    (format-binary-fpop 32
     :default-printer '(:name :tab rs1 ", " rs2 ", " rd))
  (op   :field (byte 2 30))
  (rd   :field (byte 5 25) :type 'fp-reg)
  (op3  :field (byte 6 19))
  (rs1  :field (byte 5 14) :type 'fp-reg)
  (opf  :field (byte 9 5))
  (rs2  :field (byte 5 0) :type 'fp-reg))

;;; Floating point load/save instructions encoding.
(sb!disassem:define-instruction-format
    (format-unary-fpop 32 :default-printer '(:name :tab rs2 ", " rd))
  (op   :field (byte 2 30))
  (rd   :field (byte 5 25) :type 'fp-reg)
  (op3  :field (byte 6 19))
  (rs1  :field (byte 5 14) :value 0)
  (opf  :field (byte 9 5))
  (rs2  :field (byte 5 0) :type 'fp-reg))

;;; Floating point comparison instructions encoding.

;; This is a merge of the instructions for FP comparison and FP
;; conditional moves available in the Sparc V9.  The main problem is
;; that the new instructions use part of the opcode space used by the
;; comparison instructions.  In particular, the OPF field is arranged
;; as so:
;;
;; Bit          1       0
;;              3       5
;; FMOVcc       0nn0000xx       %fccn
;;              1000000xx       %icc
;;              1100000xx       %xcc
;; FMOVR        0ccc001yy
;; FCMP         001010zzz
;;
;; So we see that if we break up the OPF field into 4 pieces, opf0,
;; opf1, opf2, and opf3, we can distinguish between these
;; instructions. So bit 9 (opf2) can be used to distinguish between
;; FCMP and the rest.  Also note that the nn field overlaps with the
;; ccc.  We need to take this into account as well.
;;
(sb!disassem:define-instruction-format
    (format-fpop2 32
                  :default-printer #!-sparc-v9 '(:name :tab rs1 ", " rs2)
                                   #!+sparc-v9 '(:name :tab rd ", " rs1 ", " rs2))
  (op   :field (byte 2 30))
  (rd   :field (byte 5 25) :value 0)
  (op3  :field (byte 6 19))
  (rs1  :field (byte 5 14))
  (opf0 :field (byte 1 13))
  (opf1 :field (byte 3 10))
  (opf2 :field (byte 1 9))
  (opf3 :field (byte 4 5))
  (rs2  :field (byte 5 0) :type 'fp-reg))

;;; Shift instructions
(sb!disassem:define-instruction-format
    (format-3-shift-reg 32 :default-printer f3-printer)
  (op   :field (byte 2 30))
  (rd    :field (byte 5 25) :type 'reg)
  (op3  :field (byte 6 19))
  (rs1   :field (byte 5 14) :type 'reg)
  (i     :field (byte 1 13) :value 0)
  (x     :field (byte 1 12))
  (asi   :field (byte 7 5) :value 0)
  (rs2   :field (byte 5 0) :type 'reg))

(sb!disassem:define-instruction-format
    (format-3-shift-immed 32 :default-printer f3-printer)
  (op   :field (byte 2 30))
  (rd    :field (byte 5 25) :type 'reg)
  (op3  :field (byte 6 19))
  (rs1   :field (byte 5 14) :type 'reg)
  (i     :field (byte 1 13) :value 1)
  (x     :field (byte 1 12))
  (immed :field (byte 12 0) :sign-extend nil))


;;; Conditional moves (only available for Sparc V9 architectures)

;; The names of all of the condition registers on the V9: 4 FP
;; conditions, the original integer condition register and the new
;; extended register.  The :reserved register is reserved on the V9.

(defconstant-eqx cond-move-condition-registers
  '(:fcc0 :fcc1 :fcc2 :fcc3 :icc :reserved :xcc :reserved)
  #'equalp)

(defconstant-eqx cond-move-cond-reg-name-vec
  (coerce cond-move-condition-registers 'vector)
  #'equalp)

(deftype cond-move-condition-register ()
    `(member ,@(remove :reserved cond-move-condition-registers)))

(defparameter cond-move-condition-reg-symbols
  (map 'vector
       (lambda (name)
           (make-symbol (concatenate 'string "%" (string name))))
       cond-move-condition-registers))

(sb!disassem:define-arg-type cond-move-condition-register
    :printer (lambda (value stream dstate)
                 (declare (stream stream) (fixnum value) (ignore dstate))
                 (let ((regname (aref cond-move-condition-reg-symbols value)))
                   (princ regname stream))))

;; From the given condition register, figure out what the cc2, cc1,
;; and cc0 bits should be.  Return cc2 and cc1/cc0 concatenated.
(defun cond-move-condition-parts (condition-reg)
  (let ((posn (position condition-reg cond-move-condition-registers)))
    (if posn
        (truncate posn 4)
        (error "Unknown conditional move condition register:  ~S~%"
               condition-reg))))

(defun cond-move-condition (condition-reg)
  (or (position condition-reg cond-move-condition-registers)
      (error "Unknown conditional move condition register:  ~S~%"
             condition-reg)))

(defconstant-eqx cond-move-printer
  `(:name cond :tab
          cc ", " (:choose immed rs2) ", " rd)
  #'equalp)

;; Conditional move integer register on integer or FP condition code
(sb!disassem:define-instruction-format
    (format-4-cond-move 32 :default-printer cond-move-printer)
  (op   :field (byte 2 30))
  (rd    :field (byte 5 25) :type 'reg)
  (op3  :field (byte 6 19))
  (cc2   :field (byte 1 18) :value 1)
  (cond  :field (byte 4 14) :type 'branch-condition)
  (i     :field (byte 1 13) :value 0)
  (cc    :field (byte 2 11) :type 'integer-condition-register)
  (empty :field (byte 6 5) :value 0)
  (rs2   :field (byte 5 0) :type 'reg))

(sb!disassem:define-instruction-format
    (format-4-cond-move-immed 32 :default-printer cond-move-printer)
  (op    :field (byte 2 30))
  (rd    :field (byte 5 25) :type 'reg)
  (op3   :field (byte 6 19))
  (cc2   :field (byte 1 18) :value 1)
  (cond  :field (byte 4 14) :type 'branch-condition)
  (i     :field (byte 1 13) :value 1)
  (cc    :field (byte 2 11) :type 'integer-condition-register)
  (immed :field (byte 11 0) :sign-extend t))

;; Floating-point versions of the above integer conditional moves
(defconstant-eqx cond-fp-move-printer
  `(:name rs1 :tab opf1 ", " rs2 ", " rd)
  #'equalp)

;;; Conditional move on integer register condition (only on Sparc
;;; V9). That is, move an integer register if some other integer
;;; register satisfies some condition.

(defconstant-eqx cond-move-integer-conditions
  '(:reserved :z :lez :lz :reserved :nz :gz :gez)
  #'equalp)

(defconstant-eqx cond-move-integer-condition-vec
  (coerce cond-move-integer-conditions 'vector)
  #'equalp)

(deftype cond-move-integer-condition ()
  `(member ,@(remove :reserved cond-move-integer-conditions)))

(sb!disassem:define-arg-type register-condition
    :printer (lambda (value stream dstate)