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 499 - (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 :     val (blkCounter, regmap, annotations, blocks, entry, exit) =
37 :     case flowgraph of
38 :     SOME(F.CLUSTER{blkCounter, regmap, annotations, blocks,
39 :     entry, exit, ...}) =>
40 :     (ref(!blkCounter-2),
41 :     ref regmap, !annotations, ref(rev blocks),
42 :     entry, exit)
43 :     | NONE => (ref 0, ref(C.regmap()), [], ref [], NOBLOCK, NOBLOCK)
44 :    
45 :     val currBlock = ref NOBLOCK
46 :     val blockNames = ref [] : Annotations.annotations ref
47 :     val aliasF = ref (Intmap.add (!regmap))
48 :     val entryLabels = ref [] : Label.label list ref
49 :    
50 :     fun nextBlockNum() =
51 :     let val n = !blkCounter in blkCounter := n + 1; n end
52 :    
53 :     (* Create a new basic block *)
54 :     fun newBasicBlock insns =
55 :     let val n = !blkCounter
56 :     in blkCounter := n + 1;
57 :     F.BBLOCK{blknum = n,
58 :     freq = ref 1,
59 :     annotations = ref (!blockNames),
60 :     liveIn = ref C.empty,
61 :     liveOut = ref C.empty,
62 :     succ = ref [],
63 :     pred = ref [],
64 :     insns = ref insns
65 :     }
66 : monnier 409 end
67 :    
68 : monnier 498 (* Add current block to the list *)
69 :     fun endCurrBlock() =
70 :     case !currBlock of
71 :     blk as F.BBLOCK _ => (blocks := blk:: !blocks; currBlock := NOBLOCK)
72 :     | _ => ()
73 :    
74 :     (* Add pseudo op/label to the block list *)
75 :     fun blockListAdd b = (endCurrBlock(); blocks := b :: !blocks)
76 :     fun pseudoOp pOp = blockListAdd (F.PSEUDO pOp)
77 :     fun defineLabel lab = blockListAdd (F.LABEL lab)
78 :     fun entryLabel lab = (entryLabels := lab :: !entryLabels; defineLabel lab)
79 :    
80 :     (* Add an instruction to the current block *)
81 :     fun emit instr =
82 :     (case !currBlock of
83 :     F.BBLOCK{insns, ...} => insns := instr :: !insns
84 :     | _ => currBlock := newBasicBlock [instr]
85 :     ;
86 :     case InsnProps.instrKind instr of
87 :     InsnProps.IK_JUMP => (blocks := !currBlock :: !blocks;
88 :     currBlock := NOBLOCK)
89 :     | _ => ()
90 :     )
91 :    
92 :     (* Add an annotation *)
93 :     fun annotation a =
94 :     case #peek MLRiscAnnotations.BLOCK_NAMES a of
95 :     SOME names => (endCurrBlock(); blockNames := names)
96 :     | NONE => if #contains MLRiscAnnotations.EMPTY_BLOCK [a] then
97 :     (case !currBlock of
98 :     F.BBLOCK _ => ()
99 :     | _ => currBlock := newBasicBlock [];
100 :     endCurrBlock())
101 :     else (case !currBlock of
102 :     F.BBLOCK{annotations, ...} =>
103 :     annotations := a :: !annotations
104 :     | _ => (currBlock := newBasicBlock []; annotation a)
105 :     )
106 :    
107 :     (* Add a comment *)
108 :     fun comment msg = annotation(#create MLRiscAnnotations.COMMENT msg)
109 :    
110 :     (* Mark a block as exit *)
111 :     fun exitBlock liveRegs =
112 :     let val addCCreg = C.addCell C.CC
113 :     (* we don't care about memory locations that may be live. *)
114 :     fun live(T.GPR(T.REG(_,r))::rest, acc) = live(rest,C.addReg(r, acc))
115 :     | live(T.FPR(T.FREG(_,f))::rest, acc) = live(rest,C.addFreg(f, acc))
116 :     | live(T.CCR(T.CC c)::rest, acc) = live(rest, addCCreg(c, acc))
117 :     | live(_::rest, acc) = live(rest, acc)
118 :     | live([], acc) = acc
119 :    
120 :     fun findLiveOut(F.BBLOCK{liveOut, ...}::_) = liveOut
121 :     | findLiveOut(F.LABEL _::blks) = findLiveOut blks
122 :     | findLiveOut _ = error "exitBlock: no basic block"
123 :     in endCurrBlock();
124 :     findLiveOut (!blocks) := live(liveRegs, C.empty)
125 :     end
126 :    
127 :     (* Add an alias to the regmap *)
128 :     fun alias(v,r) = !aliasF(v,r)
129 :    
130 :     (* Start a new cluster *)
131 :     fun beginCluster _ = !regmap
132 :    
133 :     (* End a cluster *)
134 :     fun endCluster blockAnnotations =
135 :     let exception LabelMap
136 :     val labelMap : F.block Intmap.intmap = Intmap.new(16, LabelMap)
137 :     val addLabelMap = Intmap.add labelMap
138 :    
139 :     (* find the next code block *)
140 : monnier 409 fun nextCodeBlock((blk as F.BBLOCK _)::_) = blk
141 : monnier 498 | nextCodeBlock(_::blks) = nextCodeBlock blks
142 :     | nextCodeBlock [] = error "nextCodeBlock"
143 :    
144 :     fun fillLabelMap(F.LABEL(Label.Label{id, ...})::blks,ids) =
145 :     fillLabelMap(blks, id::ids)
146 :     | fillLabelMap((blk as F.BBLOCK _)::blks, ids) =
147 :     let fun loop [] = ()
148 :     | loop (id::ids) = (addLabelMap(id, blk); loop ids)
149 :     in loop ids; fillLabelMap(blks, []) end
150 :     | fillLabelMap(_::blks, ids) = fillLabelMap(blks, ids)
151 :     | fillLabelMap([], _) = ()
152 :    
153 :     val exitBlk =
154 :     case exit of
155 :     F.EXIT{freq, ...} =>
156 :     F.EXIT{blknum=nextBlockNum(), pred=ref [], freq=freq}
157 :     | _ => F.EXIT{blknum=nextBlockNum(), pred=ref [], freq=ref 1}
158 :    
159 :     val (entryBlk, entryEdges) =
160 :     case entry of
161 :     F.ENTRY{freq, succ, ...} =>
162 :     (F.ENTRY{blknum=nextBlockNum(), succ=succ, freq=freq},
163 :     succ)
164 :     | _ =>
165 :     let val edges = ref []
166 :     in (F.ENTRY{blknum=nextBlockNum(), succ=edges, freq=ref 1},
167 :     edges)
168 :     end
169 :    
170 :     val lookupLabelMap = Intmap.mapWithDefault (labelMap, exitBlk)
171 :    
172 :     fun addPred blk (F.BBLOCK{pred, ...}, w) = pred := (blk,w) :: !pred
173 :     | addPred blk (F.EXIT{pred, ...}, w) = pred := (blk,w) :: !pred
174 :     | addPred _ _ = error "addPred"
175 :    
176 :     (* Update successor and predecessor edges *)
177 :     fun insertGraphEdges [] = ()
178 :     | insertGraphEdges((blk as F.BBLOCK{blknum,insns,succ,...})::rest) =
179 :     let fun succBlocks([], succs) = succs
180 :     | succBlocks(InsnProps.FALLTHROUGH::labs, succs) =
181 :     succBlocks(labs, (nextCodeBlock rest, ref 0)::succs)
182 :     | succBlocks(InsnProps.LABELLED(Label.Label{id,...})::labs,
183 :     succs) =
184 :     succBlocks(labs, (lookupLabelMap id, ref 0)::succs)
185 :     | succBlocks(InsnProps.ESCAPES::labs, succs) =
186 :     succBlocks(labs, (exitBlk, ref 0)::succs)
187 :    
188 :     (* Is it the last code block *)
189 :     fun isLastCodeBlock(F.BBLOCK _::_) = false
190 :     | isLastCodeBlock(_::rest) = isLastCodeBlock rest
191 :     | isLastCodeBlock [] = true
192 :    
193 :     in case !insns of
194 :     lastInstr::_ =>
195 :     (case InsnProps.instrKind lastInstr of
196 :     InsnProps.IK_JUMP =>
197 :     succ := succBlocks
198 :     (InsnProps.branchTargets lastInstr,[])
199 :     | _ =>
200 :     if isLastCodeBlock rest then
201 :     succ := [(exitBlk, ref 0)]
202 :     (* control must escape via trap! *)
203 :     else succ := [(nextCodeBlock rest, ref 0)]
204 :     )
205 :     | [] => succ := [(nextCodeBlock rest, ref 0)]
206 :     ;
207 :     app (addPred blk) (!succ);
208 :     insertGraphEdges rest
209 : monnier 409 end
210 : monnier 498 | insertGraphEdges(_::rest) = insertGraphEdges rest
211 :    
212 :     (* And entry edges *)
213 :     fun insertEntryEdges() =
214 :     let val newEntryEdges =
215 :     map (fn Label.Label{id, ...} => (lookupLabelMap id,ref 0))
216 :     (!entryLabels)
217 :     in entryEdges := newEntryEdges @ !entryEdges;
218 :     app (addPred entryBlk) newEntryEdges
219 : monnier 409 end
220 : monnier 498
221 : monnier 409
222 : monnier 498 val _ = endCurrBlock()
223 :     val allBlocks = rev(!blocks)
224 : monnier 409
225 : monnier 498 (* clean up *)
226 :     val _ = blocks := []
227 :     val _ = blockNames := []
228 :    
229 :     (* fill in edges *)
230 :     val _ = fillLabelMap(allBlocks, [])
231 :     val _ = insertGraphEdges(allBlocks)
232 :     val _ = insertEntryEdges()
233 :    
234 :     (* create a new cluster *)
235 :     val cluster =
236 :     F.CLUSTER{blocks=allBlocks, entry=entryBlk, exit=exitBlk,
237 :     blkCounter=ref(!blkCounter), regmap= !regmap,
238 :     annotations=ref(blockAnnotations @ annotations)}
239 :    
240 :     (* reset regmap *)
241 :     val _ = blkCounter := 0
242 :     val _ = regmap := C.regmap()
243 :     val _ = aliasF := Intmap.add (!regmap)
244 :     val _ = entryLabels := []
245 :     in compile cluster
246 :     end
247 :    
248 :     in S.STREAM
249 :     { beginCluster = beginCluster,
250 :     endCluster = endCluster,
251 :     emit = emit,
252 :     defineLabel = defineLabel,
253 :     entryLabel = entryLabel,
254 :     pseudoOp = pseudoOp,
255 :     exitBlock = exitBlock,
256 :     annotation = annotation,
257 :     comment = comment,
258 :     alias = alias,
259 :     phi = can'tUse
260 : monnier 409 }
261 : monnier 498 end
262 : monnier 409
263 : monnier 498 end

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