[MLton] interrupted system call

[Matthew Fluet]

> > I'd actually suggest that if the system call returns an error, then the
> > critical section is left, so that the alrm signal gets a chance to run
> > before retarting the system call.
>
> This seems contrary to the notion of critical section.  But I guess
> that's what we're allowing with the Signal.restart flag.

Sorry, I wasn't clear here.  IIRC, the context of my comment was in the
case of a system call that needed pre-/post- processing.  The point is
that with the signature:

val Posix.Error.syscall: (unit -> int) -> int

then I can't do the post- processing within the syscall function.  So, I'm
stuck wrapping syscall and the post-processing in atomicBegin/End, which
means that a signal will force us into the block signals and restart
case.  I want finer grained control.

Consider a system call like

  struct foo {int a; int b};
  struct bar {int y; int z};
  int F(int x, struct foo b, struct bar* c);

where x and b are inputs and c is output.  Our convention has been to
implement this in the runtime like:

  static struct foo foo;
  static struct bar bar;

  void MLton_F_Foo_setA(Int i) { foo.a = i; }
  void MLton_F_Foo_setB(Int i) { foo.b = i; }
  Int MLton_F_Bar_getY() { return bar.y; }
  Int MLton_F_Bar_getZ() { return bar.z; }
  Int MLton_F(int i) { return F(i, foo, &bar); }

In ML, though, we want to eventually export
  val mlF : int * {a: int, b: int} -> {y: int, z: int}
so we write
  fun mlF (x, {a, b}) =
    let
      val () = F_Foo_setA(a)
      val () = F_Foo_setB(b)
      val n = MLton_F(x)
      val () = Posix.Error.checkResut(n)
      val y = F_Bar_getY()
      val z = F_Bar_getZ()
    in
      {y = y, z = z}
    end

If I replace
      val n = MLton_F(x)
      val () = Posix.Error.checkResut(n)
with
      val n = Posix.Error.syscall(fn () => MLton_F(x))
we can have the following situation:  a signal interrupts the F
system call (called via MLton_F), syscall loops to restart MLton_F (and
the system call F), the ML signal handler runs, switches threads; much
later, this thread is resumed, continues to restart MLton_F, but now there
is invalid data sitting in the global foo struct (because another thread
may have called mlF before switching back).  Clearly bad.

If we write
  fun mlF (x, {a, b}) =
    let
      val () = atomicBegin ();
      val () = F_Foo_setA(a);
      val () = F_Foo_setB(b);
      val n = Posix.Error.syscall(fn () => MLton_F(x));
      val y = F_Bar_getY();
      val z = F_Bar_getZ();
      val () = atomicEnd ();
    in
      {y = y, z = z}
    end
then I'm in the situation described above, where syscall is in an atomic
region, forcing a blocking restart.  This seems bad, too.

In C, if I wanted to get the same effect (of restarting), I'd write
something like:

  int cF(int x, struct foo b, struct bar* c) {
    int n, e;
    while (1) {
       n = F(x, b, c);
       /* C signal handler runs here on EINTR */
       if (n == ~1) {
         e = errno;
         if (e == EINTR || e == ERESTART) {
           continue;
         } else return n;
       } else return n;
    }
  }

Ignoring the fact that errno may be corrupted by the signal handler,
things are better in C, because my signal handler gets to run (and
presumably switch threads and maybe switch back), but if cF
returns, I know I get the right answer.  I don't need to do any fancy
atomic stuff, because everything is function local data.  I'd like to see
this same abstraction in SML.

So, here's the signature for syscall that I'd really like to see:

val Posix.Error.syscall :
   {wrapAtomic: bool,
    wrapRestart: bool,
    pre: 'a -> 'aa,
    call: 'aa -> 'bb,
    return: 'bb -> int,
    post: 'bb -> 'b} ->
   ('a -> 'b)

(This is fairly general, but a lot of special cases fall out as nice
instances.  Also, I like symmetry, even if it makes things a little more
verbose.)

Now, we can implement mlF as
val mlF =
  Posix.Error.syscall
  {wrapAtomic = true,
   wrapRestart = true,
   pre = fn (x, {a, b}) => (F_Foo_setA(a)
                            ; F_Foo_setB(b)
                            ; x)),
   call = fn x => MLton_F x,
   return = fn n => n,
   post = fn _ => let val y = F_Bar_getY()
                      val z = F_Bar_getZ()
                  in {y = y, z = z}
                  end}
which will take care of doing the atomic begin and end, leaving the atomic
region if the return code is an error, and invoking the restart (which
will reenter the atomic region) if necessary.