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