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/cluster/clustergen.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/cluster/clustergen.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 545 - (view) (download)

1 : monnier 409 (* flowgen.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     functor ClusterGen
8 :     (structure Flowgraph : FLOWGRAPH
9 :     structure InsnProps : INSN_PROPERTIES
10 :     structure MLTree : MLTREE
11 :     sharing Flowgraph.I = InsnProps.I
12 :     sharing MLTree.Constant = InsnProps.I.Constant
13 : monnier 429 sharing MLTree.PseudoOp = Flowgraph.P
14 : monnier 409 ) : FLOWGRAPH_GEN =
15 :     struct
16 :    
17 :     structure F = Flowgraph
18 :     structure I = Flowgraph.I
19 :     structure C = I.C
20 :    
21 :     structure T = MLTree
22 :     structure P = T.PseudoOp
23 : monnier 429 structure S = T.Stream
24 : monnier 409
25 :     fun error msg = MLRiscErrorMsg.error("ClusterGen",msg)
26 :    
27 : monnier 498 fun can'tUse _ = error "unimplemented"
28 :    
29 : monnier 409 type flowgraph = F.cluster
30 :    
31 : monnier 498 (* This rewritten version allows increment flowgraph updates *)
32 : monnier 475
33 : monnier 498 fun newStream{compile,flowgraph} =
34 :     let val NOBLOCK = F.LABEL(Label.Label{id= ~1, name="", addr=ref 0})
35 :    
36 : george 545 val freq = 1
37 :    
38 : monnier 498 val (blkCounter, regmap, annotations, blocks, entry, exit) =
39 :     case flowgraph of
40 :     SOME(F.CLUSTER{blkCounter, regmap, annotations, blocks,
41 :     entry, exit, ...}) =>
42 :     (ref(!blkCounter-2),
43 :     ref regmap, !annotations, ref(rev blocks),
44 :     entry, exit)
45 :     | NONE => (ref 0, ref(C.regmap()), [], ref [], NOBLOCK, NOBLOCK)
46 :    
47 :     val currBlock = ref NOBLOCK
48 :     val blockNames = ref [] : Annotations.annotations ref
49 :     val aliasF = ref (Intmap.add (!regmap))
50 :     val entryLabels = ref [] : Label.label list ref
51 :    
52 :     fun nextBlockNum() =
53 :     let val n = !blkCounter in blkCounter := n + 1; n end
54 :    
55 :     (* Create a new basic block *)
56 :     fun newBasicBlock insns =
57 :     let val n = !blkCounter
58 :     in blkCounter := n + 1;
59 :     F.BBLOCK{blknum = n,
60 : george 545 freq = ref freq,
61 : monnier 498 annotations = ref (!blockNames),
62 :     liveIn = ref C.empty,
63 :     liveOut = ref C.empty,
64 :     succ = ref [],
65 :     pred = ref [],
66 :     insns = ref insns
67 :     }
68 : monnier 409 end
69 :    
70 : monnier 498 (* Add current block to the list *)
71 :     fun endCurrBlock() =
72 :     case !currBlock of
73 :     blk as F.BBLOCK _ => (blocks := blk:: !blocks; currBlock := NOBLOCK)
74 :     | _ => ()
75 :    
76 :     (* Add pseudo op/label to the block list *)
77 :     fun blockListAdd b = (endCurrBlock(); blocks := b :: !blocks)
78 :     fun pseudoOp pOp = blockListAdd (F.PSEUDO pOp)
79 :     fun defineLabel lab = blockListAdd (F.LABEL lab)
80 :     fun entryLabel lab = (entryLabels := lab :: !entryLabels; defineLabel lab)
81 :    
82 :     (* Add an instruction to the current block *)
83 :     fun emit instr =
84 :     (case !currBlock of
85 :     F.BBLOCK{insns, ...} => insns := instr :: !insns
86 :     | _ => currBlock := newBasicBlock [instr]
87 :     ;
88 :     case InsnProps.instrKind instr of
89 :     InsnProps.IK_JUMP => (blocks := !currBlock :: !blocks;
90 :     currBlock := NOBLOCK)
91 :     | _ => ()
92 :     )
93 :    
94 :     (* Add an annotation *)
95 :     fun annotation a =
96 :     case #peek MLRiscAnnotations.BLOCK_NAMES a of
97 :     SOME names => (endCurrBlock(); blockNames := names)
98 : george 545 | NONE =>
99 :     (if #contains MLRiscAnnotations.EMPTY_BLOCK [a] then
100 :     (case !currBlock of
101 :     F.BBLOCK _ => ()
102 :     | _ => currBlock := newBasicBlock [];
103 :     endCurrBlock())
104 :     else
105 :     (case #peek MLRiscAnnotations.EXECUTION_FREQ a of
106 :     SOME f =>
107 :     (case !currBlock of
108 :     F.BBLOCK{freq, ...} => freq := f
109 :     | _ => (currBlock := newBasicBlock []; annotation a)
110 :     )
111 :     | NONE =>
112 :     (case !currBlock of
113 :     F.BBLOCK{annotations, ...} =>
114 :     annotations := a :: !annotations
115 :     | _ => (currBlock := newBasicBlock []; annotation a)
116 :     )
117 :     )
118 :     )
119 :    
120 : monnier 498 (* Add a comment *)
121 :     fun comment msg = annotation(#create MLRiscAnnotations.COMMENT msg)
122 :    
123 :     (* Mark a block as exit *)
124 : george 545 fun exitBlock cellset =
125 :     let fun findLiveOut(F.BBLOCK{liveOut, ...}::_) = liveOut
126 : monnier 498 | findLiveOut(F.LABEL _::blks) = findLiveOut blks
127 :     | findLiveOut _ = error "exitBlock: no basic block"
128 :     in endCurrBlock();
129 : george 545 findLiveOut (!blocks) := cellset
130 : monnier 498 end
131 :    
132 :     (* Add an alias to the regmap *)
133 :     fun alias(v,r) = !aliasF(v,r)
134 :    
135 :     (* Start a new cluster *)
136 :     fun beginCluster _ = !regmap
137 :    
138 :     (* End a cluster *)
139 :     fun endCluster blockAnnotations =
140 :     let exception LabelMap
141 :     val labelMap : F.block Intmap.intmap = Intmap.new(16, LabelMap)
142 :     val addLabelMap = Intmap.add labelMap
143 :    
144 :     (* find the next code block *)
145 : monnier 409 fun nextCodeBlock((blk as F.BBLOCK _)::_) = blk
146 : monnier 498 | nextCodeBlock(_::blks) = nextCodeBlock blks
147 :     | nextCodeBlock [] = error "nextCodeBlock"
148 :    
149 :     fun fillLabelMap(F.LABEL(Label.Label{id, ...})::blks,ids) =
150 :     fillLabelMap(blks, id::ids)
151 :     | fillLabelMap((blk as F.BBLOCK _)::blks, ids) =
152 :     let fun loop [] = ()
153 :     | loop (id::ids) = (addLabelMap(id, blk); loop ids)
154 :     in loop ids; fillLabelMap(blks, []) end
155 :     | fillLabelMap(_::blks, ids) = fillLabelMap(blks, ids)
156 :     | fillLabelMap([], _) = ()
157 :    
158 :     val exitBlk =
159 :     case exit of
160 :     F.EXIT{freq, ...} =>
161 :     F.EXIT{blknum=nextBlockNum(), pred=ref [], freq=freq}
162 : george 545 | _ => F.EXIT{blknum=nextBlockNum(), pred=ref [], freq=ref freq}
163 : monnier 498
164 :     val (entryBlk, entryEdges) =
165 :     case entry of
166 :     F.ENTRY{freq, succ, ...} =>
167 :     (F.ENTRY{blknum=nextBlockNum(), succ=succ, freq=freq},
168 :     succ)
169 :     | _ =>
170 :     let val edges = ref []
171 : george 545 in (F.ENTRY{blknum=nextBlockNum(), succ=edges, freq=ref freq},
172 : monnier 498 edges)
173 :     end
174 :    
175 :     val lookupLabelMap = Intmap.mapWithDefault (labelMap, exitBlk)
176 :    
177 :     fun addPred blk (F.BBLOCK{pred, ...}, w) = pred := (blk,w) :: !pred
178 :     | addPred blk (F.EXIT{pred, ...}, w) = pred := (blk,w) :: !pred
179 :     | addPred _ _ = error "addPred"
180 :    
181 :     (* Update successor and predecessor edges *)
182 :     fun insertGraphEdges [] = ()
183 :     | insertGraphEdges((blk as F.BBLOCK{blknum,insns,succ,...})::rest) =
184 :     let fun succBlocks([], succs) = succs
185 :     | succBlocks(InsnProps.FALLTHROUGH::labs, succs) =
186 :     succBlocks(labs, (nextCodeBlock rest, ref 0)::succs)
187 :     | succBlocks(InsnProps.LABELLED(Label.Label{id,...})::labs,
188 :     succs) =
189 :     succBlocks(labs, (lookupLabelMap id, ref 0)::succs)
190 :     | succBlocks(InsnProps.ESCAPES::labs, succs) =
191 :     succBlocks(labs, (exitBlk, ref 0)::succs)
192 :    
193 :     (* Is it the last code block *)
194 :     fun isLastCodeBlock(F.BBLOCK _::_) = false
195 :     | isLastCodeBlock(_::rest) = isLastCodeBlock rest
196 :     | isLastCodeBlock [] = true
197 :    
198 :     in case !insns of
199 :     lastInstr::_ =>
200 :     (case InsnProps.instrKind lastInstr of
201 :     InsnProps.IK_JUMP =>
202 :     succ := succBlocks
203 :     (InsnProps.branchTargets lastInstr,[])
204 :     | _ =>
205 :     if isLastCodeBlock rest then
206 :     succ := [(exitBlk, ref 0)]
207 :     (* control must escape via trap! *)
208 :     else succ := [(nextCodeBlock rest, ref 0)]
209 :     )
210 :     | [] => succ := [(nextCodeBlock rest, ref 0)]
211 :     ;
212 :     app (addPred blk) (!succ);
213 :     insertGraphEdges rest
214 : monnier 409 end
215 : monnier 498 | insertGraphEdges(_::rest) = insertGraphEdges rest
216 :    
217 :     (* And entry edges *)
218 :     fun insertEntryEdges() =
219 :     let val newEntryEdges =
220 :     map (fn Label.Label{id, ...} => (lookupLabelMap id,ref 0))
221 :     (!entryLabels)
222 :     in entryEdges := newEntryEdges @ !entryEdges;
223 :     app (addPred entryBlk) newEntryEdges
224 : monnier 409 end
225 : monnier 498
226 : monnier 409
227 : monnier 498 val _ = endCurrBlock()
228 :     val allBlocks = rev(!blocks)
229 : monnier 409
230 : monnier 498 (* clean up *)
231 :     val _ = blocks := []
232 :     val _ = blockNames := []
233 :    
234 :     (* fill in edges *)
235 :     val _ = fillLabelMap(allBlocks, [])
236 :     val _ = insertGraphEdges(allBlocks)
237 :     val _ = insertEntryEdges()
238 :    
239 :     (* create a new cluster *)
240 :     val cluster =
241 :     F.CLUSTER{blocks=allBlocks, entry=entryBlk, exit=exitBlk,
242 :     blkCounter=ref(!blkCounter), regmap= !regmap,
243 :     annotations=ref(blockAnnotations @ annotations)}
244 :    
245 :     (* reset regmap *)
246 : george 545 val _ = blkCounter := 0
247 : monnier 498 val _ = regmap := C.regmap()
248 :     val _ = aliasF := Intmap.add (!regmap)
249 :     val _ = entryLabels := []
250 :     in compile cluster
251 :     end
252 :    
253 :     in S.STREAM
254 :     { beginCluster = beginCluster,
255 :     endCluster = endCluster,
256 :     emit = emit,
257 :     defineLabel = defineLabel,
258 :     entryLabel = entryLabel,
259 :     pseudoOp = pseudoOp,
260 :     exitBlock = exitBlock,
261 :     annotation = annotation,
262 :     comment = comment,
263 :     alias = alias,
264 :     phi = can'tUse
265 : monnier 409 }
266 : monnier 498 end
267 : monnier 409
268 : monnier 498 end

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