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 3058, Tue Jun 3 17:17:28 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 329  Line 328 
328  structure CCalls = AMD64SVIDFn (  structure CCalls = AMD64SVIDFn (
329                      structure T = AMD64MLTree)                      structure T = AMD64MLTree)
330    
331  (*  
332  structure CCalls = AMD64SVID (  structure OldCCalls = AMD64SVID (
333             structure T = AMD64MLTree             structure T = AMD64MLTree
334             val frameAlign = 16)             val frameAlign = 16)
335  *)  
336    
337  structure RA2 =  structure RA2 =
338      RISC_RA      RISC_RA
# 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(
497                           structure T = T
498                           fun push e = T.EXT(AMD64InstrExt.PUSHQ e)
499                           val leave = T.EXT(AMD64InstrExt.LEAVE)
500                       )
501    
502  structure TestStagedAllocation =  structure TestSA =
503    struct    struct
504    
505      val wordTy = 64      val wordTy = 64
506    
507        fun gen (functionName, stms, result) = let
508               val insnStrm = FlowGraph.build()
509               val stream as AMD64Stream.STREAM
510               { beginCluster,  (* start a cluster *)
511                 endCluster,    (* end a cluster *)
512                 emit,          (* emit MLTREE stm *)
513                 defineLabel,   (* define a local label *)
514                 entryLabel,    (* define an external entry *)
515                 exitBlock,     (* mark the end of a procedure *)
516                 pseudoOp,      (* emit a pseudo op *)
517                 annotation,    (* add an annotation *)
518                 ... } =
519                 AMD64.selectInstructions insnStrm
520            fun doit () = (
521                beginCluster 0;      (* start a new cluster *)
522                pseudoOp PseudoOpsBasisTyp.TEXT;
523                pseudoOp (PseudoOpsBasisTyp.EXPORT [functionName]);
524                entryLabel functionName; (* define the entry label *)
525                List.app emit stms; (* emit all the statements *)
526                exitBlock result;
527                endCluster [])
528            val cfg = doit ()
529            val cfg = RA.run cfg
530            val cfg = AMD64Expand.run cfg
531            in
532             (cfg, stream)        (* end the cluster *)
533           end
534    
535      fun codegen (functionName, target, proto, initStms, args) = let      fun codegen (functionName, target, proto, initStms, args) = let
536          val _ = Label.reset()          val _ = Label.reset()
537    
538          val [functionName, target] = List.map Label.global [functionName, target]          val [functionName, target] = List.map Label.global [functionName, target]
539    
         val insnStrm = FlowGraph.build()  
540          (* construct the C call *)          (* construct the C call *)
541          val {result, callseq} = CCalls.genCall {          val {result, callseq} = CCalls.genCall {
542                     name=T.LABEL target,                     name=T.LABEL target,
# Line 526  Line 559 
559          val _ = List.all (fn stm => ChkTy.check stm          val _ = List.all (fn stm => ChkTy.check stm
560                                      orelse raise Fail ("typechecking error: "^AMD64MTC.AMD64MLTreeUtils.stmToString stm))                                      orelse raise Fail ("typechecking error: "^AMD64MTC.AMD64MLTreeUtils.stmToString stm))
561                  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  
562          in          in
563           (cfg, stream)        (* end the cluster *)             gen (functionName, stms, result)
564         end (* codegen *)          end
565    
566      fun dumpOutput (cfg, stream) = let      fun dumpOutput (cfg, stream) = let
567          val (cfg as Graph.GRAPH graph, blocks) =          val (cfg as Graph.GRAPH graph, blocks) =
# Line 560  Line 571 
571            AMD64Emit.asmEmit (cfg, blocks)            AMD64Emit.asmEmit (cfg, blocks)
572          end (* dumpOutput *)          end (* dumpOutput *)
573    
574        fun lit i = T.LI (T.I.fromInt (wordTy, i))
575    
576       fun vararg _ = let
577               val _ = Label.reset()
578               val (lab, varargStms) = Vararg.genVarargs()
579               val asmOutStrm = TextIO.openOut "mlrisc.s"
580               fun doit () = dumpOutput(gen(lab, varargStms, [T.GPR (T.REG (wordTy, C.rax))]))
581               val _ = AsmStream.withStream asmOutStrm doit ()
582               val _ = TextIO.closeOut asmOutStrm
583               in
584                  0
585               end
586    end    end
587    
588    
# Line 571  Line 594 
594      (* maximum argument size in machine words *)      (* maximum argument size in machine words *)
595      val maxArgSz = 16      val maxArgSz = 16
596      val maxArgSzB = maxArgSz * wordSzB      val maxArgSzB = maxArgSz * wordSzB
597    (*
598  (* unit testing code *)  (* unit testing code *)
599  structure Test =  structure Test =
600    struct    struct
# Line 626  Line 649 
649                 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"
650              end              end
651    end    end
652    *)
653    
654    structure Test = struct end

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

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