From fd2f0a602d941f35cd9a9fef3219c5a82bea7329 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 19 Aug 2009 22:00:21 -0500 Subject: [PATCH] compiler.cfg.stacks.local: more accurate local replace set computation; optimizes out 'swap swap' --- basis/compiler/cfg/stacks/local/local.factor | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/basis/compiler/cfg/stacks/local/local.factor b/basis/compiler/cfg/stacks/local/local.factor index 4878dbe3ab..30a2c4c13f 100644 --- a/basis/compiler/cfg/stacks/local/local.factor +++ b/basis/compiler/cfg/stacks/local/local.factor @@ -69,18 +69,11 @@ M: rs-loc translate-local-loc n>> current-height get r>> - ; : peek-loc ( loc -- vreg ) translate-local-loc - dup local-replace-set get key? [ dup local-peek-set get conjoin ] unless - dup replace-mapping get at [ ] [ loc>vreg ] ?if ; + dup replace-mapping get at + [ ] [ dup local-peek-set get conjoin loc>vreg ] ?if ; : replace-loc ( vreg loc -- ) - translate-local-loc - 2dup loc>vreg = - [ nip replace-mapping get delete-at ] - [ - [ local-replace-set get conjoin ] - [ replace-mapping get set-at ] - bi - ] if ; + translate-local-loc replace-mapping get set-at ; : compute-local-kill-set ( -- assoc ) basic-block get current-height get @@ -90,13 +83,17 @@ M: rs-loc translate-local-loc n>> current-height get r>> - ; : begin-local-analysis ( -- ) H{ } clone local-peek-set set - H{ } clone local-replace-set set H{ } clone replace-mapping set current-height get [ 0 >>emit-d 0 >>emit-r drop ] [ [ d>> ] [ r>> ] bi basic-block get record-stack-heights ] bi ; +: remove-redundant-replaces ( -- ) + replace-mapping get [ [ loc>vreg ] dip = not ] assoc-filter + [ replace-mapping set ] [ keys unique local-replace-set set ] bi ; + : end-local-analysis ( -- ) + remove-redundant-replaces emit-changes basic-block get { [ [ local-peek-set get ] dip peek-sets get set-at ]