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
 [smlnj] / MLRISC / trunk / cluster / clusterGraph.sml

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

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