diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-07 12:55:48 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-07 12:55:48 -0800 |
commit | f0ac10cf207f5a9b62b19a2bca186bc56a565d65 (patch) | |
tree | be55dc4c033adc851b8683d1b464bbd0125f5af3 | |
parent | 55273419408ffc106718a342496bba63d6d517a9 (diff) | |
download | txr-f0ac10cf207f5a9b62b19a2bca186bc56a565d65.tar.gz txr-f0ac10cf207f5a9b62b19a2bca186bc56a565d65.tar.bz2 txr-f0ac10cf207f5a9b62b19a2bca186bc56a565d65.zip |
compiler: frame reduction optimizations.
These optimizations have to do with moving a (frame x y)
instruction past the next instruction. The goal is to move the
frame past a conditional branch, under the right
circumstances, so that the frame is eliminated when the branch
is taken.
* share/txr/stdlib/optimize.tl (basic-blocks (cut-block,
next-block)): New methods.
(basic-block peephole): Add two patterns: one to move a frame
past a mov, call or gcall. Another more complicated one to
move it past an if which jumps to an end.
-rw-r--r-- | share/txr/stdlib/optimize.tl | 37 |
1 files changed, 36 insertions, 1 deletions
diff --git a/share/txr/stdlib/optimize.tl b/share/txr/stdlib/optimize.tl index 5a50f495..011b7bf0 100644 --- a/share/txr/stdlib/optimize.tl +++ b/share/txr/stdlib/optimize.tl @@ -39,7 +39,22 @@ (mapdo (do set [bb.hash (car @1)] @1) bb.list)) (:method get-insns (bb) - [mappend bb.hash bb.labels]))) + [mappend bb.hash bb.labels]) + + (:method cut-block (bb label at insns) + (let ((nlabel (gensym "nl")) + (ltail (cdr (member label bb.labels)))) + (set bb.labels (append (ldiff bb.labels ltail) + (list nlabel) + ltail)) + (set [bb.hash nlabel] (cons nlabel at)) + (set [bb.hash label] (ldiff insns at)) + nlabel)) + + (:method next-block (bb label) + (let ((ltail (member label bb.labels))) + (iflet ((next (cdr ltail))) + (car next)))))) (defmacro rewrite-case (sym list . cases) ^(rewrite (lambda (,sym) @@ -106,6 +121,26 @@ (cdr insns)) (((mov @reg0 @reg1) (mov reg1 @reg0) . @rest) ^(,(car insns) ,*rest)) + ;; frame reduction + (((frame @lev @size) + (@(or call gcall mov) + . @(require @(coll (v @vlev @nil)) + (none vlev (op eql (ppred lev))))) + . @rest) + ^(,(cadr insns) ,(car insns) ,*rest)) + (((frame . @nil) + (if (t @reg) @jlabel) . @rest) + (let ((jinsns [bb.hash jlabel])) + (match-case jinsns + ((@jlabel + (end (t @reg)) . @jrest) + (let ((xlabel (if jrest + bb.(cut-block jlabel jrest jinsns) + bb.(next-block jlabel)))) + (if xlabel + ^((if (t ,reg) ,xlabel) ,(car insns) ,*rest) + insns))) + (@jelse insns)))) (@else insns))))) (defun rewrite (fun list) |