From b39b0dd393b437f3f7e9ac541d900770143552bc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 22 Jul 2009 02:05:40 -0500 Subject: [PATCH] compiler.cfg.dcn.global: redo using compiler.cfg.dataflow-analysis --- basis/compiler/cfg/dcn/global/global.factor | 175 ++------------------ 1 file changed, 10 insertions(+), 165 deletions(-) diff --git a/basis/compiler/cfg/dcn/global/global.factor b/basis/compiler/cfg/dcn/global/global.factor index d644ed8703..44f8af24cc 100644 --- a/basis/compiler/cfg/dcn/global/global.factor +++ b/basis/compiler/cfg/dcn/global/global.factor @@ -1,194 +1,39 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs deques dlists fry kernel namespaces sequences -combinators combinators.short-circuit compiler.cfg.instructions -compiler.cfg.dcn.local compiler.cfg.rpo compiler.cfg.utilities -compiler.cfg ; +USING: assocs kernel combinators compiler.cfg.dataflow-analysis +compiler.cfg.dcn.local ; IN: compiler.cfg.dcn.global - -: peek-in ( bb -- assoc ) peek-ins get at ; -: peek-out ( bb -- assoc ) peek-outs get at ; - -> peek-ins get '[ _ at ] map assoc-refine ; - -M: kill-block compute-peek-out drop f ; - -: update-peek-out ( bb -- ? ) - [ compute-peek-out ] keep peek-outs get maybe-set-at ; - -: peek-step ( bb -- ) - dup update-peek-out [ - dup update-peek-in - [ predecessors>> add-to-work-list ] [ drop ] if - ] [ drop ] if ; - -: compute-peek-sets ( cfg -- ) - H{ } clone peek-ins set - H{ } clone peek-outs set - post-order add-to-work-list work-list get [ peek-step ] slurp-deque ; +M: peek-analysis transfer-set drop [ replace assoc-diff ] keep peek assoc-union ; ! Replace analysis. Replace-in is the set of all locations which ! will be overwritten at some point after the start of a basic block. -SYMBOLS: replace-ins replace-outs ; +FORWARD-ANALYSIS: replace -PRIVATE> - -: replace-in ( bb -- assoc ) replace-ins get at ; -: replace-out ( bb -- assoc ) replace-outs get at ; - -> replace-outs get '[ _ at ] map assoc-refine ; - -M: kill-block compute-replace-in drop f ; - -: update-replace-in ( bb -- ? ) - [ compute-replace-in ] keep replace-ins get maybe-set-at ; - -GENERIC: compute-replace-out ( bb -- assoc ) - -M: basic-block compute-replace-out - [ replace-in ] [ replace ] bi assoc-union ; - -M: kill-block compute-replace-out drop f ; - -: update-replace-out ( bb -- ? ) - [ compute-replace-out ] keep replace-outs get maybe-set-at ; - -: replace-step ( bb -- ) - dup update-replace-in [ - dup update-replace-out - [ successors>> add-to-work-list ] [ drop ] if - ] [ drop ] if ; - -: compute-replace-sets ( cfg -- ) - H{ } clone replace-ins set - H{ } clone replace-outs set - reverse-post-order add-to-work-list work-list get [ replace-step ] slurp-deque ; +M: replace-analysis transfer-set drop replace assoc-union ; ! Availability analysis. Avail-out is the set of all locations ! in registers at the end of a basic block. -SYMBOLS: avail-ins avail-outs ; +FORWARD-ANALYSIS: avail -PRIVATE> - -: avail-in ( bb -- assoc ) avail-ins get at ; -: avail-out ( bb -- assoc ) avail-outs get at ; - -> avail-outs get '[ _ at ] map assoc-refine ; - -M: kill-block compute-avail-in drop f ; - -: update-avail-in ( bb -- ? ) - [ compute-avail-in ] keep avail-ins get maybe-set-at ; - -GENERIC: compute-avail-out ( bb -- assoc ) - -M: basic-block compute-avail-out - [ avail-in ] [ peek ] [ replace ] tri assoc-union assoc-union ; - -M: kill-block compute-avail-out drop f ; - -: update-avail-out ( bb -- ? ) - [ compute-avail-out ] keep avail-outs get maybe-set-at ; - -: avail-step ( bb -- ) - dup update-avail-in [ - dup update-avail-out - [ successors>> add-to-work-list ] [ drop ] if - ] [ drop ] if ; - -: compute-avail-sets ( cfg -- ) - H{ } clone avail-ins set - H{ } clone avail-outs set - reverse-post-order add-to-work-list work-list get [ avail-step ] slurp-deque ; +M: avail-analysis transfer-set drop [ peek ] [ replace ] bi assoc-union assoc-union ; ! Kill analysis. Kill-in is the set of all locations ! which are going to be overwritten. -SYMBOLS: kill-ins kill-outs ; +BACKWARD-ANALYSIS: kill -PRIVATE> - -: kill-in ( bb -- assoc ) kill-ins get at ; -: kill-out ( bb -- assoc ) kill-outs get at ; - -> kill-ins get '[ _ at ] map assoc-refine ; - -M: kill-block compute-kill-out drop f ; - -: update-kill-out ( bb -- ? ) - [ compute-kill-out ] keep kill-outs get maybe-set-at ; - -: kill-step ( bb -- ) - dup update-kill-out [ - dup update-kill-in - [ predecessors>> add-to-work-list ] [ drop ] if - ] [ drop ] if ; - -: compute-kill-sets ( cfg -- ) - H{ } clone kill-ins set - H{ } clone kill-outs set - post-order add-to-work-list work-list get [ kill-step ] slurp-deque ; +M: kill-analysis transfer-set drop replace assoc-union ; PRIVATE> ! Main word : compute-global-sets ( cfg -- ) - work-list set { [ compute-peek-sets ] [ compute-replace-sets ]