Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /MLRISC/trunk/vararg-ccall/vararg-ccall.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3063 - (view) (download)

1 : mrainey 3062 structure VarargCCall =
2 :     struct
3 :    
4 :     structure DL = DynLinkage
5 :     structure V = VarArgs
6 :     structure Consts = VarargCCallConstants
7 :    
8 :     fun main's s = DL.lib_symbol (DL.main_lib, s)
9 :     val malloc_h = main's "malloc"
10 :     val free_h = main's "free"
11 :    
12 :     exception OutOfMemory
13 :    
14 :     fun sys_malloc (n : Word32.word) =
15 :     let val w_p = RawMemInlineT.rawccall :
16 :     Word32.word * Word32.word * (unit * word -> string) list
17 :     -> Word32.word
18 :     val a = w_p (DL.addr malloc_h, n, [])
19 :     in if a = 0w0 then raise OutOfMemory else a
20 :     end
21 :    
22 :     fun sys_free (a : Word32.word) =
23 :     let val p_u = RawMemInlineT.rawccall :
24 :     Word32.word * Word32.word * (unit * string -> unit) list
25 :     -> unit
26 :     in p_u (DL.addr free_h, a, [])
27 :     end
28 :    
29 :     fun alloc bytes = sys_malloc (Word32.toLargeWord bytes)
30 :     fun free a = sys_free a
31 :    
32 :     type addr = Word32.word
33 :     infix ++
34 :     fun (a: addr) ++ i = a + Word32.fromInt i
35 :    
36 :     fun set' (p, w) = RawMemInlineT.w32s (p, w)
37 :     fun nxt' p = p ++ 1
38 :    
39 :     fun cpML' { from, to } = let
40 :     val n = String.size from
41 :     fun loop (i, p) =
42 :     if i >= n then set' (p, 0w0)
43 :     else (set' (p, Word32.fromInt (Char.ord
44 :     (String.sub (from, i))));
45 :     loop (i+1, nxt' p))
46 :     in
47 :     loop (0, to)
48 :     end
49 :    
50 :     fun dupML' s = let
51 :     val z = alloc (Word32.fromInt (String.size s + 1))
52 :     in
53 :     cpML' { from = s, to = z };
54 :     z
55 :     end
56 :    
57 :     fun encodeArg (V.I i) = Word32.fromInt i
58 :     | encodeArg (V.S s) = dupML' s
59 :     | encodeArg (V.B b) = if b then 0w1 else 0w0
60 :     | encodeArg (V.R r) = raise Fail "todo"
61 :    
62 :     val defaultWidthB = Word32.fromInt Consts.defaultWidthB
63 :     val argOffB = Word32.fromInt Consts.argOff * defaultWidthB
64 :     val kindOffB = Word32.fromInt Consts.kindOff * defaultWidthB
65 :     val locOffB = Word32.fromInt Consts.locOff * defaultWidthB
66 :     val tyOffB = Word32.fromInt Consts.tyOff * defaultWidthB
67 :    
68 :     fun set (p, off, v) = set'(p+off, v)
69 :    
70 :     fun encodeZippedArg (arg, k, l, ty) = let
71 :     (* 4 elements x 8 bytes per element *)
72 :     val x = alloc (0w4 * defaultWidthB)
73 :     in
74 :     set(x, argOffB, encodeArg arg);
75 :     set(x, kindOffB, Word32.fromInt k);
76 :     set(x, locOffB, Word32.fromInt l);
77 :     set(x, tyOffB, Word32.fromInt ty);
78 :     x
79 :     end
80 :    
81 :     val hdOffB = Word32.fromInt Consts.HD * defaultWidthB
82 :     val tlOffB = Word32.fromInt Consts.TL * defaultWidthB
83 :    
84 :     fun encodeZippedArgList args = let
85 :     fun loop [] = Word32.fromInt Consts.NIL
86 :     | loop (za :: zas) = let
87 :     val l = alloc(0w2 * defaultWidthB)
88 :     in
89 :     set(l, hdOffB, za);
90 :     set(l, tlOffB, loop(zas));
91 :     l
92 :     end
93 :     in
94 :     loop (List.map encodeZippedArg args)
95 :     end
96 :    
97 :     fun vararg's s = let
98 :     val lh = DynLinkage.open_lib
99 :     { name = "./vararg", global = true, lazy = true }
100 :     in
101 :     DL.lib_symbol (lh, s)
102 :     end
103 :    
104 :     (* call the vararg interpreter *)
105 :     fun vararg (cFun, zippedArgs, stkArgSzB) = let
106 : mrainey 3063 val vararg_h = vararg's "vararg_wrapper"
107 : mrainey 3062 val callInterp = RawMemInlineT.rawccall :
108 :     Word32.word * (Word32.word * Word32.word * Word32.word) *
109 :     (unit * Word32.word * Word32.word * Word32.word -> Word32.word) list
110 :     -> Word32.word
111 :     val cFunAddr = DL.addr (vararg's cFun)
112 :     val cArgs = encodeZippedArgList zippedArgs
113 :     in
114 :     callInterp (DL.addr vararg_h, (cFunAddr, cArgs, Word32.fromInt stkArgSzB), [])
115 :     end
116 :    
117 :     end

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