diff options
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 1 | ||||
| -rw-r--r-- | share/txr/stdlib/optimize.tl | 25 |
2 files changed, 26 insertions, 0 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 0c90d5ce..d6ca1f45 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -1508,6 +1508,7 @@ bb.(elim-dead-code) bb.(calc-liveness) bb.(peephole) + bb.(merge-jump-thunks) bb.(get-insns))) (defun true-const-p (arg) diff --git a/share/txr/stdlib/optimize.tl b/share/txr/stdlib/optimize.tl index e94c98a1..af684aea 100644 --- a/share/txr/stdlib/optimize.tl +++ b/share/txr/stdlib/optimize.tl @@ -467,6 +467,31 @@ bb.(elim-next-jump bl))) bb.(join-blocks)) +(defmeth basic-blocks merge-jump-thunks (bb) + (let* ((candidates (mappend (load-time + [andf [chain .links len (op eql 1)] + [chain .insns len (lop < 4)] + [chain .insns last car + [iff consp + [chain car (op eq 'jmp)]]] + list]) + bb.list)) + (hash (group-by (load-time [chain .insns cdr]) candidates))) + (dohash (insns bls hash) + (when (cdr bls) + (whenlet ((keep (or (keep-if (op some @1.rlinks (op eq @@1) .next) bls) + (list (car bls)))) + (leader (car keep))) + (whenlet ((dupes (diff bls keep))) + (each ((bl dupes)) + (each ((pbl bl.rlinks)) + (let* ((code pbl.insns) + (tail (last code)) + (lins (car tail)) + (sins (subst bl.label leader.label lins))) + (set pbl.insns (append (ldiff code tail) (list sins)))))) + (set bb.list (remove-if (lop memq dupes) bb.list)))))))) + (defun rewrite (fun list) (build (while* list |