insts.lisp

开源跨平台Lisp编译器

                 (:delay 1)
                 (:cost 1)
                 (:dependencies (reads :ccr) (writes :ccr))
                 (:emitter (emit-x-form-inst segment 19
                            (valid-bi-encoding dbit)
                            (valid-bi-encoding abit)
                            (valid-bi-encoding bbit)
                            ,xo
                            0)))))

   ;;; The instructions, in numerical order

  (define-instruction unimp (segment data)
    (:declare (type (signed-byte 16) data))
    (:printer xinstr ((op-to-a #.(logior (ash 3 10) (ash 6 5) 0)))
              :default :control #'unimp-control)
    :pinned
    (:delay 0)
    (:emitter (emit-d-form-inst segment 3 6 0 data)))

  (define-instruction twi (segment tcond ra si)
    (:printer d-to ((op 3)))
    (:delay 0)
    :pinned
    (:emitter (emit-d-form-inst segment 3 (valid-tcond-encoding tcond) (reg-tn-encoding ra) si)))

  (define-d-si-instruction mulli 7 :cost 5)
  (define-d-si-instruction subfic 8)

  (define-instruction cmplwi (segment crf ra &optional (ui nil ui-p))
    (:printer d-crf-ui ((op 10) (l 0)) '(:name :tab bf "," ra "," ui))
    (:dependencies (if ui-p (reads ra) (reads crf)) (writes :ccr))
    (:delay 1)
    (:emitter
     (unless ui-p
       (setq ui ra ra crf crf :cr0))
     (emit-d-form-inst segment
                       10
                       (valid-cr-field-encoding crf)
                       (reg-tn-encoding ra)
                       ui)))

  (define-instruction cmpwi (segment crf ra  &optional (si nil si-p))
    (:printer d-crf-si ((op 11) (l 0)) '(:name :tab bf "," ra "," si))
    (:dependencies (if si-p (reads ra) (reads crf)) (writes :ccr))
    (:delay 1)
    (:emitter
     (unless si-p
       (setq si ra ra crf crf :cr0))
     (emit-d-form-inst segment
                       11
                       (valid-cr-field-encoding crf)
                       (reg-tn-encoding ra)
                       si)))

  (define-d-si-instruction addic 12 :other-dependencies ((writes :xer)))
  (define-d-si-instruction addic. 13 :other-dependencies ((writes :xer) (writes :ccr)))

  (define-d-si-instruction addi 14 :fixup :l)
  (define-d-si-instruction addis 15 :fixup :ha)

  ;; There's no real support here for branch options that decrement
  ;; and test the CTR :
  ;; (a) the instruction scheduler doesn't know that anything's happening
  ;;    to the CTR
  ;; (b) Lisp may have to assume that the CTR always has a lisp
  ;;    object/locative in it.

  (define-instruction bc (segment bo bi target)
    (:declare (type label target))
    (:printer b ((op 16) (aa 0) (lk 0)))
    (:attributes branch)
    (:delay 0)
    (:dependencies (reads :ccr))
    (:emitter
     (emit-conditional-branch segment bo bi target)))

  (define-instruction bcl (segment bo bi target)
    (:declare (type label target))
    (:printer b ((op 16) (aa 0) (lk 1)))
    (:attributes branch)
    (:delay 0)
    (:dependencies (reads :ccr))
    (:emitter
     (emit-conditional-branch segment bo bi target nil t)))

  (define-instruction bca (segment bo bi target)
    (:declare (type label target))
    (:printer b ((op 16) (aa 1) (lk 0)))
    (:attributes branch)
    (:delay 0)
    (:dependencies (reads :ccr))
    (:emitter
     (emit-conditional-branch segment bo bi target t)))

  (define-instruction bcla (segment bo bi target)
    (:declare (type label target))
    (:printer b ((op 16) (aa 1) (lk 1)))
    (:attributes branch)
    (:delay 0)
    (:dependencies (reads :ccr))
    (:emitter
     (emit-conditional-branch segment bo bi target t t)))

;;; There may (or may not) be a good reason to use this in preference
;;; to "b[la] target".  I can't think of a -bad- reason ...

  (define-instruction bu (segment target)
    (:declare (type label target))
    (:printer b ((op 16) (bo #.(valid-bo-encoding :bo-u)) (bi 0) (aa 0) (lk 0))
              '(:name :tab bd))
    (:attributes branch)
    (:delay 0)
    (:emitter
     (emit-conditional-branch segment #.(valid-bo-encoding :bo-u) 0 target nil nil)))


  (define-instruction bt (segment bi  target)
    (:printer b ((op 16) (bo #.(valid-bo-encoding :bo-t)) (aa 0) (lk 0))
              '(:name :tab bi "," bd))
    (:attributes branch)
    (:delay 0)
    (:emitter
     (emit-conditional-branch segment #.(valid-bo-encoding :bo-t) bi target nil nil)))

  (define-instruction bf (segment bi  target)
    (:printer b ((op 16) (bo #.(valid-bo-encoding :bo-f)) (aa 0) (lk 0))
              '(:name :tab bi "," bd))
    (:attributes branch)
    (:delay 0)
    (:emitter
     (emit-conditional-branch segment #.(valid-bo-encoding :bo-f) bi target nil nil)))

  (define-instruction b? (segment cr-field-name cr-name  &optional (target nil target-p))
    (:attributes branch)
    (:delay 0)
    (:emitter
     (unless target-p
       (setq target cr-name cr-name cr-field-name cr-field-name :cr0))
     (let*  ((+cond (position cr-name cr-bit-names))
             (-cond (position cr-name cr-bit-inverse-names))
             (b0 (if +cond :bo-t
                     (if -cond
                         :bo-f
                         (error "Unknown branch condition ~s" cr-name))))
             (cr-form (list cr-field-name (if +cond cr-name (svref cr-bit-names -cond)))))
       (emit-conditional-branch segment b0 cr-form target))))

  (define-instruction sc (segment)
    (:printer sc ((op 17)))
    (:attributes branch)
    (:delay 0)
    :pinned
    (:emitter (emit-sc-form-inst segment 17 2)))

  (define-instruction b (segment target)
    (:printer i ((op 18) (aa 0) (lk 0)))
    (:attributes branch)
    (:delay 0)
    (:emitter
     (emit-i-form-branch segment target nil)))

  (define-instruction ba (segment target)
    (:printer i-abs ((op 18) (aa 1) (lk 0)))
    (:attributes branch)
    (:delay 0)
    (:emitter
     (when (typep target 'fixup)
       (note-fixup segment :ba target)
       (setq target 0))
     (emit-i-form-inst segment 18 (ash target -2) 1 0)))


  (define-instruction bl (segment target)
    (:printer i ((op 18) (aa 0) (lk 1)))
    (:attributes branch)
    (:delay 0)
    (:emitter
     (emit-i-form-branch segment target t)))

  (define-instruction bla (segment target)
    (:printer i-abs ((op 18) (aa 1) (lk 1)))
    (:attributes branch)
    (:delay 0)
    (:emitter
     (when (typep target 'fixup)
       (note-fixup segment :ba target)
       (setq target 0))
     (emit-i-form-inst segment 18 (ash target -2) 1 1)))

  (define-instruction blr (segment)
    (:printer xl-bo-bi ((op 19) (xo 16) (bo #.(valid-bo-encoding :bo-u))(bi 0) (lk 0))  '(:name))
    (:attributes branch)
    (:delay 0)
    (:dependencies (reads :ccr) (reads :ctr))
    (:emitter
     (emit-x-form-inst segment 19 (valid-bo-encoding :bo-u) 0 0 16 0)))

  (define-instruction bclr (segment bo bi)
    (:printer xl-bo-bi ((op 19) (xo 16)))
    (:attributes branch)
    (:delay 0)
    (:dependencies (reads :ccr) (reads :lr))
    (:emitter
     (emit-x-form-inst segment 19 (valid-bo-encoding bo) (valid-bi-encoding bi) 0 16 0)))

  (define-instruction bclrl (segment bo bi)
    (:printer xl-bo-bi ((op 19) (xo 16) (lk 1)))
    (:attributes branch)
    (:delay 0)
    (:dependencies (reads :ccr) (reads :lr))
    (:emitter
     (emit-x-form-inst segment 19 (valid-bo-encoding bo)
                       (valid-bi-encoding bi) 0 16 1)))

  (define-crbit-instruction crnor 19 33)
  (define-crbit-instruction crandc 19 129)
  (define-instruction isync (segment)
    (:printer xl-xo ((op 19) (xo 150)))
    (:delay 1)
    :pinned
    (:emitter (emit-x-form-inst segment 19 0 0 0 150 0)))

  (define-crbit-instruction crxor 19 193)
  (define-crbit-instruction crnand 19 225)
  (define-crbit-instruction crand 19 257)
  (define-crbit-instruction creqv 19 289)
  (define-crbit-instruction crorc 19 417)
  (define-crbit-instruction cror 19 449)

  (define-instruction bcctr (segment bo bi)
    (:printer xl-bo-bi ((op 19) (xo 528)))
    (:attributes branch)
    (:delay 0)
    (:dependencies (reads :ccr) (reads :ctr))
    (:emitter
     (emit-x-form-inst segment 19 (valid-bo-encoding bo) (valid-bi-encoding bi) 0 528 0)))

  (define-instruction bcctrl (segment bo bi)
    (:printer xl-bo-bi ((op 19) (xo 528) (lk 1)))
    (:attributes branch)
    (:delay 0)
    (:dependencies (reads :ccr) (reads :ctr) (writes :lr))
    (:emitter
     (emit-x-form-inst segment 19 (valid-bo-encoding bo) (valid-bi-encoding bi) 0 528 1)))

  (define-instruction bctr (segment)
    (:printer xl-bo-bi ((op 19) (xo 528) (bo #.(valid-bo-encoding :bo-u)) (bi 0) (lk 0))  '(:name))
    (:attributes branch)
    (:delay 0)
    (:dependencies (reads :ccr) (reads :ctr))
    (:emitter
     (emit-x-form-inst segment 19 #.(valid-bo-encoding :bo-u) 0 0  528 0)))

  (define-instruction bctrl (segment)
    (:printer xl-bo-bi ((op 19) (xo 528) (bo #.(valid-bo-encoding :bo-u)) (bi 0) (lk 1))  '(:name))
    (:attributes branch)
    (:delay 0)
    (:dependencies (reads :ccr) (reads :ctr))
    (:emitter
     (emit-x-form-inst segment 19 #.(valid-bo-encoding :bo-u) 0 0  528 1)))

  (define-instruction rlwimi (segment ra rs sh mb me)
    (:printer m-sh ((op 20) (rc 0)))
    (:dependencies (reads rs) (writes ra))
    (:delay 1)
    (:emitter
     (emit-a-form-inst segment 20 (reg-tn-encoding rs) (reg-tn-encoding ra) sh mb me 0)))

  (define-instruction rlwimi. (segment ra rs sh mb me)
    (:printer m-sh ((op 20) (rc 1)))
    (:dependencies (reads rs) (writes ra) (writes :ccr))
    (:delay 1)
    (:emitter
     (emit-a-form-inst segment 20 (reg-tn-encoding rs) (reg-tn-encoding ra) sh mb me 1)))

  (define-instruction rlwinm (segment ra rs sh mb me)
    (:printer m-sh ((op 21) (rc 0)))
    (:delay 1)
    (:dependencies (reads rs) (writes ra))
    (:emitter
     (emit-a-form-inst segment 21 (reg-tn-encoding rs) (reg-tn-encoding ra) sh mb me 0)))

  (define-instruction rlwinm. (segment ra rs sh mb me)
    (:printer m-sh ((op 21) (rc 1)))
    (:delay 1)
    (:dependencies (reads rs) (writes ra) (writes :ccr))
    (:emitter
     (emit-a-form-inst segment 21 (reg-tn-encoding rs) (reg-tn-encoding ra) sh mb me 1)))

  (define-instruction rlwnm (segment ra rs rb mb me)
    (:printer m ((op 23) (rc 0) (rb nil :type 'reg)))
    (:delay 1)
    (:dependencies (reads rs) (writes ra) (reads rb))
    (:emitter
     (emit-a-form-inst segment 23 (reg-tn-encoding rs) (reg-tn-encoding ra) (reg-tn-encoding rb) mb me 0)))

  (define-instruction rlwnm. (segment ra rs rb mb me)
    (:printer m ((op 23) (rc 1) (rb nil :type 'reg)))
    (:delay 1)
    (:dependencies (reads rs) (reads rb) (writes ra) (writes :ccr))
    (:emitter
     (emit-a-form-inst segment 23 (reg-tn-encoding rs) (reg-tn-encoding ra) (reg-tn-encoding rb) mb me 1)))


  (define-d-rs-ui-instruction ori 24)

  (define-instruction nop (segment)
    (:printer d-rs-ui ((op 24) (rs 0) (ra 0) (ui 0)) '(:name))
    (:cost 1)
    (:delay 1)
    (:emitter
     (emit-d-form-inst segment 24 0 0 0)))

  (define-d-rs-ui-instruction oris 25)
  (define-d-rs-ui-instruction xori 26)
  (define-d-rs-ui-instruction xoris 27)
  (define-d-rs-ui-instruction andi. 28 :other-dependencies ((writes :ccr)))
  (define-d-rs-ui-instruction andis. 29 :other-dependencies ((writes :ccr)))

  (define-instruction cmpw (segment crf ra  &optional (rb nil rb-p))
    (:printer x-14 ((op 31) (xo 0) (l 0)) '(:name :tab bf "," ra "," rb))
    (:delay 1)
    (:dependencies (reads ra) (if rb-p (reads rb) (reads crf)) (reads :xer) (writes :ccr))
    (:emitter
     (unless rb-p
       (setq rb ra ra crf crf :cr0))
     (emit-x-form-inst segment
                       31
                       (valid-cr-field-encoding crf)
                       (reg-tn-encoding ra)
                       (reg-tn-encoding rb)
                       0
                       0)))

  (define-instruction tw (segment tcond ra rb)