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 3037, Tue May 27 06:30:07 2008 UTC revision 3038, Tue May 27 23:48:15 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 326  Line 326 
326      structure CFG=AMD64CFG      structure CFG=AMD64CFG
327      structure Shuffle = AMD64Shuffle)      structure Shuffle = AMD64Shuffle)
328    
329  structure CCalls2 = AMD64SVIDFn (  structure CCalls = AMD64SVIDFn (
330                      structure T = AMD64MLTree)                      structure T = AMD64MLTree)
331    
332    (*
333  structure CCalls = AMD64SVID (  structure CCalls = AMD64SVID (
334             structure T = AMD64MLTree             structure T = AMD64MLTree
335             val frameAlign = 16)             val frameAlign = 16)
336    *)
337    
338  structure RA2 =  structure RA2 =
339      RISC_RA      RISC_RA
# Line 490  Line 491 
491  structure T = AMD64MLTree  structure T = AMD64MLTree
492  structure CFG = AMD64CFG  structure CFG = AMD64CFG
493  structure FlowGraph = AMD64FlowGraph  structure FlowGraph = AMD64FlowGraph
494    structure ChkTy = MLTreeCheckTy(structure T = T val intTy = 64)
495    
496  structure TestStagedAllocation =  structure TestStagedAllocation =
497    struct    struct
# Line 521  Line 523 
523                     callseq,                     callseq,
524                     [T.EXT(AMD64InstrExt.LEAVE)],                     [T.EXT(AMD64InstrExt.LEAVE)],
525                     [T.RET []]]                     [T.RET []]]
526            val _ = List.all (fn stm => ChkTy.check stm
527                                        orelse raise Fail ("typechecking error: "^AMD64MTC.AMD64MLTreeUtils.stmToString stm))
528                    stms
529          val stream as AMD64Stream.STREAM          val stream as AMD64Stream.STREAM
530             { beginCluster,  (* start a cluster *)             { beginCluster,  (* start a cluster *)
531               endCluster,    (* end a cluster *)               endCluster,    (* end a cluster *)
# Line 567  Line 571 
571      (* maximum argument size in machine words *)      (* maximum argument size in machine words *)
572      val maxArgSz = 16      val maxArgSz = 16
573      val maxArgSzB = maxArgSz * wordSzB      val maxArgSzB = maxArgSz * wordSzB
574    
575    (* unit testing code *)
576    structure Test =
577      struct
578    
579        open CCalls
580    
581        fun li2k (_, k, _) = k
582    
583        val ty1 = CTy.C_STRUCT [CTy.C_STRUCT [CTy.C_unsigned CTy.I_char, CTy.C_unsigned CTy.I_int]]
584        val ty2 = CTy.C_STRUCT [CTy.C_signed CTy.I_short]
585        val ty3 = CTy.C_STRUCT [CTy.C_signed CTy.I_short, CTy.C_PTR]
586        val ty4 = CTy.C_STRUCT [CTy.C_PTR, CTy.C_PTR]
587        val ty4 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_unsigned CTy.I_int], CTy.C_PTR]
588        val ty5 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_float]]
589        val ty6 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float]]
590        val ty7 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_STRUCT[CTy.C_float,CTy.C_float],CTy.C_float,CTy.C_float]]
591        val ty8 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_STRUCT[CTy.C_float,CTy.C_unsigned CTy.I_int],CTy.C_float,CTy.C_float]]
592        val ty9 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float]]
593        val ty10 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_float,CTy.C_float, CTy.C_STRUCT[CTy.C_float,CTy.C_unsigned CTy.I_int]]]
594        val ty11 = CTy.C_STRUCT [CTy.C_PTR, CTy.C_float, CTy.C_float, CTy.C_float]
595    
596        fun kindOfEB () = let
597            fun test (eb, k) = (kindOfEightByte eb = k) orelse raise Fail "failed test"
598            fun eb1 ty = hd (eightBytesOfCTy ty)
599            fun eb2 ty = hd(tl (eightBytesOfCTy ty))
600            in
601               List.all test [(eb1 ty1, K_GPR), (eb1 ty2, K_GPR), (eb2 ty3, K_GPR),
602                              (eb1 ty5, K_FPR), (eb1 ty6, K_FPR), (eb2 ty6, K_FPR),
603                              (eb1 ty7, K_FPR), (eb2 ty7, K_FPR),
604                              (eb1 ty8, K_GPR), (eb2 ty8, K_FPR)]
605            end
606    
607        fun slots () = let
608            fun test (lis : SA.slot list, ks2 : location_kind list) = let
609                val ks1 = List.map li2k lis
610                in
611                    (List.length ks1 = List.length ks2) andalso (ListPair.all (op =) (ks1, ks2))
612                end
613                val tests = [
614                           (ty2, [K_GPR]),
615                           (ty1, [K_GPR]),
616                           (ty3, [K_GPR, K_GPR]),
617                           (ty4, [K_GPR, K_GPR]),
618                           (ty5, [K_FPR]),
619                           (ty6, [K_FPR, K_FPR]),
620                           (ty7, [K_FPR, K_FPR]),
621                           (ty8, [K_GPR, K_FPR]),
622                           (ty11, [K_MEM, K_MEM, K_MEM])
623                                           ]
624                val (ts, anss) = ListPair.unzip tests
625                in
626                   ListPair.all test (List.map slotsOfCTy ts, anss) orelse raise Fail "failed test"
627                end
628      end

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

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