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/branches/SMLNJ/src/MLRISC/IR/mlrisc-cfg-gen.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/MLRISC/IR/mlrisc-cfg-gen.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 469 - (view) (download)

1 : monnier 411 (*
2 :     * This module takes a stream of instructions and build a CFG.
3 :     * The building can be incremental.
4 :     *
5 :     * -- Allen
6 :     *)
7 : monnier 245 functor ControlFlowGraphGenFn
8 :     (structure CFG : CONTROL_FLOW_GRAPH
9 : monnier 411 structure Stream : INSTRUCTION_STREAM
10 :     structure InsnProps : INSN_PROPERTIES
11 :     sharing CFG.I = InsnProps.I
12 :     sharing CFG.P = Stream.P
13 : monnier 245 ) : CONTROL_FLOW_GRAPH_GEN =
14 :     struct
15 :    
16 :     structure CFG = CFG
17 :     structure I = CFG.I
18 :     structure P = CFG.P
19 :     structure G = Graph
20 :     structure W = CFG.W
21 : monnier 411 structure S = Stream
22 : monnier 245
23 : monnier 411 fun error msg = MLRiscErrorMsg.error("ControlFlowGraphGen",msg)
24 : monnier 245
25 : monnier 411 fun builder(CFG) =
26 : monnier 469 let val NOBLOCK = CFG.newBlock(~1,ref 0)
27 : monnier 429 val currentBlock = ref NOBLOCK
28 : monnier 245 val newBlocks = ref [] : CFG.block list ref
29 : monnier 429 val entryLabels = ref [] : Label.label list ref
30 :     fun can'tUse _ = error "unimplemented"
31 : monnier 245 exception NotFound
32 : monnier 429 val labelMap = Intmap.new(32,NotFound)
33 : monnier 245 val newLabel = Intmap.add labelMap
34 : monnier 429 val CFG = ref CFG
35 :     val aliasF = ref can'tUse : (int * int -> unit) ref
36 : monnier 245
37 : monnier 411 fun init _ =
38 : monnier 429 (currentBlock := NOBLOCK;
39 : monnier 411 newBlocks := [];
40 : monnier 429 entryLabels := [];
41 : monnier 411 Intmap.clear labelMap;
42 : monnier 429 aliasF := can'tUse
43 : monnier 411 )
44 :    
45 :     val _ = init()
46 :    
47 : monnier 429 fun next cfg = CFG := cfg
48 : monnier 411
49 : monnier 245 fun newBlock() =
50 : monnier 429 let val G.GRAPH cfg = !CFG
51 :     val id = #new_id cfg ()
52 : monnier 469 val b = CFG.newBlock(id,ref 0)
53 : monnier 429 in currentBlock := b;
54 :     newBlocks := b :: !newBlocks;
55 :     #add_node cfg (id,b);
56 :     b
57 :     end
58 : monnier 245
59 :     fun getBlock() =
60 :     case !currentBlock of
61 : monnier 429 CFG.BLOCK{id= ~1,...} => newBlock()
62 :     | b => b
63 : monnier 245
64 :     fun newPseudoOpBlock() =
65 :     (case !currentBlock of
66 : monnier 429 CFG.BLOCK{id= ~1,...} => newBlock()
67 :     | b as CFG.BLOCK{insns=ref [],...} => b
68 : monnier 245 | _ => newBlock()
69 :     )
70 :    
71 :     fun insertOp p =
72 : monnier 429 let val CFG.BLOCK{data,...} = newPseudoOpBlock()
73 :     in data := !data @ [p] end
74 : monnier 245
75 : monnier 429 fun defineLabel(l as Label.Label{id=labelId,...}) =
76 :     let val CFG.BLOCK{id,labels,...} = newPseudoOpBlock()
77 :     in labels := l :: !labels;
78 :     newLabel(labelId,id)
79 :     end
80 : monnier 245
81 : monnier 429 fun entryLabel l = (defineLabel l; entryLabels := l :: !entryLabels)
82 :    
83 : monnier 245 fun pseudoOp p = insertOp(CFG.PSEUDO p)
84 :    
85 : monnier 429 fun annotation a =
86 :     let val CFG.BLOCK{annotations,...} = getBlock()
87 :     in annotations := a :: !annotations
88 :     end
89 :    
90 : monnier 245 fun exitBlock liveOut =
91 : monnier 429 let fun setLiveOut(CFG.BLOCK{annotations,...}) =
92 : monnier 469 annotations := #create CFG.LIVEOUT liveOut :: !annotations
93 : monnier 429 in case !currentBlock of
94 :     CFG.BLOCK{id= ~1,...} =>
95 :     (case !newBlocks of
96 :     [] => error "exitBlock"
97 :     | b::_ => setLiveOut b
98 :     )
99 :     | b => setLiveOut b
100 :     end
101 : monnier 245
102 : monnier 469 fun comment msg = annotation(#create BasicAnnotations.COMMENT msg)
103 : monnier 245
104 : monnier 429 fun emitInstr i =
105 :     let val CFG.BLOCK{insns,...} = getBlock()
106 :     in insns := i :: !insns;
107 :     if InsnProps.instrKind i = InsnProps.IK_JUMP then
108 :     currentBlock := NOBLOCK
109 :     else ()
110 : monnier 245 end
111 : monnier 411
112 : monnier 429 fun finish(annotations) =
113 :     let val G.GRAPH cfg = !CFG
114 :     val _ = CFG.init(!CFG) (* create entry/exit *)
115 :     val ENTRY = hd(#entries cfg ())
116 :     val EXIT = hd(#exits cfg ())
117 : monnier 245
118 : monnier 429 fun next(CFG.BLOCK{id,data=ref [],...}::_) = id
119 :     | next _ = error "next"
120 :     val lookupLabelMap = Intmap.mapWithDefault(labelMap,EXIT)
121 :     val TRUE = CFG.BRANCH true
122 :     val FALSE = CFG.BRANCH false
123 :     val addEdge = #add_edge cfg
124 :    
125 :     fun target(Label.Label{id,...}) = lookupLabelMap id
126 :    
127 : monnier 411 fun addEdges [] = ()
128 :     | addEdges(CFG.BLOCK{id,insns,...}::blocks) =
129 :     (case !insns of
130 :     [] => fallsThru(id,blocks)
131 :     | instr::_ =>
132 : monnier 429 if InsnProps.instrKind instr = InsnProps.IK_JUMP then
133 :     jump(id,InsnProps.branchTargets instr,blocks)
134 : monnier 411 else
135 :     fallsThru(id,blocks);
136 :     addEdges blocks
137 :     )
138 :     and fallsThru(i,CFG.BLOCK{id=j,data,...}::_) =
139 :     (case !data of
140 :     [] => ()
141 : monnier 429 | _ => error("falls thru into pseudo ops: "^
142 :     Int.toString i^" -> "^Int.toString j)
143 : monnier 411 ;
144 : monnier 429 addEdge(i,j,CFG.EDGE{k=CFG.FALLSTHRU,w=ref 0, a=ref []})
145 : monnier 411 )
146 :     | fallsThru(i,[]) =
147 : monnier 429 (* error("missing return in block "^Int.toString i) *)
148 :     addEdge(i,EXIT,CFG.EDGE{k=CFG.EXIT,w=ref 0,a=ref []})
149 :     and jump(i,[InsnProps.ESCAPES],_) =
150 :     addEdge(i,EXIT,CFG.EDGE{k=CFG.EXIT,w=ref 0,a=ref []})
151 :     | jump(i,[InsnProps.LABELLED L],_) =
152 :     addEdge(i,target L,CFG.EDGE{k=CFG.JUMP,w=ref 0,a=ref []})
153 :     | jump(i,[InsnProps.LABELLED L,InsnProps.FALLTHROUGH],bs) =
154 :     (addEdge(i,target L,CFG.EDGE{k=TRUE,w=ref 0,a=ref[]});
155 :     addEdge(i,next bs,CFG.EDGE{k=FALSE,w=ref 0,a=ref []})
156 : monnier 411 )
157 : monnier 429 | jump(i,[InsnProps.FALLTHROUGH,InsnProps.LABELLED L],bs) =
158 :     (addEdge(i,target L,CFG.EDGE{k=TRUE,w=ref 0,a=ref []});
159 :     addEdge(i,next bs,CFG.EDGE{k=FALSE,w=ref 0,a=ref []})
160 :     )
161 : monnier 411 | jump(i,targets,_) =
162 : monnier 429 let fun loop(n,[]) = ()
163 :     | loop(n,InsnProps.LABELLED L::targets) =
164 :     (addEdge(i,target L,
165 :     CFG.EDGE{k=CFG.SWITCH n,w=ref 0,a=ref []});
166 :     loop(n+1,targets))
167 :     | loop _ = error "jump"
168 :     in loop(0,targets) end
169 : monnier 411 in addEdges(rev(!newBlocks));
170 : monnier 429 app (fn l => addEdge(ENTRY,target l,
171 :     CFG.EDGE{k=CFG.ENTRY,a=ref [],w=ref 0}))
172 :     (!entryLabels);
173 :     CFG.setAnnotations(!CFG,annotations @ CFG.getAnnotations(!CFG));
174 : monnier 411 init()
175 :     end
176 :    
177 : monnier 429 fun beginGraph _ =
178 :     let val regmap = CFG.regmap(!CFG)
179 :     in init();
180 :     aliasF := Intmap.add regmap;
181 :     regmap
182 :     end
183 :    
184 :     fun alias(v,r) = !aliasF(v,r)
185 :    
186 : monnier 411 in {stream=S.STREAM
187 : monnier 429 { beginCluster= beginGraph,
188 :     endCluster = finish,
189 : monnier 411 defineLabel = defineLabel,
190 :     entryLabel = entryLabel,
191 :     pseudoOp = pseudoOp,
192 : monnier 429 emit = emitInstr,
193 : monnier 411 exitBlock = exitBlock,
194 :     comment = comment,
195 :     annotation = annotation,
196 : monnier 429 alias = alias,
197 :     phi = can'tUse
198 : monnier 411 },
199 :     next = next
200 :     }
201 : monnier 245 end
202 :    
203 :     end

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