diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-01-29 19:51:00 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-01-29 19:51:00 -0800 |
commit | ab20526520a5458a40bdbf7b77af4cd5ef62c096 (patch) | |
tree | 8b5696b93a483c0a77b30766f01fda64e8cf4d96 /share | |
parent | 1b33bf2abdf88071ff38c3f2c25ba57433257a2a (diff) | |
download | txr-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.tl | 2 | ||||
-rw-r--r-- | share/txr/stdlib/optimize.tl | 14 |
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) |