regression/library/libm1.sml

   1 val () = print "libm1 starting up\n"
   2 val () = OS.Process.atExit (fn () => print "libm1 exits\n")
   3
   4 type p = MLton.Pointer.t
   5
   6 type 'a s = (unit -> 'a) * ('a -> unit)
   7 val (_, setSI) = _symbol "libm1smlSymPrivate" alloc private : p s;
   8 val (_, setSB) = _symbol "libm1smlSymPublic"  alloc public  : p s;
   9 val (_, setCI) = _symbol "libm1cSymPrivate" private : p s;
  10 val (_, setCB) = _symbol "libm1cSymPublic"  public  : p s;
  11
  12 type i = (unit -> p)
  13 type e = i -> unit
  14 val () = _export "libm1smlFnPrivate" private : e;
  15          (fn () => _address "libm1smlSymPrivate" private : p;)
  16 val () = _export "libm1smlFnPublic" public : e;
  17          (fn () => _address "libm1smlSymPublic" public : p;)
  18 val getCI = _import "libm1cFnPrivate" private : i;
  19 val getCB = _import "libm1cFnPublic" public : i;
  20
  21 (* Store our idea of what the function pointers are in symbols *)
  22 val () = setSI (_address "libm1smlFnPrivate" private : p;)
  23 val () = setSB (_address "libm1smlFnPublic"  public  : p;)
  24 val () = setCI (_address "libm1cFnPrivate"   private : p;)
  25 val () = setCB (_address "libm1cFnPublic"    public  : p;)
  26
  27 (* Have C confirm that it sees the same function pointers we do.
  28  * C will check the values of the variables against it's own pointers.
  29  * C also checks SML functions return his idea of pointers to our exports.
  30  *)
  31 val () = _import "libm1confirmC" private : unit -> unit; ()
  32
  33 (* Confirm that C functions return pointers to address as we expect. *)
  34 fun check (s, b) = if b then () else print (s ^ " pointers don't match!\n")
  35 val () = check ("libm1cFnPrivate", getCI () = _address "libm1cSymPrivate" private : p;)
  36 val () = check ("libm1cFnPublic",  getCB () = _address "libm1cSymPublic"  public  : p;)
  37
  38 val () = print "m1 pointer test complete.\n"