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/vararg-ccall/vararg-ccall.sml
ViewVC logotype

Diff of /MLRISC/trunk/vararg-ccall/vararg-ccall.sml

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

revision 3067, Thu Jun 5 22:18:34 2008 UTC revision 3068, Fri Jun 6 00:25:53 2008 UTC
# Line 2  Line 2 
2    struct    struct
3    
4      structure DL = DynLinkage      structure DL = DynLinkage
     structure V = VarArgs  
5      structure Consts = VarargCCallConstants      structure Consts = VarargCCallConstants
6    
7        datatype argument = I of int | R of real | B of bool | S of string
8    
9      fun main's s = DL.lib_symbol (DL.main_lib, s)      fun main's s = DL.lib_symbol (DL.main_lib, s)
10      val malloc_h = main's "malloc"      val malloc_h = main's "malloc"
11      val free_h = main's "free"      val free_h = main's "free"
# Line 54  Line 55 
55              z              z
56          end          end
57    
58      fun encodeArg (V.I i) = Word32.fromInt i    (* default width of a field in a zipped argument *)
       | encodeArg (V.S s) = dupML' s  
       | encodeArg (V.B b) = if b then 0w1 else 0w0  
       | encodeArg (V.R r) = raise Fail "todo"  
   
59      val defaultWidthB = Word32.fromInt Consts.defaultWidthB      val defaultWidthB = Word32.fromInt Consts.defaultWidthB
60      val argOffB = Word32.fromInt Consts.argOff * defaultWidthB      val argOffB = Word32.fromInt Consts.argOff * defaultWidthB
61      val kindOffB = Word32.fromInt Consts.kindOff * defaultWidthB      val kindOffB = Word32.fromInt Consts.kindOff * defaultWidthB
62      val locOffB = Word32.fromInt Consts.locOff * defaultWidthB      val locOffB = Word32.fromInt Consts.locOff * defaultWidthB
63      val tyOffB = Word32.fromInt Consts.tyOff * defaultWidthB      val tyOffB = Word32.fromInt Consts.tyOff * defaultWidthB
64        val zippedArgSzB = Word32.fromInt Consts.zippedArgSzB
65    
66      fun set (p, off, v) = set'(p+off, v)      fun set (p, off, v) = set'(p+off, v)
67    
68      fun encodeZippedArg (arg, k, l, ty) = let    (* track strings allocated for the call *)
69            (* 4 elements x 8 bytes per element *)      local
70              val x = alloc (0w4 * defaultWidthB)          val allocatedStrs = ref ([] : Word32.word list)
71              in      in
72                 set(x, argOffB, encodeArg arg);          fun freeStrs () = (
73                 set(x, kindOffB, Word32.fromInt k);                 List.app free (!allocatedStrs);
74                 set(x, locOffB, Word32.fromInt l);                 allocatedStrs := [])
75                 set(x, tyOffB, Word32.fromInt ty);          fun addStr s = allocatedStrs := s :: !allocatedStrs
76                 x      end
77              end  
78      (* encode the argument field *)
79      val hdOffB = Word32.fromInt Consts.HD * defaultWidthB      fun encodeArg (arrPtr, I i) = set(arrPtr, argOffB, Word32.fromInt i)
80      val tlOffB = Word32.fromInt Consts.TL * defaultWidthB        | encodeArg (arrPtr, S s) = let
81                val strPtr = dupML' s
82      fun encodeZippedArgList args = let              in
83              fun loop [] = Word32.fromInt Consts.NIL                 addStr strPtr;
84                | loop (za :: zas) = let                 set(arrPtr, argOffB, strPtr)
85                      val l = alloc(0w2 * defaultWidthB)              end
86                      in        | encodeArg (arrPtr, B b) = set(arrPtr, argOffB, if b then 0w1 else 0w0)
87                          set(l, hdOffB, za);        | encodeArg (arrPtr, R r) = RawMemInlineT.f64s (arrPtr+argOffB, r)
88                          set(l, tlOffB, loop(zas));  
89                          l    (* encode a zipped argument *)
90                      end      fun encodeZippedArg ((arg, k, l, ty), arrPtr) = (
91                encodeArg(arrPtr, arg);
92                set(arrPtr, kindOffB, Word32.fromInt k);
93                set(arrPtr, locOffB, Word32.fromInt l);
94                set(arrPtr, tyOffB, Word32.fromInt ty);
95              (* advance the pointer by one zipped argument *)
96                arrPtr + zippedArgSzB
97            )
98    
99      (* encode an array of zipped arguments *)
100        fun encodeZippedArgs args = let
101                val nArgs = List.length args
102                val argsSzB = Word32.fromInt nArgs * zippedArgSzB
103                val arrPtr = alloc argsSzB
104              in              in
105                  loop (List.map encodeZippedArg args)                  List.foldl encodeZippedArg arrPtr args;
106                    {startCArr=arrPtr, endCArr=argsSzB+arrPtr}
107              end              end
108    
109      fun vararg's s = let      fun vararg's s = let
# Line 102  Line 114 
114          end          end
115    
116    (* call the vararg interpreter *)    (* call the vararg interpreter *)
117      fun vararg (cFun, zippedArgs, stkArgSzB) = let      fun vararg (cFun, zippedArgs) = let
118              val vararg_h = vararg's "varargs"              val vararg_h = vararg's Consts.varargInterpreter
119              val callInterp = RawMemInlineT.rawccall :              val callInterp = RawMemInlineT.rawccall :
120                        Word32.word * (Word32.word * Word32.word * Word32.word) *                        Word32.word * (Word32.word * Word32.word * Word32.word) *
121                        (unit * Word32.word * Word32.word * Word32.word -> Word32.word) list                        (unit * Word32.word * Word32.word * Word32.word -> Word32.word) list
122                        -> Word32.word                        -> Word32.word
123              val cFunAddr = DL.addr (vararg's cFun)              val cFunAddr = DL.addr (vararg's cFun)
124              val cArgs = encodeZippedArgList zippedArgs              val {startCArr, endCArr} = encodeZippedArgs zippedArgs
125             (* call the interpreter *)
126                val x = callInterp (DL.addr vararg_h, (cFunAddr, startCArr, endCArr), [])
127              in              in
128                  callInterp (DL.addr vararg_h, (cFunAddr, cArgs, Word32.fromInt stkArgSzB), [])                  freeStrs();
129                    free startCArr;
130                    x
131              end              end
132    
133    end    end

Legend:
Removed from v.3067  
changed lines
  Added in v.3068

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