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 3041, Wed May 28 18:39:35 2008 UTC revision 3042, Wed May 28 23:40:21 2008 UTC
# Line 471  Line 471 
471    
472       structure Int =       structure Int =
473          struct          struct
474            val avail = C.Regs CellsBasis.GP {from=0, to=15, step=1}            val allRegs = C.Regs CellsBasis.GP {from=0, to=15, step=1}
475              val allRegsSet = List.foldl C.addReg C.empty allRegs
476            val dedicated = [C.rsp, C.rbp]            val dedicated = [C.rsp, C.rbp]
477              val avail = C.getReg (List.foldl C.rmvReg allRegsSet dedicated)
478            fun spillLoc _ = raise Fail ""            fun spillLoc _ = raise Fail ""
479            val mode = RACore.NO_OPTIMIZATION            val mode = RACore.NO_OPTIMIZATION
480          end          end
# Line 492  Line 494 
494  structure CFG = AMD64CFG  structure CFG = AMD64CFG
495  structure FlowGraph = AMD64FlowGraph  structure FlowGraph = AMD64FlowGraph
496  structure ChkTy = MLTreeCheckTy(structure T = T val intTy = 64)  structure ChkTy = MLTreeCheckTy(structure T = T val intTy = 64)
497    structure Vararg = AMD64VarargCCallFn(structure T = T)
498    
499  structure TestStagedAllocation =  structure TestStagedAllocation =
500    struct    struct
501    
502      val wordTy = 64      val wordTy = 64
503    
504        fun gen (functionName, stms, result) = let
505               val insnStrm = FlowGraph.build()
506               val stream as AMD64Stream.STREAM
507               { beginCluster,  (* start a cluster *)
508                 endCluster,    (* end a cluster *)
509                 emit,          (* emit MLTREE stm *)
510                 defineLabel,   (* define a local label *)
511                 entryLabel,    (* define an external entry *)
512                 exitBlock,     (* mark the end of a procedure *)
513                 pseudoOp,      (* emit a pseudo op *)
514                 annotation,    (* add an annotation *)
515                 ... } =
516                 AMD64.selectInstructions insnStrm
517            fun doit () = (
518                beginCluster 0;      (* start a new cluster *)
519                pseudoOp PseudoOpsBasisTyp.TEXT;
520                pseudoOp (PseudoOpsBasisTyp.EXPORT [functionName]);
521                entryLabel functionName; (* define the entry label *)
522                List.app emit stms; (* emit all the statements *)
523                exitBlock result;
524                endCluster [])
525            val cfg = doit ()
526            val cfg = RA.run cfg
527            val cfg = AMD64Expand.run cfg
528            in
529             (cfg, stream)        (* end the cluster *)
530           end
531    
532      fun codegen (functionName, target, proto, initStms, args) = let      fun codegen (functionName, target, proto, initStms, args) = let
533          val _ = Label.reset()          val _ = Label.reset()
534    
535          val [functionName, target] = List.map Label.global [functionName, target]          val [functionName, target] = List.map Label.global [functionName, target]
536    
         val insnStrm = FlowGraph.build()  
537          (* construct the C call *)          (* construct the C call *)
538          val {result, callseq} = CCalls.genCall {          val {result, callseq} = CCalls.genCall {
539                     name=T.LABEL target,                     name=T.LABEL target,
# Line 526  Line 556 
556          val _ = List.all (fn stm => ChkTy.check stm          val _ = List.all (fn stm => ChkTy.check stm
557                                      orelse raise Fail ("typechecking error: "^AMD64MTC.AMD64MLTreeUtils.stmToString stm))                                      orelse raise Fail ("typechecking error: "^AMD64MTC.AMD64MLTreeUtils.stmToString stm))
558                  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  
559          in          in
560           (cfg, stream)        (* end the cluster *)             gen (functionName, stms, result)
561         end (* codegen *)          end
562    
563      fun dumpOutput (cfg, stream) = let      fun dumpOutput (cfg, stream) = let
564          val (cfg as Graph.GRAPH graph, blocks) =          val (cfg as Graph.GRAPH graph, blocks) =
# Line 560  Line 568 
568            AMD64Emit.asmEmit (cfg, blocks)            AMD64Emit.asmEmit (cfg, blocks)
569          end (* dumpOutput *)          end (* dumpOutput *)
570    
571        fun lit i = T.LI (T.I.fromInt (wordTy, i))
572    
573       fun testVarargs _ = let
574               val lab = Label.global "varargs"
575               val tmp = C.newReg()
576               val tmpC = C.newReg()
577               val preCallInstrs = [T.MV(wordTy, C.rax, lit (List.length CCalls.CCs.fprParams))]
578               val stms =
579                   List.concat [
580                       [T.EXT(AMD64InstrExt.PUSHQ(T.REG(64, Cells.rbp))),
581                        T.COPY (wordTy, [Cells.rbp], [Cells.rsp])],
582                       [T.MV(wordTy, tmp, T.REG(wordTy, C.rsi))],
583                       [T.MV(wordTy, tmpC, T.REG(wordTy, C.rdi))],
584                       Vararg.genVarArgs (T.REG(wordTy, tmpC), tmp, preCallInstrs),
585                       [T.EXT(AMD64InstrExt.LEAVE)],
586                       [T.RET []]
587                       ]
588    
589               val asmOutStrm = TextIO.openOut "mlrisc.s"
590               fun doit () = dumpOutput(gen(lab, stms, [T.GPR (T.REG (wordTy, C.rax))]))
591               val _ = AsmStream.withStream asmOutStrm doit ()
592               val _ = TextIO.closeOut asmOutStrm
593               in
594                  0
595               end
596    
597    end    end
598    
599    

Legend:
Removed from v.3041  
changed lines
  Added in v.3042

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