diff --git a/basis/compiler/cfg/stack-analysis/merge/merge.factor b/basis/compiler/cfg/stack-analysis/merge/merge.factor index cb0ad7d615..a53fd7494e 100644 --- a/basis/compiler/cfg/stack-analysis/merge/merge.factor +++ b/basis/compiler/cfg/stack-analysis/merge/merge.factor @@ -92,6 +92,7 @@ SYMBOL: added-phis :: multiple-predecessors ( bb states -- state ) states [ not ] any? [ + bb add-to-work-list ] [ [ H{ } clone added-instructions set diff --git a/basis/compiler/cfg/stack-analysis/stack-analysis.factor b/basis/compiler/cfg/stack-analysis/stack-analysis.factor index 48a4b79783..51baea71a9 100644 --- a/basis/compiler/cfg/stack-analysis/stack-analysis.factor +++ b/basis/compiler/cfg/stack-analysis/stack-analysis.factor @@ -14,9 +14,7 @@ compiler.cfg.stack-analysis.merge compiler.cfg.utilities ; IN: compiler.cfg.stack-analysis -SYMBOL: work-list - -: add-to-work-list ( bb -- ) work-list get push-front ; +SYMBOL: global-optimization? : redundant-replace? ( vreg loc -- ? ) dup state get untranslate-loc n>> 0 < @@ -70,7 +68,8 @@ UNION: sync-if-back-edge [ [ predecessors>> ] keep '[ _ back-edge? ] any? ] any? ; M: sync-if-back-edge visit - sync-state? [ sync-state ] when , ; + global-optimization? get [ sync-state? [ sync-state ] when ] unless + , ; : eliminate-peek ( dst src -- ) ! the requested stack location is already in 'src' @@ -87,31 +86,8 @@ M: ##replace visit M: ##copy visit [ call-next-method ] [ record-copy ] bi ; -! Instructions that poison the stack state -UNION: poison-insn - ##jump - ##return - ##callback-return - ##fixnum-mul-tail - ##fixnum-add-tail - ##fixnum-sub-tail ; - M: poison-insn visit call-next-method poison-state ; -! Instructions that kill all live vregs -UNION: kill-vreg-insn - poison-insn - ##stack-frame - ##call - ##prologue - ##epilogue - ##fixnum-mul - ##fixnum-add - ##fixnum-sub - ##alien-invoke - ##alien-indirect - ##alien-callback ; - M: kill-vreg-insn visit sync-state , ; ! Maps basic-blocks to states @@ -142,21 +118,13 @@ SYMBOLS: state-in state-out ; ] 2bi ] V{ } make >>instructions drop ; -: visit-successors ( bb -- ) - dup successors>> [ - 2dup back-edge? [ 2drop ] [ nip add-to-work-list ] if - ] with each ; - -: process-work-list ( -- ) - work-list get [ visit-block ] slurp-deque ; - : stack-analysis ( cfg -- cfg' ) [ work-list set H{ } clone copies set H{ } clone state-in set H{ } clone state-out set - dup [ add-to-work-list ] each-basic-block - process-work-list + dup [ visit-block ] each-basic-block + global-optimization? get [ work-list get [ visit-block ] slurp-deque ] when cfg-changed ] with-scope ; diff --git a/basis/compiler/cfg/stack-analysis/state/state.factor b/basis/compiler/cfg/stack-analysis/state/state.factor index f701b84763..25fa249853 100644 --- a/basis/compiler/cfg/stack-analysis/state/state.factor +++ b/basis/compiler/cfg/stack-analysis/state/state.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors namespaces assocs sets math +USING: kernel accessors namespaces assocs sets math deques compiler.cfg.registers ; IN: compiler.cfg.stack-analysis.state @@ -47,3 +47,7 @@ M: rs-loc translate-loc [ n>> ] [ rs-height>> ] bi* - ; GENERIC# untranslate-loc 1 ( loc state -- loc' ) M: ds-loc untranslate-loc [ n>> ] [ ds-height>> ] bi* + ; M: rs-loc untranslate-loc [ n>> ] [ rs-height>> ] bi* + ; + +SYMBOL: work-list + +: add-to-work-list ( bb -- ) work-list get push-front ;