Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /MLRISC/trunk/amd64/staged-allocation/test.sml
ViewVC logotype

Diff of /MLRISC/trunk/amd64/staged-allocation/test.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

MLRISC/trunk/staged-allocation/test-staged-allocation-amd64.sml revision 3008, Mon Apr 28 19:40:46 2008 UTC MLRISC/trunk/amd64/staged-allocation/test.sml revision 3009, Tue Apr 29 00:36:12 2008 UTC
# Line 1  Line 1 
1    (*
2     * Client defined extensions.  None for now.
3     * You'll need this only if you need to extend the set of MLTREE operators
4     *)
5    structure UserExtension =
6    struct
7    
8       type ('s,'r,'f,'c) sx = ('s,'r,'f,'c) AMD64InstrExt.sext
9       type ('s,'r,'f,'c) rx = unit
10       type ('s,'r,'f,'c) fx = unit
11       type ('s,'r,'f,'c) ccx = unit
12    
13    end
14    
15    (*
16     * This module controls how we handle user extensions.  Since we don't
17     * have any yet.  This is just a bunch of dummy routines.
18     *)
19    functor UserMLTreeExtComp
20                (    structure I : AMD64INSTR where T.Extension = UserExtension
21        structure TS : MLTREE_STREAM where T = I.T
22        structure CFG : CONTROL_FLOW_GRAPH where I = I and P = TS.S.P
23       ) : MLTREE_EXTENSION_COMP =
24    struct
25        structure T = TS.T
26        structure TS = TS
27        structure I = I
28        structure CFG = CFG
29        structure C = I.C
30    
31        structure CompInstrExt = AMD64CompInstrExt (
32          structure I = I
33          structure TS = TS
34          structure CFG = CFG)
35    
36        type reducer =
37              (I.instruction,C.cellset,I.operand,I.addressing_mode,CFG.cfg) TS.reducer
38    
39        val compileSext = CompInstrExt.compileSext
40    
41        fun compileRext _ = raise Fail "AMD64CompExtFn.compileRext"
42        fun compileFext _ = raise Fail "AMD64CompExtFn.compileFext"
43        fun compileCCext _ = raise Fail "AMD64CompExtFn.compileCCext"
44    
45    end
46    
47  val floats16ByteAligned = true  val floats16ByteAligned = true
48    
49  structure AMD64MLTree =  structure AMD64MLTree =
# Line 390  Line 436 
436    
437      )      )
438    
439    structure RA = RA2
440    structure Cells = AMD64Instr.C
441    structure T = AMD64MLTree
442    structure CFG = AMD64CFG
443    structure FlowGraph = AMD64FlowGraph
444    
445    structure TestStagedAllocation =
446      struct
447    
448        val wordTy = 64
449    
450        fun codegen (functionName, target, proto, initStms, args) = let
451            val _ = Label.reset()
452    
453            val [functionName, target] = List.map Label.global [functionName, target]
454    
455            val insnStrm = FlowGraph.build()
456            (* construct the C call *)
457            val {result, callseq} = CCalls.genCall {
458                       name=T.LABEL target,
459                       paramAlloc=fn _ => false,
460                       structRet=fn _ => T.REG (64, Cells.rax),
461                       saveRestoreDedicated=fn _ => {save=[], restore=[]},
462                       callComment=NONE,
463                       proto=proto,
464                       args=args}
465    
466            fun wordLit i = T.LI (T.I.fromInt (wordTy, i))
467    
468            val stms = List.concat [
469                       [T.EXT(AMD64InstrExt.PUSHQ(T.REG(64, Cells.rbp))),
470                        T.COPY (wordTy, [Cells.rbp], [Cells.rsp])],
471                       initStms,
472                       callseq,
473                       [T.EXT(AMD64InstrExt.LEAVE)],
474                       [T.RET []]]
475    
476            val stream as AMD64Stream.STREAM
477               { beginCluster,  (* start a cluster *)
478                 endCluster,    (* end a cluster *)
479                 emit,          (* emit MLTREE stm *)
480                 defineLabel,   (* define a local label *)
481                 entryLabel,    (* define an external entry *)
482                 exitBlock,     (* mark the end of a procedure *)
483                 pseudoOp,      (* emit a pseudo op *)
484                 annotation,    (* add an annotation *)
485                 ... } =
486                 AMD64.selectInstructions insnStrm
487            fun doit () = (
488                beginCluster 0;      (* start a new cluster *)
489                pseudoOp PseudoOpsBasisTyp.TEXT;
490                pseudoOp (PseudoOpsBasisTyp.EXPORT [functionName]);
491                entryLabel functionName; (* define the entry label *)
492                List.app emit stms; (* emit all the statements *)
493                exitBlock result;
494                endCluster [])
495            val cfg = doit ()
496            val cfg = RA.run cfg
497            val cfg = AMD64Expand.run cfg
498            in
499             (cfg, stream)        (* end the cluster *)
500           end (* codegen *)
501    
502        fun dumpOutput (cfg, stream) = let
503            val (cfg as Graph.GRAPH graph, blocks) =
504                    AMD64BlockPlacement.blockPlacement cfg
505            val CFG.INFO{annotations=an, data, decls, ...} = #graph_info graph
506            in
507              AMD64Emit.asmEmit (cfg, blocks)
508            end (* dumpOutput *)
509    
510      end
511    
512    
513        (* machine-specific data *)
514        val wordTy = 64
515        val wordSzB = wordTy div 8
516        val param0 = T.REG(wordTy, Cells.rdi)
517    
518        (* maximum argument size in machine words *)
519        val maxArgSz = 16
520        val maxArgSzB = maxArgSz * wordSzB

Legend:
Removed from v.3008  
changed lines
  Added in v.3009

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