summaryrefslogtreecommitdiffstats
path: root/share
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-01-29 19:51:00 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-01-29 19:51:00 -0800
commitab20526520a5458a40bdbf7b77af4cd5ef62c096 (patch)
tree8b5696b93a483c0a77b30766f01fda64e8cf4d96 /share
parent1b33bf2abdf88071ff38c3f2c25ba57433257a2a (diff)
downloadtxr-ab20526520a5458a40bdbf7b77af4cd5ef62c096.tar.gz
txr-ab20526520a5458a40bdbf7b77af4cd5ef62c096.tar.bz2
txr-ab20526520a5458a40bdbf7b77af4cd5ef62c096.zip
optimizer: add a few peephole reductions.
* share/txr/stdlib/compiler.tl (compiler optimize): Call peephole method on basic-blocks object, rather than thread-jumps. * share/txr/stdlib/optimize.tl (basic-blocks thread-jumps): Rename method to peephole, since it does more than just thread-jumps. Add some dead code elimination, and elimination of wasteful moves.
Diffstat (limited to 'share')
-rw-r--r--share/txr/stdlib/compiler.tl2
-rw-r--r--share/txr/stdlib/optimize.tl14
2 files changed, 14 insertions, 2 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index bf06548e..08dc2c13 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -1272,7 +1272,7 @@
(defmeth compiler optimize (me insns)
(let* ((bb (new (basic-blocks insns))))
- bb.(thread-jumps)
+ bb.(peephole)
bb.(get-insns)))
(defun maybe-mov (to-reg from-reg)
diff --git a/share/txr/stdlib/optimize.tl b/share/txr/stdlib/optimize.tl
index 4cc82876..7a6b9dbb 100644
--- a/share/txr/stdlib/optimize.tl
+++ b/share/txr/stdlib/optimize.tl
@@ -47,10 +47,17 @@
,*cases))
,list))
-(defmeth basic-blocks thread-jumps (bb)
+(defmeth basic-blocks peephole (bb)
(dohash (label code bb.hash)
(set [bb.hash label]
(rewrite-case insns code
+ ;; dead code
+ ((@(or (jmp @nil) (if (t 0) @nil)) @nil . @rest)
+ (list (car insns)))
+ ;; always taken if
+ (((if (d @reg) @jlabel) . @rest)
+ rest)
+ ;; jump threading
(((jmp @jlabel) . @rest)
(let ((jinsns [bb.hash jlabel]))
(match-case jinsns
@@ -87,6 +94,11 @@
(jmp @(require @jjlabel (neq jjlabel jlabel))) . @nil)
^((close ,reg ,nargs ,jjlabel ,*cargs) ,*rest))
(@jelse insns))))
+ ;; wasteful moves
+ (((mov @reg0 @nil) (mov @reg0 @nil) . @nil)
+ (cdr insns))
+ (((mov @reg0 @reg1) (mov reg1 @reg0) . @rest)
+ ^(,(car insns) ,*rest))
(@else insns)))))
(defun rewrite (fun list)