1 val () = print
"libm2 starting up\n"
2 val () = OS
.Process
.atExit
3 (fn () => (_import
"m1_close" public
: unit
-> unit
; ()
4 ; print
"libm2 exits\n"))
7 val () = _import
"m1_open" public
: int * string vector
-> unit
;
8 (1, Vector.fromList
["libm1"])
10 type p
= MLton
.Pointer
.t
11 type 'a s
= (unit
-> 'a
) * ('a
-> unit
)
12 val (_
, setSI
) = _symbol
"libm2smlSymPrivate" alloc private
: p s
;
13 val (_
, setSB
) = _symbol
"libm2smlSymPublic" alloc public
: p s
;
14 val (_
, setCI
) = _symbol
"libm2cSymPrivate" private
: p s
;
15 val (_
, setCB
) = _symbol
"libm2cSymPublic" public
: p s
;
19 val () = _export
"libm2smlFnPrivate" private
: e
;
20 (fn () => _address
"libm2smlSymPrivate" private
: p
;)
21 val () = _export
"libm2smlFnPublic" public
: e
;
22 (fn () => _address
"libm2smlSymPublic" public
: p
;)
23 val getCI
= _import
"libm2cFnPrivate" private
: i
;
24 val getCB
= _import
"libm2cFnPublic" public
: i
;
26 (* Store our idea
of what the function pointers are
in symbols
*)
27 val () = setSI (_address
"libm2smlFnPrivate" private
: p
;)
28 val () = setSB (_address
"libm2smlFnPublic" public
: p
;)
29 val () = setCI (_address
"libm2cFnPrivate" private
: p
;)
30 val () = setCB (_address
"libm2cFnPublic" public
: p
;)
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
.
36 val () = _import
"libm2confirmC" private
: unit
-> unit
; ()
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 ("libm2cFnPrivate", getCI () = _address
"libm2cSymPrivate" private
: p
;)
41 val () = check ("libm2cFnPublic", getCB () = _address
"libm2cSymPublic" public
: p
;)
43 (* Test symbols
in libm1
*)
44 val (SB
, _
) = _symbol
"libm1smlSymPublic" public
: p s
;
45 val (CB
, _
) = _symbol
"libm1cSymPublic" public
: p s
;
46 val getSB
= _import
"libm1smlFnPublic" public
: i
;
47 val getCB
= _import
"libm1cFnPublic" public
: i
;
49 (* Check function pointers
*)
50 val () = check ("libm1smlFnPublic", SB () = _address
"libm1smlFnPublic" public
: p
;)
51 val () = check ("libm1cFnPublic", CB () = _address
"libm1cFnPublic" public
: p
;)
52 (* Check symbol pointers
*)
53 val () = check ("libm1smlSymPublic", getSB () = _address
"libm1smlSymPublic" public
: p
;)
54 val () = check ("libm1cSymPublic", getCB () = _address
"libm1cSymPublic" public
: p
;)
56 val () = print
"m2 pointer test complete.\n"