regression/library/libm4.sml

   1 val () = print "libm4 starting up\n"
   2 val () = OS.Process.atExit
   3          (fn () => (_import "m3_close" public : unit -> unit; ()
   4                    ; print "libm4 exits\n"))
   5
   6 (* Prepare libm3 *)
   7 val () = _import "m3_open" public : int * string vector -> unit;
   8          (1, Vector.fromList ["libm3"])
   9
  10 type p = MLton.Pointer.t
  11 type 'a s = (unit -> 'a) * ('a -> unit)
  12 val (_, setSI) = _symbol "libm4smlSymPrivate" alloc private : p s;
  13 val (_, setSB) = _symbol "libm4smlSymPublic"  alloc public  : p s;
  14 val (_, setCI) = _symbol "libm4cSymPrivate" private : p s;
  15 val (_, setCB) = _symbol "libm4cSymPublic"  public  : p s;
  16
  17 type i = (unit -> p)
  18 type e = i -> unit
  19 val () = _export "libm4smlFnPrivate" private : e;
  20          (fn () => _address "libm4smlSymPrivate" private : p;)
  21 val () = _export "libm4smlFnPublic" public : e;
  22          (fn () => _address "libm4smlSymPublic" public : p;)
  23 val getCI = _import "libm4cFnPrivate" private : i;
  24 val getCB = _import "libm4cFnPublic" public : i;
  25
  26 (* Store our idea of what the function pointers are in symbols *)
  27 val () = setSI (_address "libm4smlFnPrivate" private : p;)
  28 val () = setSB (_address "libm4smlFnPublic"  public  : p;)
  29 val () = setCI (_address "libm4cFnPrivate"   private : p;)
  30 val () = setCB (_address "libm4cFnPublic"    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 "libm4confirmC" 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 ("libm4cFnPrivate", getCI () = _address "libm4cSymPrivate" private : p;)
  41 val () = check ("libm4cFnPublic",  getCB () = _address "libm4cSymPublic"  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 (* Test symbols in libm3 *)
  70 val (SB, _) = _symbol "libm3smlSymPublic" public : p s;
  71 val (CB, _) = _symbol "libm3cSymPublic"   public : p s;
  72 val getSB = _import "libm3smlFnPublic" public : i;
  73 val getCB = _import "libm3cFnPublic"   public : i;
  74
  75 (* Check function pointers *)
  76 val () = check ("libm3smlFnPublic", SB () = _address "libm3smlFnPublic" public : p;)
  77 val () = check ("libm3cFnPublic",   CB () = _address "libm3cFnPublic"   public : p;)
  78 (* Check symbol pointers *)
  79 val () = check ("libm3smlSymPublic", getSB () = _address "libm3smlSymPublic" public : p;)
  80 val () = check ("libm3cSymPublic",   getCB () = _address "libm3cSymPublic"   public : p;)
  81
  82 val () = print "m4 pointer test complete.\n"