insts.lisp

开源跨平台Lisp编译器

               `(define-instruction ,name (segment rt ra rb)
                 (:printer xo-oe ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0))))
                 (:dependencies (reads ra) (reads rb) ,@(if always-reads-xer '((reads :xer)))
                  (writes rt) ,@(if rc-p '((writes :ccr))) ,@(if always-writes-xer '((writes :xer))))
                 (:cost ,cost)
                 (:delay ,cost)
                 (:emitter
                  (emit-xo-form-inst segment ,op
                   (reg-tn-encoding rt)
                   (reg-tn-encoding ra)
                   (reg-tn-encoding rb)
                   0
                   ,xo
                   (if ,rc-p 1 0)))))
           (define-4-xo-instructions
               (base op xo &key always-reads-xer always-writes-xer (cost 1))
               `(progn
                 (define-xo-instruction ,base ,op ,xo nil nil ,always-reads-xer ,always-writes-xer ,cost)
                 (define-xo-instruction ,(symbolicate base ".") ,op ,xo nil t ,always-reads-xer ,always-writes-xer ,cost)
                 (define-xo-instruction ,(symbolicate base "O") ,op ,xo t nil ,always-reads-xer ,always-writes-xer ,cost)
                 (define-xo-instruction ,(symbolicate base "O.") ,op ,xo t t ,always-reads-xer ,always-writes-xer ,cost)))

           (define-2-xo-oe-instructions (base op xo &key always-reads-xer always-writes-xer (cost 1))
               `(progn
                 (define-xo-oe-instruction ,base ,op ,xo nil ,always-reads-xer ,always-writes-xer ,cost)
                 (define-xo-oe-instruction ,(symbolicate base ".") ,op ,xo t ,always-reads-xer ,always-writes-xer ,cost)))

           (define-xo-a-instruction (name op xo oe-p rc-p always-reads-xer always-writes-xer cost)
               `(define-instruction ,name (segment rt ra)
                 (:printer xo-a ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0)) (oe ,(if oe-p 1 0))))
                 (:dependencies (reads ra) ,@(if always-reads-xer '((reads :xer)))
                  (writes rt) ,@(if rc-p '((writes :ccr))) ,@(if always-writes-xer '((writes :xer))) )
                 (:cost ,cost)
                 (:delay ,cost)
                 (:emitter
                  (emit-xo-form-inst segment ,op
                   (reg-tn-encoding rt)
                   (reg-tn-encoding ra)
                   0
                   (if ,oe-p 1 0)
                   ,xo
                   (if ,rc-p 1 0)))))

           (define-4-xo-a-instructions (base op xo &key always-reads-xer always-writes-xer (cost 1))
               `(progn
                 (define-xo-a-instruction ,base ,op ,xo nil nil ,always-reads-xer ,always-writes-xer ,cost)
                 (define-xo-a-instruction ,(symbolicate base ".") ,op ,xo nil t ,always-reads-xer ,always-writes-xer ,cost)
                 (define-xo-a-instruction ,(symbolicate base "O")  ,op ,xo t nil ,always-reads-xer ,always-writes-xer ,cost)
                 (define-xo-a-instruction ,(symbolicate base "O.") ,op ,xo t t ,always-reads-xer ,always-writes-xer ,cost)))

           (define-x-instruction (name op xo &key (cost 2) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment rt ra rb)
                   (:printer x ((op ,op) (xo ,xo)))
                   (:delay ,cost)
                   (:cost ,cost)
                   (:dependencies (reads ra) (reads rb) (reads :memory) ,@other-reads
                    (writes rt) ,@other-writes)
                   (:emitter
                    (emit-x-form-inst segment ,op
                     (reg-tn-encoding rt)
                     (reg-tn-encoding ra)
                     (reg-tn-encoding rb)
                     ,xo
                     0)))))

           (define-x-20-instruction (name op xo &key (cost 2) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment frt ra rb)
                   (:printer x-20 ((op ,op) (xo ,xo)))
                   (:delay ,cost)
                   (:cost ,cost)
                   (:dependencies (reads ra) (reads rb) ,@other-reads
                    (writes frt) ,@other-writes)
                   (:emitter
                    (emit-x-form-inst segment ,op
                     (fp-reg-tn-encoding frt)
                     (reg-tn-encoding ra)
                     (reg-tn-encoding rb)
                     ,xo
                     0)))))

           (define-x-5-instruction (name op xo rc-p &key (cost 1) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment ra rs rb)
                   (:printer x-5 ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0))))
                   (:delay ,cost)
                   (:cost ,cost)
                   (:dependencies (reads rb) (reads rs) ,@other-reads
                    (writes ra) ,@other-writes)
                   (:emitter
                    (emit-x-form-inst segment ,op
                     (reg-tn-encoding rs)
                     (reg-tn-encoding ra)
                     (reg-tn-encoding rb)
                     ,xo
                     ,(if rc-p 1 0))))))


           (define-x-5-st-instruction (name op xo rc-p &key (cost 1) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment rs ra rb)
                   (:printer x-5 ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0))))
                   (:delay ,cost)
                   (:cost ,cost)
                   (:dependencies (reads ra) (reads rb) (reads rs) ,@other-reads
                    (writes :memory :partially t) ,@other-writes)
                   (:emitter
                    (emit-x-form-inst segment ,op
                     (reg-tn-encoding rs)
                     (reg-tn-encoding ra)
                     (reg-tn-encoding rb)
                     ,xo
                     ,(if rc-p 1 0))))))

           (define-x-23-st-instruction (name op xo &key (cost 1) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment frs ra rb)
                   (:printer x-23 ((op ,op) (xo ,xo)))
                   (:delay ,cost)
                   (:cost ,cost)
                   (:dependencies (reads ra) (reads rb) (reads frs) ,@other-reads
                    (writes :memory :partially t) ,@other-writes)
                   (:emitter
                    (emit-x-form-inst segment ,op
                     (fp-reg-tn-encoding frs)
                     (reg-tn-encoding ra)
                     (reg-tn-encoding rb)
                     ,xo
                     0)))))

           (define-x-10-instruction (name op xo rc-p &key (cost 1) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment ra rs)
                   (:printer x-10 ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0))))
                   (:delay ,cost)
                   (:cost ,cost)
                   (:dependencies (reads rs) ,@other-reads
                    (writes ra) ,@other-writes)
                   (:emitter
                    (emit-x-form-inst segment ,op
                     (reg-tn-encoding rs)
                     (reg-tn-encoding ra)
                     0
                     ,xo
                     ,(if rc-p 1 0))))))

           (define-2-x-5-instructions (name op xo &key (cost 1) other-dependencies)
               `(progn
                 (define-x-5-instruction ,name ,op ,xo nil :cost ,cost :other-dependencies ,other-dependencies)
                 (define-x-5-instruction ,(symbolicate name ".") ,op ,xo t :cost ,cost
                                         :other-dependencies ,other-dependencies)))

           (define-2-x-10-instructions (name op xo &key (cost 1) other-dependencies)
               `(progn
                 (define-x-10-instruction ,name ,op ,xo nil :cost ,cost :other-dependencies ,other-dependencies)
                 (define-x-10-instruction ,(symbolicate name ".") ,op ,xo t :cost ,cost
                                          :other-dependencies ,other-dependencies)))


           (define-x-21-instruction (name op xo rc-p &key (cost 4) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment frt frb)
                   (:printer x-21 ((op ,op) (xo ,xo) (rc ,(if rc-p 1 0))))
                   (:cost ,cost)
                   (:delay ,cost)
                   (:dependencies (reads frb) ,@other-reads
                    (writes frt) ,@other-writes)
                   (:emitter
                    (emit-x-form-inst segment ,op
                     (fp-reg-tn-encoding frt)
                     0
                     (fp-reg-tn-encoding frb)
                     ,xo
                     ,(if rc-p 1 0))))))

           (define-2-x-21-instructions (name op xo &key (cost 4) other-dependencies)
               `(progn
                 (define-x-21-instruction ,name ,op ,xo nil :cost ,cost :other-dependencies ,other-dependencies)
                 (define-x-21-instruction ,(symbolicate name ".") ,op ,xo t :cost ,cost
                                          :other-dependencies ,other-dependencies)))


           (define-d-si-instruction (name op &key (fixup nil) (cost 1) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment rt ra si)
                   (:declare (type (or ,@(when fixup '(fixup))
                                       (unsigned-byte 16) (signed-byte 16))
                                   si))
                   (:printer d-si ((op ,op)))
                   (:delay ,cost)
                   (:cost ,cost)
                   (:dependencies (reads ra) ,@other-reads
                    (writes rt) ,@other-writes)
                   (:emitter
                    (when (typep si 'fixup)
                      (ecase ,fixup
                        ((:ha :l) (note-fixup segment ,fixup si)))
                      (setq si (or (fixup-offset si) 0)))
                    (emit-d-form-inst segment ,op (reg-tn-encoding rt) (reg-tn-encoding ra) si)))))

           (define-d-rs-ui-instruction (name op &key (cost 1) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment ra rs ui)
                   (:declare (type (unsigned-byte 16) ui))
                   (:printer d-rs-ui ((op ,op)))
                   (:cost ,cost)
                   (:delay ,cost)
                   (:dependencies (reads rs) ,@other-reads
                    (writes ra) ,@other-writes)
                   (:emitter
                    (emit-d-form-inst segment ,op (reg-tn-encoding rs) (reg-tn-encoding ra) ui)))))

           (define-d-instruction (name op &key (cost 2) other-dependencies pinned)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment rt ra si)
                   (:declare (type (signed-byte 16) si))
                   (:printer d ((op ,op)))
                   (:delay ,cost)
                   (:cost ,cost)
                   ,@(when pinned '(:pinned))
                   (:dependencies (reads ra) (reads :memory) ,@other-reads
                    (writes rt) ,@other-writes)
                   (:emitter
                    (emit-d-form-inst segment ,op (reg-tn-encoding rt) (reg-tn-encoding ra) si)))))

           (define-d-frt-instruction (name op &key (cost 3) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment frt ra si)
                   (:declare (type (signed-byte 16) si))
                   (:printer d-frt ((op ,op)))
                   (:delay ,cost)
                   (:cost ,cost)
                   (:dependencies (reads ra) (reads :memory) ,@other-reads
                    (writes frt) ,@other-writes)
                   (:emitter
                    (emit-d-form-inst segment ,op (fp-reg-tn-encoding frt) (reg-tn-encoding ra) si)))))

           (define-d-rs-instruction (name op &key (cost 1) other-dependencies pinned)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment rs ra si)
                   (:declare (type (signed-byte 16) si))
                   (:printer d-rs ((op ,op)))
                   (:delay ,cost)
                   (:cost ,cost)
                   ,@(when pinned '(:pinned))
                   (:dependencies (reads rs) (reads ra) ,@other-reads
                    (writes :memory :partially t) ,@other-writes)
                   (:emitter
                    (emit-d-form-inst segment ,op (reg-tn-encoding rs) (reg-tn-encoding ra) si)))))

           (define-d-frs-instruction (name op &key (cost 1) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment frs ra si)
                   (:declare (type (signed-byte 16) si))
                   (:printer d-frs ((op ,op)))
                   (:delay ,cost)
                   (:cost ,cost)
                   (:dependencies (reads frs) (reads ra) ,@other-reads
                    (writes :memory :partially t) ,@other-writes)
                   (:emitter
                    (emit-d-form-inst segment ,op (fp-reg-tn-encoding frs) (reg-tn-encoding ra) si)))))

           (define-a-instruction (name op xo rc &key (cost 1) other-dependencies)
               `(define-instruction ,name (segment frt fra frb frc)
                 (:printer a ((op ,op) (xo ,xo) (rc ,rc)))
                 (:cost ,cost)
                 (:delay ,cost)
                 (:dependencies (writes frt) (reads fra) (reads frb) (reads frc) ,@other-dependencies)
                 (:emitter
                  (emit-a-form-inst segment
                   ,op
                   (fp-reg-tn-encoding frt)
                   (fp-reg-tn-encoding fra)
                   (fp-reg-tn-encoding frb)
                   (fp-reg-tn-encoding frb)
                   ,xo
                   ,rc))))

           (define-2-a-instructions (name op xo &key (cost 1) other-dependencies)
               `(progn
                 (define-a-instruction ,name ,op ,xo 0 :cost ,cost :other-dependencies ,other-dependencies)
                 (define-a-instruction ,(symbolicate name ".")
                     ,op ,xo 1  :cost ,cost :other-dependencies ,other-dependencies)))

           (define-a-tab-instruction (name op xo rc &key (cost 1) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment frt fra frb)
                   (:printer a-tab ((op ,op) (xo ,xo) (rc ,rc)))
                   (:cost ,cost)
                   (:delay 1)
                   (:dependencies (reads fra) (reads frb) ,@other-reads
                    (writes frt) ,@other-writes)
                   (:emitter
                    (emit-a-form-inst segment
                     ,op
                     (fp-reg-tn-encoding frt)
                     (fp-reg-tn-encoding fra)
                     (fp-reg-tn-encoding frb)
                     0
                     ,xo
                     ,rc)))))

           (define-2-a-tab-instructions (name op xo &key (cost 1) other-dependencies)
               `(progn
                 (define-a-tab-instruction ,name ,op ,xo 0 :cost ,cost :other-dependencies ,other-dependencies)
                 (define-a-tab-instruction ,(symbolicate name ".")
                     ,op ,xo 1  :cost ,cost :other-dependencies ,other-dependencies)))

           (define-a-tac-instruction (name op xo rc &key (cost 1) other-dependencies)
               (multiple-value-bind (other-reads other-writes) (classify-dependencies other-dependencies)
                 `(define-instruction ,name (segment frt fra frb)
                   (:printer a-tac ((op ,op) (xo ,xo) (rc ,rc)))
                   (:cost ,cost)
                   (:delay 1)
                   (:dependencies (reads fra) (reads frb) ,@other-reads
                    (writes frt) ,@other-writes)
                   (:emitter
                    (emit-a-form-inst segment
                     ,op
                     (fp-reg-tn-encoding frt)
                     (fp-reg-tn-encoding fra)
                     0
                     (fp-reg-tn-encoding frb)
                     ,xo
                     ,rc)))))

           (define-2-a-tac-instructions (name op xo &key (cost 1) other-dependencies)
               `(progn
                 (define-a-tac-instruction ,name ,op ,xo 0 :cost ,cost :other-dependencies ,other-dependencies)
                 (define-a-tac-instruction ,(symbolicate name ".")
                     ,op ,xo 1  :cost ,cost :other-dependencies ,other-dependencies)))

           (define-crbit-instruction (name op xo)
               `(define-instruction ,name (segment dbit abit bbit)
                 (:printer xl ((op ,op ) (xo ,xo)))