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

revision 3038, Tue May 27 23:48:15 2008 UTC revision 3051, Fri May 30 06:29:06 2008 UTC
# Line 130  Line 130 
130  end (* AMD64PseudoOps *)  end (* AMD64PseudoOps *)
131  *)  *)
132    
133  (*  
134  functor AMD64PseudoOpsFn (  functor AMD64PseudoOpsFn (
135      structure T : MLTREE      structure T : MLTREE
136      structure MLTreeEval : MLTREE_EVAL where T = T      structure MLTreeEval : MLTREE_EVAL where T = T
137    ) : PSEUDO_OPS_BASIS = AMD64GasPseudoOps (    ) : PSEUDO_OPS_BASIS = AMD64GasPseudoOps (
138      structure T = T      structure T = T
139      structure MLTreeEval = MLTreeEval)      structure MLTreeEval = MLTreeEval)
 *)  
140    
141    (*
142  functor AMD64PseudoOpsFn (  functor AMD64PseudoOpsFn (
143      structure T : MLTREE      structure T : MLTREE
144      structure MLTreeEval : MLTREE_EVAL where T = T      structure MLTreeEval : MLTREE_EVAL where T = T
145    ) : PSEUDO_OPS_BASIS = AMD64DarwinPseudoOps (    ) : PSEUDO_OPS_BASIS = AMD64DarwinPseudoOps (
146      structure T = T      structure T = T
147      structure MLTreeEval = MLTreeEval)      structure MLTreeEval = MLTreeEval)
148    *)
149    
150  structure AMD64PseudoOps = AMD64PseudoOpsFn(  structure AMD64PseudoOps = AMD64PseudoOpsFn(
151              structure T = AMD64MLTree              structure T = AMD64MLTree
# Line 197  Line 197 
197              structure InsnProps = AMD64InsnProps              structure InsnProps = AMD64InsnProps
198              structure Asm = AMD64Asm)              structure Asm = AMD64Asm)
199    
 (*structure AMD64Stream = InstructionStream(AMD64PseudoOps)*)  
200  structure AMD64MLTStream = MLTreeStream (  structure AMD64MLTStream = MLTreeStream (
201                        structure T = AMD64MLTree                        structure T = AMD64MLTree
202                        structure S = AMD64Stream)                        structure S = AMD64Stream)
# Line 471  Line 470 
470    
471       structure Int =       structure Int =
472          struct          struct
473            val avail = C.Regs CellsBasis.GP {from=0, to=15, step=1}            val allRegs = C.Regs CellsBasis.GP {from=0, to=15, step=1}
474              val allRegsSet = List.foldl C.addReg C.empty allRegs
475            val dedicated = [C.rsp, C.rbp]            val dedicated = [C.rsp, C.rbp]
476              val avail = C.getReg (List.foldl C.rmvReg allRegsSet dedicated)
477            fun spillLoc _ = raise Fail ""            fun spillLoc _ = raise Fail ""
478            val mode = RACore.NO_OPTIMIZATION            val mode = RACore.NO_OPTIMIZATION
479          end          end
# Line 492  Line 493 
493  structure CFG = AMD64CFG  structure CFG = AMD64CFG
494  structure FlowGraph = AMD64FlowGraph  structure FlowGraph = AMD64FlowGraph
495  structure ChkTy = MLTreeCheckTy(structure T = T val intTy = 64)  structure ChkTy = MLTreeCheckTy(structure T = T val intTy = 64)
496    structure Vararg = AMD64VarargCCallFn(structure T = T)
497    
498  structure TestStagedAllocation =  structure TestSA =
499    struct    struct
500    
501      val wordTy = 64      val wordTy = 64
502    
503        fun gen (functionName, stms, result) = let
504               val insnStrm = FlowGraph.build()
505               val stream as AMD64Stream.STREAM
506               { beginCluster,  (* start a cluster *)
507                 endCluster,    (* end a cluster *)
508                 emit,          (* emit MLTREE stm *)
509                 defineLabel,   (* define a local label *)
510                 entryLabel,    (* define an external entry *)
511                 exitBlock,     (* mark the end of a procedure *)
512                 pseudoOp,      (* emit a pseudo op *)
513                 annotation,    (* add an annotation *)
514                 ... } =
515                 AMD64.selectInstructions insnStrm
516            fun doit () = (
517                beginCluster 0;      (* start a new cluster *)
518                pseudoOp PseudoOpsBasisTyp.TEXT;
519                pseudoOp (PseudoOpsBasisTyp.EXPORT [functionName]);
520                entryLabel functionName; (* define the entry label *)
521                List.app emit stms; (* emit all the statements *)
522                exitBlock result;
523                endCluster [])
524            val cfg = doit ()
525            val cfg = RA.run cfg
526            val cfg = AMD64Expand.run cfg
527            in
528             (cfg, stream)        (* end the cluster *)
529           end
530    
531      fun codegen (functionName, target, proto, initStms, args) = let      fun codegen (functionName, target, proto, initStms, args) = let
532          val _ = Label.reset()          val _ = Label.reset()
533    
534          val [functionName, target] = List.map Label.global [functionName, target]          val [functionName, target] = List.map Label.global [functionName, target]
535    
         val insnStrm = FlowGraph.build()  
536          (* construct the C call *)          (* construct the C call *)
537          val {result, callseq} = CCalls.genCall {          val {result, callseq} = CCalls.genCall {
538                     name=T.LABEL target,                     name=T.LABEL target,
# Line 526  Line 555 
555          val _ = List.all (fn stm => ChkTy.check stm          val _ = List.all (fn stm => ChkTy.check stm
556                                      orelse raise Fail ("typechecking error: "^AMD64MTC.AMD64MLTreeUtils.stmToString stm))                                      orelse raise Fail ("typechecking error: "^AMD64MTC.AMD64MLTreeUtils.stmToString stm))
557                  stms                  stms
         val stream as AMD64Stream.STREAM  
            { beginCluster,  (* start a cluster *)  
              endCluster,    (* end a cluster *)  
              emit,          (* emit MLTREE stm *)  
              defineLabel,   (* define a local label *)  
              entryLabel,    (* define an external entry *)  
              exitBlock,     (* mark the end of a procedure *)  
              pseudoOp,      (* emit a pseudo op *)  
              annotation,    (* add an annotation *)  
              ... } =  
              AMD64.selectInstructions insnStrm  
         fun doit () = (  
             beginCluster 0;      (* start a new cluster *)  
             pseudoOp PseudoOpsBasisTyp.TEXT;  
             pseudoOp (PseudoOpsBasisTyp.EXPORT [functionName]);  
             entryLabel functionName; (* define the entry label *)  
             List.app emit stms; (* emit all the statements *)  
             exitBlock result;  
             endCluster [])  
         val cfg = doit ()  
         val cfg = RA.run cfg  
         val cfg = AMD64Expand.run cfg  
558          in          in
559           (cfg, stream)        (* end the cluster *)             gen (functionName, stms, result)
560         end (* codegen *)          end
561    
562      fun dumpOutput (cfg, stream) = let      fun dumpOutput (cfg, stream) = let
563          val (cfg as Graph.GRAPH graph, blocks) =          val (cfg as Graph.GRAPH graph, blocks) =
# Line 560  Line 567 
567            AMD64Emit.asmEmit (cfg, blocks)            AMD64Emit.asmEmit (cfg, blocks)
568          end (* dumpOutput *)          end (* dumpOutput *)
569    
570        fun lit i = T.LI (T.I.fromInt (wordTy, i))
571    
572       fun vararg _ = let
573               val lab = Label.global "varargs"
574               val tmp = C.newReg()
575               val tmpC = C.newReg()
576               val stms =
577                   List.concat [
578                       [T.EXT(AMD64InstrExt.PUSHQ(T.REG(64, Cells.rbp))),
579                        T.COPY (wordTy, [Cells.rbp], [Cells.rsp])],
580                       [T.MV(wordTy, tmp, T.REG(wordTy, C.rsi))],
581                       [T.MV(wordTy, tmpC, T.REG(wordTy, C.rdi))],
582                       Vararg.genVarargs (T.REG(wordTy, tmpC), tmp),
583                       [T.EXT(AMD64InstrExt.LEAVE)],
584                       [T.RET []]
585                       ]
586    
587               val asmOutStrm = TextIO.openOut "mlrisc.s"
588               fun doit () = dumpOutput(gen(lab, stms, [T.GPR (T.REG (wordTy, C.rax))]))
589               val _ = AsmStream.withStream asmOutStrm doit ()
590               val _ = TextIO.closeOut asmOutStrm
591               in
592                  0
593               end
594    end    end
595    
596    
# Line 571  Line 602 
602      (* maximum argument size in machine words *)      (* maximum argument size in machine words *)
603      val maxArgSz = 16      val maxArgSz = 16
604      val maxArgSzB = maxArgSz * wordSzB      val maxArgSzB = maxArgSz * wordSzB
605    (*
606  (* unit testing code *)  (* unit testing code *)
607  structure Test =  structure Test =
608    struct    struct
# Line 626  Line 657 
657                 ListPair.all test (List.map slotsOfCTy ts, anss) orelse raise Fail "failed test"                 ListPair.all test (List.map slotsOfCTy ts, anss) orelse raise Fail "failed test"
658              end              end
659    end    end
660    *)
661    
662    structure Test = struct end

Legend:
Removed from v.3038  
changed lines
  Added in v.3051

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