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 /sml/trunk/src/MLRISC/IR/mlrisc-ir.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/IR/mlrisc-ir.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 228 - (view) (download)

1 : monnier 221 functor MLRISC_IRFn
2 :     (structure CFG : CONTROL_FLOW_GRAPH
3 :     structure CDG : CONTROL_DEPENDENCE_GRAPH
4 :     structure Loop : LOOP_STRUCTURE
5 :     structure GraphViewer : GRAPH_VIEWER
6 :     structure Util : CFG_UTIL
7 :     sharing Loop.Dom = CDG.Dom
8 :     sharing Util.CFG = CFG
9 :     ) : MLRISC_IR =
10 :     struct
11 :    
12 :     structure I = CFG.I
13 :     structure CFG = CFG
14 :     structure Dom = Loop.Dom
15 :     structure CDG = CDG
16 :     structure Loop = Loop
17 :     structure G = Graph
18 :     structure A = Annotations
19 :     structure Util = Util
20 :     structure L = GraphLayout
21 :    
22 :     type cfg = CFG.cfg
23 :     type IR = CFG.cfg
24 :     type dom = (CFG.block,CFG.edge_info,CFG.info) Dom.dominator_tree
25 :     type pdom = (CFG.block,CFG.edge_info,CFG.info) Dom.postdominator_tree
26 :     type cdg = (CFG.block,CFG.edge_info,CFG.info) CDG.cdg
27 :     type loop = (CFG.block,CFG.edge_info,CFG.info) Loop.loop_structure
28 :    
29 :     val layouts = ref [] : (string * (IR -> L.layout)) list ref
30 :    
31 :     fun addLayout name layout =
32 :     let fun f((x,y)::rest) = if x = name then (x,layout)::rest
33 :     else (x,y)::f rest
34 :     | f [] = [(name,layout)]
35 :     in layouts := f(!layouts) end
36 :    
37 :     fun view name IR =
38 :     let fun f [] = print ("[Can't find "^name^"]\n")
39 :     | f((x,layout)::rest) =
40 :     if x = name then GraphViewer.view (layout IR) else f rest
41 :     in f(!layouts) end
42 :    
43 :     fun viewSubgraph IR subgraph =
44 :     GraphViewer.view (CFG.subgraphLayout{cfg=IR,subgraph=subgraph})
45 :    
46 :     (*
47 :     * This function defines how we compute a new view
48 :     *)
49 :    
50 :     fun memo compute =
51 :     let val {get,put,rmv,...} = A.new()
52 :     fun getView
53 :     (IR as G.GRAPH{graph_info=CFG.INFO{annotations,...},...} : IR) =
54 :     case get (!annotations) of
55 :     SOME info => info
56 :     | NONE => let val info = compute IR
57 :     fun kill() = annotations := rmv(!annotations)
58 :     in annotations :=
59 :     CFG.CHANGEDONCE kill::put(info,!annotations);
60 :     info
61 :     end
62 :     in getView
63 :     end
64 :    
65 :     (*
66 :     * Extract various views from an IR
67 :     *)
68 :    
69 :     val doms = memo Dom.dominator_trees
70 :     fun dom IR = #1 (doms IR)
71 :     fun pdom IR = #2 (doms IR)
72 :     val cdg = memo (fn IR => CDG.control_dependence_graph CFG.cdgEdge (doms IR))
73 :     val loop = memo (Loop.loop_structure o dom)
74 :     val changed = CFG.changed
75 :    
76 :     (*
77 :     * Methods to layout various graphs
78 :     *)
79 :     fun defaultEdge _ = [L.COLOR "red"]
80 :     fun defaultGraph _ = []
81 :     fun layoutDom' IR G =
82 :     let val {node,...} = CFG.viewStyle IR
83 :     in L.makeLayout {edge = defaultEdge,
84 :     graph= defaultGraph,
85 :     node = fn (x,Dom.DOM{node=n,...}) => node(x,n)} G
86 :     end
87 :    
88 :     fun layoutDom IR = layoutDom' IR (dom IR)
89 :     fun layoutPdom IR = layoutDom' IR (pdom IR)
90 :     fun layoutDoms IR = layoutDom' IR
91 :     let val (dom,pdom) = doms IR
92 :     in GraphCombinations.sum(dom,ReversedGraphView.rev_view pdom)
93 :     end
94 :     fun layoutCDG IR = CFG.viewLayout(cdg IR)
95 :     fun layoutLoop (IR as G.GRAPH cfg) =
96 :     let val loop = loop IR
97 :     val regmap = CFG.regmap IR
98 :     fun mkNodes nodes =
99 :     String.concat(map (fn i => Int.toString i^" ") nodes)
100 :     fun mkEdges edges =
101 :     String.concat(map
102 :     (fn (i,j,_) => Int.toString i^"->"^Int.toString j^" ") edges)
103 :     fun node(_,Loop.LOOP{nesting,header,loop_nodes,
104 :     backedges,exits,...}) =
105 :     [L.LABEL("nesting: "^Int.toString nesting^"\n"^
106 :     CFG.show_block regmap (#node_info cfg header)^
107 :     "loop_nodes: "^mkNodes loop_nodes^"\n"^
108 :     "backedges: "^mkEdges backedges^"\n"^
109 :     "exits: "^mkEdges exits^"\n"
110 :     )]
111 :     in L.makeLayout {edge=defaultEdge,
112 :     graph=defaultGraph,
113 :     node=node} loop
114 :     end
115 :    
116 :     (*
117 :     * Insert the layout methods here.
118 :     *)
119 :     val _ = addLayout "cfg" CFG.viewLayout
120 :     val _ = addLayout "dom" layoutDom
121 :     val _ = addLayout "pdom" layoutPdom
122 :     val _ = addLayout "doms" layoutDoms
123 :     val _ = addLayout "cdg" layoutCDG
124 :     val _ = addLayout "loop" layoutLoop
125 :    
126 :     end
127 :    
128 :     (*
129 : monnier 227 * $Log$
130 : monnier 221 *)
131 :    

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