[MLton] interrupted system call

Stephen Weeks MLton@mlton.org
Fri, 26 Mar 2004 15:34:17 -0800


> 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.)

Makes sense.  But it does seem verbose.  The crucial point that I take
away from your examples is that we need to connect the code that sets
up the system call with the call itself and with the code afterwards.
Also, from what I can tell, your use of wrapAtomic is just an
optimization.  That is {wrapAtomic = false} is used to tell syscall
that there is no state that needs connecting.  It doesn't seem like
there would be any harm caused by forcing {wrapAtomic = true}.  If the
user wanted something to be done prior to the critical section then
they could put it before the syscall.  Finally, I think the other
thread about putting extra (to my eyes) type variables in interfaces
is relevant.

Putting all that together, I propose the following.

val syscall: (unit -> int * (unit -> 'a)) * {restart: bool} -> 'a

With that, mlF looks like

fun mlF (x, {a, b}) =
   syscall (fn () => (F_Foo_setA a
		      ; F_Foo_setB b
		      ; (MLton_F x,
			 fn () => {y = F_Bar_getY (),
				   z = F_Bar_getZ ()})),
	    {restart = true})

This approach seems to give you as much control as you need -- namely
that syscall can restart the computation if it needs and it can ensure
that the computation is atomic.  More precisely, here is what I am
thinking of.

val syscall: (unit -> int * (unit -> 'a)) * {restart: bool} -> 'a =
   fn (f, {restart}) =>
   let
      fun call (err: int -> 'a): 'a =
         let
	    val () = atomicBegin ()
            val (n, post) = f ()
         in
            if n = ~1
	       then (atomicEnd (); err (getErrno ()))
	    else (post () before atomicEnd ())
         end
      fun err (e: int): 'a =
         if restart andalso (e = Signal.intr orelse e = Signal.restart)
            then
	       if 0 = Signal.canHandle ()
		  then call err
	       else
		  let
		     val m = Signal.Mask.getBlocked ()
		     val () = Signal.Mask.setBlocked (Signal.Mask.handled ())
		  in
		     dynamicWind (fn () => call raiseSys,
				  fn () => Signal.Mask.setBlocked m)
		  end
         else raiseSys e
   in
      call err
   end