summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-02-07 12:55:48 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-02-07 12:55:48 -0800
commitf0ac10cf207f5a9b62b19a2bca186bc56a565d65 (patch)
treebe55dc4c033adc851b8683d1b464bbd0125f5af3
parent55273419408ffc106718a342496bba63d6d517a9 (diff)
downloadtxr-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.tl37
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)