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/compiler/CodeGen/main/mlriscGen.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/CodeGen/main/mlriscGen.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 590 - (view) (download)

1 : monnier 429 (* mlriscGenNew.sml --- translate CPS to MLRISC.
2 :     *
3 :     * This version of MLRiscGen also injects GC types to the MLRISC backend.
4 :     * I've also reorganized it a bit and added a few comments
5 :     * so that I can understand it.
6 : monnier 247 *
7 :     * COPYRIGHT (c) 1996 AT&T Bell Laboratories.
8 :     *
9 :     *)
10 :    
11 : monnier 429 signature MLRISCGEN =
12 :     sig
13 : monnier 247 val codegen :
14 :     CPS.function list * (CPS.lvar -> (int * int)) * ErrorMsg.complainer -> unit
15 :     end
16 :    
17 :     functor MLRiscGen
18 :     ( structure MachineSpec: MACH_SPEC
19 :     structure PseudoOp : SMLNJ_PSEUDO_OP_TYPE
20 : leunga 585 structure C : CPSREGS where T.Region = CPSRegions
21 :     and T.Constant = SMLNJConstant
22 :     structure InvokeGC : INVOKE_GC where T = C.T
23 :     structure MLTreeComp : MLTREECOMP where T = C.T
24 :     structure Flowgen : FLOWGRAPH_GEN where T = C.T
25 :     structure Cells : CELLS
26 :     sharing C.T.PseudoOp = PseudoOp
27 :     sharing Flowgen.I = MLTreeComp.I
28 : monnier 498 val compile : Flowgen.flowgraph -> unit
29 : leunga 585 ) : MLRISCGEN =
30 : monnier 247 struct
31 :    
32 : leunga 585 structure M = C.T (* MLTree *)
33 :     structure P = CPS.P (* CPS primitive operators *)
34 :     structure LE = M.LabelExp (* Label Expression *)
35 :     structure R = CPSRegions (* Regions *)
36 : leunga 590 structure PT = R.PT (* PointsTo *)
37 : leunga 585 structure CG = Control.CG (* Compiler Control *)
38 :     structure MS = MachineSpec (* Machine Specification *)
39 :     structure D = MS.ObjDesc (* ML Object Descriptors *)
40 : monnier 247
41 : leunga 585 structure ArgP = (* Argument passing *)
42 : monnier 247 ArgPassing(structure Cells=Cells
43 : monnier 429 structure C=C
44 :     structure MS=MachineSpec)
45 : monnier 247
46 : leunga 585 structure Frag = Frag(M) (* Decompose a compilation unit into clusters *)
47 : monnier 247
48 : leunga 585 structure MemAliasing = MemAliasing(Cells) (* Memory aliasing *)
49 :    
50 :     fun error msg = MLRiscErrorMsg.error("MLRiscGen", msg)
51 : monnier 247
52 : leunga 585 (*
53 :     * Debugging
54 :     *)
55 :     fun printCPSFun cps =
56 :     (Control.Print.say "*********************************************** \n";
57 :     PPCps.printcps0 cps;
58 :     Control.Print.say "*********************************************** \n";
59 :     Control.Print.flush()
60 :     )
61 :     val print = Control.Print.say
62 :    
63 :    
64 : monnier 429 (*
65 :     * GC Safety
66 :     *)
67 : leunga 585 structure GCCells = (* How to annotate GC information *)
68 : monnier 429 GCCells(structure C = Cells
69 : monnier 475 structure GCMap = SMLGCMap)
70 : monnier 247
71 : monnier 498 val I31 = SMLGCType.I31 (* tagged integers *)
72 :     val I32 = SMLGCType.I32 (* untagged integers *)
73 :     val REAL64 = SMLGCType.REAL64 (* untagged floats *)
74 :     val PTR = SMLGCType.PTR (* boxed objects *)
75 : leunga 585 val NO_OPT = [#create MLRiscAnnotations.NO_OPTIMIZATION ()]
76 : monnier 429
77 : leunga 585 val enterGC = ref (fn _ => error "enterGC") :
78 :     (int * SMLGCType.gctype -> unit) ref
79 :    
80 :     val ptr = #create MLRiscAnnotations.MARK_REG(fn r => !enterGC(r,PTR))
81 :     val i32 = #create MLRiscAnnotations.MARK_REG(fn r => !enterGC(r,I32))
82 :     val i31 = #create MLRiscAnnotations.MARK_REG(fn r => !enterGC(r,I32))
83 :     val flt = #create MLRiscAnnotations.MARK_REG(fn r => !enterGC(r,REAL64))
84 :     fun ctyToAnn CPS.INTt = i31
85 :     | ctyToAnn CPS.INT32t = i32
86 :     | ctyToAnn CPS.FLTt = flt
87 :     | ctyToAnn _ = ptr
88 :    
89 : george 546 (*
90 :     * Convert kind to gc type
91 :     *)
92 : leunga 585 fun kindToGCty(CPS.P.INT 31) = I31
93 :     | kindToGCty(CPS.P.UINT 31) = I31
94 :     | kindToGCty(_) = I32
95 : george 546
96 : leunga 585 fun ctyToGCty(CPS.FLTt) = REAL64
97 :     | ctyToGCty(CPS.INTt) = I31
98 :     | ctyToGCty(CPS.INT32t) = I32
99 :     | ctyToGCty _ = PTR
100 :    
101 : monnier 429 (*
102 :     * These are the type widths of ML. They are hardwired for now.
103 :     *)
104 :     val pty = 32 (* size of ML's pointer *)
105 :     val ity = 32 (* size of ML's integer *)
106 :     val fty = 64 (* size of ML's real number *)
107 : monnier 247
108 : leunga 585 val zero = M.LI 0
109 :     val one = M.LI 1
110 :     val two = M.LI 2
111 :     val mlZero = M.LI 1
112 :     val offp0 = CPS.OFFp 0
113 :    
114 : monnier 429 (*
115 : leunga 585 * The allocation pointer. This must be a register
116 : monnier 429 *)
117 : monnier 411 val M.REG(_,allocptrR) = C.allocptr
118 : monnier 247
119 : monnier 429 (*
120 :     * Dedicated registers.
121 :     *)
122 : george 555 val dedicated' =
123 : monnier 411 map (fn r => M.GPR(M.REG(ity,r))) C.dedicatedR @
124 :     map (fn f => M.FPR(M.FREG(fty,f))) C.dedicatedF
125 : monnier 429
126 : monnier 247 val dedicated =
127 : monnier 429 case C.exhausted of NONE => dedicated'
128 :     | SOME cc => M.CCR cc :: dedicated'
129 : monnier 247
130 : leunga 585 (*
131 :     * This flag controls whether extra MLRISC optimizations should be
132 :     * performed. By default, this is off.
133 :     *)
134 : monnier 498 val mlrisc = Control.MLRISC.getFlag "mlrisc"
135 :    
136 : monnier 429 (*
137 :     * If this flag is on then annotate the registers with GC type info.
138 :     * Otherwise use the default behavior.
139 :     *)
140 : george 546 val gctypes = Control.MLRISC.getFlag "mlrisc-gc-types"
141 :    
142 :     (*
143 :     * If this flag is on then perform optimizations before generating gc code.
144 :     * If this flag is on then gctypes must also be turned on!
145 :     * Otherwise use the default behavior.
146 :     *)
147 : monnier 429 val gcsafety = Control.MLRISC.getFlag "mlrisc-gcsafety"
148 : monnier 411
149 : monnier 429 (*
150 : monnier 475 * If this flag is on then split the entry block.
151 :     * This should be on for SSA optimizations.
152 : monnier 429 *)
153 : monnier 475 val splitEntry = Control.MLRISC.getFlag "split-entry-block"
154 : monnier 247
155 : monnier 429 (*
156 : monnier 475 * This dummy annotation is used to get an empty block
157 :     *)
158 : monnier 498 val EMPTY_BLOCK = #create MLRiscAnnotations.EMPTY_BLOCK ()
159 : george 546
160 : monnier 475 (*
161 : leunga 585 * convert object descriptor to int
162 : monnier 429 *)
163 : leunga 585 val dtoi = LargeWord.toInt
164 :    
165 :     (*
166 :     * The mltree stream
167 :     *)
168 :     val stream as M.Stream.STREAM
169 : monnier 429 { beginCluster, (* start a cluster *)
170 :     endCluster, (* end a cluster *)
171 :     emit, (* emit MLTREE stm *)
172 :     alias, (* generate register alias *)
173 :     defineLabel, (* define a local label *)
174 :     entryLabel, (* define an external entry *)
175 :     exitBlock, (* mark the end of a procedure *)
176 :     pseudoOp, (* emit a pseudo op *)
177 : monnier 475 annotation, (* add an annotation *)
178 : monnier 429 ... } =
179 : monnier 498 MLTreeComp.selectInstructions
180 : george 555 (Flowgen.newStream{compile=compile, flowgraph=NONE})
181 : leunga 585
182 :     (*
183 :     * The main codegen function.
184 :     *)
185 :     fun codegen(funcs : CPS.function list, limits:CPS.lvar -> (int*int), err) =
186 :     let
187 : monnier 429 val maxAlloc = #1 o limits
188 : monnier 475 val splitEntry = !splitEntry
189 : monnier 247
190 : monnier 429 (*
191 :     * The natural address arithmetic width of the architecture.
192 :     * For most architecture this is 32 but for the Alpha this is 64,
193 :     * since 64-bit address arithmetic is more efficiently implemented
194 :     * on the Alpha.
195 : monnier 247 *)
196 : monnier 429 val addrTy = C.addressWidth
197 : monnier 247
198 : monnier 429 (*
199 : leunga 585 * These functions generate new virtual register names and
200 :     * mark expressions with their gc types.
201 : monnier 429 * When the gc-safety feature is turned on, we'll use the
202 :     * versions of newReg that automatically update the GCMap.
203 :     * Otherwise, we'll just use the normal version.
204 : monnier 247 *)
205 : george 546 val gctypes = !gctypes
206 : leunga 586
207 :     val _ = if gctypes then
208 :     let val gcMap = GCCells.newGCMap()
209 :     in enterGC := Intmap.add gcMap;
210 :     GCCells.setGCMap gcMap
211 :     end
212 :     else ()
213 :    
214 : leunga 585 val (newReg, newRegWithCty, newRegWithKind, newFreg) =
215 :     if gctypes then
216 :     let val newReg = GCCells.newCell Cells.GP
217 :     val newFreg = GCCells.newCell Cells.FP
218 :     fun newRegWithCty cty = newReg(ctyToGCty cty)
219 :     fun newRegWithKind kind = newReg(kindToGCty kind)
220 :     in (newReg, newRegWithCty, newRegWithKind, newFreg) end
221 :     else (Cells.newReg, Cells.newReg, Cells.newReg, Cells.newFreg)
222 :    
223 :     fun markPTR e = if gctypes then M.MARK(e,ptr) else e
224 :     fun markI32 e = if gctypes then M.MARK(e,i32) else e
225 :     fun markFLT e = if gctypes then M.FMARK(e,flt) else e
226 :     fun markGC(e,cty) = if gctypes then M.MARK(e,ctyToAnn cty) else e
227 : george 546 fun markNothing e = e
228 : monnier 247
229 : monnier 498 (*
230 :     * Known functions have parameters passed in fresh temporaries.
231 :     * We also annotate the gc types of these temporaries.
232 :     *)
233 :     fun known [] = []
234 :     | known(cty::rest) =
235 :     (case cty of
236 : leunga 585 CPS.FLTt => M.FPR(M.FREG(fty,newFreg REAL64))
237 :     | CPS.INTt => M.GPR(M.REG(ity,newReg I31))
238 :     | CPS.INT32t => M.GPR(M.REG(ity,newReg I32))
239 :     | _ => M.GPR(M.REG(pty,newReg PTR))
240 : monnier 498 )::known rest
241 : monnier 247
242 : leunga 585 (*
243 :     * labelTbl is a mapping of function names (CPS.lvars) to labels.
244 :     * If the flag splitEntry is on, we also distinguish between external and
245 :     * internal labels, make sure that no directly branches go to the
246 :     * external labels.
247 :     *)
248 : monnier 429 exception LabelBind and TypTbl
249 :     val labelTbl : Label.label Intmap.intmap = Intmap.new(32, LabelBind)
250 :     val functionLabel = Intmap.map labelTbl
251 :     val addLabelTbl = Intmap.add labelTbl
252 : monnier 247
253 : leunga 585 (*
254 :     * typTbl is a mapping of CPS.lvars to CPS types
255 :     *)
256 : monnier 429 val typTbl : CPS.cty Intmap.intmap = Intmap.new(32, TypTbl)
257 :     val addTypBinding = Intmap.add typTbl
258 :     val typmap = Intmap.map typTbl
259 : monnier 411
260 : leunga 585 (*
261 :     * mkGlobalTables define the labels and cty for all CPS functions
262 :     *)
263 : monnier 429 fun mkGlobalTables(fk, f, _, _, _) =
264 : monnier 475 ((* internal label *)
265 :     addLabelTbl (f, Label.newLabel "");
266 :     (* external entry label *)
267 :     if splitEntry then
268 :     (case fk of
269 :     (CPS.CONT | CPS.ESCAPE) =>
270 :     addLabelTbl (~f-1, Label.newLabel(Int.toString f))
271 :     | _ => ()
272 :     )
273 :     else ();
274 : monnier 429 case fk
275 :     of CPS.CONT => addTypBinding(f, CPS.CNTt)
276 :     | _ => addTypBinding(f, CPS.BOGt)
277 :     (*esac*))
278 : monnier 247
279 : monnier 429 (*
280 :     * This is the GC comparison test used. We have a choice of signed
281 :     * and unsigned comparisons. This usually doesn't matter, but some
282 :     * architectures work better in one way or the other, so we are given
283 : leunga 585 * a choice here. For example, the Alpha has to do extra for unsigned
284 :     * tests, so on the Alpha we use signed tests.
285 : monnier 247 *)
286 : monnier 429 val gcTest = M.CMP(pty, if C.signedGCTest then M.GT else M.GTU,
287 :     C.allocptr, C.limitptr)
288 : monnier 498
289 : monnier 429 (*
290 :     * Function for generating code for one cluster.
291 : monnier 247 *)
292 : monnier 429 fun genCluster(cluster) =
293 :     let val _ = if !Control.debugging then app PPCps.printcps0 cluster else ()
294 :     val clusterSize = length cluster
295 : monnier 247
296 : monnier 429 (* per-cluster tables *)
297 :     exception RegMap and GenTbl
298 : leunga 585
299 : monnier 429 (*
300 :     * genTbl -- is used to retrieve the parameter passing
301 :     * conventions once a function has been compiled.
302 :     *)
303 :     val genTbl : Frag.frag Intmap.intmap = Intmap.new(clusterSize, GenTbl)
304 :     val addGenTbl = Intmap.add genTbl
305 :     val lookupGenTbl = Intmap.map genTbl
306 : monnier 247
307 : monnier 429 (*
308 :     * {fp,gp}RegTbl -- mapping of lvars to registers
309 :     *)
310 : george 555 val fpRegTbl : M.fexp Intmap.intmap = Intmap.new(2, RegMap)
311 :     val gpRegTbl : M.rexp Intmap.intmap = Intmap.new(32, RegMap)
312 : monnier 429 val addExpBinding = Intmap.add gpRegTbl
313 :     fun addRegBinding(x,r) = addExpBinding(x,M.REG(ity,r))
314 :     val addFregBinding = Intmap.add fpRegTbl
315 : monnier 247
316 : monnier 429 (*
317 :     * The following function is used to translate CPS into
318 : leunga 585 * larger trees. Definitions marked TREEIFY can be forward
319 :     * propagated to their (only) use. This can drastically reduce
320 :     * register pressure.
321 : monnier 429 *)
322 : leunga 585 datatype treeify = TREEIFY | TREEIFIED | COMPUTE | DEAD
323 :     exception UseCntTbl
324 :     val useCntTbl : treeify Intmap.intmap = Intmap.new(32, UseCntTbl)
325 :     val treeify = Intmap.mapWithDefault(useCntTbl,DEAD)
326 :     val addCntTbl = Intmap.add useCntTbl
327 :     fun markAsTreeified r = addCntTbl(r, TREEIFIED)
328 :     (*
329 :     * Reset the bindings and use count tables. These tables
330 :     * can be reset at the same time.
331 :     *)
332 :     fun clearTables() =
333 :     (Intmap.clear gpRegTbl;
334 :     Intmap.clear fpRegTbl;
335 :     Intmap.clear useCntTbl
336 :     )
337 : monnier 247
338 : monnier 429 (*
339 :     * memDisambiguation uses the new register counters,
340 :     * so this must be reset here.
341 :     *)
342 :     val _ = Cells.reset()
343 :     val memDisambig = MemAliasing.analyze(cluster)
344 : monnier 247
345 : monnier 429 (*
346 :     * Points-to analysis projection.
347 :     *)
348 : leunga 590 fun pi(x as ref(PT.TOP _),_) = x
349 :     | pi(x,i) = PT.pi(x,i)
350 : monnier 247
351 : monnier 429 val memDisambigFlag = !CG.memDisambiguate
352 : monnier 247
353 : leunga 590 fun getRegion e =
354 : monnier 429 if memDisambigFlag then
355 :     (case e of
356 : leunga 590 CPS.VAR v => memDisambig v
357 :     | _ => R.readonly
358 :     )
359 :     else R.memory
360 :    
361 :     fun getRegionPi(e,i) =
362 :     if memDisambigFlag then
363 :     (case e of
364 : monnier 429 CPS.VAR v => pi(memDisambig v,i)
365 :     | _ => R.readonly
366 :     )
367 : leunga 590 else R.memory
368 : monnier 411
369 : leunga 590 fun dataptrRegion v = getRegionPi(v, 0)
370 :    
371 :     (* fun arrayRegion(x as ref(PT.TOP _)) = x
372 :     | arrayRegion x = PT.weakSubscript x *)
373 :     (* For safety, let's assume it's the global memory right now *)
374 :     fun arrayRegion _ = R.memory
375 :    
376 : leunga 585 (* This keeps track of all the advanced offset on the hp
377 :     * since the beginning of the CPS function.
378 :     * This is important for generating the correct address offset
379 :     * for newly allocated records.
380 : monnier 429 *)
381 : leunga 585 val advancedHP = ref 0
382 :    
383 : monnier 429 (*
384 :     * Function grabty lookups the CPS type of a value expression in CPS.
385 :     *)
386 :     fun grabty(CPS.VAR v) = typmap v
387 :     | grabty(CPS.LABEL v) = typmap v
388 :     | grabty(CPS.INT _) = CPS.INTt
389 :     | grabty(CPS.INT32 _) = CPS.INT32t
390 :     | grabty(CPS.VOID) = CPS.FLTt
391 :     | grabty _ = CPS.BOGt
392 : monnier 247
393 : monnier 429 (*
394 :     * The baseptr contains the start address of the entire
395 :     * compilation unit. This function generates the address of
396 :     * a label that is embedded in the same compilation unit. The
397 :     * generated address is relative to the baseptr.
398 : monnier 498 *
399 :     * Note: For GC safety, we considered this to be an object reference
400 : monnier 429 *)
401 :     fun laddr(lab, k) =
402 : monnier 498 let val e =
403 : monnier 429 M.ADD(addrTy, C.baseptr,
404 :     M.LABEL(LE.PLUS(LE.LABEL lab,
405 : george 546 LE.INT(k-MachineSpec.constBaseRegOffset))))
406 :     in markPTR e end
407 : monnier 247
408 : monnier 429 (*
409 :     * A CPS register may be implemented as a physical
410 :     * register or a memory location. The function assign moves a
411 :     * value v into a register or a memory location.
412 :     *)
413 :     fun assign(M.REG(ty,r), v) = M.MV(ty, r, v)
414 : leunga 585 | assign(M.LOAD(ty, ea, mem), v) = M.STORE(ty, ea, v, mem)
415 : monnier 429 | assign _ = error "assign"
416 : monnier 247
417 : monnier 429 (*
418 :     * The following function looks up the MLTREE expression associated
419 :     * with a general purpose value expression.
420 :     *)
421 : leunga 585 val lookupGpRegTbl = Intmap.map gpRegTbl
422 :    
423 :     (*
424 :     * This function resolve the address computation of the
425 :     * form M.CONST k, where offset is a reference to the
426 :     * kth byte allocated since the beginning of the CPS function.
427 :     *)
428 :     fun resolveHpOffset(M.CONST(absoluteHpOffset)) =
429 :     let val tmpR = newReg PTR
430 :     val offset = absoluteHpOffset - !advancedHP
431 :     in emit(M.MV(pty, tmpR, M.ADD(addrTy, C.allocptr, M.LI offset)));
432 :     M.REG(pty, tmpR)
433 :     end
434 :     | resolveHpOffset(e) = e
435 :    
436 :     fun regbind(CPS.VAR v) = resolveHpOffset(lookupGpRegTbl v)
437 : monnier 429 | regbind(CPS.INT i) = M.LI (i+i+1)
438 :     | regbind(CPS.INT32 w) = M.LI32 w
439 : monnier 475 | regbind(CPS.LABEL v) =
440 :     laddr(functionLabel(if splitEntry then ~v-1 else v), 0)
441 : monnier 429 | regbind _ = error "regbind"
442 : monnier 247
443 : leunga 585 (*
444 :     * This version allows the value to be further propagated
445 :     *)
446 :     fun resolveHpOffset'(M.CONST(absoluteHpOffset)) =
447 :     let val tmpR = newReg PTR
448 :     val offset = absoluteHpOffset - !advancedHP
449 :     in M.ADD(addrTy, C.allocptr, M.LI offset)
450 :     end
451 :     | resolveHpOffset'(e) = e
452 :    
453 :     fun regbind'(CPS.VAR v) = resolveHpOffset'(lookupGpRegTbl v)
454 :     | regbind'(CPS.INT i) = M.LI (i+i+1)
455 :     | regbind'(CPS.INT32 w) = M.LI32 w
456 :     | regbind'(CPS.LABEL v) =
457 :     laddr(functionLabel(if splitEntry then ~v-1 else v), 0)
458 :     | regbind' _ = error "regbind'"
459 :    
460 :    
461 : monnier 429 (*
462 :     * The following function looks up the MLTREE expression associated
463 :     * with a floating point value expression.
464 :     *)
465 :     val lookupFpRegTbl = Intmap.map fpRegTbl
466 :     fun fregbind(CPS.VAR v) = lookupFpRegTbl v
467 :     | fregbind _ = error "fregbind"
468 : monnier 247
469 : monnier 429 (* On entry to a function, the parameters will be in formal
470 :     * parameter passing registers. Within the body of the function, they
471 :     * are moved immediately to fresh temporary registers. This ensures
472 :     * that the life time of the formal paramters is restricted to the
473 :     * function body and is critical in avoiding artificial register
474 :     * interferences.
475 :     *)
476 :     fun initialRegBindingsEscaping(vl, rl, tl) =
477 :     let fun eCopy(x::xs, M.GPR(M.REG(_,r))::rl, rds, rss, xs', rl') =
478 : monnier 498 let val t = newReg PTR
479 : monnier 429 in addRegBinding(x, t);
480 :     eCopy(xs, rl, t::rds, r::rss, xs', rl')
481 :     end
482 :     | eCopy(x::xs, r::rl, rds, rss, xs', rl') =
483 :     eCopy(xs, rl, rds, rss, x::xs', r::rl')
484 :     | eCopy([], [], [], [], xs', rl') = (xs', rl')
485 :     | eCopy([], [], rds, rss, xs', rl') =
486 :     (emit(M.COPY(ity, rds, rss)); (xs', rl'))
487 : monnier 247
488 : monnier 429 fun eOther(x::xs, M.GPR(r)::rl, xs', rl') =
489 : monnier 498 let val t = newReg PTR
490 : monnier 429 in addRegBinding(x, t); emit(M.MV(ity, t, r));
491 :     eOther(xs, rl, xs', rl')
492 :     end
493 :     | eOther(x::xs, (M.FPR(M.FREG(_,f)))::rl, xs', rl') =
494 :     eOther(xs, rl, x::xs', f::rl')
495 :     | eOther([], [], xs, rl) = (xs, rl)
496 : monnier 247
497 : monnier 429 fun eFcopy([], []) = ()
498 :     | eFcopy(xs, rl) =
499 : monnier 498 let val fs = map (fn _ => newFreg REAL64) xs
500 : monnier 429 in ListPair.app
501 :     (fn (x,f) => addFregBinding(x,M.FREG(fty,f))) (xs,fs);
502 :     emit(M.FCOPY(fty, fs, rl))
503 :     end
504 :     val (vl', rl') = eCopy(vl, rl, [], [], [], [])
505 :     in eFcopy(eOther(vl', rl', [], []));
506 :     ListPair.app addTypBinding (vl, tl)
507 :     end
508 : monnier 247
509 : monnier 429 fun initialRegBindingsKnown(vl, rl, tl) =
510 :     let fun f(v, M.GPR(reg as M.REG _)) = addExpBinding(v, reg)
511 :     | f(v, M.FPR(freg as M.FREG _)) = addFregBinding(v, freg)
512 :     | f _ = error "initialRegBindingsKnown.f"
513 :     in ListPair.app f (vl, rl);
514 :     ListPair.app addTypBinding (vl, tl)
515 :     end
516 : monnier 247
517 : monnier 429 (* Keep allocation pointer aligned on odd boundary
518 :     * Note: We have accounted for the extra space this eats up in
519 :     * limit.sml
520 :     *)
521 : leunga 585
522 : monnier 429 fun updtHeapPtr(hp) =
523 : leunga 585 let fun advBy hp =
524 :     (advancedHP := !advancedHP + hp;
525 :     emit(M.MV(pty, allocptrR, M.ADD(addrTy, C.allocptr, M.LI hp))))
526 : monnier 429 in if hp = 0 then ()
527 :     else if Word.andb(Word.fromInt hp, 0w4) <> 0w0 then advBy(hp+4)
528 :     else advBy(hp)
529 :     end
530 : monnier 247
531 : monnier 429 fun testLimit hp =
532 : george 546 let fun assignCC(M.CC(_, cc), v) = emit(M.CCMV(cc, v))
533 : monnier 429 | assignCC _ = error "testLimit.assign"
534 :     in updtHeapPtr(hp);
535 :     case C.exhausted
536 :     of NONE => ()
537 :     | SOME cc => assignCC(cc, gcTest)
538 :     (*esac*)
539 :     end
540 : monnier 247
541 : leunga 590
542 : leunga 585 (*
543 : leunga 590 * Function to allocate an integer record
544 :     * x <- [descriptor ... fields]
545 :     *)
546 :     fun ea(r, 0) = r
547 :     | ea(r, n) = M.ADD(addrTy, r, M.LI n)
548 :     fun indexEA(r, 0) = r
549 :     | indexEA(r, n) = M.ADD(addrTy, r, M.LI(n*4))
550 :    
551 :     fun allocRecord(markComp, mem, desc, fields, hp) =
552 :     let fun getField(v, e, CPS.OFFp 0) = e
553 :     | getField(v, e, CPS.OFFp n) = M.ADD(addrTy, e, M.LI(4*n))
554 :     | getField(v, e, p) = getPath(getRegion v, e, p)
555 :    
556 :     and getPath(mem, e, CPS.OFFp n) = indexEA(e, n)
557 :     | getPath(mem, e, CPS.SELp(n, CPS.OFFp 0)) =
558 :     markComp(M.LOAD(ity, indexEA(e, n), pi(mem, n)))
559 :     | getPath(mem, e, CPS.SELp(n, p)) =
560 :     let val mem = pi(mem, n)
561 :     in getPath(mem, markPTR(M.LOAD(ity, indexEA(e, n), mem)), p)
562 :     end
563 :    
564 :     fun storeFields([], hp, elem) = hp
565 :     | storeFields((v, p)::fields, hp, elem) =
566 :     (emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, M.LI hp),
567 :     getField(v, regbind' v, p), pi(mem, elem)));
568 :     storeFields(fields, hp+4, elem+1)
569 :     )
570 :    
571 :     in emit(M.STORE(ity, ea(C.allocptr, hp), desc, pi(mem, ~1)));
572 :     storeFields(fields, hp+4, 0);
573 :     hp+4
574 :     end
575 :    
576 :     (*
577 :     * Functions to allocate a floating point record
578 :     * x <- [descriptor ... fields]
579 :     *)
580 :     fun allocFrecord(mem, desc, fields, hp) =
581 :     let fun fea(r, 0) = r
582 :     | fea(r, n) = M.ADD(addrTy, r, M.LI(n*8))
583 :     fun fgetField(v, CPS.OFFp 0) = fregbind v
584 :     | fgetField(v, CPS.OFFp _) = error "allocFrecord.fgetField"
585 :     | fgetField(v, p) = fgetPath(getRegion v, regbind' v, p)
586 :    
587 :     and fgetPath(mem, e, CPS.OFFp _) = error "allocFrecord.fgetPath"
588 :     | fgetPath(mem, e, CPS.SELp(n, CPS.OFFp 0)) =
589 :     markFLT(M.FLOAD(fty, fea(e, n), pi(mem, n)))
590 :     | fgetPath(mem, e, CPS.SELp(n, p)) =
591 :     let val mem = pi(mem, n)
592 :     in fgetPath(mem, markPTR(M.LOAD(ity, indexEA(e, n), mem)),p)
593 :     end
594 :    
595 :     fun fstoreFields([], hp, elem) = hp
596 :     | fstoreFields((v, p)::fields, hp, elem) =
597 :     (emit(M.FSTORE(fty, M.ADD(addrTy, C.allocptr, M.LI hp),
598 :     fgetField(v, p), pi(mem, elem)));
599 :     fstoreFields(fields, hp+8, elem+1)
600 :     )
601 :     in emit(M.STORE(ity, ea(C.allocptr, hp), desc, pi(mem, ~1)));
602 :     fstoreFields(fields, hp+4, 0);
603 :     hp+4
604 :     end
605 :    
606 :     (* Allocate a header pair for vector or array *)
607 :     fun allocHeaderPair(hdrDesc, mem, dataPtr, len, hp) =
608 :     (emit(M.STORE(ity, ea(C.allocptr, hp), M.LI hdrDesc,pi(mem,~1)));
609 :     emit(M.STORE(ity, ea(C.allocptr, hp+4),
610 :     M.REG(ity,dataPtr),pi(mem, 0)));
611 :     emit(M.STORE(ity, ea(C.allocptr, hp+8), M.LI(len+len+1),
612 :     pi(mem, 1)));
613 :     hp+4
614 :     )
615 :    
616 :     (*
617 : leunga 585 * Int 31 tag optimizations.
618 :     * Note: if the tagging scheme changes then we'll have to redo these.
619 :     *)
620 : monnier 247
621 : leunga 585 fun addTag e = M.ADD(ity, e, one)
622 : monnier 429 fun stripTag e = M.SUB(ity, e, one)
623 : leunga 585 fun orTag e = M.ORB(ity, e, one)
624 : monnier 247
625 : leunga 585 fun tag(false, e) = tagUnsigned e
626 :     | tag(true, e) = tagSigned e
627 :     and tagUnsigned e =
628 :     let fun double r = M.ADD(ity,r,r)
629 :     in case e
630 :     of M.REG _ => addTag(double e)
631 :     | _ => let val tmp = newReg PTR (* XXX ??? *)
632 :     in M.LET(M.MV(ity, tmp, e),
633 :     addTag(double(M.REG(ity,tmp))))
634 :     end
635 :     end
636 :     and tagSigned e =
637 :     let fun double r = M.ADDT(ity,r,r)
638 :     in case e
639 :     of M.REG _ => addTag(double e)
640 :     | _ => let val tmp = newReg PTR (* XXX ??? *)
641 :     in M.LET(M.MV(ity, tmp, e),
642 :     addTag(double(M.REG(ity,tmp))))
643 :     end
644 :     end
645 : monnier 247
646 : leunga 585 fun untag(true, e) = untagSigned e
647 :     | untag(false, e) = untagUnsigned e
648 :     and untagUnsigned(CPS.INT i) = M.LI i
649 :     | untagUnsigned v = M.SRL(ity, regbind v, one)
650 :     and untagSigned(CPS.INT i) = M.LI i
651 :     | untagSigned v = M.SRA(ity, regbind v, one)
652 : monnier 247
653 : leunga 585 (*
654 :     * Integer operators
655 :     *)
656 :     fun int31add(addOp, CPS.INT k, w) = addOp(ity, M.LI(k+k), regbind w)
657 :     | int31add(addOp, w, v as CPS.INT _) = int31add(addOp, v, w)
658 :     | int31add(addOp, v, w) = addOp(ity,regbind v,stripTag(regbind w))
659 : monnier 247
660 : leunga 585 fun int31sub(subOp, CPS.INT k, w) = subOp(ity, M.LI(k+k+2),regbind w)
661 :     | int31sub(subOp, v, CPS.INT k) = subOp(ity, regbind v, M.LI(k+k))
662 :     | int31sub(subOp, v, w) = addTag(subOp(ity, regbind v, regbind w))
663 :    
664 :     fun int31xor(CPS.INT k, w) = M.XORB(ity, M.LI(k+k), regbind w)
665 :     | int31xor(w, v as CPS.INT _) = int31xor (v,w)
666 :     | int31xor(v, w) = addTag (M.XORB(ity, regbind v, regbind w))
667 :    
668 :     fun int31mul(signed, v, w) =
669 :     let fun f(CPS.INT k, CPS.INT j) = (M.LI(k+k), M.LI(j))
670 :     | f(CPS.INT k, w) = (untag(signed,w), M.LI(k+k))
671 :     | f(v, w as CPS.INT _) = f(w, v)
672 :     | f(v, w) = (stripTag(regbind v), untag(signed,w))
673 :     val (v, w) = f(v, w)
674 :     in addTag(if signed then M.MULT(ity, v, w) else M.MULU(ity, v, w))
675 : monnier 429 end
676 : monnier 247
677 : leunga 585 fun int31div(signed, v, w) =
678 :     let val (v, w) =
679 :     case (v, w) of
680 :     (CPS.INT k, CPS.INT j) => (M.LI k, M.LI j)
681 :     | (CPS.INT k, w) => (M.LI k, untag(signed, w))
682 :     | (v, CPS.INT k) => (untag(signed, v), M.LI(k))
683 :     | (v, w) => (untag(signed, v), untag(signed, w))
684 :     in tag(signed,
685 :     if signed then M.DIVT(ity, v, w) else M.DIVU(ity, v, w))
686 : monnier 429 end
687 : monnier 247
688 : leunga 585 fun int31lshift(CPS.INT k, w) =
689 :     addTag (M.SLL(ity, M.LI(k+k), untagUnsigned(w)))
690 :     | int31lshift(v, CPS.INT k) =
691 : monnier 429 addTag(M.SLL(ity,stripTag(regbind v), M.LI(k)))
692 : leunga 585 | int31lshift(v,w) =
693 :     addTag(M.SLL(ity,stripTag(regbind v), untagUnsigned(w)))
694 : monnier 247
695 : leunga 585 fun int31rshift(rshiftOp, v, CPS.INT k) =
696 : monnier 429 orTag(rshiftOp(ity, regbind v, M.LI(k)))
697 : leunga 585 | int31rshift(rshiftOp, v, w) =
698 :     orTag(rshiftOp(ity, regbind v, untagUnsigned(w)))
699 : monnier 247
700 : monnier 429 fun getObjDescriptor(v) =
701 : leunga 590 M.LOAD(ity, M.SUB(pty, regbind v, M.LI(4)), getRegionPi(v, ~1))
702 : monnier 247
703 : monnier 429 fun getObjLength(v) =
704 :     M.SRL(ity, getObjDescriptor(v), M.LI(D.tagWidth -1))
705 : monnier 247
706 : monnier 429 (*
707 :     * Note: because formals are moved into fresh temporaries,
708 :     * (formals intersection actuals) is empty.
709 : leunga 585 *
710 :     * Do the treeified computation first so as to prevent extra
711 :     * interferences from being created.
712 :     *
713 : monnier 429 *)
714 :     fun callSetup(formals, actuals) =
715 : leunga 585 let fun isTreeified(CPS.VAR r) = treeify r = TREEIFIED
716 :     | isTreeified _ = false
717 :     fun gather([], [], cpRd, cpRs, fcopies, treeified, moves) =
718 :     (app emit treeified;
719 :     case (cpRd,cpRs)
720 : monnier 429 of ([],[]) => ()
721 :     | _ => emit(M.COPY(ity, cpRd, cpRs));
722 :     case fcopies
723 :     of [] => ()
724 :     | _ => emit(M.FCOPY(fty, map #1 fcopies, map #2 fcopies));
725 :     app emit moves
726 :     )
727 : leunga 585 | gather(M.GPR(M.REG(ty,rd))::fmls,act::acts,cpRd,cpRs,f,t,m) =
728 : monnier 429 (case regbind act
729 : leunga 585 of M.REG(_,rs) => gather(fmls,acts,rd::cpRd,rs::cpRs,f,t,m)
730 :     | e => if isTreeified act then
731 :     gather(fmls, acts, cpRd, cpRs, f,
732 :     M.MV(ty, rd, e)::t, m)
733 :     else
734 :     gather(fmls, acts, cpRd, cpRs, f,
735 :     t, M.MV(ty, rd, e)::m)
736 : monnier 429 (*esac*))
737 : leunga 585 | gather(M.GPR(M.LOAD(ty,ea,r))::fmls,act::acts,cpRd,cpRs,f,t,m) =
738 :     (* Always store them early! *)
739 : monnier 429 gather(fmls,acts,cpRd,cpRs,f,
740 : leunga 585 M.STORE(ty,ea,regbind act,r)::t, m)
741 :     | gather(M.FPR(M.FREG(ty,fd))::fmls,act::acts,cpRd,cpRs,f,t,m) =
742 : monnier 429 (case fregbind act
743 :     of M.FREG(_,fs) =>
744 : leunga 585 gather(fmls,acts,cpRd,cpRs,(fd,fs)::f,t,m)
745 : monnier 429 | e =>
746 : leunga 585 if isTreeified act then
747 :     gather(fmls,acts,cpRd,cpRs,f,M.FMV(ty, fd, e)::t,m)
748 :     else
749 :     gather(fmls,acts,cpRd,cpRs,f,t,M.FMV(ty, fd, e)::m)
750 : monnier 429 (*esac*))
751 :     | gather _ = error "callSetup.gather"
752 : leunga 585 in gather(formals, actuals, [], [], [], [], [])
753 : monnier 429 end
754 : monnier 247
755 : monnier 429 (* scale-and-add *)
756 :     fun scale1(a, CPS.INT 0) = a
757 :     | scale1(a, CPS.INT k) = M.ADD(ity, a, M.LI(k))
758 : leunga 585 | scale1(a, i) = M.ADD(ity, a, untagSigned(i))
759 : monnier 247
760 : monnier 429 fun scale4(a, CPS.INT 0) = a
761 :     | scale4(a, CPS.INT i) = M.ADD(ity, a, M.LI(i*4))
762 : leunga 585 | scale4(a, i) = M.ADD(ity, a, M.SLL(ity, untagSigned(i), two))
763 : monnier 429
764 : monnier 247
765 : monnier 429 fun scale8(a, CPS.INT 0) = a
766 :     | scale8(a, CPS.INT i) = M.ADD(ity, a, M.LI(i*8))
767 :     | scale8(a, i) = M.ADD(ity, a, M.SLL(ity, stripTag(regbind i),
768 :     M.LI(2)))
769 :    
770 :     (* add to storelist, the address where a boxed update has occured *)
771 :     fun recordStore(tmp, hp) =
772 :     (emit(M.STORE(pty,M.ADD(addrTy,C.allocptr,M.LI(hp)),
773 :     tmp,R.storelist));
774 :     emit(M.STORE(pty,M.ADD(addrTy,C.allocptr,M.LI(hp+4)),
775 :     C.storeptr,R.storelist));
776 :     emit(assign(C.storeptr, M.ADD(addrTy, C.allocptr, M.LI(hp)))))
777 :    
778 :     fun unsignedCmp oper =
779 :     case oper
780 : leunga 585 of P.> => M.GTU | P.>= => M.GEU
781 :     | P.< => M.LTU | P.<= => M.LEU
782 :     | P.eql => M.EQ | P.neq => M.NE
783 : monnier 429
784 :     fun signedCmp oper =
785 :     case oper
786 : leunga 585 of P.> => M.GT | P.>= => M.GE
787 :     | P.< => M.LT | P.<= => M.LE
788 :     | P.neq => M.NE | P.eql => M.EQ
789 : monnier 429
790 : george 546 fun branchToLabel(lab) = M.JMP([],M.LABEL(LE.LABEL lab),[])
791 : monnier 429
792 :     local
793 :     open CPS
794 :     in
795 : monnier 498
796 : leunga 585 (*
797 :     * This function initializes a CPS function before we generate
798 :     * code for it. Its tasks include:
799 :     * 1. Add type bindings for each definition. This is used to determine
800 :     * the parameter passing convention for standard functions.
801 :     * 2. Compute the number of uses for each variable. This is
802 :     * used in the forward propagation logic.
803 :     * 3. Check whether the base pointer is needed.
804 :     * It is needed iff
805 :     * a. There is a reference to LABEL
806 :     * b. It uses SWITCH (the jumptable requires the basepointer)
807 :     * 4. Generate the gc tests for STANDARD and KNOWN functions
808 :     * 5. Check to see if floating point allocation is being performed
809 :     * in the function. If so, we will align the allocptr.
810 : monnier 429 *)
811 : leunga 585 fun genCPSFunction(lab, kind, f, params, formals, tys, e) =
812 :     let val add = addTypBinding
813 :     fun addUse v =
814 :     case treeify v of
815 :     DEAD => addCntTbl(v, TREEIFY)
816 :     | TREEIFY => addCntTbl(v, COMPUTE)
817 :     | COMPUTE => ()
818 :     | _ => error "addUse"
819 :    
820 :     val hasFloats = ref false (* default is no *)
821 :     val needBasePtr = ref false
822 :    
823 :     fun addValue(VAR v) = addUse v
824 :     | addValue(LABEL _) = needBasePtr := true
825 :     | addValue _ = ()
826 :    
827 :     fun addValues [] = ()
828 :     | addValues(VAR v::vs) = (addUse v; addValues vs)
829 :     | addValues(LABEL _::vs) = (needBasePtr := true; addValues vs)
830 :     | addValues(_::vs) = addValues vs
831 :    
832 :     fun addRecValues [] = ()
833 :     | addRecValues((VAR v,_)::l) = (addUse v; addRecValues l)
834 :     | addRecValues((LABEL v,_)::l) =
835 :     (needBasePtr := true; addRecValues l)
836 :     | addRecValues(_::l) = addRecValues l
837 :    
838 :     fun init e =
839 :     case e
840 :     of RECORD(k,vl,x,e) =>
841 :     (case k of
842 :     (RK_FCONT | RK_FBLOCK) => hasFloats := true
843 :     | _ => ();
844 :     addRecValues vl; add(x,BOGt); init e
845 :     )
846 :     | SELECT(_,v,x,t,e) => (addValue v; add(x,t); init e)
847 :     | OFFSET(_,v,x,e) => (addValue v; add(x,BOGt); init e)
848 :     | SWITCH(v,_,el) =>
849 :     (needBasePtr := true; addValue v; app init el)
850 :     | SETTER(_,vl,e) => (addValues vl; init e)
851 :     | LOOKER(looker,vl,x,t,e) =>
852 :     (addValues vl;
853 :     (* floating subscript cannot move past a floating update.
854 :     * For now subscript operations cannot be treeified.
855 :     * This is hacked by making it (falsely) used
856 :     * more than once.
857 :     *)
858 :     case looker of
859 :     P.numsubscript{kind=P.FLOAT _} => addCntTbl(x,COMPUTE)
860 :     | _ => ();
861 :     add(x,t); init e
862 :     )
863 :     | ARITH(_,vl,x,t,e) => (addValues vl; add(x,t); init e)
864 :     | PURE(p,vl,x,t,e) =>
865 :     (case p of
866 :     P.fwrap => hasFloats := true
867 :     | _ => ();
868 :     addValues vl; add(x,t); init e
869 :     )
870 :     | BRANCH(_,vl,_,e1,e2) => (addValues vl; init e1; init e2)
871 :     | APP(v,vl) => (addValue v; addValues vl)
872 :     | _ => error "genCPSFunction"
873 :    
874 :     in (* Print debugging information *)
875 :     if !CG.printit then printCPSFun(kind,f,params,tys,e) else ();
876 :    
877 :     (* Move parameters *)
878 :     case kind of
879 :     KNOWN =>
880 :     (defineLabel lab;
881 :     init e;
882 :     initialRegBindingsEscaping(params, formals, tys)
883 :     )
884 :     | KNOWN_CHECK =>
885 :     (defineLabel lab;
886 :     (* gc test *)
887 :     (if !mlrisc andalso !gcsafety then
888 :     InvokeGC.optimizedKnwCheckLimit else
889 :     InvokeGC.knwCheckLimit)
890 :     stream
891 :     {maxAlloc=4*maxAlloc f, regfmls=formals, regtys=tys,
892 :     return=branchToLabel(lab)};
893 :     init e;
894 :     initialRegBindingsEscaping(params, formals, tys)
895 :     )
896 :     | _ =>
897 :     (* Standard function *)
898 :     let val regfmls as (M.GPR linkreg::regfmlsTl) = formals
899 :     val entryLab =
900 :     if splitEntry then functionLabel(~f-1) else lab
901 :     in if splitEntry then
902 :     (entryLabel entryLab;
903 :     annotation EMPTY_BLOCK;
904 :     defineLabel lab
905 :     )
906 :     else
907 :     entryLabel lab;
908 :     clearTables();
909 :     init e;
910 :     if !needBasePtr then
911 :     let val baseval =
912 :     M.ADD(addrTy,linkreg,
913 :     M.LABEL(LE.MINUS(
914 :     LE.INT MachineSpec.constBaseRegOffset,
915 :     LE.LABEL entryLab)))
916 :     in emit(assign(C.baseptr, baseval)) end
917 :     else ();
918 :     InvokeGC.stdCheckLimit stream
919 :     {maxAlloc=4 * maxAlloc f, regfmls=regfmls,
920 :     regtys=tys, return=M.JMP([], linkreg,[])};
921 :     initialRegBindingsEscaping
922 :     (List.tl params, regfmlsTl, List.tl tys)
923 :     end
924 :     ;
925 :    
926 :     (* Align the allocation pointer if necessary *)
927 :     if !hasFloats then
928 :     emit(M.MV(pty,allocptrR, M.ORB(pty,C.allocptr, M.LI 4)))
929 :     else ();
930 :    
931 :     (* Generate code *)
932 :     advancedHP := 0;
933 :     gen(e, 0)
934 : monnier 247 end
935 : leunga 585
936 :     (*
937 :     * Generate code for x := e; k
938 :     *)
939 :     and define(r, x, e, k, hp) =
940 :     (addRegBinding(x, r);
941 :     emit(M.MV(ity, r, e));
942 :     gen(k, hp)
943 :     )
944 :    
945 :     and def(gc, x, e, k, hp) = define(newReg gc,x,e,k,hp)
946 :    
947 :     and defWithCty(cty, x, e, k, hp) = define(newRegWithCty cty,x,e,k,hp)
948 :    
949 :     and defWithKind(kind, x, e, k, hp) =
950 :     define(newRegWithKind kind,x,e,k,hp)
951 : monnier 498
952 : leunga 585 and defI31(x, e, k, hp) = def(I31, x, e, k, hp)
953 :     and defI32(x, e, k, hp) = def(I32, x, e, k, hp)
954 :     and defBoxed(x, e, k, hp) = def(PTR, x, e, k, hp)
955 : monnier 247
956 : monnier 429 (*
957 : leunga 585 * Generate code for x : cty := e; k
958 :     *)
959 :     and treeifyDef(x, e, cty, k, hp) =
960 :     case treeify x of
961 :     COMPUTE => defWithCty(cty, x, e, k, hp)
962 :     | TREEIFY => (markAsTreeified x;
963 :     addExpBinding(x, markGC(e, cty)); gen(k, hp))
964 :     | DEAD => gen(k, hp)
965 :     | _ => error "treeifyDef"
966 :    
967 :     (*
968 :     * Generate code for
969 :     * x := allocptr + offset; k
970 :     * where offset is the address offset of a newly allocated record.
971 :     * If x is only used once, we try to propagate that to its use.
972 :     *)
973 :     and defAlloc(x, offset, k, hp) =
974 :     defBoxed(x, M.ADD(addrTy, C.allocptr, M.LI offset), k, hp)
975 :    
976 :    
977 :     (* Generate code for
978 :     * x := allocptr + offset; k
979 :     * If there is only one reference then we delay the computation
980 :     * until it is used.
981 :     *)
982 :     and treeifyAlloc(x, offset, k, hp) =
983 :     (case treeify x of
984 :     COMPUTE => defAlloc(x, offset, k, hp)
985 :     | TREEIFY =>
986 :     (* Note, don't mark this as treeified since it has low
987 :     * register pressure.
988 :     *)
989 :     let val absoluteAllocOffset = offset + !advancedHP
990 :     in addExpBinding(x, M.CONST(absoluteAllocOffset));
991 :     gen(k, hp)
992 :     end
993 :     | DEAD => gen(k, hp)
994 :     | _ => error "treeifyAlloc"
995 :     )
996 :    
997 :     (*
998 : monnier 429 * x <- e where e contains an floating-point value
999 :     *)
1000 : leunga 585 and treeifyDefF64(x, e, k, hp) =
1001 : monnier 429 (case treeify x
1002 : leunga 585 of DEAD => gen(k, hp)
1003 :     | TREEIFY => (markAsTreeified x;
1004 :     addFregBinding(x,e); gen(k, hp))
1005 :     | COMPUTE =>
1006 : monnier 498 let val f = newFreg REAL64
1007 : monnier 429 in addFregBinding(x, M.FREG(fty, f));
1008 :     emit(M.FMV(fty, f, e));
1009 : leunga 585 gen(k, hp)
1010 : monnier 429 end
1011 : leunga 585 | _ => error "treeifyDefF64"
1012 : monnier 429 (*esac*))
1013 :    
1014 : leunga 585 and nop(x, v, e, hp) = defI31(x, regbind v, e, hp)
1015 : monnier 429
1016 : leunga 585 and copy(gc, x, v, k, hp) =
1017 : monnier 498 let val dst = newReg gc
1018 : monnier 429 in addRegBinding(x, dst);
1019 :     case regbind v
1020 :     of M.REG(_,src) => emit(M.COPY(ity, [dst], [src]))
1021 :     | e => emit(M.MV(ity, dst, e))
1022 :     (*esac*);
1023 : leunga 585 gen(k, hp)
1024 : monnier 429 end
1025 : monnier 498
1026 : leunga 585 and copyM(31, x, v, k, hp) = copy(I31, x, v, k, hp)
1027 :     | copyM(_, x, v, k, hp) = copy(I32, x, v, k, hp)
1028 : monnier 498
1029 : leunga 585 and eqVal(VAR x,VAR y) = x = y
1030 :     | eqVal(LABEL x,LABEL y) = x = y
1031 :     | eqVal(INT x, INT y) = x = y
1032 :     | eqVal _ = false
1033 :    
1034 :     (* Perform conditional move folding *)
1035 :     (*
1036 :     and branch(cmp, [v,w], yes, no, hp) =
1037 :     case (yes, no) of
1038 :     (APP(f,fs), APP(g,gs)) =>
1039 :     if eqVal(f,g) then
1040 :     let val cmp = M.CMP(32, cmp, regbind v, regbind w)
1041 :     fun condMove([],[]) = []
1042 :     | condMove(x::xs,y::ys) =
1043 :     if eqVal(x,y) then x::condMove(xs,ys)
1044 :     else
1045 :     let val v = LambdaVar.mkLvar()
1046 :     val tmp = newReg PTR
1047 :     in emit(M.MV(32, tmp,
1048 :     M.COND(32, cmp, regbind x, regbind y)));
1049 :     addRegBinding(v, tmp);
1050 :     addTypBinding(v, grabty x);
1051 :     VAR v::condMove(xs, ys)
1052 :     end
1053 :     | condMove _ = error "condMove"
1054 :     val e = APP(f,condMove(fs, gs))
1055 :     in gen(e, hp)
1056 :     end
1057 :     else normalBranch(cmp, v, w, yes, no, hp)
1058 :     | _ => normalBranch(cmp, v, w, yes, no, hp)
1059 :     *)
1060 :    
1061 :     (* normal branches *)
1062 :     and branch (cmp, [v, w], yes, no, hp) =
1063 : monnier 429 let val trueLab = Label.newLabel""
1064 :     in (* is single assignment great or what! *)
1065 : george 546 emit(M.BCC([], M.CMP(32, cmp, regbind v, regbind w), trueLab));
1066 : leunga 585 genCont(no, hp);
1067 :     genlab(trueLab, yes, hp)
1068 : monnier 429 end
1069 : leunga 585
1070 :     (* branch if x is boxed *)
1071 :     and branchOnBoxed(x, yes, no, hp) =
1072 :     let val lab = Label.newLabel ""
1073 :     val cmp = M.CMP(32, M.NE, M.ANDB(ity, regbind x, one), zero)
1074 :     in emit(M.BCC([], cmp, lab));
1075 :     genCont(yes, hp);
1076 :     genlab(lab, no, hp)
1077 :     end
1078 :    
1079 :     (* branch if are identical strings v, w of length n *)
1080 :     and branchStreq(n, v, w, yes, no, hp) =
1081 :     let val n' = ((n+3) div 4) * 4
1082 :     val false_lab = Label.newLabel ""
1083 :     val r1 = newReg I32
1084 :     val r2 = newReg I32
1085 :     fun cmpWord(i) =
1086 :     M.CMP(32, M.NE,
1087 :     M.LOAD(ity,M.ADD(ity,M.REG(ity, r1),i),R.readonly),
1088 :     M.LOAD(ity,M.ADD(ity,M.REG(ity, r2),i),R.readonly))
1089 :     fun unroll i =
1090 :     if i=n' then ()
1091 :     else (emit(M.BCC([], cmpWord(M.LI(i)), false_lab));
1092 :     unroll (i+4))
1093 :     in emit(M.MV(ity, r1, M.LOAD(ity, regbind v, R.readonly)));
1094 :     emit(M.MV(ity, r2, M.LOAD(ity, regbind w, R.readonly)));
1095 :     unroll 0;
1096 :     genCont(yes, hp);
1097 :     genlab(false_lab, no, hp)
1098 :     end
1099 :    
1100 : monnier 498 and arith(gc, oper, v, w, x, e, hp) =
1101 : leunga 585 def(gc, x, oper(ity, regbind v, regbind w), e, hp)
1102 : monnier 498
1103 :     and arith32(oper, v, w, x, e, hp) =
1104 :     arith(I32, oper, v, w, x, e, hp)
1105 : monnier 429
1106 : monnier 498 and logical(gc, oper, v, w, x, e, hp) =
1107 : leunga 585 def(gc, x, oper(ity, regbind v, untagUnsigned(w)), e, hp)
1108 : monnier 498
1109 :     and logical31(oper, v, w, x, e, hp) =
1110 :     logical(I31, oper, v, w, x, e, hp)
1111 :    
1112 :     and logical32(oper, v, w, x, e, hp) =
1113 :     logical(I32, oper, v, w, x, e, hp)
1114 : monnier 429
1115 : leunga 585 and genCont(e, hp) =
1116 :     let val save = !advancedHP
1117 :     in gen(e, hp); advancedHP := save end
1118 :    
1119 : monnier 429 and genlab(lab, e, hp) = (defineLabel lab; gen(e, hp))
1120 : monnier 411
1121 : leunga 585 and genlabCont(lab, e, hp) = (defineLabel lab; genCont(e, hp))
1122 : monnier 247
1123 : leunga 585 (* Allocate a normal record *)
1124 :     and mkRecord(vl, w, e, hp) =
1125 :     let val len = length vl
1126 :     val desc = dtoi(D.makeDesc (len, D.tag_record))
1127 :     in treeifyAlloc(w,
1128 : leunga 590 allocRecord(markPTR, memDisambig w, M.LI desc, vl, hp),
1129 :     e, hp+4+len*4)
1130 : leunga 585 end
1131 :    
1132 :     (* Allocate a record with I32 components *)
1133 :     and mkI32block(vl, w, e, hp) =
1134 :     let val len = length vl
1135 :     val desc = dtoi(D.makeDesc (len, D.tag_raw32))
1136 : leunga 590 in treeifyAlloc(w,
1137 :     allocRecord(markI32, memDisambig w, M.LI desc, vl, hp),
1138 :     e, hp+4+len*4)
1139 : leunga 585 end
1140 :    
1141 :     (* Allocate a floating point record *)
1142 :     and mkFblock(vl, w, e, hp) =
1143 : monnier 429 let val len = List.length vl
1144 :     val desc = dtoi(D.makeDesc(len+len, D.tag_raw64))
1145 :     (* At initialization the allocation pointer is aligned on
1146 :     * an odd-word boundary, and the heap offset set to zero. If an
1147 :     * odd number of words have been allocated then the heap pointer
1148 :     * is misaligned for this record creation.
1149 :     *)
1150 :     val hp =
1151 :     if Word.andb(Word.fromInt hp, 0w4) <> 0w0 then hp+4 else hp
1152 : leunga 590 in (* The components are floating point *)
1153 :     treeifyAlloc(w,
1154 :     allocFrecord(memDisambig w, M.LI desc, vl, hp),
1155 :     e, hp+4+len*8)
1156 : monnier 429 end
1157 : leunga 585
1158 :     (* Allocate a vector *)
1159 :     and mkVector(vl, w, e, hp) =
1160 : monnier 429 let val len = length vl
1161 :     val hdrDesc = dtoi(D.desc_polyvec)
1162 :     val dataDesc = dtoi(D.makeDesc(len, D.tag_vec_data))
1163 : monnier 498 val dataPtr = newReg PTR
1164 : leunga 590 val mem = memDisambig w
1165 :     val hp' = hp + 4 + len*4
1166 : leunga 585 in (* The components are boxed *)
1167 : leunga 590 (* Allocate the data *)
1168 :     allocRecord(markPTR, mem, M.LI dataDesc, vl, hp);
1169 :     emit(M.MV(pty, dataPtr, ea(C.allocptr, hp+4)));
1170 :     (* Now allocate the header pair *)
1171 : leunga 585 treeifyAlloc(w,
1172 : leunga 590 allocHeaderPair(hdrDesc, mem, dataPtr, len, hp+4+len*4),
1173 :     e, hp'+12)
1174 : monnier 429 end
1175 : leunga 585
1176 :     (*
1177 :     * Floating point select
1178 :     *)
1179 :     and fselect(i, v, x, e, hp) =
1180 :     treeifyDefF64(x,
1181 :     M.FLOAD(fty, scale8(regbind v, INT i), R.real),
1182 :     e, hp)
1183 :    
1184 :     (*
1185 :     * Non-floating point select
1186 :     *)
1187 :     and select(i, v, x, t, e, hp) =
1188 :     treeifyDef(x,
1189 : leunga 590 M.LOAD(ity,scale4(regbind v,INT i),getRegionPi(v,i)),
1190 : leunga 585 t, e, hp)
1191 :    
1192 :     (*
1193 :     * Funny select; I don't know that this does
1194 :     *)
1195 :     and funnySelect(i, k, x, t, e, hp) =
1196 :     let val unboxedfloat = MS.unboxedFloats
1197 :     fun isFlt t =
1198 :     if unboxedfloat then (case t of FLTt => true | _ => false)
1199 :     else false
1200 :     fun fallocSp(x,e,hp) =
1201 :     (addFregBinding(x,M.FREG(fty,newFreg REAL64));gen(e, hp))
1202 :     (* warning: the following generated code should never be
1203 :     executed; its semantics is completely screwed up !
1204 : monnier 429 *)
1205 : leunga 585 in if isFlt t then fallocSp(x, e, hp)
1206 :     else defI32(x, M.LI k, e, hp)(* BOGUS *)
1207 : monnier 429 end
1208 : monnier 247
1209 : leunga 585 (*
1210 :     * Call an external function
1211 :     *)
1212 :     and externalApp(f, args, hp) =
1213 : monnier 429 let val formals as (M.GPR dest::_) =
1214 :     ArgP.standard(typmap f, map grabty args)
1215 :     in callSetup(formals, args);
1216 :     testLimit hp;
1217 : george 546 emit(M.JMP([], dest, []));
1218 : monnier 429 exitBlock(formals @ dedicated)
1219 :     end
1220 : leunga 585
1221 :     (*
1222 :     * Call an internal function
1223 :     *)
1224 :     and internalApp(f, args, hp) =
1225 : monnier 429 (case lookupGenTbl f
1226 :     of Frag.KNOWNFUN(ref(Frag.GEN formals)) =>
1227 :     (updtHeapPtr(hp);
1228 :     callSetup(formals, args);
1229 :     emit(branchToLabel(functionLabel f)))
1230 :     | Frag.KNOWNFUN(r as ref(Frag.UNGEN(f,vl,tl,e))) =>
1231 : monnier 498 let val formals = known tl
1232 : monnier 429 val lab = functionLabel f
1233 :     in r := Frag.GEN formals;
1234 :     updtHeapPtr(hp);
1235 :     callSetup(formals, args);
1236 : leunga 585 genCPSFunction(lab, KNOWN, f, vl, formals, tl, e)
1237 : monnier 429 end
1238 :     | Frag.KNOWNCHK(r as ref(Frag.UNGEN(f,vl,tl,e))) =>
1239 :     let val formals =
1240 :     if MS.fixedArgPassing then ArgP.fixed tl
1241 : monnier 498 else known tl
1242 : monnier 429 val lab = functionLabel f
1243 : leunga 585 in r := Frag.GEN formals;
1244 : monnier 429 callSetup(formals, args);
1245 :     testLimit hp;
1246 : leunga 585 genCPSFunction(lab, KNOWN_CHECK, f, vl, formals, tl, e)
1247 : monnier 429 end
1248 :     | Frag.KNOWNCHK(ref(Frag.GEN formals)) =>
1249 :     (callSetup(formals, args);
1250 :     testLimit hp;
1251 :     emit(branchToLabel(functionLabel f)))
1252 :     | Frag.STANDARD{fmlTyps, ...} =>
1253 :     let val formals = ArgP.standard(typmap f, fmlTyps)
1254 :     in callSetup(formals, args);
1255 :     testLimit hp;
1256 :     emit(branchToLabel(functionLabel f))
1257 :     end
1258 :     (*esac*))
1259 : monnier 247
1260 : leunga 585 (*
1261 :     * Generate code
1262 :     *)
1263 :    
1264 :     (** RECORD **)
1265 :     and gen(RECORD(RK_FCONT, vl, w, e), hp) = mkFblock(vl, w, e, hp)
1266 :     | gen(RECORD(RK_FBLOCK, vl, w, e), hp) = mkFblock(vl, w, e, hp)
1267 :     | gen(RECORD(RK_VECTOR, vl, w, e), hp) = mkVector(vl, w, e, hp)
1268 :     | gen(RECORD(RK_I32BLOCK, vl, w, e), hp) = mkI32block(vl, w, e, hp)
1269 :     | gen(RECORD(_, vl, w, e), hp) = mkRecord(vl, w, e, hp)
1270 :    
1271 :     (*** SELECT ***)
1272 :     | gen(SELECT(i, INT k, x, t, e), hp) = funnySelect(i,k,x,t,e,hp)
1273 :     | gen(SELECT(i, v, x, FLTt, e), hp) = fselect(i, v, x, e, hp)
1274 :     | gen(SELECT(i, v, x, t, e), hp) = select(i, v, x, t, e, hp)
1275 :    
1276 :     (*** OFFSET ***)
1277 :     | gen(OFFSET(i, v, x, e), hp) =
1278 :     defBoxed(x, scale4(regbind v, INT i), e, hp)
1279 :    
1280 :     (*** APP ***)
1281 :     | gen(APP(INT k, args), hp) = updtHeapPtr(hp)
1282 :     | gen(APP(VAR f, args), hp) = externalApp(f, args, hp)
1283 :     | gen(APP(LABEL f, args), hp) = internalApp(f, args, hp)
1284 :    
1285 : monnier 429 (*** SWITCH ***)
1286 :     | gen(SWITCH(INT _, _, _), hp) = error "SWITCH"
1287 :     | gen(SWITCH(v, _, l), hp) =
1288 :     let val lab = Label.newLabel""
1289 :     val labs = map (fn _ => Label.newLabel"") l
1290 : monnier 498 val tmpR = newReg I32 val tmp = M.REG(ity,tmpR)
1291 : monnier 429 in emit(M.MV(ity, tmpR, laddr(lab, 0)));
1292 : george 546 emit(M.JMP([], M.ADD(addrTy, tmp, M.LOAD(pty, scale4(tmp, v),
1293 : monnier 429 R.readonly)), labs));
1294 :     pseudoOp(PseudoOp.JUMPTABLE{base=lab, targets=labs});
1295 : leunga 585 ListPair.app (fn (lab, e) => genlabCont(lab, e, hp)) (labs, l)
1296 : monnier 429 end
1297 : monnier 247
1298 : monnier 429 (*** PURE ***)
1299 : monnier 498 | gen(PURE(P.pure_arith{oper=P.orb, kind}, [v,w], x, _, e), hp) =
1300 : leunga 585 defWithKind(kind, x, M.ORB(ity, regbind v, regbind w), e, hp)
1301 : monnier 498 | gen(PURE(P.pure_arith{oper=P.andb, kind}, [v,w], x, _, e), hp) =
1302 : leunga 585 defWithKind(kind, x, M.ANDB(ity, regbind v, regbind w), e, hp)
1303 :     | gen(PURE(P.pure_arith{oper, kind}, [v,w], x, ty, e), hp) =
1304 : monnier 429 (case kind
1305 :     of P.INT 31 => (case oper
1306 : leunga 585 of P.xorb => defI31(x, int31xor(v,w), e, hp)
1307 :     | P.lshift => defI31(x, int31lshift(v,w), e, hp)
1308 :     | P.rshift => defI31(x, int31rshift(M.SRA,v,w),e,hp)
1309 : monnier 429 | _ => error "gen:PURE INT 31"
1310 :     (*esac*))
1311 :     | P.INT 32 => (case oper
1312 : monnier 498 of P.xorb => arith32(M.XORB, v, w, x, e, hp)
1313 :     | P.lshift => logical32(M.SLL, v, w, x, e, hp)
1314 :     | P.rshift => logical32(M.SRA, v, w, x, e, hp)
1315 : monnier 429 | _ => error "gen:PURE INT 32"
1316 :     (*esac*))
1317 :     | P.UINT 31 => (case oper
1318 : leunga 585 of P.+ => defI31(x, int31add(M.ADD, v, w), e, hp)
1319 :     | P.- => defI31(x, int31sub(M.SUB, v, w), e, hp)
1320 :     | P.* => defI31(x, int31mul(false, v, w), e, hp)
1321 : monnier 429 | P./ => (* This is not really a pure
1322 :     operation -- oh well *)
1323 : leunga 585 (updtHeapPtr hp;
1324 :     defI31(x, int31div(false, v, w), e, 0))
1325 :     | P.xorb => defI31(x, int31xor(v, w), e, hp)
1326 :     | P.lshift => defI31(x,int31lshift(v, w), e, hp)
1327 :     | P.rshift => defI31(x,int31rshift(M.SRA,v, w),e,hp)
1328 :     | P.rshiftl => defI31(x,int31rshift(M.SRL,v, w),e,hp)
1329 : monnier 429 | _ => error "gen:PURE UINT 31"
1330 :     (*esac*))
1331 :     | P.UINT 32 => (case oper
1332 : monnier 498 of P.+ => arith32(M.ADD, v, w, x, e, hp)
1333 : leunga 585 | P.- => arith32(M.SUB, v, w, x, e, hp)
1334 : monnier 498 | P.* => arith32(M.MULU, v, w, x, e, hp)
1335 : monnier 429 | P./ => (updtHeapPtr hp;
1336 : monnier 498 arith32(M.DIVU, v, w, x, e, 0))
1337 :     | P.xorb => arith32(M.XORB, v, w, x, e, hp)
1338 :     | P.lshift => logical32(M.SLL, v, w, x, e, hp)
1339 :     | P.rshift => logical32(M.SRA, v, w, x, e, hp)
1340 :     | P.rshiftl=> logical32(M.SRL, v, w, x, e, hp)
1341 : monnier 429 | _ => error "gen:PURE UINT 32"
1342 :     (*esac*))
1343 :     (*esac*))
1344 :     | gen(PURE(P.pure_arith{oper=P.notb, kind}, [v], x, _, e), hp) =
1345 : leunga 585 (case kind
1346 :     of P.UINT 32 => defI32(x,M.XORB(ity, regbind v,
1347 : monnier 429 M.LI32 0wxFFFFFFFF), e, hp)
1348 : leunga 585 | P.INT 32 => defI32(x,M.XORB(ity, regbind v,
1349 : monnier 429 M.LI32 0wxFFFFFFFF), e, hp)
1350 : leunga 585 | P.UINT 31 => defI31(x,M.SUB(ity, zero, regbind v), e, hp)
1351 :     | P.INT 31 => defI31(x,M.SUB(ity, zero, regbind v), e, hp)
1352 : monnier 429 (*esac*))
1353 :     | gen(PURE(P.copy ft, [v], x, _, e), hp) =
1354 :     (case ft
1355 : leunga 585 of (31, 32) => defI32(x, M.SRL(ity, regbind v, one), e, hp)
1356 : monnier 498 | (8, 31) => copy(I31, x, v, e, hp)
1357 : leunga 585 | (8, 32) => defI32(x, M.SRL(ity, regbind v, one), e, hp)
1358 : monnier 498 | (n,m) => if n = m then copyM(m, x, v, e, hp)
1359 : monnier 429 else error "gen:PURE:copy"
1360 :     (*esac*))
1361 :     | gen(PURE(P.extend ft, [v], x, _ ,e), hp) =
1362 :     (case ft
1363 :     of (8,31) =>
1364 : leunga 585 defI31(x,
1365 : monnier 498 M.SRA(ity, M.SLL(ity, regbind v,M.LI 23), M.LI 23),
1366 : monnier 429 e, hp)
1367 :     | (8,32) =>
1368 : leunga 585 defI32(x,
1369 : monnier 498 M.SRA(ity, M.SLL(ity, regbind v, M.LI 23), M.LI 24),
1370 : monnier 429 e, hp)
1371 : leunga 585 | (31,32) => defI32(x, M.SRA(ity, regbind v, one), e, hp)
1372 : monnier 498 | (n, m) => if n = m then copyM(m, x, v, e, hp)
1373 : monnier 429 else error "gen:PURE:extend"
1374 :     (*esac*))
1375 :     | gen(PURE(P.trunc ft, [v], x, _, e), hp) =
1376 :     (case ft
1377 :     of (32, 31) =>
1378 : leunga 585 defI31(x, M.ORB(ity, M.SLL(ity, regbind v, one), one), e, hp)
1379 :     | (31,8) => defI32(x, M.ANDB(ity, regbind v, M.LI 0x1ff), e, hp)
1380 :     | (32,8) => defI32(x, tagUnsigned(M.ANDB(ity, regbind v,
1381 :     M.LI 0xff)), e, hp)
1382 : monnier 498 | (n, m) => if n = m then copyM(m, x, v, e, hp)
1383 : monnier 429 else error "gen:PURE:trunc"
1384 :     (*esac*))
1385 : leunga 585 | gen(PURE(P.real{fromkind=P.INT 31, tokind=P.FLOAT 64},
1386 :     [v], x, _, e), hp) =
1387 :     treeifyDefF64(x,M.CVTI2F(fty,ity,untagSigned(v)), e, hp)
1388 : monnier 429 | gen(PURE(P.pure_arith{oper, kind=P.FLOAT 64}, [v], x, _, e), hp) =
1389 :     let val r = fregbind v
1390 :     in case oper
1391 : leunga 585 of P.~ => treeifyDefF64(x, M.FNEG(fty,r), e, hp)
1392 :     | P.abs => treeifyDefF64(x, M.FABS(fty,r), e, hp)
1393 : monnier 429 end
1394 :     | gen(PURE(P.objlength, [v], x, _, e), hp) =
1395 : leunga 585 defI31(x, orTag(getObjLength(v)), e, hp)
1396 :     | gen(PURE(P.length, [v], x, t, e), hp) = select(1, v, x, t, e, hp)
1397 : monnier 429 | gen(PURE(P.subscriptv, [v, INT i], x, t, e), hp) =
1398 : leunga 590 let (* get data pointer *)
1399 :     val mem = dataptrRegion v
1400 :     val a = markPTR(M.LOAD(ity, regbind v, mem))
1401 :     val mem' = arrayRegion mem
1402 :     in defBoxed(x, M.LOAD(ity, scale4(a, INT i), mem'), e, hp)
1403 : monnier 429 end
1404 :     | gen(PURE(P.subscriptv, [v, w], x, _, e), hp) =
1405 :     let (* get data pointer *)
1406 : leunga 590 val mem = dataptrRegion v
1407 :     val a = markPTR(M.LOAD(ity, regbind v, mem))
1408 :     val mem' = arrayRegion mem
1409 :     in defBoxed(x, M.LOAD(ity, scale4(a, w), mem'), e, hp)
1410 : monnier 429 end
1411 :     | gen(PURE(P.pure_numsubscript{kind=P.INT 8}, [v,i], x, _, e), hp) =
1412 :     let (* get data pointer *)
1413 : leunga 590 val mem = dataptrRegion v
1414 :     val a = markPTR(M.LOAD(ity, regbind v, mem))
1415 :     val mem' = arrayRegion mem
1416 :     in defI31(x,tagUnsigned(M.LOAD(8,scale1(a, i), mem')), e, hp)
1417 : monnier 429 end
1418 :     | gen(PURE(P.gettag, [v], x, _, e), hp) =
1419 : leunga 585 defI31(x, tagUnsigned(M.ANDB(ity,
1420 : monnier 429 getObjDescriptor(v), M.LI(D.powTagWidth-1))),
1421 :     e, hp)
1422 :     | gen(PURE(P.mkspecial, [i, v], x, _, e), hp) =
1423 :     let val desc = case i
1424 :     of INT n => M.LI(dtoi(D.makeDesc(n, D.tag_special)))
1425 : leunga 585 | _ => M.ORB(ity, M.SLL(ity, untagSigned(i),M.LI D.tagWidth),
1426 : monnier 429 M.LI(dtoi D.desc_special))
1427 : george 546 in (* What gc types are the components? *)
1428 : leunga 590 treeifyAlloc(x,
1429 :     allocRecord(markNothing, memDisambig x,
1430 :     desc, [(v, offp0)], hp),
1431 : leunga 585 e, hp+8)
1432 : monnier 429 end
1433 :     | gen(PURE(P.makeref, [v], x, _, e), hp) =
1434 : leunga 585 let val tag = M.LI(dtoi D.desc_ref)
1435 : monnier 429 val mem = memDisambig x
1436 :     in emit(M.STORE(ity,M.ADD(addrTy,C.allocptr,M.LI hp),tag,mem));
1437 :     emit(M.STORE(ity,M.ADD(addrTy,C.allocptr,M.LI(hp+4)),
1438 : leunga 585 regbind' v, mem));
1439 :     treeifyAlloc(x, hp+4, e, hp+8)
1440 : monnier 429 end
1441 : leunga 585 | gen(PURE(P.fwrap,[u],w,_,e), hp) = mkFblock([(u, offp0)],w,e,hp)
1442 :     | gen(PURE(P.funwrap,[u],w,_,e), hp) = fselect(0,u,w,e,hp)
1443 : monnier 429 | gen(PURE(P.iwrap,[u],w,_,e), _) = error "iwrap not implemented"
1444 :     | gen(PURE(P.iunwrap,[u],w,_,e), _) = error "iunwrap not implemented"
1445 :     | gen(PURE(P.i32wrap,[u],w,_,e), hp) =
1446 : leunga 585 mkI32block([(u, offp0)], w, e, hp)
1447 : monnier 429 | gen(PURE(P.i32unwrap,[u],w,_,e), hp) =
1448 : leunga 585 select(0, u, w, INT32t, e, hp)
1449 : monnier 498
1450 :     | gen(PURE(P.wrap,[u],w,_,e), hp) = copy(PTR, w, u, e, hp)
1451 :     | gen(PURE(P.unwrap,[u],w,_,e), hp) = copy(I32, w, u, e, hp)
1452 :    
1453 : leunga 585 (* Note: the gc type is unsafe! XXX *)
1454 : monnier 498 | gen(PURE(P.cast,[u],w,_,e), hp) = copy(PTR, w, u, e, hp)
1455 :    
1456 : leunga 585 | gen(PURE(P.getcon,[u],w,t,e), hp) = select(0,u,w,t,e,hp)
1457 :     | gen(PURE(P.getexn,[u],w,t,e), hp) = select(0,u,w,t,e,hp)
1458 :     | gen(PURE(P.getseqdata, [u], x, t, e), hp) = select(0,u,x,t,e,hp)
1459 : monnier 429 | gen(PURE(P.recsubscript, [v, INT w], x, t, e), hp) =
1460 : leunga 585 select(w,v,x,t,e,hp)
1461 : monnier 429 | gen(PURE(P.recsubscript, [v, w], x, _, e), hp) =
1462 : leunga 590 (* no indirection! *)
1463 :     let val mem = arrayRegion(getRegion v)
1464 :     in defI31(x, M.LOAD(ity, scale4(regbind v, w), mem), e, hp)
1465 :     end
1466 : monnier 429 | gen(PURE(P.raw64subscript, [v, i], x, _, e), hp) =
1467 : leunga 590 let val mem = arrayRegion(getRegion v)
1468 :     in treeifyDefF64(x, M.FLOAD(fty,scale8(regbind v, i), mem),
1469 :     e, hp)
1470 :     end
1471 : monnier 429 | gen(PURE(P.newarray0, [_], x, t, e), hp) =
1472 :     let val hdrDesc = dtoi(D.desc_polyarr)
1473 :     val dataDesc = dtoi D.desc_ref
1474 : monnier 498 val dataPtr = newReg PTR
1475 : monnier 429 val hdrM = memDisambig x
1476 :     val (tagM, valM) = (hdrM, hdrM) (* Allen *)
1477 : leunga 585 in (* gen code to allocate "ref()" for array data *)
1478 : monnier 429 emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, M.LI hp),
1479 :     M.LI dataDesc, tagM));
1480 :     emit(M.STORE(ity, M.ADD(addrTy, C.allocptr, M.LI(hp+4)),
1481 :     mlZero, valM));
1482 :     emit(M.MV(pty, dataPtr, M.ADD(addrTy,C.allocptr,M.LI(hp+4))));
1483 : leunga 585 (* gen code to allocate array header *)
1484 : leunga 590 treeifyAlloc(x,
1485 :     allocHeaderPair(hdrDesc, hdrM, dataPtr, 0, hp+8),
1486 :     e, hp+20)
1487 : monnier 429 end
1488 :     (*** ARITH ***)
1489 : leunga 585 | gen(ARITH(P.arith{kind=P.INT 31, oper=P.~}, [v], x, _, e), hp) =
1490 :     (updtHeapPtr hp;
1491 :     defI31(x, M.SUBT(ity, M.LI 2, regbind v), e, 0)
1492 :     )
1493 :     | gen(ARITH(P.arith{kind=P.INT 31, oper}, [v, w], x, _, e), hp) =
1494 :     (updtHeapPtr hp;
1495 :     let val t =
1496 :     case oper
1497 :     of P.+ => int31add(M.ADDT, v, w)
1498 :     | P.- => int31sub(M.SUBT, v, w)
1499 :     | P.* => int31mul(true, v, w)
1500 :     | P./ => int31div(true, v, w)
1501 :     | _ => error "gen:ARITH INT 31"
1502 :     in defI31(x, t, e, 0) end
1503 : monnier 429 (*esac*))
1504 :     | gen(ARITH(P.arith{kind=P.INT 32, oper}, [v,w], x, _, e), hp) =
1505 :     (updtHeapPtr hp;
1506 :     case oper
1507 : monnier 498 of P.+ => arith32(M.ADDT, v, w, x, e, 0)
1508 :     | P.- => arith32(M.SUBT, v, w, x, e, 0)
1509 :     | P.* => arith32(M.MULT, v, w, x, e, 0)
1510 :     | P./ => arith32(M.DIVT, v, w, x, e, 0)
1511 : monnier 429 | _ => error "P.arith{kind=INT 32, oper}, [v,w], ..."
1512 :     (*esac*))
1513 :     | gen(ARITH(P.arith{kind=P.INT 32, oper=P.~ }, [v], x, _, e), hp) =
1514 :     (updtHeapPtr hp;
1515 : leunga 585 defI32(x, M.SUBT(ity, zero, regbind v), e, 0))
1516 : monnier 429
1517 :     (* Note: for testu operations we use a somewhat arcane method
1518 :     * to generate traps on overflow conditions. A better approach
1519 :     * would be to generate a trap-if-negative instruction available
1520 :     * on a variety of machines, e.g. mips and sparc (maybe others).
1521 :     *)
1522 :     | gen(ARITH(P.testu(32, 32), [v], x, _, e), hp) =
1523 : monnier 498 let val xreg = newReg I32
1524 : monnier 429 val vreg = regbind v
1525 :     in updtHeapPtr hp;
1526 :     emit(M.MV(ity, xreg, M.ADDT(ity, vreg,
1527 :     regbind(INT32 0wx80000000))));
1528 : leunga 585 defI32(x, vreg, e, 0)
1529 : monnier 429 end
1530 :     | gen(ARITH(P.testu(31, 31), [v], x, _, e), hp) =
1531 : monnier 498 let val xreg = newReg I31
1532 : monnier 429 val vreg = regbind v
1533 :     in updtHeapPtr hp;
1534 :     emit(M.MV(ity,xreg,M.ADDT(ity, vreg,
1535 :     regbind(INT32 0wx80000000))));
1536 : leunga 585 defI31(x, vreg, e, 0)
1537 : monnier 429 end
1538 :     | gen(ARITH(P.testu(32,31), [v], x, _, e), hp) =
1539 :     let val vreg = regbind v
1540 : monnier 498 val tmp = newReg I32
1541 : monnier 429 val tmpR = M.REG(ity,tmp)
1542 :     val lab = Label.newLabel ""
1543 :     in emit(M.MV(ity, tmp, regbind(INT32 0wx3fffffff)));
1544 : leunga 585 updtHeapPtr hp;
1545 : george 546 emit(M.BCC([], M.CMP(32, M.LEU, vreg, tmpR),lab));
1546 : monnier 429 emit(M.MV(ity, tmp, M.SLL(ity, tmpR, one)));
1547 :     emit(M.MV(ity, tmp, M.ADDT(ity, tmpR, tmpR)));
1548 :     defineLabel lab;
1549 : leunga 585 defI31(x, tagUnsigned(vreg), e, 0)
1550 : monnier 429 end
1551 :     | gen(ARITH(P.test(32,31), [v], x, _, e), hp) =
1552 : leunga 585 (updtHeapPtr hp; defI31(x, tagSigned(regbind v), e, 0))
1553 : monnier 429 | gen(ARITH(P.test(n, m), [v], x, _, e), hp) =
1554 : monnier 498 if n = m then copyM(m, x, v, e, hp) else error "gen:ARITH:test"
1555 : leunga 585 | gen(ARITH(P.arith{oper, kind=P.FLOAT 64}, [v,w], x, _, e), hp) =
1556 :     let val v = fregbind v
1557 :     val w = fregbind w
1558 :     val t =
1559 :     case oper
1560 :     of P.+ => M.FADD(fty, v, w)
1561 :     | P.* => M.FMUL(fty, v, w)
1562 :     | P.- => M.FSUB(fty, v, w)
1563 :     | P./ => M.FDIV(fty, v, w)
1564 :     in treeifyDefF64(x, t, e, hp)
1565 : monnier 429 end
1566 :     (*** LOOKER ***)
1567 :     | gen(LOOKER(P.!, [v], x, _, e), hp) =
1568 : leunga 590 let val mem = arrayRegion(getRegion v)
1569 :     in defBoxed (x, M.LOAD(ity, regbind v, mem), e, hp)
1570 :     end
1571 : monnier 429 | gen(LOOKER(P.subscript, [v,w], x, _, e), hp) =
1572 :     let (* get data pointer *)
1573 : leunga 590 val mem = dataptrRegion v
1574 :     val a = markPTR(M.LOAD(ity, regbind v, mem))
1575 :     val mem' = arrayRegion mem
1576 :     in defBoxed (x, M.LOAD(ity, scale4(a, w), mem'), e, hp)
1577 : monnier 429 end
1578 :     | gen(LOOKER(P.numsubscript{kind=P.INT 8},[v,i],x,_,e), hp) =
1579 :     let (* get data pointer *)
1580 : leunga 590 val mem = dataptrRegion v
1581 :     val a = markPTR(M.LOAD(ity, regbind v, mem))
1582 :     val mem' = arrayRegion mem
1583 :     in defI31(x, tagUnsigned(M.LOAD(8,scale1(a, i), mem')), e, hp)
1584 : monnier 429 end
1585 :     | gen(LOOKER(P.numsubscript{kind=P.FLOAT 64}, [v,i], x, _, e), hp)=
1586 :     let (* get data pointer *)
1587 : leunga 590 val mem = dataptrRegion v
1588 :     val a = markPTR(M.LOAD(ity, regbind v, mem))
1589 :     val mem' = arrayRegion mem
1590 :     in treeifyDefF64(x, M.FLOAD(fty,scale8(a, i), mem'), e, hp)
1591 : monnier 429 end
1592 : leunga 585 | gen(LOOKER(P.gethdlr,[],x,_,e), hp) = defBoxed(x, C.exnptr, e, hp)
1593 :     | gen(LOOKER(P.getvar, [], x, _, e), hp)= defBoxed(x, C.varptr, e, hp)
1594 :     | gen(LOOKER(P.deflvar, [], x, _, e), hp)= defBoxed(x, zero, e, hp)
1595 : monnier 429 | gen(LOOKER(P.getspecial, [v], x, _, e), hp) =
1596 : leunga 585 defBoxed(x, orTag(M.SRA(ity, getObjDescriptor(v),
1597 :     M.LI (D.tagWidth-1))),
1598 :     e, hp)
1599 : monnier 429 | gen(LOOKER(P.getpseudo, [i], x, _, e), hp) =
1600 :     (print "getpseudo not implemented\n"; nop(x, i, e, hp))
1601 :     (*** SETTER ***)
1602 :     | gen(SETTER(P.assign, [a as VAR arr, v], e), hp) =
1603 :     let val ea = regbind a
1604 : leunga 590 val mem = arrayRegion(getRegion a)
1605 : monnier 429 in recordStore(ea, hp);
1606 : leunga 590 emit(M.STORE(ity, ea, regbind v, mem));
1607 : monnier 429 gen(e, hp+8)
1608 :     end
1609 :     | gen(SETTER(P.unboxedassign, [a, v], e), hp) =
1610 : leunga 590 let val mem = arrayRegion(getRegion a)
1611 :     in emit(M.STORE(ity, regbind a, regbind v, mem));
1612 :     gen(e, hp)
1613 :     end
1614 : monnier 429 | gen(SETTER(P.update, [v,i,w], e), hp) =
1615 :     let (* get data pointer *)
1616 : leunga 590 val mem = dataptrRegion v
1617 :     val a = markPTR(M.LOAD(ity, regbind v, mem))
1618 : monnier 429 val tmpR = Cells.newReg() (* derived pointer! *)
1619 : leunga 590 val tmp = M.REG(ity, tmpR)
1620 :     val ea = scale4(a, i) (* address of updated cell *)
1621 :     val mem' = arrayRegion(mem)
1622 : monnier 429 in emit(M.MV(ity, tmpR, ea));
1623 :     recordStore(tmp, hp);
1624 : leunga 590 emit(M.STORE(ity, tmp, regbind w, mem'));
1625 : monnier 429 gen(e, hp+8)
1626 :     end
1627 :     | gen(SETTER(P.boxedupdate, args, e), hp) =
1628 :     gen(SETTER(P.update, args, e), hp)
1629 :     | gen(SETTER(P.unboxedupdate, [v, i, w], e), hp) =
1630 :     let (* get data pointer *)
1631 : leunga 590 val mem = dataptrRegion v
1632 :     val a = markPTR(M.LOAD(ity, regbind v, mem))
1633 :     val mem' = arrayRegion mem
1634 :     in emit(M.STORE(ity, scale4(a, i), regbind w, mem'));
1635 : monnier 429 gen(e, hp)
1636 :     end
1637 :     | gen(SETTER(P.numupdate{kind=P.INT 8}, [s,i,v], e), hp) =
1638 :     let (* get data pointer *)
1639 : leunga 590 val mem = dataptrRegion v
1640 :     val a = markPTR(M.LOAD(ity, regbind s, mem))
1641 :     val ea = scale1(a, i)
1642 :     val mem' = arrayRegion mem
1643 :     in emit(M.STORE(8, ea, untagUnsigned(v), mem'));
1644 : monnier 429 gen(e, hp)
1645 :     end
1646 :     | gen(SETTER(P.numupdate{kind=P.FLOAT 64},[v,i,w],e), hp) =
1647 :     let (* get data pointer *)
1648 : leunga 590 val mem = dataptrRegion v
1649 :     val a = markPTR(M.LOAD(ity, regbind v, mem))
1650 :     val mem' = arrayRegion mem
1651 :     in emit(M.FSTORE(fty,scale8(a, i), fregbind w, mem'));
1652 : monnier 429 gen(e, hp)
1653 :     end
1654 :     | gen(SETTER(P.setspecial, [v, i], e), hp) =
1655 :     let val ea = M.SUB(ity, regbind v, M.LI 4)
1656 :     val i' =
1657 :     case i
1658 :     of INT k => M.LI(dtoi(D.makeDesc(k, D.tag_special)))
1659 : leunga 585 | _ => M.ORB(ity, M.SLL(ity, untagSigned(i),
1660 : monnier 429 M.LI D.tagWidth),
1661 :     M.LI(dtoi D.desc_special))
1662 : leunga 590 val mem = getRegionPi(v, 0)
1663 :     in emit(M.STORE(ity, ea, i', mem));
1664 : monnier 429 gen(e, hp)
1665 :     end
1666 :     | gen(SETTER(P.sethdlr,[x],e), hp) =
1667 : leunga 585 (emit(assign(C.exnptr, regbind x)); gen(e, hp))
1668 : monnier 429 | gen(SETTER(P.setvar,[x],e), hp) =
1669 : leunga 585 (emit(assign(C.varptr, regbind x)); gen(e, hp))
1670 : monnier 429 | gen(SETTER(P.uselvar,[x],e), hp) = gen(e, hp)
1671 :     | gen(SETTER(P.acclink,_,e), hp) = gen(e, hp)
1672 :     | gen(SETTER(P.setmark,_,e), hp) = gen(e, hp)
1673 :     | gen(SETTER(P.free,[x],e), hp) = gen(e, hp)
1674 :     | gen(SETTER(P.setpseudo,_,e), hp) =
1675 :     (print "setpseudo not implemented\n"; gen(e, hp))
1676 :    
1677 :     (*** BRANCH ***)
1678 :     | gen(BRANCH(P.cmp{oper,kind=P.INT 31},[INT v, INT k],_,e,d), hp) =
1679 : leunga 585 if (case oper
1680 :     of P.> => v>k
1681 :     | P.>= => v>=k
1682 :     | P.< => v<k
1683 :     | P.<= => v<=k
1684 :     | P.eql => v=k
1685 :     | P.neq => v<>k
1686 :     (*esac*))
1687 :     then gen(e, hp)
1688 :     else gen(d, hp)
1689 : monnier 429 | gen(BRANCH(P.cmp{oper, kind=P.INT 31}, vw, _, e, d), hp) =
1690 :     branch(signedCmp oper, vw, e, d, hp)
1691 :     | gen(BRANCH(P.cmp{oper,kind=P.UINT 31},[INT v', INT k'],_,e,d),hp)=
1692 :     let open Word
1693 :     val v = fromInt v'
1694 :     val k = fromInt k'
1695 :     in if (case oper
1696 :     of P.> => v>k
1697 :     | P.>= => v>=k
1698 :     | P.< => v<k
1699 :     | P.<= => v<=k
1700 :     | P.eql => v=k
1701 :     | P.neq => v<>k
1702 :     (*esac*))
1703 :     then gen(e, hp)
1704 :     else gen(d, hp)
1705 :     end
1706 :     | gen(BRANCH(P.cmp{oper, kind=P.UINT 31}, vw, _, e, d), hp) =
1707 :     branch(unsignedCmp oper, vw, e, d, hp)
1708 :     | gen(BRANCH(P.cmp{oper,kind=P.UINT 32},[INT32 v,INT32 k],_,e,d),
1709 :     hp) =
1710 :     let open Word32
1711 :     in if (case oper
1712 :     of P.> => v>k
1713 :     | P.>= => v>=k
1714 :     | P.< => v<k
1715 :     | P.<= => v<=k
1716 :     | P.eql => v=k
1717 :     | P.neq => v<>k
1718 :     (*esac*))
1719 :     then gen(e, hp)
1720 :     else gen(d, hp)
1721 :     end
1722 :     | gen(BRANCH(P.cmp{oper, kind=P.UINT 32}, vw, _, e, d), hp) =
1723 :     branch(unsignedCmp oper, vw, e, d, hp)
1724 :    
1725 :     | gen(BRANCH(P.cmp{oper, kind=P.INT 32}, vw, _, e, d), hp) =
1726 :     branch(signedCmp oper, vw, e, d, hp)
1727 :     | gen(BRANCH(P.fcmp{oper,size=64}, [v,w], _, d, e), hp) =
1728 :     let val trueLab = Label.newLabel""
1729 :     val fcond =
1730 :     case oper
1731 :     of P.fEQ => M.==
1732 :     | P.fULG => M.?<>
1733 :     | P.fUN => M.?
1734 :     | P.fLEG => M.<=>
1735 :     | P.fGT => M.>
1736 :     | P.fGE => M.>=
1737 :     | P.fUGT => M.?>
1738 :     | P.fUGE => M.?>=
1739 :     | P.fLT => M.<
1740 :     | P.fLE => M.<=
1741 :     | P.fULT => M.?<
1742 :     | P.fULE => M.?<=
1743 :     | P.fLG => M.<>
1744 :     | P.fUE => M.?=
1745 :    
1746 :     val cmp = M.FCMP(64, fcond, fregbind v, fregbind w)
1747 : george 546 in emit(M.BCC([], cmp, trueLab));
1748 : leunga 585 genCont(e, hp);
1749 : monnier 429 genlab(trueLab, d, hp)
1750 :     end
1751 :     | gen(BRANCH(P.peql, vw, _,e,d), hp) = branch(M.EQ, vw, e, d, hp)
1752 :     | gen(BRANCH(P.pneq, vw, _, e, d), hp) = branch(M.NE, vw, e, d, hp)
1753 : leunga 585 | gen(BRANCH(P.strneq, [INT n,v,w], _, d, e), hp) =
1754 :     branchStreq(n,v,w,e,d,hp)
1755 : monnier 429 | gen(BRANCH(P.streq, [INT n,v,w],_,d,e), hp) =
1756 : leunga 585 branchStreq(n,v,w,d,e,hp)
1757 :     | gen(BRANCH(P.boxed, [x], _, a, b), hp) = branchOnBoxed(x,a,b,hp)
1758 :     | gen(BRANCH(P.unboxed, [x], _, a, b), hp) = branchOnBoxed(x,b,a,hp)
1759 : monnier 429 | gen(e, hp) = (PPCps.prcps e; print "\n"; error "genCluster.gen")
1760 : leunga 585
1761 :     end (*local*)
1762 : monnier 429
1763 :     fun fragComp() =
1764 :     let fun continue() = fcomp (Frag.next())
1765 :     and fcomp(NONE) = ()
1766 :     | fcomp(SOME(_, Frag.KNOWNFUN _)) = continue()
1767 :     | fcomp(SOME(_, Frag.KNOWNCHK _)) = continue()
1768 :     | fcomp(SOME(_, Frag.STANDARD{func=ref NONE, ...})) = continue()
1769 :     | fcomp(SOME(lab,
1770 : leunga 585 Frag.STANDARD{func as ref(SOME (zz as (k,f,vl,tl,e))),
1771 : monnier 429 ...})) =
1772 : leunga 585 let val formals = ArgP.standard(typmap f, tl)
1773 :     in func := NONE;
1774 :     pseudoOp PseudoOp.ALIGN4;
1775 :     genCPSFunction(lab, k, f, vl, formals, tl, e);
1776 :     continue()
1777 : monnier 429 end
1778 :     in fcomp (Frag.next())
1779 :     end (* fragComp *)
1780 : monnier 247
1781 : monnier 429 (*
1782 :     * execution starts at the first CPS function -- the frag
1783 :     * is maintained as a queue.
1784 :     *)
1785 :     fun initFrags (start::rest : CPS.function list) =
1786 :     let fun init(func as (fk, f, _, _, _)) =
1787 :     addGenTbl (f, Frag.makeFrag(func, functionLabel f))
1788 :     in app init rest;
1789 :     init start
1790 : monnier 247 end
1791 :     in
1792 : monnier 498 initFrags cluster;
1793 :     beginCluster 0;
1794 : george 546 if gctypes then Intmap.clear(GCCells.getGCMap()) else ();
1795 : monnier 429 fragComp();
1796 :     InvokeGC.emitLongJumpsToGCInvocation stream;
1797 :     endCluster(
1798 : george 546 if gctypes then
1799 : monnier 429 let val gcmap = GCCells.getGCMap()
1800 : monnier 475 in [#create SMLGCMap.GCMAP gcmap,
1801 : monnier 469 #create
1802 : george 546 MLRiscAnnotations.REGINFO(
1803 :     let val pr = SMLGCMap.toString gcmap
1804 :     in fn (_,r) => pr r end
1805 :     )
1806 : monnier 429 ]
1807 :     end
1808 :     else []
1809 :     )
1810 :     end (* genCluster *)
1811 : monnier 247
1812 : monnier 469 fun emitMLRiscUnit f =
1813 : monnier 429 (Cells.reset();
1814 :     beginCluster 0;
1815 :     f stream;
1816 : leunga 585 endCluster NO_OPT
1817 : monnier 429 )
1818 :     in app mkGlobalTables funcs;
1819 :     app genCluster (Cluster.cluster funcs);
1820 : leunga 586 emitMLRiscUnit InvokeGC.emitModuleGC
1821 : monnier 247 end (* codegen *)
1822 :     end (* MLRiscGen *)
1823 :    

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