Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | val () = print "libm3 starting up\n" |
2 | val () = OS.Process.atExit | |
3 | (fn () => (_import "m2_close" public : unit -> unit; () | |
4 | ; print "libm3 exits\n")) | |
5 | ||
6 | (* Prepare libm2 *) | |
7 | val () = _import "m2_open" external : int * string vector -> unit; | |
8 | (1, Vector.fromList ["libm2"]) | |
9 | ||
10 | type p = MLton.Pointer.t | |
11 | type 'a s = (unit -> 'a) * ('a -> unit) | |
12 | val (_, setSI) = _symbol "libm3smlSymPrivate" alloc private : p s; | |
13 | val (_, setSB) = _symbol "libm3smlSymPublic" alloc public : p s; | |
14 | val (_, setCI) = _symbol "libm3cSymPrivate" private : p s; | |
15 | val (_, setCB) = _symbol "libm3cSymPublic" public : p s; | |
16 | ||
17 | type i = (unit -> p) | |
18 | type e = i -> unit | |
19 | val () = _export "libm3smlFnPrivate" private : e; | |
20 | (fn () => _address "libm3smlSymPrivate" private : p;) | |
21 | val () = _export "libm3smlFnPublic" public : e; | |
22 | (fn () => _address "libm3smlSymPublic" public : p;) | |
23 | val getCI = _import "libm3cFnPrivate" private : i; | |
24 | val getCB = _import "libm3cFnPublic" public : i; | |
25 | ||
26 | (* Store our idea of what the function pointers are in symbols *) | |
27 | val () = setSI (_address "libm3smlFnPrivate" private : p;) | |
28 | val () = setSB (_address "libm3smlFnPublic" public : p;) | |
29 | val () = setCI (_address "libm3cFnPrivate" private : p;) | |
30 | val () = setCB (_address "libm3cFnPublic" public : p;) | |
31 | ||
32 | (* Have C confirm that it sees the same function pointers we do. | |
33 | * C will check the values of the variables against it's own pointers. | |
34 | * C also checks SML functions return his idea of pointers to our exports. | |
35 | *) | |
36 | val () = _import "libm3confirmC" private : unit -> unit; () | |
37 | ||
38 | (* Confirm that C functions return pointers to address as we expect. *) | |
39 | fun check (s, b) = if b then () else print (s ^ " pointers don't match!\n") | |
40 | val () = check ("libm3cFnPrivate", getCI () = _address "libm3cSymPrivate" private : p;) | |
41 | val () = check ("libm3cFnPublic", getCB () = _address "libm3cSymPublic" public : p;) | |
42 | ||
43 | (* Test symbols in libm1 *) | |
44 | val (SB, _) = _symbol "libm1smlSymPublic" external : p s; | |
45 | val (CB, _) = _symbol "libm1cSymPublic" external : p s; | |
46 | val getSB = _import "libm1smlFnPublic" external : i; | |
47 | val getCB = _import "libm1cFnPublic" external : i; | |
48 | ||
49 | (* Check function pointers *) | |
50 | val () = check ("libm1smlFnPublic", SB () = _address "libm1smlFnPublic" external : p;) | |
51 | val () = check ("libm1cFnPublic", CB () = _address "libm1cFnPublic" external : p;) | |
52 | (* Check symbol pointers *) | |
53 | val () = check ("libm1smlSymPublic", getSB () = _address "libm1smlSymPublic" external : p;) | |
54 | val () = check ("libm1cSymPublic", getCB () = _address "libm1cSymPublic" external : p;) | |
55 | ||
56 | (* Test symbols in libm2 *) | |
57 | val (SB, _) = _symbol "libm2smlSymPublic" external : p s; | |
58 | val (CB, _) = _symbol "libm2cSymPublic" external : p s; | |
59 | val getSB = _import "libm2smlFnPublic" external : i; | |
60 | val getCB = _import "libm2cFnPublic" external : i; | |
61 | ||
62 | (* Check function pointers *) | |
63 | val () = check ("libm2smlFnPublic", SB () = _address "libm2smlFnPublic" external : p;) | |
64 | val () = check ("libm2cFnPublic", CB () = _address "libm2cFnPublic" external : p;) | |
65 | (* Check symbol pointers *) | |
66 | val () = check ("libm2smlSymPublic", getSB () = _address "libm2smlSymPublic" external : p;) | |
67 | val () = check ("libm2cSymPublic", getCB () = _address "libm2cSymPublic" external : p;) | |
68 | ||
69 | val () = print "m3 pointer test complete.\n" |