Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /MLRISC/trunk/cluster/clusterGraph.sml
ViewVC logotype

Annotation of /MLRISC/trunk/cluster/clusterGraph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 467 - (view) (download)
Original Path: sml/trunk/src/MLRISC/cluster/clusterGraph.sml

1 : monnier 467 (*
2 :     * This gives a cluster a graph view so that all graph based algorithms
3 :     * can be applied on the cluster. The view is readonly though.
4 :     *
5 :     * -- Allen
6 :     *)
7 :     functor ClusterGraphFn(F : FLOWGRAPH) : CLUSTER_GRAPH =
8 :     struct
9 :    
10 :     structure F = F
11 :     structure W = F.W
12 :     structure G = Graph
13 :     structure A = Array
14 :    
15 :     datatype clusterInfo = INFO of F.cluster * F.block A.array
16 :    
17 :     type clusterGraph = (F.block,W.freq ref,clusterInfo) Graph.graph
18 :    
19 :    
20 :     fun error msg = MLRiscErrorMsg.error("ClusterGraph",msg)
21 :    
22 :     fun table(G.GRAPH{graph_info=INFO(_,table),...}) = table
23 :     fun cluster(G.GRAPH{graph_info=INFO(cluster,_),...}) = cluster
24 :    
25 :     (* In a cluster the basic blocks are numbered consecutively.
26 :     *)
27 :     fun isTakenBranch(i,j,_) = i+1 <> j
28 :    
29 :     (*
30 :     * Extract the node frequency of a block
31 :     *)
32 :     fun nodeFreq(F.BBLOCK{freq,...}) = freq
33 :     | nodeFreq(F.ENTRY{freq,...}) = freq
34 :     | nodeFreq(F.EXIT{freq,...}) = freq
35 :     | nodeFreq _ = error "nodeFreq"
36 :    
37 :     fun clusterGraph(cluster as F.CLUSTER{blocks,blkCounter,exit,entry,...}) =
38 :     let fun readonly _ = raise G.Readonly
39 :     fun do_nothing _ = ()
40 :     val table = A.array(!blkCounter,F.LABEL(Label.newLabel "dummy"))
41 :     fun number(F.BBLOCK{blknum,...}) = blknum
42 :     | number(F.ENTRY{blknum,...}) = blknum
43 :     | number(F.EXIT{blknum,...}) = blknum
44 :     | number _ = raise G.Graph "clusterGraph"
45 :     fun fill([],size,order,entry,exit) = (size,order,entry,exit)
46 :     | fill((b as F.ENTRY{blknum,succ,...})::rest,size,order,entry,exit) =
47 :     (A.update(table,blknum,b);
48 :     fill(rest,size+length(!succ),order+1,blknum,exit)
49 :     )
50 :     | fill((b as F.EXIT{blknum,...})::rest,size,order,entry,exit) =
51 :     (A.update(table,blknum,b);
52 :     fill(rest,size,order+1,entry,blknum)
53 :     )
54 :     | fill((b as F.BBLOCK{blknum,succ,...})::rest,size,order,entry,exit) =
55 :     (A.update(table,blknum,b);
56 :     fill(rest,size+length(!succ),order+1,entry,exit)
57 :     )
58 :     | fill(_::rest,size,order,entry,exit) =
59 :     fill(rest,size,order,entry,exit)
60 :     val (size,order,entryId,exitId) = fill(entry::exit::blocks,0,0,~1,~1)
61 :     fun nodes() = A.foldri(fn (_,F.LABEL _,rest) => rest
62 :     | (b,b',rest) => (b,b')::rest) [] (table,0,NONE)
63 :     fun edges() =
64 :     let fun f(i,succ,es) =
65 :     foldr (fn ((j,e),es) => (i,number j,e)::es) es (!succ)
66 :     in A.foldri
67 :     (fn (i,F.BBLOCK{succ,...},es) => f(i,succ,es)
68 :     | (i,F.ENTRY{succ,...},es) => f(i,succ,es)
69 :     | (_,_,es) => es) [] (table,0,NONE)
70 :     end
71 :    
72 :     fun out_edges i =
73 :     let fun f succ = map (fn (j,e) => (i,number j,e)) (!succ)
74 :     in case A.sub(table,i) of
75 :     F.BBLOCK{succ,...} => f succ
76 :     | F.ENTRY{succ,...} => f succ
77 :     | _ => []
78 :     end
79 :    
80 :     fun in_edges j =
81 :     let fun f pred = map (fn (i,e) => (number i,j,e)) (!pred)
82 :     in case A.sub(table,j) of
83 :     F.BBLOCK{pred,...} => f pred
84 :     | F.EXIT{pred,...} => f pred
85 :     | _ => []
86 :     end
87 :    
88 :     fun succ i =
89 :     let fun f succ = map (fn (j,e) => number j) (!succ)
90 :     in case A.sub(table,i) of
91 :     F.BBLOCK{succ,...} => f succ
92 :     | F.ENTRY{succ,...} => f succ
93 :     | _ => []
94 :     end
95 :    
96 :     fun pred j =
97 :     let fun f pred = map (fn (i,e) => number i) (!pred)
98 :     in case A.sub(table,j) of
99 :     F.BBLOCK{pred,...} => f pred
100 :     | F.EXIT{pred,...} => f pred
101 :     | _ => []
102 :     end
103 :    
104 :     fun has_edge(i,j) =
105 :     let fun find [] = false
106 :     | find((k,_)::es) = j = number k orelse find es
107 :     in case A.sub(table,i) of
108 :     F.BBLOCK{succ,...} => find(!succ)
109 :     | F.ENTRY{succ,...} => find(!succ)
110 :     | _ => false
111 :     end handle _ => false
112 :    
113 :     fun has_node i =
114 :     (case A.sub(table,i) of
115 :     F.BBLOCK _ => true
116 :     | F.ENTRY _ => true
117 :     | F.EXIT _ => true
118 :     | _ => false
119 :     ) handle _ => false
120 :    
121 :     fun node_info i = A.sub(table,i) handle _ => raise G.NotFound
122 :    
123 :     fun empty _ = []
124 :     fun forall_nodes f =
125 :     A.appi (fn (i,i' as F.LABEL _) => ()
126 :     | (i,i') => f(i,i')) (table,0,NONE)
127 :     fun forall_edges f =
128 :     let fun g(_,[]) = ()
129 :     | g(i,(j,e)::es) = (f(i,number j,e); g(i,es))
130 :     in A.appi (fn (i,F.BBLOCK{succ,...}) => g(i,!succ)
131 :     | (i,F.ENTRY{succ,...}) => g(i,!succ)
132 :     | _ => ()) (table,0,NONE)
133 :     end
134 :    
135 :     in G.GRAPH
136 :     { name = "cluster",
137 :     graph_info = INFO(cluster,table),
138 :     new_id = readonly,
139 :     add_node = readonly,
140 :     add_edge = readonly,
141 :     remove_node = readonly,
142 :     set_out_edges = readonly,
143 :     set_in_edges = readonly,
144 :     set_entries = readonly,
145 :     set_exits = readonly,
146 :     garbage_collect = do_nothing,
147 :     nodes = nodes,
148 :     edges = edges,
149 :     order = fn _ => order,
150 :     size = fn _ => size,
151 :     capacity = fn _ => !blkCounter,
152 :     succ = succ,
153 :     pred = pred,
154 :     out_edges = out_edges,
155 :     in_edges = in_edges,
156 :     has_edge = has_edge,
157 :     has_node = has_node,
158 :     node_info = node_info,
159 :     entries = fn _ => [entryId],
160 :     exits = fn _ => [exitId],
161 :     entry_edges = empty,
162 :     exit_edges = empty,
163 :     forall_nodes = forall_nodes,
164 :     forall_edges = forall_edges
165 :     }
166 :     end
167 :    
168 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0