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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 228 - (view) (download)

1 : monnier 221 (* flowgen.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     signature FLOWGRAPH_GEN = sig
8 :    
9 :     structure F : FLOWGRAPH
10 :     structure C : CELLS
11 :     structure I : INSTRUCTIONS
12 :     structure P : INSN_PROPERTIES
13 :     structure T : MLTREE
14 :     structure B : BLOCK_NAMES
15 :     structure Pu : PSEUDO_OPS
16 :    
17 :     sharing I.C = C
18 :     sharing F.I = P.I = I
19 :     sharing T.Constant = I.Constant
20 :     sharing T.PseudoOp = Pu
21 :    
22 :     val defineLabel : Label.label -> unit
23 :     (** define a label in the flowgraph **)
24 :    
25 :     val entryLabel : Label.label -> unit
26 :     (** define argument as being a label and entry point **)
27 :    
28 :     val pseudoOp : Pu.pseudo_op -> unit
29 :     (** create a pseudo op in the flowgraph **)
30 :    
31 :     val emitInstr : I.instruction -> unit
32 :     (** emitInstr - either creates a new BBLOCK or adds the instruction
33 :     ** to a BBLOCK that is being built locally.
34 :     ** If the instruction is a branch, then the successor labels
35 :     ** are noted in a hash table.
36 :     ** Uses: I.branchTargets, I.instrKind
37 :     **)
38 :    
39 :     val exitBlock : T.mlrisc list -> unit
40 :     (** exitBlock - associates the list of live registers with the last
41 :     ** code block. The last instruction is usually a branch
42 :     ** with no targets. If not it is assumed to be a label
43 :     ** that will be linked in at some later time. The call
44 :     ** to exitBlock had better reflect the correct list of live
45 :     ** registers that terminate the branch.
46 :     **)
47 :    
48 :     val endCluster : int Intmap.intmap -> unit
49 :     (** endCluster
50 :     ** cleans up all local references and tables.
51 :     ** creates the final flowgraph and calls the continuation.
52 :     **)
53 :    
54 :     val ordered : T.mltree list -> unit
55 :     (** ordered
56 :     ** creates an ordered list of pseudo-ops and labels, that
57 :     ** must be kept together always.
58 :     **)
59 :    
60 :     val blockName : B.name -> unit
61 :    
62 :     val beginCluster : unit -> unit
63 :     end
64 :    
65 :     functor FlowGraphGen
66 :     (structure Flowgraph : FLOWGRAPH
67 :     structure InsnProps : INSN_PROPERTIES
68 :     structure MLTree : MLTREE
69 :    
70 :     val codegen : Flowgraph.cluster -> unit
71 :     sharing Flowgraph.I = InsnProps.I
72 :     sharing MLTree.Constant = InsnProps.I.Constant
73 :     sharing MLTree.PseudoOp = Flowgraph.P
74 :     sharing Flowgraph.B = MLTree.BNames) : FLOWGRAPH_GEN =
75 :     struct
76 :    
77 :     structure F = Flowgraph
78 :     structure P = InsnProps
79 :     structure I = Flowgraph.I
80 :     structure C = I.C
81 :     structure T = MLTree
82 :     structure B = MLTree.BNames
83 :     structure Pu = T.PseudoOp
84 :    
85 :     type label = Label.label
86 :    
87 :     fun error msg = MLRiscErrorMsg.impossible ("FlowGraph." ^ msg)
88 :    
89 :     val bblkCnt = ref 0
90 :     val entryLabels = ref ([] : Label.label list)
91 :     val blkName = ref B.default
92 :     val currBlock : F.block option ref = ref NONE
93 :     val blockList : F.block list ref = ref []
94 :    
95 :     fun nextBlkNum () = !bblkCnt before bblkCnt := !bblkCnt + 1
96 :     fun blockName name =
97 :     (case !currBlock
98 :     of NONE => ()
99 :     | SOME blk =>
100 :     (currBlock := NONE; blockList := blk:: !blockList)
101 :     (*esac*);
102 :     blkName := name)
103 :    
104 :     (** Note - currBlock will always be a reference to a F.BLOCK{..} **)
105 :     fun newBasicBlk init =
106 :     F.BBLOCK{blknum=nextBlkNum(),
107 :     name= !blkName,
108 :     liveIn=ref C.empty,
109 :     liveOut=ref C.empty,
110 :     succ=ref [],
111 :     pred=ref [],
112 :     insns=ref init}
113 :     local
114 :     fun blockListAdd b = let
115 :     val blocks = !blockList
116 :     in
117 :     case !currBlock
118 :     of NONE => blockList := b::blocks
119 :     | SOME blk => (blockList:=b::blk::blocks; currBlock:=NONE)
120 :     end
121 :     in
122 :     fun pseudoOp pOp = blockListAdd (F.PSEUDO pOp)
123 :     fun defineLabel lab = blockListAdd(F.LABEL lab)
124 :     fun entryLabel lab =
125 :     (entryLabels := lab::(!entryLabels); blockListAdd(F.LABEL lab))
126 :     fun ordered(mlts) =
127 :     blockListAdd
128 :     (F.ORDERED(map (fn T.PSEUDO_OP pOp => F.PSEUDO pOp
129 :     | T.DEFINELABEL lab => F.LABEL lab
130 :     | T.ENTRYLABEL lab =>
131 :     (entryLabels := lab :: !entryLabels;
132 :     F.LABEL lab)
133 :     | _ => error "ordered ")
134 :     mlts))
135 :     end (*local*)
136 :    
137 :     (** emitInstr - instructions are always added to currBlock. **)
138 :     fun emitInstr instr = let
139 :     fun addInstr (NONE) = currBlock:=SOME(newBasicBlk [instr])
140 :     | addInstr (SOME(F.BBLOCK{insns, ...})) = insns := instr::(!insns)
141 :     in
142 :     addInstr(!currBlock);
143 :     case P.instrKind instr
144 :     of P.IK_JUMP =>
145 :     (blockList:= Option.valOf(!currBlock) :: (!blockList);
146 :     currBlock := NONE)
147 :     | _ => ()
148 :     (*esac*)
149 :     end
150 :    
151 :    
152 :     fun exitBlock liveRegs = let
153 :     val addReg = C.addCell C.GP
154 :     val addFreg = C.addCell C.FP
155 :     val addCCreg = C.addCell C.CC
156 :     (* we don't care about memory locations that may be live. *)
157 :     fun live(T.GPR(T.REG r)::rest, acc) = live(rest, addReg(r, acc))
158 :     | live(T.FPR(T.FREG f)::rest, acc) = live(rest, addFreg(f, acc))
159 :     | live(T.CCR(T.CC c)::rest, acc) = live(rest, addCCreg(c, acc))
160 :     | live(_::rest, acc) = live(rest, acc)
161 :     | live([], acc) = acc
162 :    
163 :     val lout = live(liveRegs, C.empty)
164 :    
165 :     fun findCodeBlock(F.BBLOCK{liveOut,...}::_) = liveOut
166 :     | findCodeBlock(F.LABEL _::blks) = findCodeBlock blks
167 :     | findCodeBlock _ = error "exitBlock.codeBlock"
168 :    
169 :     in
170 :     case !currBlock
171 :     of NONE => let
172 :     val outRef = findCodeBlock (!blockList)
173 :     in outRef := lout
174 :     end
175 :     | SOME(F.BBLOCK{liveOut, ...}) =>
176 :     (liveOut := lout;
177 :     blockList := Option.valOf(!currBlock) :: (!blockList);
178 :     currBlock := NONE)
179 :     | _ => error "exitBlock"
180 :     (*esac*)
181 :     end
182 :    
183 :     fun endCluster(regmap) = let
184 :     exception LabTbl
185 :     val labTbl : F.block Intmap.intmap = Intmap.new(16, LabTbl)
186 :     val addLabTbl = Intmap.add labTbl
187 :     val lookupLabTbl = Intmap.map labTbl
188 :    
189 :     (* find next code block *)
190 :     exception NextCodeBlock
191 :     fun nextCodeBlock((blk as F.BBLOCK _)::_) = blk
192 :     | nextCodeBlock(_::rest) = nextCodeBlock rest
193 :     | nextCodeBlock [] = raise NextCodeBlock
194 :    
195 :     (* mapping of labels to code blocks *)
196 :     fun fillLabTbl(F.LABEL lab::blks) =
197 :     (addLabTbl(Label.id lab, nextCodeBlock blks)
198 :     handle NextCodeBlock => ();
199 :     fillLabTbl blks)
200 :     | fillLabTbl(F.ORDERED labs::blks) = fillLabTbl(labs@blks)
201 :     | fillLabTbl(_::blks) = fillLabTbl(blks)
202 :     | fillLabTbl [] = ()
203 :    
204 :     val exitBlk = F.EXIT{blknum=nextBlkNum(), pred=ref []}
205 :    
206 :     (** update successor and predecessor information **)
207 :     fun graphEdges((blk as F.BBLOCK{blknum,insns,succ,...})::blks) = let
208 :     fun updtPred(F.BBLOCK{pred, ...}) = pred := blk :: (!pred)
209 :     | updtPred(F.EXIT{pred, ...}) = pred := blk :: (!pred)
210 :    
211 :     fun succBlks([], acc) = acc
212 :     | succBlks(P.FALLTHROUGH::labs, acc) =
213 :     ((succBlks(labs, nextCodeBlock blks::acc))
214 :     handle NextCodeBlock => error "graphEdges.succBlks")
215 :     | succBlks(P.LABELLED lab::labs, acc) =
216 :     ((succBlks(labs, lookupLabTbl(Label.id lab)::acc))
217 :     handle LabTbl =>
218 :     succBlks(labs, exitBlk::acc))
219 :     | succBlks(P.ESCAPES::labs,acc) =
220 :     succBlks(labs, exitBlk::acc)
221 :    
222 :     val lastInstr = ((hd (!insns))
223 :     handle _ => error "endCluster.graphEdges.lastInstr")
224 :    
225 :     fun lastCodeBlock(F.BBLOCK _ :: _) = false
226 :     | lastCodeBlock(_::rest) = lastCodeBlock rest
227 :     | lastCodeBlock [] = true
228 :     in
229 :     case P.instrKind lastInstr
230 :     of P.IK_JUMP => succ:=succBlks (P.branchTargets lastInstr,[])
231 :     | _ =>
232 :     if lastCodeBlock blks then
233 :     succ := [exitBlk] (* control must escape via trap *)
234 :     else succ := [nextCodeBlock blks]
235 :     (*esac*);
236 :     app updtPred (!succ);
237 :     graphEdges(blks)
238 :     end
239 :     | graphEdges(_::blks) = graphEdges(blks)
240 :     | graphEdges [] = ()
241 :    
242 :     fun mkEntryBlock () = let
243 :     val blocks = map (lookupLabTbl o Label.id) (!entryLabels)
244 :     val entryBlk = F.ENTRY{blknum=nextBlkNum(), succ=ref blocks}
245 :     in
246 :     app (fn (F.BBLOCK{pred, ...}) => pred := entryBlk::(!pred)) blocks;
247 :     entryBlk
248 :     end
249 :    
250 :     val _ = case !currBlock
251 :     of NONE => ()
252 :     | SOME blk => blockList := blk :: !blockList
253 :    
254 :     val blocks = rev(!blockList) before blockList := []
255 :     val _ = fillLabTbl(blocks)
256 :     val _ = graphEdges(blocks)
257 :     in
258 :     codegen (F.CLUSTER{blocks=blocks, entry=mkEntryBlock(), exit=exitBlk,
259 :     blkCounter=ref(!bblkCnt), regmap=regmap})
260 :     end
261 :    
262 :     fun beginCluster _ =
263 :     (entryLabels := [];
264 :     bblkCnt := 0;
265 :     blkName := B.default;
266 :     currBlock := NONE)
267 :     end
268 :    
269 :     (*
270 :     * $Log: flowgen.sml,v $
271 :     * Revision 1.4 1998/07/25 03:08:17 george
272 :     * added to support block names in MLRISC
273 :     *
274 :     * Revision 1.3 1998/05/25 15:11:03 george
275 :     * Fixed RCS keywords
276 :     *
277 :     *)

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