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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3008 - (view) (download)

1 : mrainey 2990 structure TestStagedAllocation =
2 :     struct
3 :    
4 :     structure C = AMD64Instr.C
5 :     structure T = AMD64MLTree
6 :     structure CFG = AMD64CFG
7 : mrainey 2992
8 :     val wordTy = 64
9 : mrainey 2990
10 : mrainey 2992 fun codegen (functionName, target, proto, initStms, args) = let
11 : mrainey 2990 val _ = Label.reset()
12 :    
13 : mrainey 3008 val [functionName, target] = List.map Label.global [functionName, target]
14 : mrainey 2990
15 :     val insnStrm = AMD64FlowGraph.build()
16 :     (* construct the C call *)
17 :     val {result, callseq} = CCalls.genCall {
18 :     name=T.LABEL target,
19 :     paramAlloc=fn _ => false,
20 :     structRet=fn _ => T.REG (64, C.rax),
21 :     saveRestoreDedicated=fn _ => {save=[], restore=[]},
22 :     callComment=NONE,
23 :     proto=proto,
24 :     args=args}
25 :    
26 : mrainey 3000 fun wordLit i = T.LI (T.I.fromInt (wordTy, i))
27 :    
28 : mrainey 2990 val stms = List.concat [
29 : mrainey 2992 [T.EXT(AMD64InstrExt.PUSHQ(T.REG(64, C.rbp))),
30 : mrainey 3000 T.COPY (wordTy, [C.rbp], [C.rsp])],
31 : mrainey 2992 initStms,
32 : mrainey 3000 callseq,
33 : mrainey 2990 [T.EXT(AMD64InstrExt.LEAVE)],
34 :     [T.RET []]]
35 :    
36 :     val stream as AMD64Stream.STREAM
37 :     { beginCluster, (* start a cluster *)
38 :     endCluster, (* end a cluster *)
39 :     emit, (* emit MLTREE stm *)
40 :     defineLabel, (* define a local label *)
41 :     entryLabel, (* define an external entry *)
42 :     exitBlock, (* mark the end of a procedure *)
43 :     pseudoOp, (* emit a pseudo op *)
44 :     annotation, (* add an annotation *)
45 :     ... } =
46 :     AMD64.selectInstructions insnStrm
47 :     fun doit () = (
48 :     beginCluster 0; (* start a new cluster *)
49 :     pseudoOp PseudoOpsBasisTyp.TEXT;
50 :     pseudoOp (PseudoOpsBasisTyp.EXPORT [functionName]);
51 :     entryLabel functionName; (* define the entry label *)
52 : mrainey 2992 List.app emit stms; (* emit all the statements *)
53 : mrainey 3008 exitBlock result;
54 : mrainey 2990 endCluster [])
55 :     val cfg = doit ()
56 :     val cfg = AMD64RA.run cfg
57 :     val cfg = AMD64Expand.run cfg
58 :     in
59 :     (cfg, stream) (* end the cluster *)
60 :     end (* codegen *)
61 :    
62 :     fun dumpOutput (cfg, stream) = let
63 :     val (cfg as Graph.GRAPH graph, blocks) =
64 :     AMD64BlockPlacement.blockPlacement cfg
65 :     val CFG.INFO{annotations=an, data, decls, ...} = #graph_info graph
66 :     in
67 :     AMD64Emit.asmEmit (cfg, blocks)
68 :     end (* dumpOutput *)
69 :    
70 :     end

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