cannam@167
|
1 (*
|
cannam@167
|
2 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
|
cannam@167
|
3 * Copyright (c) 2003, 2007-14 Matteo Frigo
|
cannam@167
|
4 * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology
|
cannam@167
|
5 *
|
cannam@167
|
6 * This program is free software; you can redistribute it and/or modify
|
cannam@167
|
7 * it under the terms of the GNU General Public License as published by
|
cannam@167
|
8 * the Free Software Foundation; either version 2 of the License, or
|
cannam@167
|
9 * (at your option) any later version.
|
cannam@167
|
10 *
|
cannam@167
|
11 * This program is distributed in the hope that it will be useful,
|
cannam@167
|
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
|
cannam@167
|
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
cannam@167
|
14 * GNU General Public License for more details.
|
cannam@167
|
15 *
|
cannam@167
|
16 * You should have received a copy of the GNU General Public License
|
cannam@167
|
17 * along with this program; if not, write to the Free Software
|
cannam@167
|
18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
cannam@167
|
19 *
|
cannam@167
|
20 *)
|
cannam@167
|
21
|
cannam@167
|
22 open Util
|
cannam@167
|
23
|
cannam@167
|
24 (* Here, we have functions to transform a sequence of assignments
|
cannam@167
|
25 (variable = expression) into a DAG (a directed, acyclic graph).
|
cannam@167
|
26 The nodes of the DAG are the assignments, and the edges indicate
|
cannam@167
|
27 dependencies. (The DAG is analyzed in the scheduler to find an
|
cannam@167
|
28 efficient ordering of the assignments.)
|
cannam@167
|
29
|
cannam@167
|
30 This file also contains utilities to manipulate the DAG in various
|
cannam@167
|
31 ways. *)
|
cannam@167
|
32
|
cannam@167
|
33 (********************************************
|
cannam@167
|
34 * Dag structure
|
cannam@167
|
35 ********************************************)
|
cannam@167
|
36 type color = RED | BLUE | BLACK | YELLOW
|
cannam@167
|
37
|
cannam@167
|
38 type dagnode =
|
cannam@167
|
39 { assigned: Variable.variable;
|
cannam@167
|
40 mutable expression: Expr.expr;
|
cannam@167
|
41 input_variables: Variable.variable list;
|
cannam@167
|
42 mutable successors: dagnode list;
|
cannam@167
|
43 mutable predecessors: dagnode list;
|
cannam@167
|
44 mutable label: int;
|
cannam@167
|
45 mutable color: color}
|
cannam@167
|
46
|
cannam@167
|
47 type dag = Dag of (dagnode list)
|
cannam@167
|
48
|
cannam@167
|
49 (* true if node uses v *)
|
cannam@167
|
50 let node_uses v node =
|
cannam@167
|
51 List.exists (Variable.same v) node.input_variables
|
cannam@167
|
52
|
cannam@167
|
53 (* true if assignment of v clobbers any input of node *)
|
cannam@167
|
54 let node_clobbers node v =
|
cannam@167
|
55 List.exists (Variable.same_location v) node.input_variables
|
cannam@167
|
56
|
cannam@167
|
57 (* true if nodeb depends on nodea *)
|
cannam@167
|
58 let depends_on nodea nodeb =
|
cannam@167
|
59 node_uses nodea.assigned nodeb ||
|
cannam@167
|
60 node_clobbers nodea nodeb.assigned
|
cannam@167
|
61
|
cannam@167
|
62 (* transform an assignment list into a dag *)
|
cannam@167
|
63 let makedag alist =
|
cannam@167
|
64 let dag = List.map
|
cannam@167
|
65 (fun assignment ->
|
cannam@167
|
66 let (v, x) = assignment in
|
cannam@167
|
67 { assigned = v;
|
cannam@167
|
68 expression = x;
|
cannam@167
|
69 input_variables = Expr.find_vars x;
|
cannam@167
|
70 successors = [];
|
cannam@167
|
71 predecessors = [];
|
cannam@167
|
72 label = 0;
|
cannam@167
|
73 color = BLACK })
|
cannam@167
|
74 alist
|
cannam@167
|
75 in begin
|
cannam@167
|
76 for_list dag (fun i ->
|
cannam@167
|
77 for_list dag (fun j ->
|
cannam@167
|
78 if depends_on i j then begin
|
cannam@167
|
79 i.successors <- j :: i.successors;
|
cannam@167
|
80 j.predecessors <- i :: j.predecessors;
|
cannam@167
|
81 end));
|
cannam@167
|
82 Dag dag;
|
cannam@167
|
83 end
|
cannam@167
|
84
|
cannam@167
|
85 let map f (Dag dag) = Dag (List.map f dag)
|
cannam@167
|
86 let for_all (Dag dag) f =
|
cannam@167
|
87 (* type system loophole *)
|
cannam@167
|
88 let make_unit _ = () in
|
cannam@167
|
89 make_unit (List.map f dag)
|
cannam@167
|
90 let to_list (Dag dag) = dag
|
cannam@167
|
91
|
cannam@167
|
92 let find_node f (Dag dag) = Util.find_elem f dag
|
cannam@167
|
93
|
cannam@167
|
94 (* breadth-first search *)
|
cannam@167
|
95 let rec bfs (Dag dag) node init_label =
|
cannam@167
|
96 let _ = node.label <- init_label in
|
cannam@167
|
97 let rec loop = function
|
cannam@167
|
98 [] -> ()
|
cannam@167
|
99 | node :: rest ->
|
cannam@167
|
100 let neighbors = node.predecessors @ node.successors in
|
cannam@167
|
101 let m = min_list (List.map (fun node -> node.label) neighbors) in
|
cannam@167
|
102 if (node.label > m + 1) then begin
|
cannam@167
|
103 node.label <- m + 1;
|
cannam@167
|
104 loop (rest @ neighbors);
|
cannam@167
|
105 end else
|
cannam@167
|
106 loop rest
|
cannam@167
|
107 in let neighbors = node.predecessors @ node.successors in
|
cannam@167
|
108 loop neighbors
|
cannam@167
|
109
|