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 2994, Thu Apr 17 23:34:02 2008 UTC revision 2995, Fri Apr 18 06:59:04 2008 UTC
# Line 75  Line 75 
75             | FLOAT of real             | FLOAT of real
76             | DOUBLE of real             | DOUBLE of real
77             | POINTER of int             | POINTER of int
78               | STRUCT of c_argument list
79    
80        fun flattenArg cArg = (case cArg
81            of STRUCT args => List.concat (List.map flattenArg args)
82             | cArg => [cArg])
83    
84      fun cArgToString (cArg) = (case cArg      fun cArgToString (cArg) = (case cArg
85          of INT i => Int.toString i          of INT i => Int.toString i
86           | FLOAT f => Real.toString f^"f"           | FLOAT f => Real.toString f^"f"
87           | DOUBLE f => Real.toString f           | DOUBLE f => Real.toString f
88           | POINTER p => "(void*)0x"^Int.fmt StringCvt.HEX p           | POINTER p => "(void*)0x"^Int.fmt StringCvt.HEX p
89             | STRUCT args => "{"^String.concatWith ", " (List.map cArgToString args)^"}"
90          (* end case *))          (* end case *))
91    
92      fun tyToFormatString (ty) = (case ty      fun tyToFormatString (ty) = (case ty
# Line 89  Line 95 
95           | CTy.C_float => "%f"           | CTy.C_float => "%f"
96           | CTy.C_double => "%f"           | CTy.C_double => "%f"
97           | CTy.C_PTR => "%p"           | CTy.C_PTR => "%p"
98             | CTy.C_STRUCT cTys => String.concatWith " " (List.map tyToFormatString cTys)
99            (* end case *))
100    
101        fun cTyToName cTy = (case cTy
102            of CTy.C_unsigned _ => "u"
103             | CTy.C_signed _ => "i"
104             | CTy.C_float => "f"
105             | CTy.C_double => "d"
106             | CTy.C_PTR => "vs"
107             | CTy.C_STRUCT cTys => "s"^String.concat (List.map cTyToName cTys)
108          (* end case *))          (* end case *))
109    
110      fun cTyToString (ty) = (case ty      fun cTyToString (ty) = (case ty
# Line 98  Line 114 
114           | CTy.C_double => "double"           | CTy.C_double => "double"
115           | CTy.C_PTR => "void*"           | CTy.C_PTR => "void*"
116           | CTy.C_void => "void"           | CTy.C_void => "void"
117             | CTy.C_STRUCT cTys => "struct "^cTyToName ty
118            (* end case *))
119    
120        val i = ref 0
121        fun freshName () = (
122            i := (!i) + 1;
123            "x"^Int.toString (!i))
124    
125        fun cTyDecl' cTy = (case cTy
126             of CTy.C_STRUCT cTys => cTyToString cTy^"{ "^(String.concatWith " " (List.map cTyDecl' cTys))^"}"^freshName()^";"
127             | cTy => cTyToString cTy^" "^freshName()^";"
128            (* end case *))
129    
130        fun cTyDecl cTy = let
131            val td = cTyDecl' cTy
132            in
133                i := 0;
134                td
135            end
136    
137        fun cTyNames' prefix (cTy) = (case cTy
138             of CTy.C_STRUCT cTys => List.concat (List.map (cTyNames' (prefix^"."^freshName())) cTys)
139             | cTy => [prefix^"."^freshName()]
140          (* end case *))          (* end case *))
141    
142        fun cTyNames prefix cTy = let
143            val td = (case cTy
144                of CTy.C_STRUCT cTys => List.concat (List.map (cTyNames' prefix) cTys)
145                 | cTy => [prefix])
146            in
147                i := 0;
148                td
149            end
150    
151      fun cTyToParam (ty, (i, params, vars)) = let      fun cTyToParam (ty, (i, params, vars)) = let
152          val var = " a"^Int.toString i          val var = " a"^Int.toString i
153          in          in
# Line 121  Line 169 
169      fun targetFun (targetName, proto as {conv, retTy, paramTys}, retVal) = let      fun targetFun (targetName, proto as {conv, retTy, paramTys}, retVal) = let
170          val (_, params, vars) = List.foldl cTyToParam (0, [], []) paramTys          val (_, params, vars) = List.foldl cTyToParam (0, [], []) paramTys
171          val (params, vars) = (List.rev params, List.rev vars)          val (params, vars) = (List.rev params, List.rev vars)
172            val vars = List.concat (ListPair.map (fn (prefix, ty) => cTyNames prefix ty) (vars, paramTys))
173          in          in
174             cTyToString retTy ^ " " ^ targetName ^ "(" ^ (String.concatWith ", " params) ^ ")" ^             cTyToString retTy ^ " " ^ targetName ^ "(" ^ (String.concatWith ", " params) ^ ")" ^
175                "{" ^                "{" ^
# Line 176  Line 225 
225      fun genGlue (target, mlriscGlue, proto, args, retVal) = String.concatWith "\n" [      fun genGlue (target, mlriscGlue, proto, args, retVal) = String.concatWith "\n" [
226            cIncludes,            cIncludes,
227            "#define MAX_SZ "^Int.toString(maxArgSz),            "#define MAX_SZ "^Int.toString(maxArgSz),
228              String.concatWith "\n" (List.map cTyDecl (#paramTys proto)),
229            genMLRISCGlueHdr(mlriscGlue, proto),            genMLRISCGlueHdr(mlriscGlue, proto),
230            targetFun(target, proto, retVal),            targetFun(target, proto, retVal),
231            genCGlueCode(mlriscGlue, proto, args)            genCGlueCode(mlriscGlue, proto, args)
# Line 184  Line 234 
234      fun genCMain () = "int main () { glueCode(); return 0; }"      fun genCMain () = "int main () { glueCode(); return 0; }"
235    
236      fun genSanityCheck (proto, args, retVal) = let      fun genSanityCheck (proto, args, retVal) = let
237            val args = List.concat (List.map flattenArg args)
238            val args = List.map cArgToString args
239          val retPrintf = (case retVal          val retPrintf = (case retVal
240               of [] => ""               of [] => ""
241                | [retVal] => genPrintf(genFormatString [tyToFormatString (#retTy proto)], [cArgToString retVal])                | [retVal] => genPrintf(genFormatString [tyToFormatString (#retTy proto)], [cArgToString retVal])
# Line 194  Line 246 
246          end          end
247    
248      fun offset arr0 i = T.ADD(wordTy, arr0, li(i*maxArgSzB))      fun offset arr0 i = T.ADD(wordTy, arr0, li(i*maxArgSzB))
249    
250      fun genGlueArg arr0 (ty, (i, args)) = (i+1,      fun genGlueArg arr0 (ty, (i, args)) = (i+1,
251          (case ty          (case ty
252            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 arr0 i, ()))
253             | 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 arr0 i, ()))
254             | CTy.C_PTR => CCalls.ARG (T.LOAD(wordTy, offset arr0 i, ()))             | CTy.C_PTR => CCalls.ARG (T.LOAD(wordTy, offset arr0 i, ()))
255               | CTy.C_STRUCT _ => CCalls.ARG (T.LOAD(wordTy, offset arr0 i, ()))
256             | CTy.C_float => CCalls.FARG (T.FLOAD(32, offset arr0 i, ()))             | CTy.C_float => CCalls.FARG (T.FLOAD(32, offset arr0 i, ()))
257             | CTy.C_double => CCalls.FARG (T.FLOAD(64, offset arr0 i, ()))             | CTy.C_double => CCalls.FARG (T.FLOAD(64, offset arr0 i, ()))
258          (* end case *)) :: args)          (* end case *)) :: args)
259    
260      val rand = Random.rand (0, 255)      val rand = Random.rand (0, 255)
261    
262      fun genRandArg (ty) = (case ty      fun genRandArg (ty) = (case ty
263          of CTy.C_float => FLOAT (Random.randReal(rand))          of CTy.C_float => FLOAT (Random.randReal(rand))
264           | CTy.C_double => DOUBLE(Random.randReal(rand))           | CTy.C_double => DOUBLE(Random.randReal(rand))
265           | CTy.C_unsigned _ => INT (Random.randNat(rand))           | CTy.C_unsigned _ => INT (Random.randNat(rand))
266           | CTy.C_signed _ => INT (Random.randNat(rand))           | CTy.C_signed _ => INT (Random.randNat(rand))
267           | CTy.C_PTR => POINTER(Random.randNat(rand))           | CTy.C_PTR => POINTER(Random.randNat(rand))
268             | CTy.C_STRUCT cTys => STRUCT(List.map genRandArg cTys)
269          (* end case *))          (* end case *))
270    
271      fun output (strm, s) = TextIO.output(strm, s^"\n")      fun output (strm, s) = TextIO.output(strm, s^"\n")
272    
273      fun main _ = let      val pty1 = [CTy.C_double, CTy.C_unsigned CTy.I_int, CTy.C_PTR, CTy.C_double,
         val retTy = CTy.C_double  
         val paramTys = [CTy.C_double, CTy.C_unsigned CTy.I_int, CTy.C_PTR, CTy.C_double,  
274                     CTy.C_float, CTy.C_PTR, CTy.C_float, CTy.C_PTR, CTy.C_PTR, CTy.C_PTR,                     CTy.C_float, CTy.C_PTR, CTy.C_float, CTy.C_PTR, CTy.C_PTR, CTy.C_PTR,
275                     CTy.C_signed CTy.I_int,                     CTy.C_signed CTy.I_int,
276                     CTy.C_double, CTy.C_double, CTy.C_double, CTy.C_double, CTy.C_double,                     CTy.C_double, CTy.C_double, CTy.C_double, CTy.C_double, CTy.C_double,
277                     CTy.C_double, CTy.C_double]                     CTy.C_double, CTy.C_double]
278        val pty2 = [CTy.C_STRUCT [CTy.C_float]]
279        val pty3 = [CTy.C_STRUCT [CTy.C_float,CTy.C_float]]
280        val pty3 = [CTy.C_STRUCT [CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float]]
281        val pty4 = [CTy.C_STRUCT [CTy.C_PTR,CTy.C_float,CTy.C_float,CTy.C_float]]
282    
283        fun main _ = let
284            val retTy = CTy.C_double
285            val paramTys = pty4
286    
287          val cArgs = List.map genRandArg paramTys          val cArgs = List.map genRandArg paramTys
288          val retVal = if retTy <> CTy.C_void then [genRandArg retTy] else []          val retVal = if retTy <> CTy.C_void then [genRandArg retTy] else []
# Line 236  Line 298 
298    
299          (* output C code for santity check *)          (* output C code for santity check *)
300          val cOutStrm = TextIO.openOut "sanity.c"          val cOutStrm = TextIO.openOut "sanity.c"
301          val cCode = genSanityCheck(proto, List.map cArgToString cArgs, retVal)          val cCode = genSanityCheck(proto, cArgs, retVal)
302          val _ = output(cOutStrm, cCode)          val _ = output(cOutStrm, cCode)
303          val _ = TextIO.closeOut cOutStrm          val _ = TextIO.closeOut cOutStrm
304    

Legend:
Removed from v.2994  
changed lines
  Added in v.2995

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