diff --git a/basis/compiler/cfg/dependence/dependence.factor b/basis/compiler/cfg/dependence/dependence.factor index ac5666c285..97c381dff4 100644 --- a/basis/compiler/cfg/dependence/dependence.factor +++ b/basis/compiler/cfg/dependence/dependence.factor @@ -12,7 +12,7 @@ SYMBOL: +data+ SYMBOL: +control+ TUPLE: node - number insn precedes follows + number insn precedes children parent registers parent-index ; @@ -24,8 +24,7 @@ M: node hashcode* nip number>> ; node new node-number counter >>number swap >>insn - H{ } clone >>precedes - V{ } clone >>follows ; + H{ } clone >>precedes ; :: precedes ( first second how -- ) how second first precedes>> set-at ; @@ -69,15 +68,8 @@ M: object add-control-edge 2drop ; : add-control-edges ( nodes -- ) [ [ dup insn>> add-control-edge ] each ] with-scope ; -: set-follows ( nodes -- ) - [ - dup precedes>> keys [ - follows>> push - ] with each - ] each ; - : build-dependence-graph ( nodes -- ) - [ add-control-edges ] [ add-data-edges ] [ set-follows ] tri ; + [ add-control-edges ] [ add-data-edges ] bi ; ! Sethi-Ulmann numbering :: calculate-registers ( node -- registers ) diff --git a/basis/compiler/cfg/scheduling/scheduling.factor b/basis/compiler/cfg/scheduling/scheduling.factor index 81f2e43fdf..e5f7bc7f76 100644 --- a/basis/compiler/cfg/scheduling/scheduling.factor +++ b/basis/compiler/cfg/scheduling/scheduling.factor @@ -12,35 +12,28 @@ IN: compiler.cfg.scheduling ! by Vivek Sarkar, et al. ! http://portal.acm.org/citation.cfm?id=377849 -ERROR: bad-delete-at key assoc ; - -: check-delete-at ( key assoc -- ) - 2dup key? [ delete-at ] [ bad-delete-at ] if ; - : set-parent-indices ( node -- ) children>> building get length '[ _ >>parent-index drop ] each ; : ready? ( node -- ? ) precedes>> assoc-empty? ; -: remove-node ( roots node -- ) - dup follows>> [ [ precedes>> check-delete-at ] with each ] keep - [ ready? ] filter swap push-all ; +! Remove the node and unregister it from all nodes precedes links. +: remove-node ( nodes node -- ) + [ swap remove! ] keep '[ precedes>> _ swap delete-at ] each ; : score ( node -- n ) [ parent-index>> ] [ registers>> neg ] [ insn>> insn#>> ] tri 3array ; -: select ( vector quot: ( elt -- score ) -- elt ) - dupd supremum-by swap dupd remove-eq! drop ; inline - -: select-instruction ( roots -- insn/f ) +: select-instruction ( nodes -- insn/f ) [ f ] [ - dup [ score ] select + ! select one among the ready nodes (roots) + dup [ ready? ] filter [ score ] supremum-by [ remove-node ] keep [ insn>> ] [ set-parent-indices ] bi ] if-empty ; -: (reorder) ( roots -- ) +: (reorder) ( nodes -- ) dup select-instruction [ , (reorder) ] [ drop ] if* ; UNION: initial-insn ##phi ##inc-d ##inc-r ##callback-inputs ; @@ -62,14 +55,12 @@ conditional-branch-insn : split-insns ( insns -- pre/body/post ) dup [ initial-insn-end ] [ final-insn-start ] bi 2array split-indices ; -: setup-root-nodes ( insns -- roots ) - [ ] map - [ build-dependence-graph ] - [ build-fan-in-trees ] - [ [ ready? ] V{ } filter-as ] tri ; +: setup-nodes ( insns -- nodes ) + [ ] V{ } map-as + [ build-dependence-graph ] [ build-fan-in-trees ] [ ] tri ; : reorder-body ( body -- body' ) - setup-root-nodes [ (reorder) ] V{ } make reverse ; + setup-nodes [ (reorder) ] V{ } make reverse ; : reorder ( insns -- insns' ) split-insns first3 [ reorder-body ] dip 3append ;