diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2023-04-10 01:29:49 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2023-04-10 01:29:49 -0700 |
commit | 2959397edd309c9e64ddf509137619a618d12cf0 (patch) | |
tree | 16fc8bc5cd9d159c93422737154ab2286a0325ab /stdlib | |
parent | a6e3a7aabd3563120afdac87d1788e891a359ced (diff) | |
download | txr-2959397edd309c9e64ddf509137619a618d12cf0.tar.gz txr-2959397edd309c9e64ddf509137619a618d12cf0.tar.bz2 txr-2959397edd309c9e64ddf509137619a618d12cf0.zip |
compiler: improve t-reg copy elimination.
* optimize.tl (rename): Instead of a mapping operation,
we perform the substitution only until we hit an
instruction that defines either the src or dst register.
(basic-blocks do-peephole-block): Drop the conditions
for doing the rename: that neither register can be
defined somewhere in the rest of the block. This
restriction is too limiting. We have to be careful now;
we cannot delete the first instruction, and must only
set the recalc flag and add to the rescan list if the
substitution did something, to avoid looping.
Diffstat (limited to 'stdlib')
-rw-r--r-- | stdlib/optimize.tl | 25 |
1 files changed, 18 insertions, 7 deletions
diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl index 7b495617..d43cfbd1 100644 --- a/stdlib/optimize.tl +++ b/stdlib/optimize.tl @@ -355,7 +355,15 @@ (t (set [bb.li-hash sub] li) sub)))) (defmeth basic-blocks rename (bb insns dst src) - (mapcar (op subst-preserve dst src bb [bb.li-hash @1] @1) insns)) + (build + (whilet ((insn (pop insns))) + (let ((li [bb.li-hash insn])) + (cond + ((mequal li.def dst src) + (add insn) + (pend insns) + (set insns nil)) + (t (add (subst-preserve dst src bb li insn)))))))) (defmeth basic-blocks peephole-block (bb bl) (let ((code bb.(do-peephole-block bl bl.insns))) @@ -390,12 +398,15 @@ ;; unnecessary copying t-reg (@(require ((mov @(as dst (t @n)) @src) . @rest) (only-locally-used-treg (car insns) n) - (neq (car src) 'v) - (not (find dst rest : [chain bb.li-hash .def])) - (not (find src rest : [chain bb.li-hash .def]))) - (pushnew bl bb.rescan) - (set bb.recalc t) - bb.(rename rest dst src)) + (nequal dst src) + (neq (car src) 'v)) + (let ((ren bb.(rename rest dst src))) + (cond + ((nequal rest ren) + (pushnew bl bb.rescan) + (set bb.recalc t) + (cons (car insns) ren)) + (t insns)))) ;; wasteful moves (((mov @reg0 @nil) (mov @reg0 @nil) . @nil) (cdr insns)) |