asm/peephole.lisp

   1 (in-package :as3-asm)
   2
   3 ;;;; simple peephole optimizer for as3 asm, to handle some obvious cases
   4 ;;;; of redundant code in the compiler
   5 ;;;; ex. (peephole '((:pushnull) (:pop))) -> ()
   6
   7
   8 ;;; hash of symbol -> list of lambdas to call to try to optimize forms
   9 ;;; starting with that symbol
  10 (defparameter *peephole-patterns* (make-hash-table))
  11
  12 (defun %peephole (forms)
  13   (let* ((sym (caar forms))
  14          (funs (gethash sym *peephole-patterns*)))
  15     (loop for i in funs
  16        for j = (funcall i forms)
  17        unless (eql j :keep)
  18        do (return-from %peephole j))
  19     :keep))
  20
  21
  22 (defun peephole (forms)
  23   "as3 asm peephole optimizer, pass in list of asm forms, returns
  24 optimized version"
  25   ;; quick hack peephole optimizer, for simple stuff like pushnull+pop, etc
  26   ;;  get/setlocal 1
  27   (loop for i = forms then (if (not (eql j :keep)) j (cdr i))
  28      for j = (%peephole i)
  29      while i
  30      ;;do (format t "i=~s~%  j=~s~%" i j)
  31      when (eql j :keep)
  32      collect (car i)))
  33
  34
  35
  36 (defmacro def-peephole (name length args &body body)
  37   ;; name is symbol or list of symbols to match against car of form
  38   ;; length = minimum # of forms required for a given pattern
  39   ;;   fixme: detect pattern length automatically
  40   ;; args = destructuring lambda list passed the current remaining
  41   ;;   forms to be assembled, with the addition of nil to mark
  42   ;;   entries to be ignored when destructuring
  43   ;;   ex: (nil &rest rest) would get the forms after the current one
  44   ;;       ((nil arg) &rest rest) would get the same, + arg to the current form
  45   ;; body = code to run to test/perform peephole pass, returns either new
  46   ;;   list of forms, or :keep to keep current form
  47   ;;   (can't return nil, since then we wouldn't be able to get rid of
  48   ;;    the last form(s) in a set)
  49   (unless (consp name) (setf name  (list name)))
  50   (let ((forms (gensym "FORMS-"))
  51         (arg-syms nil))
  52     (labels
  53       ((gensym-nils (list)
  54          (when list
  55            (cons (cond
  56                    ((null (car list))
  57                     (car (push (gensym "IGNORE-") arg-syms)))
  58                    ((consp (car list)) (gensym-nils (car list)))
  59                    (t (car list)))
  60                  (gensym-nils (cdr list))))))
  61       `(progn
  62          ,@(loop
  63               with iargs = (gensym-nils args)
  64               with lambda = `(lambda (,forms)
  65                                (when (>= (length ,forms) ,length)
  66                                  (destructuring-bind (,@iargs) ,forms
  67                                    ,@(when arg-syms
  68                                            `((declare (ignore ,@arg-syms))))
  69                                    ,@body)))
  70               for i in name
  71               collect `(push ,lambda (gethash ',i *peephole-patterns* nil)))))))
  72
  73 ;; TODO:
  74 ;;   (kill x)+ (returnvalue) -> (returnvalue)
  75 ;;      -- (can't do directly, since then it would only get the last kill
  76 ;;          need to check rest for more kills and then a returnvalue)
  77 ;;
  78
  79
  80 ;;; push-*/get-*+ pop -> ()
  81 (def-peephole (:push-null :push-undefined :push-byte :push-short :push-true
  82                           :push-false :push-nan :push-string :push-int
  83                           :push-uint :push-double :push-namespace
  84                           :get-local-0 :get-local-1 :get-local-2 :get-local-3
  85                           :get-local) 2 (nil next &rest rest)
  86   (if (eql :pop (car next))
  87       (progn #+(or)(format t "drop ~s -> ~s~%" next rest)
  88              rest)
  89       :keep))
  90
  91 ;;; get-local N (N<4) -> get-local-n
  92 (def-peephole :get-local 1 ((nil local) &rest rest)
  93   (if (< local 4)
  94       (cons (elt '((:get-local-0) (:get-local-1)
  95                    (:get-local-2) (:get-local-3)) local)
  96           rest)
  97     :keep))
  98
  99 ;;; set-local N (N<4) -> set-local-n
 100 (def-peephole :set-local 1 ((nil local) &rest rest)
 101   (if (< local 4)
 102       (cons (elt '((:set-local-0) (:set-local-1)
 103                    (:set-local-2) (:set-local-3)) local)
 104           rest)
 105     :keep))
 106
 107 ;;; dup setlocal pop -> setlocal
 108 (def-peephole :dup 3 (nil next pop &rest rest)
 109   (if (and (eql (car pop) :pop)
 110            (member (car next) '(:set-local-0 :set-local-1 :set-local-2
 111                                 :set-local-3 :set-local)))
 112       (cons next rest)
 113       :keep))
 114
 115
 116 ;;; less-than/greater-than/equals + if-true/if-false -> if-lt/etc
 117 ;;; fixme: generalize/combine these
 118 (def-peephole :less-than 2 (nil next &rest rest)
 119   (cond
 120     ((eql :if-true (car next))
 121      (cons `(:if-lt ,@(cdr next)) rest))
 122     ((eql :if-false (car next))
 123      (cons `(:if-nlt ,@(cdr next)) rest))
 124     (t :keep)))
 125
 126 (def-peephole :greater-than 2 (nil next &rest rest)
 127   (cond
 128     ((eql :if-true (car next))
 129      (cons `(:if-gt ,@(cdr next)) rest))
 130     ((eql :if-false (car next))
 131      (cons `(:if-ngt ,@(cdr next)) rest))
 132     (t :keep)))
 133
 134 (def-peephole :equals 2 (nil next &rest rest)
 135   (cond
 136     ((eql :if-true (car next))
 137      (cons `(:if-eq ,@(cdr next)) rest))
 138     ((eql :if-false (car next))
 139      (cons `(:if-ne ,@(cdr next)) rest))
 140     (t :keep)))
 141
 142 ;; hack to allow comments in generated asm
 143 (def-peephole :comment 1 (nil &rest rest)
 144   rest)
 145
 146 ;; fixme: move interning into the assembler so we can peephole push-int
 147 ;; into push-byte or push-short if applicable
 148
 149 #+ (or)
 150 (format t "~s~%"
 151         (peephole `((get-local 1) (pop) ;; -> nil
 152                     (set-local 1) ;; -> (set-local-1)
 153                     (set-local 5)
 154                     (equals) (if-false) ;; -> (if-ne)
 155                     (less-than) (if-true) ;; -> (if-lt)
 156                     (push-null) (pop))))  ;; -> nil