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 2996, Fri Apr 18 16:26:23 2008 UTC revision 2997, Fri Apr 18 19:33:29 2008 UTC
# Line 5  Line 5 
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   * 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.   * of main.c and sanity.c should be identical.
9    
10   /* glue.c */   /* glue.c */
11   #define MAX_SZ 16   #define MAX_SZ 16
# Line 32  Line 32 
32        printf("%d", tmp);        printf("%d", tmp);
33   }   }
34    
35     /* main.c */
36   int main ()   int main ()
37   {   {
38       glueCode();       glueCode();
# Line 41  Line 42 
42   /* sanity.c */   /* sanity.c */
43   int main ()   int main ()
44   {   {
45       printf("%d %f %d", 23423, 1024.013f, 23432);       int x = 23432;
46         float y = 1024.013f;
47         int tmp = target(x, y);
48         printf ("%d", tmp);
49       return 0;       return 0;
50   }   }
51    
# Line 148  Line 152 
152              td              td
153          end          end
154    
155      fun cTyToParam (ty, (i, params, vars)) = let      fun genParamName (i) = " a"^Int.toString i
156          val var = " a"^Int.toString i  
157          in      fun genParamNames (tys) = List.rev(#2 (List.foldl (fn (ty, (i, params)) => (i+1, genParamName(i) :: params)) (0, []) tys))
158             (i+1, (cTyToString(ty)^var) :: params, var :: vars)  
159          end      fun genParam (ty, name) = cTyToString ty^name
160    
161        fun genParams (paramTys, vars) = List.map genParam (ListPair.zip (paramTys, vars))
162    
163        fun genTargetPrintfArgs (vars, paramTys) = List.concat (ListPair.map (fn (prefix, ty) => cTyNames prefix ty) (vars, paramTys))
164    
165      fun genPrintf (formatString, args) =      fun genPrintf (formatString, args) =
166          "printf("^formatString^","^(String.concatWith ", " args)^");"          "printf("^formatString^","^(String.concatWith ", " args)^");"
# Line 161  Line 169 
169          "\"" ^ String.concatWith " " elts ^ "\\n\""          "\"" ^ String.concatWith " " elts ^ "\\n\""
170    
171      (* construct a format string printing the parameters of a proto *)      (* construct a format string printing the parameters of a proto *)
172      fun protoToFormatString {conv, retTy, paramTys} = genFormatString (List.map tyToFormatString paramTys)      fun protoToFormatString ({conv, retTy, paramTys}, args) = genFormatString (ListPair.map (fn (arg, ty) => arg^"="^tyToFormatString ty^"\\n") (args, paramTys))
173    
174      fun protoToPrintf (proto, args) = genPrintf(protoToFormatString(proto), args)      fun protoToPrintf (proto, args) = genPrintf(protoToFormatString(proto, args), args)
175    
176      (* generate a dummy target function that prints its parameters *)      (* generate a dummy target function that prints its parameters *)
177      fun targetFun (targetName, proto as {conv, retTy, paramTys}, retVal) = let      fun targetFun (targetName, proto as {conv, retTy, paramTys}, retVal) = let
178          val (_, params, vars) = List.foldl cTyToParam (0, [], []) paramTys          val vars = genParamNames paramTys
179          val (params, vars) = (List.rev params, List.rev vars)          val params = genParams(paramTys, vars)
180          val vars = List.concat (ListPair.map (fn (prefix, ty) => cTyNames prefix ty) (vars, paramTys))          val printfArgs = genTargetPrintfArgs(vars, paramTys)
181          in          in
182             cTyToString retTy ^ " " ^ targetName ^ "(" ^ (String.concatWith ", " params) ^ ")" ^             cTyToString retTy ^ " " ^ targetName ^ "(" ^ (String.concatWith ", " params) ^ ")" ^
183                "{" ^                "{" ^
184                    protoToPrintf(proto, vars) ^                    protoToPrintf(proto, printfArgs) ^
185                    "return "^(String.concat (List.map cArgToString retVal))^";"^                    "return "^(String.concat (List.map cArgToString retVal))^";"^
186                "}"                "}"
187          end          end
188    
189      fun genMLRISCGlueHdr (mlriscGlue, proto as {conv, retTy, paramTys}) = let      fun genMLRISCGlueHdr (mlriscGlue, proto as {conv, retTy, paramTys}) =
         val (_, params, vars) = List.foldl cTyToParam (0, [], []) paramTys  
         val (params, vars) = (List.rev params, List.rev vars)  
         in  
190             cTyToString retTy ^ " " ^ mlriscGlue ^ "(void* arr0);"             cTyToString retTy ^ " " ^ mlriscGlue ^ "(void* arr0);"
         end  
191    
192      (* generate C code that initializes an argument *)      fun genAssignArg (ty, var, arg) = cTyToString(ty)^" "^var^" = "^cArgToString(arg)^";"
193      fun genArg ((ty, arg), (i, assignStms)) =  
194          (i+1,      (* generate C code that initializes an argument in arr0 *)
195        fun genInitArr0 (ty, arg) =
196           String.concatWith "\t" [           String.concatWith "\t" [
197           "{",           "{",
198                cTyToString(ty)^" tmp = "^cArgToString(arg)^";",                genAssignArg(ty, "tmp", arg),
199                "memcpy(arr, &tmp, sizeof("^cTyToString(ty)^"));",                "memcpy(arr, &tmp, sizeof("^cTyToString(ty)^"));",
200                "arr += MAX_SZ;",                "arr += MAX_SZ;",
201           "}\n"           "}\n"
202           ]           ]
          :: assignStms)  
203    
204      (* generate C code that calls the MLRISC-generated function *)      (* generate C code that calls the MLRISC-generated function *)
205      fun genCGlueCode (mlriscGlue, proto as {conv, retTy, paramTys}, args) = let      fun genCGlueCode (mlriscGlue, proto as {conv, retTy, paramTys}, args) = let
206          val (_, stms) = List.foldl genArg (0, []) (ListPair.zip (paramTys, args))          val stms = List.rev (ListPair.map genInitArr0 (paramTys, args))
207          val glueCall = if retTy <> CTy.C_void          val glueCall = if retTy <> CTy.C_void
208                            then cTyToString retTy ^ " " ^retValVar^" = " ^ mlriscGlue^"(arr0);\n\t"^                            then cTyToString retTy ^ " " ^retValVar^" = " ^ mlriscGlue^"(arr0);\n\t"^
209                                 genPrintf(genFormatString([tyToFormatString retTy]), [retValVar])                                 genPrintf(genFormatString([tyToFormatString retTy]), [retValVar])
# Line 216  Line 220 
220              ]              ]
221          end          end
222    
223        fun zip3 (ls1, ls2, ls3) = let
224            fun f ([], _, _, xs) = List.rev xs
225              | f (x1 ::xs1, x2::xs2, x3::xs3, xs) = f(xs1, xs2, xs3, (x1, x2, x3) :: xs)
226            in
227               f(ls1, ls2, ls3, [])
228            end
229    
230        (* generate C code that calls the MLRISC-generated function *)
231        fun genTestCode (proto as {conv, retTy, paramTys}, args) = let
232            val paramNames = genParamNames paramTys
233            val stms = List.map genAssignArg (zip3(paramTys, paramNames, args))
234            val callTarget = "target("^String.concatWith ", " paramNames^");"
235            val glueCall = if retTy <> CTy.C_void
236                              then cTyToString retTy ^ " " ^retValVar^" = " ^ callTarget^"\n\t"^
237                                   genPrintf(genFormatString([tyToFormatString retTy]), [retValVar])
238                              else callTarget
239            in
240               String.concatWith "\n\t" [
241                 "void testCode(){",
242                    String.concatWith "\t " (List.rev stms),
243                    glueCall,
244                  "}"
245                ]
246            end
247    
248      val cIncludes = String.concatWith "\n" [      val cIncludes = String.concatWith "\n" [
249          "#include <stdio.h>",          "#include <stdio.h>",
250          "#include <stdlib.h>",          "#include <stdlib.h>",
251          "#include <string.h>\n"          "#include <string.h>\n"
252      ]      ]
253    
254        fun isStruct (CTy.C_STRUCT _) = true
255          | isStruct _ = false
256    
257        fun maxSzOfProto ({conv, paramTys, retTy}) = let
258            fun szOfTy ty = #sz (CSizes.sizeOfTy ty)
259            in
260                List.foldl Int.max 0 (List.map szOfTy (retTy ::paramTys))
261            end
262    
263      fun genGlue (target, mlriscGlue, proto, args, retVal) = String.concatWith "\n" [      fun genGlue (target, mlriscGlue, proto, args, retVal) = String.concatWith "\n" [
264            cIncludes,            cIncludes,
265            "#define MAX_SZ "^Int.toString(maxArgSz),            "#define MAX_SZ "^Int.toString((maxSzOfProto proto) div 8),
266            String.concatWith "\n" (List.map cTyDecl (#paramTys proto)),            (* tyep declarations for structs *)
267              String.concatWith "\n" (List.map cTyDecl (List.filter isStruct (#paramTys proto))),
268              (* C prototype for the MLRISC assembly stub *)
269            genMLRISCGlueHdr(mlriscGlue, proto),            genMLRISCGlueHdr(mlriscGlue, proto),
270              (* target function *)
271            targetFun(target, proto, retVal),            targetFun(target, proto, retVal),
272            genCGlueCode(mlriscGlue, proto, args)            (* C glue code for calling into the MLRISC assembly stub *)
273              genCGlueCode(mlriscGlue, proto, args),
274              (* C test code that directly calls the target function *)
275              genTestCode(proto, args)
276          ]          ]
277    
278      fun genCMain () = "int main () { glueCode(); return 0; }"      fun genCMain () = "int main () { glueCode(); return 0; }"
279    
280      fun genSanityCheck (proto, args, retVal) = let      fun genSanityCheck (proto, args, retVal) = "int main () { testCode(); return 0; }"
         val args = List.concat (List.map flattenArg args)  
         val args = List.map cArgToString args  
         val retPrintf = (case retVal  
              of [] => ""  
               | [retVal] => genPrintf(genFormatString [tyToFormatString (#retTy proto)], [cArgToString retVal])  
             (* end case *))  
         in  
             cIncludes^  
             "int main () { "^protoToPrintf(proto, args)^retPrintf^" return 0; }"  
         end  
281    
282      fun offset arr0 i = T.ADD(wordTy, arr0, li(i*maxArgSzB))      fun offset maxSz arr0 i = T.ADD(wordTy, arr0, li(i*maxSz))
283    
284      fun genGlueArg arr0 (ty, (i, args)) = (i+1,      fun genGlueArg maxSz arr0 (ty, (i, args)) = (i+1,
285          (case ty          (case ty
286            of CTy.C_signed CTy.I_int => CCalls.ARG (T.LOAD(32, offset arr0 i, ()))            of CTy.C_signed CTy.I_int => CCalls.ARG (T.LOAD(32, offset maxSz arr0 i, ()))
287             | CTy.C_unsigned CTy.I_int => CCalls.ARG (T.LOAD(32, offset arr0 i, ()))             | CTy.C_unsigned CTy.I_int => CCalls.ARG (T.LOAD(32, offset maxSz arr0 i, ()))
288             | CTy.C_PTR => CCalls.ARG (T.LOAD(wordTy, offset arr0 i, ()))             | CTy.C_PTR => CCalls.ARG (T.LOAD(wordTy, offset maxSz arr0 i, ()))
289             | CTy.C_STRUCT _ => CCalls.ARG (T.LOAD(wordTy, offset arr0 i, ()))             | CTy.C_STRUCT _ => CCalls.ARG (T.LOAD(wordTy, offset maxSz arr0 i, ()))
290             | CTy.C_float => CCalls.FARG (T.FLOAD(32, offset arr0 i, ()))             | CTy.C_float => CCalls.FARG (T.FLOAD(32, offset maxSz arr0 i, ()))
291             | CTy.C_double => CCalls.FARG (T.FLOAD(64, offset arr0 i, ()))             | CTy.C_double => CCalls.FARG (T.FLOAD(64, offset maxSz arr0 i, ()))
292          (* end case *)) :: args)          (* end case *)) :: args)
293    
294      val rand = Random.rand (0, 255)      val rand = Random.rand (0, 255)
# Line 279  Line 313 
313      val pty3 = [CTy.C_STRUCT [CTy.C_float,CTy.C_float]]      val pty3 = [CTy.C_STRUCT [CTy.C_float,CTy.C_float]]
314      val pty3 = [CTy.C_STRUCT [CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float]]      val pty3 = [CTy.C_STRUCT [CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float]]
315      val pty4 = [CTy.C_STRUCT [CTy.C_PTR,CTy.C_float,CTy.C_float,CTy.C_float]]      val pty4 = [CTy.C_STRUCT [CTy.C_PTR,CTy.C_float,CTy.C_float,CTy.C_float]]
316        val pty5 = [CTy.C_double, CTy.C_unsigned CTy.I_int, CTy.C_PTR]
317        val pty6 = [CTy.C_PTR, CTy.C_PTR, CTy.C_PTR, CTy.C_PTR, CTy.C_PTR, CTy.C_PTR, CTy.C_PTR]
318    
319      fun main _ = let      fun main _ = let
320          val retTy = CTy.C_double          val retTy = CTy.C_double
321          val paramTys = pty4          val paramTys = pty1
322    
323          val cArgs = List.map genRandArg paramTys          val cArgs = List.map genRandArg paramTys
324          val retVal = if retTy <> CTy.C_void then [genRandArg retTy] else []          val retVal = if retTy <> CTy.C_void then [genRandArg retTy] else []
# Line 311  Line 347 
347          (* output MLRISC code *)          (* output MLRISC code *)
348          val tmpReg = C.newReg()          val tmpReg = C.newReg()
349          val tmpR = T.REG(wordTy, tmpReg)          val tmpR = T.REG(wordTy, tmpReg)
350          val (_, glueArgs) = List.foldl (genGlueArg tmpR) (0, []) paramTys          val (_, glueArgs) = List.foldl (genGlueArg (maxSzOfProto proto) tmpR) (0, []) paramTys
351          val asmOutStrm = TextIO.openOut "mlrisc.s"          val asmOutStrm = TextIO.openOut "mlrisc.s"
352          fun doit () = Test.dumpOutput(Test.codegen(mlriscGlue, target, proto, [T.MV(wordTy, tmpReg, param0)], List.rev glueArgs))          fun doit () = Test.dumpOutput(Test.codegen(mlriscGlue, target, proto, [T.MV(wordTy, tmpReg, param0)], List.rev glueArgs))
353          val _ = AsmStream.withStream asmOutStrm doit ()          val _ = AsmStream.withStream asmOutStrm doit ()

Legend:
Removed from v.2996  
changed lines
  Added in v.2997

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