| 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" |