regression/library/libm5.sml

   1 val () = print "libm5 starting up\n"
   2 val () = OS.Process.atExit
   3          (fn () => (_import "m4_close" public : unit -> unit; ()
   4                    ; print "libm5 exits\n"))
   5
   6 (* Prepare libm4 *)
   7 val () = _import "m4_open" external : int * string vector -> unit;
   8          (1, Vector.fromList ["libm4"])
   9
  10 type p = MLton.Pointer.t
  11 type 'a s = (unit -> 'a) * ('a -> unit)
  12 val (_, setSI) = _symbol "libm5smlSymPrivate" alloc private : p s;
  13 val (_, setSB) = _symbol "libm5smlSymPublic"  alloc public  : p s;
  14 val (_, setCI) = _symbol "libm5cSymPrivate" private : p s;
  15 val (_, setCB) = _symbol "libm5cSymPublic"  public  : p s;
  16
  17 type i = (unit -> p)
  18 type e = i -> unit
  19 val () = _export "libm5smlFnPrivate" private : e;
  20          (fn () => _address "libm5smlSymPrivate" private : p;)
  21 val () = _export "libm5smlFnPublic" public : e;
  22          (fn () => _address "libm5smlSymPublic" public : p;)
  23 val getCI = _import "libm5cFnPrivate" private : i;
  24 val getCB = _import "libm5cFnPublic" public : i;
  25
  26 (* Store our idea of what the function pointers are in symbols *)
  27 val () = setSI (_address "libm5smlFnPrivate" private : p;)
  28 val () = setSB (_address "libm5smlFnPublic"  public  : p;)
  29 val () = setCI (_address "libm5cFnPrivate"   private : p;)
  30 val () = setCB (_address "libm5cFnPublic"    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 "libm5confirmC" 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 ("libm5cFnPrivate", getCI () = _address "libm5cSymPrivate" private : p;)
  41 val () = check ("libm5cFnPublic",  getCB () = _address "libm5cSymPublic"  public  : p;)
  42
  43 (* Test symbols in libm3 *)
  44 val (SB, _) = _symbol "libm3smlSymPublic" external : p s;
  45 val (CB, _) = _symbol "libm3cSymPublic"   external : p s;
  46 val getSB = _import "libm3smlFnPublic" external : i;
  47 val getCB = _import "libm3cFnPublic"   external : i;
  48
  49 (* Check function pointers *)
  50 val () = check ("libm3smlFnPublic", SB () = _address "libm3smlFnPublic" external : p;)
  51 val () = check ("libm3cFnPublic",   CB () = _address "libm3cFnPublic"   external : p;)
  52 (* Check symbol pointers *)
  53 val () = check ("libm3smlSymPublic", getSB () = _address "libm3smlSymPublic" external : p;)
  54 val () = check ("libm3cSymPublic",   getCB () = _address "libm3cSymPublic"   external : p;)
  55
  56 (* Test symbols in libm4 *)
  57 val (SB, _) = _symbol "libm4smlSymPublic" external : p s;
  58 val (CB, _) = _symbol "libm4cSymPublic"   external : p s;
  59 val getSB = _import "libm4smlFnPublic" external : i;
  60 val getCB = _import "libm4cFnPublic"   external : i;
  61
  62 (* Check function pointers *)
  63 val () = check ("libm4smlFnPublic", SB () = _address "libm4smlFnPublic" external : p;)
  64 val () = check ("libm4cFnPublic",   CB () = _address "libm4cFnPublic"   external : p;)
  65 (* Check symbol pointers *)
  66 val () = check ("libm4smlSymPublic", getSB () = _address "libm4smlSymPublic" external : p;)
  67 val () = check ("libm4cSymPublic",   getCB () = _address "libm4cSymPublic"   external : p;)
  68
  69 val () = print "m5 pointer test complete.\n"