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/staged-allocation/test-staged-allocation-main.sml
ViewVC logotype

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

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

revision 2991, Tue Apr 15 15:05:41 2008 UTC revision 2992, Tue Apr 15 22:30:33 2008 UTC
# Line 4  Line 4 
4   * of calls.  To verify the test, we generate a dummy C function that prints out its   * of calls.  To verify the test, we generate a dummy C function that prints out its
5   * parameters in order.   * parameters in order.
6   *   *
7     * The example code below passes arguments x and y to the MLRISC-generated C call. The output
8     * of glue.c and sanity.c should be identical.
9    
10   #define MAX_SZB 16   /* glue.c */
11     #define MAX_SZ 16
12    
13   void target (int x, float y)   int target (int x, float y)
14   {   {
15     printf("%d %f", x, y);     printf("%d %f", x, y);
16       return 23432;
17   }   }
18    
19   void glueCode()   void glueCode()
# Line 19  Line 23 
23        /* initialize arguments */        /* initialize arguments */
24        int x = 23423;        int x = 23423;
25        memcpy(arr, &x, sizeof(int));        memcpy(arr, &x, sizeof(int));
26        arr += MAX_SZB;        arr += MAX_SZ;
27        float y = 1024.013;        float y = 1024.013f;
28        memcpy(arr, &y, sizeof(float));        memcpy(arr, &y, sizeof(float));
29        arr += MAX_SZB;        arr += MAX_SZ;
30        /* call into the MLRISC glue code that will make the C call */        /* call into the MLRISC glue code that will make the C call */
31        mlriscGlue(arr0);        int tmp = mlriscGlue(arr0);
32          printf("%d", tmp);
33   }   }
34    
35   int main () {   int main ()
36     {
37       glueCode();       glueCode();
38       return 0;       return 0;
39   }   }
40    
41     /* sanity.c */
42     int main ()
43     {
44         printf("%d %f %d", 23423, 1024.013f, 23432);
45         return 0;
46     }
47    
48     * We also generate the mlriscGlue code in MLRISC.  This code grabs the arguments from
49     * arr0 and then passes them to target using Staged Allocation.
50   *   *
51   *)   *)
52    
# Line 46  Line 61 
61    
62      fun li i = T.LI (T.I.fromInt (64, i))      fun li i = T.LI (T.I.fromInt (64, i))
63    
64      val maxArgSzB = 16      (* machine-specific data *)
65        val wordTy = 64
66        val wordSzB = wordTy div 8
67        val param0 = T.REG(wordTy, C.rdi)
68        (* maximum argument size in machine words *)
69        val maxArgSz = 16
70        val maxArgSzB = maxArgSz * wordSzB
71        val retValVar = "retVal"
72    
73      datatype c_argument =      datatype c_argument =
74               INT of int               INT of int
75             | FLOAT of real             | FLOAT of real
76               | DOUBLE of real
77             | POINTER of int             | POINTER of int
78    
79      fun cArgToString (cArg) = (case cArg      fun cArgToString (cArg) = (case cArg
80          of INT i => Int.toString i          of INT i => Int.toString i
81           | FLOAT f => Real.toString f           | FLOAT f => Real.toString f^"f"
82           | POINTER p => Int.toString p           | DOUBLE f => Real.toString f
83             | POINTER p => "(void*)0x"^Int.fmt StringCvt.HEX p
84          (* end case *))          (* end case *))
85    
86      fun tyToFormatString (ty) = (case ty      fun tyToFormatString (ty) = (case ty
# Line 82  Line 106 
106             (i+1, (cTyToString(ty)^var) :: params, var :: vars)             (i+1, (cTyToString(ty)^var) :: params, var :: vars)
107          end          end
108    
109        fun genPrintf (formatString, args) =
110            "printf("^formatString^","^(String.concatWith ", " args)^");"
111    
112        fun genFormatString (elts) =
113            "\"" ^ String.concatWith " " elts ^ "\\n\""
114    
115      (* construct a format string printing the parameters of a proto *)      (* construct a format string printing the parameters of a proto *)
116      fun protoToFormatString {conv, retTy, paramTys} =      fun protoToFormatString {conv, retTy, paramTys} = genFormatString (List.map tyToFormatString paramTys)
117          "\"" ^ String.concatWith " " (List.map tyToFormatString paramTys) ^ "\\n\""  
118        fun protoToPrintf (proto, args) = genPrintf(protoToFormatString(proto), args)
119    
120      (* generate a dummy target function that prints its parameters *)      (* generate a dummy target function that prints its parameters *)
121      fun targetFun (targetName, proto as {conv, retTy, paramTys}) = let      fun targetFun (targetName, proto as {conv, retTy, paramTys}, retVal) = let
122          val (_, params, vars) = List.foldl cTyToParam (0, [], []) paramTys          val (_, params, vars) = List.foldl cTyToParam (0, [], []) paramTys
123          val (params, vars) = (List.rev params, List.rev vars)          val (params, vars) = (List.rev params, List.rev vars)
124          in          in
125             cTyToString retTy ^ " " ^ targetName ^ "(" ^ (String.concatWith ", " params) ^ ")" ^             cTyToString retTy ^ " " ^ targetName ^ "(" ^ (String.concatWith ", " params) ^ ")" ^
126                "{" ^                "{" ^
127                    "printf("^protoToFormatString(proto)^","^(String.concatWith ", " vars)^");" ^                    protoToPrintf(proto, vars) ^
128                      "return "^(String.concat (List.map cArgToString retVal))^";"^
129                "}"                "}"
130          end          end
131    
132        fun genMLRISCGlueHdr (mlriscGlue, proto as {conv, retTy, paramTys}) = let
133            val (_, params, vars) = List.foldl cTyToParam (0, [], []) paramTys
134            val (params, vars) = (List.rev params, List.rev vars)
135            in
136               cTyToString retTy ^ " " ^ mlriscGlue ^ "(void* arr0);"
137            end
138    
139      (* generate C code that initializes an argument *)      (* generate C code that initializes an argument *)
140      fun genArg ((ty, arg), (i, assignStms)) =      fun genArg ((ty, arg), (i, assignStms)) =
141          (i+1, String.concatWith "\t" [          (i+1,
142             String.concatWith "\t" [
143                  "{",                  "{",
144                  cTyToString(ty)^" tmp = "^cArgToString(arg)^";",                  cTyToString(ty)^" tmp = "^cArgToString(arg)^";",
145                  "memcpy(arr, &tmp, sizeof("^cTyToString(ty)^"));",                  "memcpy(arr, &tmp, sizeof("^cTyToString(ty)^"));",
146                  "arr += MAX_SZB;",                "arr += MAX_SZ;",
147                  "}\n"                  "}\n"
148                 ]                 ]
149                :: assignStms)                :: assignStms)
# Line 111  Line 151 
151      (* generate C code that calls the MLRISC-generated function *)      (* generate C code that calls the MLRISC-generated function *)
152      fun genCGlueCode (mlriscGlue, proto as {conv, retTy, paramTys}, args) = let      fun genCGlueCode (mlriscGlue, proto as {conv, retTy, paramTys}, args) = let
153          val (_, stms) = List.foldl genArg (0, []) (ListPair.zip (paramTys, args))          val (_, stms) = List.foldl genArg (0, []) (ListPair.zip (paramTys, args))
154            val glueCall = if retTy <> CTy.C_void
155                              then cTyToString retTy ^ " " ^retValVar^" = " ^ mlriscGlue^"(arr0);\n\t"^
156                                   genPrintf(genFormatString([tyToFormatString retTy]), [retValVar])
157                              else mlriscGlue^"(arr0);"
158          in          in
159             String.concatWith "\n\t" [             String.concatWith "\n\t" [
160               "void glueCode(){",               "void glueCode(){",
# Line 118  Line 162 
162                  "void* arr0[4096];",                  "void* arr0[4096];",
163                  "void** arr = arr0;",                  "void** arr = arr0;",
164                  String.concatWith "\t " (List.rev stms),                  String.concatWith "\t " (List.rev stms),
165                  mlriscGlue^"(arr0);",                  glueCall,
166                "}"                "}"
167              ]              ]
168          end          end
169    
170      fun genCCode (target, mlriscGlue, proto, args) = String.concatWith "\n" [      val cIncludes = String.concatWith "\n" [
171            "#include <stdio.h>",            "#include <stdio.h>",
172            "#include <stdlib.h>",            "#include <stdlib.h>",
173            "#include <string.h>",          "#include <string.h>\n"
174            "#define MAX_SZB "^Int.toString(maxArgSzB),      ]
175            targetFun(target, proto),  
176        fun genGlue (target, mlriscGlue, proto, args, retVal) = String.concatWith "\n" [
177              cIncludes,
178              "#define MAX_SZ "^Int.toString(maxArgSz),
179              genMLRISCGlueHdr(mlriscGlue, proto),
180              targetFun(target, proto, retVal),
181            genCGlueCode(mlriscGlue, proto, args)            genCGlueCode(mlriscGlue, proto, args)
182          ]          ]
183    
184      fun genCMain () = "int main () { glueCode(); return 0; }"      fun genCMain () = "int main () { glueCode(); return 0; }"
185    
186        fun genSanityCheck (proto, args, retVal) = let
187            val retPrintf = (case retVal
188                 of [] => ""
189                  | [retVal] => genPrintf(genFormatString [tyToFormatString (#retTy proto)], [cArgToString retVal])
190                (* end case *))
191            in
192                cIncludes^
193                "int main () { "^protoToPrintf(proto, args)^retPrintf^" return 0; }"
194            end
195    
196        fun offset arr0 i = T.ADD(wordTy, arr0, li(i*maxArgSzB))
197        fun genGlueArg arr0 (ty, (i, args)) = (i+1,
198            (case ty
199              of CTy.C_signed CTy.I_int => CCalls.ARG (T.LOAD(32, offset arr0 i, ()))
200               | CTy.C_unsigned CTy.I_int => CCalls.ARG (T.LOAD(32, offset arr0 i, ()))
201               | CTy.C_PTR => CCalls.ARG (T.LOAD(wordTy, offset arr0 i, ()))
202               | CTy.C_float => CCalls.FARG (T.FLOAD(32, offset arr0 i, ()))
203               | CTy.C_double => CCalls.FARG (T.FLOAD(64, offset arr0 i, ()))
204            (* end case *)) :: args)
205    
206        val rand = Random.rand (0, 255)
207        fun genRandArg (ty) = (case ty
208            of CTy.C_float => FLOAT (Random.randReal(rand))
209             | CTy.C_double => DOUBLE(Random.randReal(rand))
210             | CTy.C_unsigned _ => INT (Random.randNat(rand))
211             | CTy.C_signed _ => INT (Random.randNat(rand))
212             | CTy.C_PTR => POINTER(Random.randNat(rand))
213            (* end case *))
214    
215      fun main _ = let      fun main _ = let
216          val tys = [CTy.C_signed CTy.I_int, CTy.C_PTR, CTy.C_PTR]          val retTy = CTy.C_double
217          val proto = {conv="ccall", retTy=CTy.C_void, paramTys=tys}          val paramTys = [CTy.C_double, CTy.C_unsigned CTy.I_int, CTy.C_PTR, CTy.C_double,
218                       CTy.C_float, CTy.C_PTR, CTy.C_float, CTy.C_PTR, CTy.C_PTR, CTy.C_PTR,
219                       CTy.C_signed CTy.I_int,
220                       CTy.C_double, CTy.C_double, CTy.C_double, CTy.C_double, CTy.C_double,
221                       CTy.C_double, CTy.C_double]
222    
223            val cArgs = List.map genRandArg paramTys
224            val retVal = if retTy <> CTy.C_void then [genRandArg retTy] else []
225            val proto = {conv="ccall", retTy=retTy, paramTys=paramTys}
226          val mlriscGlue = "mlriscGlue"          val mlriscGlue = "mlriscGlue"
227          val target = "target"          val target = "target"
228    
229          val args = [CCalls.ARG (li 1024), CCalls.ARG (li 1024), CCalls.ARG (li 1024)]          (* output C code that glues to the MLRISC code  *)
         val cArgs = [POINTER 0, POINTER 1, POINTER 2]  
   
         (* output C code *)  
230          val cOutStrm = TextIO.openOut "glue.c"          val cOutStrm = TextIO.openOut "glue.c"
231          val cCode = genCCode(target, mlriscGlue, proto, cArgs)          val cCode = genGlue(target, mlriscGlue, proto, cArgs, retVal)
232            val _ = TextIO.output(cOutStrm, cCode)
233            val _ = TextIO.closeOut cOutStrm
234    
235            (* output C code for santity check *)
236            val cOutStrm = TextIO.openOut "sanity.c"
237            val cCode = genSanityCheck(proto, List.map cArgToString cArgs, retVal)
238          val _ = TextIO.output(cOutStrm, cCode)          val _ = TextIO.output(cOutStrm, cCode)
239          val _ = TextIO.closeOut cOutStrm          val _ = TextIO.closeOut cOutStrm
240    
# Line 156  Line 245 
245          val _ = TextIO.closeOut cMainOutStrm          val _ = TextIO.closeOut cMainOutStrm
246    
247          (* output MLRISC code*)          (* output MLRISC code*)
248            val tmpReg = C.newReg()
249            val tmpR = T.REG(wordTy, tmpReg)
250            val (_, glueArgs) = List.foldl (genGlueArg tmpR) (0, []) paramTys
251          val asmOutStrm = TextIO.openOut "mlrisc.s"          val asmOutStrm = TextIO.openOut "mlrisc.s"
252          fun doit () = Test.dumpOutput(          fun doit () = Test.dumpOutput(Test.codegen(mlriscGlue, target, proto, [T.MV(wordTy, tmpReg, param0)], List.rev glueArgs))
                       Test.codegen(mlriscGlue, target, proto, args))  
253          val _ = AsmStream.withStream asmOutStrm doit ()          val _ = AsmStream.withStream asmOutStrm doit ()
254          val _ = TextIO.closeOut asmOutStrm          val _ = TextIO.closeOut asmOutStrm
255          in          in
256            ()            0
257          end          end
258    
259    

Legend:
Removed from v.2991  
changed lines
  Added in v.2992

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