diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-10-23 07:27:15 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-10-23 07:27:15 -0700 |
| commit | 84da351d88231cb480a25c816eff08d0669ac095 (patch) | |
| tree | bd49e5381c63613d3ca357343ba276da3e4b35ba /stdlib/optimize.tl | |
| parent | 153cb9fc22c4a7742948b4e066204fed6ef91bf7 (diff) | |
| download | txr-84da351d88231cb480a25c816eff08d0669ac095.tar.gz txr-84da351d88231cb480a25c816eff08d0669ac095.tar.bz2 txr-84da351d88231cb480a25c816eff08d0669ac095.zip | |
compiler: improvement in wasteful jmp elimination.
* stdlib/compiler.tl (compiler optimize): After the dataflow-driven
peephole optimization, call elim-dead-code again.
* stdlib/optimize.tl (basic-blocks check-bypass-empty): New method.
(basic-bocks elim-dead-code): After eliminating unreachable blocks
from the list, we use check-bypass-empty to squeeze out any
empty blocks: blocks that have no instructions in their list,
other than the leading label. This helps elim-next-jmp
to find more opportunities to eliminate a wasteful jump, because
sometimes these jumps straddle over empty blocks.
Furthermore, elim-next-jmp can generate more empty blocks itself;
so we check for this situation, delete the blocks and iterate.
Diffstat (limited to 'stdlib/optimize.tl')
| -rw-r--r-- | stdlib/optimize.tl | 33 |
1 files changed, 29 insertions, 4 deletions
diff --git a/stdlib/optimize.tl b/stdlib/optimize.tl index bf5dfdaa..a947c715 100644 --- a/stdlib/optimize.tl +++ b/stdlib/optimize.tl @@ -486,6 +486,16 @@ (each ((bl bb.list)) (set bl.insns bb.(thread-jumps-block bl.insns)))) +(defmeth basic-blocks check-bypass-empty (bb bl nx) + (unless (cdr bl.insns) + (each ((pb bl.rlinks)) + (if (eq pb.next bl) + (set pb.next nx)) + (upd pb.links (subst bl nx)) + (upd pb.insns (mapcar [iffi consp (op subst bl.label nx.label)])) + (push pb nx.rlinks)) + bl)) + (defmeth basic-blocks elim-next-jump (bb bl nx) (let* ((tail (last bl.insns)) (linsn (car tail))) @@ -523,10 +533,25 @@ (for ((bl bb.root)) (bl) ((set bl bl.next)) (visit bl)) (visit bb.root)) - (set bb.list [keep-if visited bb.list]) - (each ((bl bb.list) - (nx (cdr bb.list))) - bb.(elim-next-jump bl nx))) + (upd bb.list (keep-if visited)) + (let (flg) + (each ((bl bb.list) + (nx (cdr bb.list))) + (when bb.(check-bypass-empty bl nx) + (set flg t) + (del [visited bl]))) + (if flg + (upd bb.list (keep-if visited)))) + (while + (let (rep) + (each ((bl bb.list) + (nx (cdr bb.list))) + bb.(elim-next-jump bl nx) + (when bb.(check-bypass-empty bl nx) + (set rep t) + (del [visited bl]))) + (if rep + (upd bb.list (keep-if visited)))))) bb.(join-blocks)) (defmeth basic-blocks merge-jump-thunks (bb) |