From bb504b7c3d9fb28ef4088daff567e14a36df0e49 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Tue, 3 Mar 2015 15:20:39 +0000 Subject: [PATCH] compiler.cfg.dependence: this vocab was only used by scheduling so it isn't needed anymore --- .../cfg/dependence/dependence-docs.factor | 44 --------- .../cfg/dependence/dependence-tests.factor | 95 ------------------- .../compiler/cfg/dependence/dependence.factor | 93 ------------------ 3 files changed, 232 deletions(-) delete mode 100644 basis/compiler/cfg/dependence/dependence-docs.factor delete mode 100644 basis/compiler/cfg/dependence/dependence-tests.factor delete mode 100644 basis/compiler/cfg/dependence/dependence.factor diff --git a/basis/compiler/cfg/dependence/dependence-docs.factor b/basis/compiler/cfg/dependence/dependence-docs.factor deleted file mode 100644 index 2c7dd36f1a..0000000000 --- a/basis/compiler/cfg/dependence/dependence-docs.factor +++ /dev/null @@ -1,44 +0,0 @@ -USING: assocs compiler.cfg.instructions help.markup help.syntax math -sequences ; -IN: compiler.cfg.dependence - -HELP: node -{ $class-description "Nodes in the dependency graph. These need to be numbered so that the same instruction will get distinct nodes if it occurs multiple times. It has the following slots:" - { $table - { { $slot "insn" } { { $link insn } } } - { { $slot "precedes" } { "Hash of all nodes this node must precede in the instruction flow." } } - } -} ; - -HELP: -{ $values { "insn" insn } { "node" node } } -{ $description "Creates a new dependency graph node from an CFG instruction." } ; - -{ node } related-words - -HELP: attach-parent -{ $values { "child" node } { "parent" node } } -{ $description "Inserts 'node' as a children of 'parent' and sets the parent of 'node' to 'parent'." } -{ $examples - { $unchecked-example - "USING: compiler.cfg.dependence ;" - "T{ ##replace } T{ ##set-slot-imm } [ ] bi@ attach-parent" - } -} ; - -HELP: select-parent -{ $values { "precedes" assoc } { "parent/f" node } } -{ $description "Picks the parent node for this node from an assoc of preceding nodes." } ; - -HELP: build-fan-in-trees -{ $values { "nodes" sequence } } -{ $description "Selects a parent for each " { $link node } ", then initializes the " { $slot "parent-index" } " and Sethi-Ulmann number for the nodes." } ; - -HELP: calculate-registers -{ $values { "node" node } { "registers" integer } } -{ $description "Calculates a nodes Sethi-Ulmann number. For a leaf node, the number is equal to the number of temporary registers the word uses." } ; - -ARTICLE: "compiler.cfg.dependence" "Dependence graph construction" -"This vocab is used by " { $vocab-link "compiler.cfg.scheduling" } "." ; - -ABOUT: "compiler.cfg.dependence" diff --git a/basis/compiler/cfg/dependence/dependence-tests.factor b/basis/compiler/cfg/dependence/dependence-tests.factor deleted file mode 100644 index 71052cd4da..0000000000 --- a/basis/compiler/cfg/dependence/dependence-tests.factor +++ /dev/null @@ -1,95 +0,0 @@ -USING: accessors arrays assocs combinators.short-circuit -compiler.cfg.dependence compiler.cfg.instructions -grouping kernel math random sequences tools.test vectors -compiler.cfg.test-words ; -IN: compiler.cfg.dependence.tests -FROM: sets => members set= ; - -{ t } [ - V{ T{ ##inc-r } T{ ##inc-d } } [ ] map dup - build-dependence-graph - first2 [ insn>> ##inc-r? ] [ insn>> ##inc-d? ] bi* and -] unit-test - -{ 0 } [ - T{ ##load-tagged } calculate-registers -] unit-test - -: 2node-tree ( -- tree ) - 2 [ node new ] replicate first2 over attach-parent ; - -! 0 -> 1 -> 2 -: 3node-tree ( -- tree ) - 3 [ node new ] replicate first3 - over attach-parent over attach-parent ; - -! Verification tests -ERROR: node-missing-parent trees nodes ; -ERROR: node-missing-children trees nodes ; - -: flatten-tree ( node -- nodes ) - [ children>> [ flatten-tree ] map concat ] keep suffix ; - -: verify-children ( nodes trees -- ) - 2dup [ flatten-tree ] map concat - { [ [ length ] same? ] [ set= ] } 2&& - [ 2drop ] [ node-missing-children ] if ; - -{ } [ - 2node-tree [ flatten-tree ] keep 1array verify-children -] unit-test - -[ - 2node-tree 1array { } verify-children -] [ node-missing-children? ] must-fail-with - -{ 1 } [ 3node-tree children>> length ] unit-test - -{ 3 } [ 3node-tree flatten-tree length ] unit-test - -[ - { } 3node-tree 1array verify-children -] [ node-missing-children? ] must-fail-with - -[ - { } 3node-tree 1array verify-children -] [ node-missing-children? ] must-fail-with - -! select-parent tests -{ f } [ - { } select-parent -] unit-test - -: dummy-node ( number -- node ) - ##allot new swap >>insn# node new swap >>insn ; - -! No parent because it has +control+ -{ f } [ - 10 20 [ dummy-node ] bi@ 2array { +data+ +control+ } zip select-parent -] unit-test - -! Yes parent -{ 10 } [ - 10 dummy-node +data+ 2array 1array select-parent insn>> insn#>> -] unit-test - -{ 0 } [ - 20 iota [ dummy-node +data+ 2array ] map randomize - select-parent insn>> insn#>> -] unit-test - -! Another -{ t } [ - 100 [ - test-not-in-order [ ] map [ build-dependence-graph ] keep - [ precedes>> select-parent ] map [ dup [ insn>> ] when ] map - ] replicate all-equal? -] unit-test - -{ t } [ - 100 [ - test-not-in-order [ ] map dup dup - build-dependence-graph [ maybe-set-parent ] each - [ children>> length ] map - ] replicate all-equal? -] unit-test diff --git a/basis/compiler/cfg/dependence/dependence.factor b/basis/compiler/cfg/dependence/dependence.factor deleted file mode 100644 index 845364ff38..0000000000 --- a/basis/compiler/cfg/dependence/dependence.factor +++ /dev/null @@ -1,93 +0,0 @@ -! Copyright (C) 2009, 2010 Daniel Ehrenberg. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs compiler.cfg.def-use -compiler.cfg.instructions fry kernel locals math math.vectors -namespaces sequences sets sorting vectors ; -FROM: namespaces => set ; -IN: compiler.cfg.dependence - -SYMBOLS: +data+ +control+ ; - -TUPLE: node < identity-tuple insn precedes children registers parent-index ; - -: ( insn -- node ) - node new swap >>insn H{ } clone >>precedes ; - -:: precedes ( first second how -- ) - how second first precedes>> set-at ; - -:: add-data-edges ( nodes -- ) - ! This builds up def-use information on the fly, since - ! we only care about local def-use - H{ } clone :> definers - nodes [| node | - node insn>> defs-vregs [ node swap definers set-at ] each - node insn>> uses-vregs [ definers at [ node +data+ precedes ] when* ] each - ] each ; - -UNION: stack-insn ##peek ##replace ##replace-imm ; - -UNION: slot-insn - ##read ##write ; - -UNION: memory-insn - ##allot - ##load-memory ##load-memory-imm - ##store-memory ##store-memory-imm - ##write-barrier ##write-barrier-imm - alien-call-insn - slot-insn ; - -: chain ( node var -- ) - dup get [ - pick +control+ precedes - ] when* - set ; - -GENERIC: add-control-edge ( node insn -- ) - -M: stack-insn add-control-edge loc>> chain ; -M: memory-insn add-control-edge drop memory-insn chain ; -M: object add-control-edge 2drop ; - -: add-control-edges ( nodes -- ) - [ [ dup insn>> add-control-edge ] each ] with-scope ; - -: build-dependence-graph ( nodes -- ) - [ add-control-edges ] [ add-data-edges ] bi ; - -! Sethi-Ulmann numbering -:: calculate-registers ( node -- registers ) - node children>> [ 0 ] [ - [ [ calculate-registers ] map natural-sort ] - [ length iota ] - bi v+ supremum - ] if-empty - node insn>> temp-vregs length + - dup node registers<< ; - -! Constructing fan-in trees -: keys-for ( assoc value -- keys ) - '[ nip _ = ] assoc-filter keys ; - -: attach-parent ( child parent -- ) - [ ?push ] change-children drop ; - -! Arbitrary tie-breaker to make the ordering deterministic. -: tiebreak-parents ( nodes -- node/f ) - [ f ] [ [ insn>> insn#>> ] infimum-by ] if-empty ; - -: select-parent ( precedes -- parent/f ) - ! If a node has no control dependencies, then its parent is the tie-breaked - ! data dependency, if it has one. Otherwise it is a root node. - [ +control+ keys-for empty? ] [ +data+ keys-for tiebreak-parents ] bi f ? ; - -: maybe-set-parent ( node -- ) - dup precedes>> select-parent [ attach-parent ] [ drop ] if* ; - -: initialize-scores ( trees -- ) - [ -1/0. >>parent-index calculate-registers drop ] each ; - -: build-fan-in-trees ( nodes -- ) - dup [ maybe-set-parent ] each - dup [ children>> ] map concat diff initialize-scores ;