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 /MLRISC/trunk/x86/staged-allocation/test.sml
ViewVC logotype

Annotation of /MLRISC/trunk/x86/staged-allocation/test.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3063 - (view) (download)

1 : mrainey 3054 val fast_floating_point = ref true
2 :    
3 : mrainey 3010 (*
4 :     * User defined constant type. Dummy for now.
5 :     * In practice, you'll want to use this type to implement constants with
6 :     * values that cannot be determined until final code generation, e.g.
7 :     * stack frame offset.
8 :     *)
9 :     structure UserConst =
10 :     struct
11 :     type const = unit
12 :     fun toString() = ""
13 :     fun hash() = 0w0
14 :     fun valueOf _ = 0
15 :     fun == _ = true
16 :     end
17 :    
18 :     (*
19 :     * User defined datatype for representing aliasing. Dummy for now.
20 :     * You'll need this to represent aliasing information.
21 :     *)
22 :     structure UserRegion =
23 :     struct
24 :     type region = unit
25 :     fun toString () = ""
26 :     val memory = ()
27 :     val stack = ()
28 :     val readonly = ()
29 :     val spill = ()
30 :     end
31 :    
32 :     (*
33 :     * User defined datatype for representing pseudo assembly operators.
34 :     * Dummy for now.
35 :     *
36 :     * You'll need this to represent assembler directives.
37 :     *)
38 :     structure UserPseudoOps =
39 :     struct
40 :     type pseudo_op = unit
41 :     fun toString () = ""
42 :     fun emitValue _ = ()
43 :     fun sizeOf _ = 0
44 :     fun adjustLabels _ = true
45 :     end
46 :    
47 :    
48 :    
49 : mrainey 3009 structure C = X86Cells
50 :     structure Cells = C
51 :    
52 :     (*
53 :     * Client defined extensions. None for now.
54 :     * You'll need this only if you need to extend the set of MLTREE operators
55 :     *)
56 :     structure UserExtension =
57 :     struct
58 :    
59 :     type ('s,'r,'f,'c) sx = ('s,'r,'f,'c) X86InstrExt.sext
60 :     type ('s,'r,'f,'c) rx = unit
61 :     type ('s,'r,'f,'c) fx = unit
62 :     type ('s,'r,'f,'c) ccx = unit
63 :    
64 :     end
65 :    
66 :     (*
67 :     * This module controls how we handle user extensions. Since we don't
68 :     * have any yet. This is just a bunch of dummy routines.
69 :     *)
70 :     functor UserMLTreeExtComp
71 :     ( structure I : X86INSTR where T.Extension = UserExtension
72 :     structure TS : MLTREE_STREAM where T = I.T
73 :     structure CFG : CONTROL_FLOW_GRAPH where I = I and P = TS.S.P
74 :     ) : MLTREE_EXTENSION_COMP =
75 :     struct
76 :     structure T = TS.T
77 :     structure TS = TS
78 :     structure I = I
79 :     structure CFG = CFG
80 :     structure C = I.C
81 :    
82 :     structure CompInstrExt = X86CompInstrExt (
83 :     structure I = I
84 :     structure TS = TS
85 :     structure CFG = CFG)
86 :    
87 :     type reducer =
88 :     (I.instruction,C.cellset,I.operand,I.addressing_mode,CFG.cfg) TS.reducer
89 :    
90 :     val compileSext = CompInstrExt.compileSext
91 :    
92 : mrainey 3054 fun compileRext _ = raise Fail "CompExtFn.compileRext"
93 :     fun compileFext _ = raise Fail "CompExtFn.compileFext"
94 :     fun compileCCext _ = raise Fail "CompExtFn.compileCCext"
95 : mrainey 3009
96 :     end
97 :    
98 :     structure X86MLTree =
99 :     MLTreeF (structure Constant = UserConst
100 :     structure Region = UserRegion
101 :     structure Extension = UserExtension)
102 :    
103 :     structure X86MLTreeEval =
104 :     MLTreeEval (structure T = X86MLTree
105 :     fun eq _ _ = false
106 :     val eqRext = eq val eqFext = eq
107 :     val eqCCext = eq val eqSext = eq)
108 :    
109 :     structure X86GasPseudoOps =
110 :     X86GasPseudoOps(structure T=X86MLTree
111 :     structure MLTreeEval=X86MLTreeEval)
112 :    
113 : mrainey 3063 (*
114 : mrainey 3009 functor X86PseudoOpsFn (
115 :     structure T : MLTREE
116 :     structure MLTreeEval : MLTREE_EVAL where T = T
117 :     ) : PSEUDO_OPS_BASIS = X86GasPseudoOps (
118 :     structure T = T
119 :     structure MLTreeEval = MLTreeEval)
120 : mrainey 3063 *)
121 : mrainey 3009
122 :     functor X86PseudoOpsFn (
123 :     structure T : MLTREE
124 :     structure MLTreeEval : MLTREE_EVAL where T = T
125 :     ) : PSEUDO_OPS_BASIS = X86DarwinPseudoOps (
126 :     structure T = T
127 :     structure MLTreeEval = MLTreeEval)
128 :    
129 : mrainey 3063
130 : mrainey 3009 structure X86PseudoOps = X86PseudoOpsFn(
131 :     structure T = X86MLTree
132 :     structure MLTreeEval = X86MLTreeEval)
133 :    
134 :     structure PseudoOps =
135 :     struct
136 :    
137 :     structure Client =
138 :     struct
139 :     structure AsmPseudoOps = X86PseudoOps
140 :     type pseudo_op = unit
141 :    
142 :     fun toString () = ""
143 :    
144 :     fun emitValue _ = raise Fail "todo"
145 :     fun sizeOf _ = raise Fail "todo"
146 :     fun adjustLabels _ = raise Fail "todo"
147 :     end (* Client *)
148 :    
149 :     structure PseudoOps = PseudoOps (structure Client = Client)
150 :     end
151 :    
152 :     structure X86Stream = InstructionStream(PseudoOps.PseudoOps)
153 :     structure X86Instr = X86Instr (X86MLTree)
154 :     structure X86Shuffle = X86Shuffle(X86Instr)
155 :    
156 :     structure X86MLTreeHash =
157 :     MLTreeHash (structure T = X86MLTree
158 :     fun h _ _ = 0w0
159 :     val hashRext = h val hashFext = h
160 :     val hashCCext = h val hashSext = h)
161 :    
162 :    
163 :     functor X86MemRegs(X86Instr:X86INSTR) = struct
164 :     structure I = X86Instr
165 :     structure CB = CellsBasis
166 :    
167 :     fun memReg{reg, base} = raise Fail ""
168 :     end
169 :    
170 :     structure X86MemRegs = X86MemRegs(X86Instr)
171 :    
172 :     structure X86Asm = X86AsmEmitter
173 :     (structure Instr = X86Instr
174 :     structure S = X86Stream
175 :     val memRegBase = NONE
176 :     structure MemRegs = X86MemRegs
177 :     structure MLTreeEval = X86MLTreeEval
178 :     structure Shuffle = X86Shuffle
179 :     )
180 :    
181 :     structure X86InsnProps = X86Props
182 :     (structure Instr = X86Instr
183 :     structure MLTreeHash = X86MLTreeHash
184 :     structure MLTreeEval = X86MLTreeEval)
185 :    
186 :     structure X86CFG = ControlFlowGraph (
187 :     structure I = X86Asm.I
188 :     structure GraphImpl = DirectedGraph
189 :     structure InsnProps = X86InsnProps
190 :     structure Asm = X86Asm)
191 :    
192 :     structure X86MLTStream = MLTreeStream (
193 :     structure T = X86MLTree
194 :     structure S = X86Stream)
195 :    
196 :     structure CompInstrExt = X86CompInstrExt (
197 :     structure I = X86Instr
198 :     structure TS = X86MLTStream
199 :     structure CFG = X86CFG)
200 :    
201 :     structure X86MTC = struct
202 :     structure T = X86MLTree
203 :     structure TS = X86MLTStream
204 :     structure I = X86Instr
205 :     structure CFG = X86CFG
206 :     structure C = I.C
207 :     type reducer =
208 :     (I.instruction,C.cellset,I.operand,I.addressing_mode,X86CFG.cfg) TS.reducer
209 :     fun unimplemented _ = MLRiscErrorMsg.impossible "UserMLTreeExtComp"
210 :     val compileSext = CompInstrExt.compileSext
211 :     val compileRext = unimplemented
212 :     val compileFext = unimplemented
213 :     val compileCCext = unimplemented
214 :    
215 :     structure X86MLTreeUtils : MLTREE_UTILS =
216 :     struct
217 :     structure T = X86MLTree
218 :     structure IX = X86InstrExt
219 :     structure U = MLTreeUtils (
220 :     structure T = T
221 :     fun hashSext _ _ = 0w0
222 :     fun hashRext _ _ = 0w0
223 :     fun hashFext _ _ = 0w0
224 :     fun hashCCext _ _ = 0w0
225 :     fun eqSext _ _ = raise Fail "eqSext"
226 :     fun eqRext _ _ = raise Fail "eqRext"
227 :     fun eqFext _ _ = raise Fail "eqFext"
228 :     fun eqCCext _ _ = raise Fail "eqCCext"
229 :     fun showSext (prt : T.printer) ext = raise Fail "todo"
230 :     fun showRext _ _ = raise Fail "showRext"
231 :     fun showFext _ _ = raise Fail "showFext"
232 :     fun showCCext _ _ = raise Fail "showCCext")
233 :     open U
234 :     end
235 :     end
236 :    
237 :     structure X86 = X86 (
238 :     structure X86Instr = X86Instr
239 :     structure MLTreeUtils = X86MTC.X86MLTreeUtils
240 :     structure ExtensionComp = X86MTC
241 :     structure MLTreeStream = X86MLTStream
242 :     datatype arch = Pentium | PentiumPro | PentiumII | PentiumIII
243 :     val arch = ref Pentium (* Lowest common denominator *)
244 :    
245 :     fun cvti2f _ = raise Fail ""
246 : mrainey 3054 val fast_floating_point = fast_floating_point
247 : mrainey 3009 )
248 :    
249 :     structure X86Emit = CFGEmit (
250 :     structure CFG = X86CFG
251 :     structure E = X86Asm)
252 :    
253 :    
254 :     structure X86FlowGraph = BuildFlowgraph
255 :     (structure Props = X86InsnProps
256 :     structure Stream = X86Stream
257 :     structure CFG = X86CFG)
258 :    
259 :     structure X86Expand = CFGExpandCopies (structure CFG=X86CFG
260 :     structure Shuffle = X86Shuffle)
261 :     structure X86BlockPlacement = DefaultBlockPlacement(X86CFG)
262 :    
263 :     structure RASpill = RASpillWithRenaming (
264 :     structure Asm = X86Asm
265 :     structure InsnProps = X86InsnProps
266 :     val max_dist = ref 4
267 :     val keep_multiple_values = ref false)
268 :    
269 :     structure C = X86Cells
270 :    
271 :     datatype spill_operand_kind = SPILL_LOC
272 :     | CONST_VAL
273 :    
274 :     datatype ra_phase = SPILL_PROPAGATION
275 :     | SPILL_COLORING
276 :    
277 :     fun upto(from, to) = if from>to then [] else from::(upto (from+1,to))
278 :     infix upto
279 :    
280 :     structure CB = CellsBasis
281 :    
282 :     structure IntRA =
283 :     struct
284 :     val dedicated = [C.esp, C.ebp]
285 :     val allRegs = C.Regs CellsBasis.GP {from=0, to=7, step=1}
286 :     val allRegsSet = foldl C.addReg C.empty allRegs
287 :     val avail = let
288 :     val availSet = List.foldl C.rmvReg allRegsSet dedicated
289 :     in
290 :     C.getReg availSet
291 :     end
292 :     fun spillInit _ = ()
293 :     val memRegs = C.Regs CB.GP {from=8,to=31,step=1}
294 :     fun spillLoc {info=frame, an, cell, id=loc} =
295 :     raise Fail ""
296 :     (* {opnd = X86Instr.Immed 0, kind = SPILL_LOC}*)
297 :     val phases = [SPILL_PROPAGATION, SPILL_COLORING]
298 :     end (* IntRA *)
299 :    
300 :     structure FloatRA =
301 :     struct
302 :     val avail = List.map C.FPReg (0 upto 31)
303 :     val dedicated = []
304 :     fun spillInit _ = ()
305 :     val fastMemRegs = C.Regs CB.FP {from=8, to=31, step=1}
306 :     val fastPhases = [SPILL_PROPAGATION,SPILL_COLORING]
307 :     val memRegs = []
308 :     fun spillLoc (info, ans, id) = raise Fail ""
309 :     val phases = [SPILL_PROPAGATION]
310 :     end (* FloatRA *)
311 :    
312 :     (* register allocation *)
313 :     structure X86RA = X86RA (
314 :     structure I = X86Instr
315 :     structure InsnProps = X86InsnProps
316 :     structure CFG = X86CFG
317 :     structure Asm = X86Asm
318 :     structure SpillHeur = ChowHennessySpillHeur
319 :     structure Spill = RASpill
320 :     structure Props = X86InsnProps
321 :     type spill_info = unit
322 :     fun beforeRA (Graph.GRAPH graph) = ()
323 :     datatype spillOperandKind = datatype spill_operand_kind
324 :     datatype raPhase = datatype ra_phase
325 : mrainey 3054 val fast_floating_point = fast_floating_point
326 : mrainey 3009 structure Int = IntRA
327 :     structure Float = FloatRA)
328 :    
329 :     structure X86Expand = CFGExpandCopies (
330 :     structure CFG=X86CFG
331 :     structure Shuffle = X86Shuffle)
332 :    
333 :    
334 :     structure CCalls = IA32SVIDFn (
335 :     structure T = X86MLTree
336 :     fun ix x = x
337 : mrainey 3054 val fast_floating_point = fast_floating_point
338 : mrainey 3009 val abi = "")
339 :    
340 :    
341 :     structure C = X86Instr.C
342 :     structure T = X86MLTree
343 :     structure CFG = X86CFG
344 :     structure FlowGraph = X86FlowGraph
345 : mrainey 3049 structure Vararg = IA32VarargCCallFn(
346 :     structure T = X86MLTree
347 :     fun ix x = x
348 : mrainey 3054 val fast_floating_point = fast_floating_point
349 :     val abi = ""
350 :     fun push e = T.EXT(X86InstrExt.PUSHL e)
351 :     val leave = T.EXT X86InstrExt.LEAVE
352 :     )
353 : mrainey 3009
354 : mrainey 3049 structure TestSA =
355 : mrainey 3009 struct
356 :    
357 : mrainey 3054 val wordTy = 32
358 : mrainey 3009
359 : mrainey 3054 fun gen (functionName, stms, result) = let
360 : mrainey 3009 val insnStrm = FlowGraph.build()
361 :     val stream as X86Stream.STREAM
362 :     { beginCluster, (* start a cluster *)
363 :     endCluster, (* end a cluster *)
364 :     emit, (* emit MLTREE stm *)
365 :     defineLabel, (* define a local label *)
366 :     entryLabel, (* define an external entry *)
367 :     exitBlock, (* mark the end of a procedure *)
368 :     pseudoOp, (* emit a pseudo op *)
369 :     annotation, (* add an annotation *)
370 :     ... } =
371 :     X86.selectInstructions insnStrm
372 : mrainey 3054 fun doit () = (
373 : mrainey 3009 beginCluster 0; (* start a new cluster *)
374 :     pseudoOp PseudoOpsBasisTyp.TEXT;
375 :     pseudoOp (PseudoOpsBasisTyp.EXPORT [functionName]);
376 :     entryLabel functionName; (* define the entry label *)
377 :     List.app emit stms; (* emit all the statements *)
378 :     exitBlock result;
379 :     endCluster [])
380 :     val cfg = doit ()
381 :     val cfg = X86RA.run cfg
382 :     val cfg = X86Expand.run cfg
383 : mrainey 3054 in
384 :     (cfg, stream)
385 :     end (* gen *)
386 :    
387 :     fun codegen (functionName, target, proto, initStms, args) = let
388 :     val [functionName, target] = List.map Label.global [functionName, target]
389 :    
390 :     (* construct the C call *)
391 :     val {result, callseq} = CCalls.genCall {
392 :     name=T.LABEL target,
393 :     paramAlloc=fn _ => false,
394 :     structRet=fn _ => T.REG (32, Cells.eax),
395 :     saveRestoreDedicated=fn _ => {save=[], restore=[]},
396 :     callComment=NONE,
397 :     proto=proto,
398 :     args=args}
399 :    
400 :     fun wordLit i = T.LI (T.I.fromInt (wordTy, i))
401 :    
402 :     val stms = List.concat [
403 :     [T.EXT(X86InstrExt.PUSHL(T.REG(32, Cells.ebp))),
404 :     T.COPY (wordTy, [Cells.ebp], [Cells.esp])],
405 :     initStms,
406 :     callseq,
407 :     [T.EXT(X86InstrExt.LEAVE)],
408 :     [T.RET []]]
409 :    
410 :    
411 : mrainey 3009 in
412 : mrainey 3054 gen(functionName, stms, result)
413 :     end (* codegen *)
414 : mrainey 3009
415 :     fun dumpOutput (cfg, stream) = let
416 :     val (cfg as Graph.GRAPH graph, blocks) =
417 :     X86BlockPlacement.blockPlacement cfg
418 :     val CFG.INFO{annotations=an, data, decls, ...} = #graph_info graph
419 :     in
420 :     X86Emit.asmEmit (cfg, blocks)
421 :     end (* dumpOutput *)
422 :    
423 : mrainey 3054 fun vararg _ = let
424 :     val _ = Label.reset()
425 :     val (lab, stms) = Vararg.genVarargs()
426 :     val asmOutStrm = TextIO.openOut "mlrisc.s"
427 :     fun doit () = dumpOutput(gen(lab, stms, [T.GPR (T.REG (wordTy, C.eax))]))
428 :     val _ = AsmStream.withStream asmOutStrm doit ()
429 :     val _ = TextIO.closeOut asmOutStrm
430 :     in
431 :     0
432 :     end
433 :    
434 : mrainey 3009 end
435 :    
436 :     (* machine-specific data *)
437 :     val wordTy = 32
438 :     val wordSzB = wordTy div 8
439 : mrainey 3010 fun li i = T.LI (T.I.fromInt (wordTy, i))
440 :     val param0 = T.LOAD(wordTy, T.ADD(32, li 8, T.REG(32,Cells.ebp)), ())
441 : mrainey 3009
442 :     structure CSizes = IA32CSizes
443 :    

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