[MLton-devel] calling SML from C; reentrance

[Matthew Fluet]

I was thinking about proposing a MLton.Callback structure that would
replace MLton.FFI.handleCallFromC and alleviate some of the burden of
interoperability.  However, I was also thinking about the fact
MLton.FFI.handleCallFromC isn't reentrant (and I don't see how to
make it so from the client side) -- in the sense that the callFromC
handler can't call a C function that calls back into SML.  Slightly
modifying Steve's original example:

------------------------------------------------------------
/* f.c */
#include <stdio.h>

void MLton_callFromC ();

void f () {
	fprintf (stderr, "f calling SML\n");
	MLton_callFromC ();
	fprintf (stderr, "f calling SML again\n");
	MLton_callFromC ();
	fprintf (stderr, "f done calling SML\n");
}
------------------------------------------------------------

------------------------------------------------------------
(* z.sml *)

local
  val tab = 3
  val indent = ref 0
in
  fun push () = indent := (!indent) + tab
  fun pop () = indent := (!indent) - tab
  val print = fn s =>
    (print (CharVector.tabulate (!indent, fn _ => #" "))
     ; print s)
end

val f = _ffi "f": unit -> unit;
val f = fn () =>
  (print "calling f\n"; push ()
   ; f ()
   ; pop (); print "done calling f\n")

val h = ref true
val handler =
  fn () =>
  (print "handling C\n"; push ()
   ; print "C called me\n"
   ; if !h then (h := false ; f ()) else ()
   ; pop (); print "done handling C\n")
val _ = MLton.FFI.handleCallFromC handler

val _ = f ()
val _ = f ()
-------------------------------------------------------

[fluet@lennon test]$ mlton.cvs.HEAD z.sml f.c ; ./z
calling f
f calling SML
   handling C
      C called me
      calling f
f calling SML
      done calling f
   done handling C
f calling SML again
   handling C
      C called me
   done handling C
f done calling SML
Segmentation fault

I understand this is "bad", although I don't quite understand why the
segmentation fault.  When  handler  executes  f ()  the handleCallFromC
thread is suspended right there, so when we reenter SML, we resume that
thread and continue with  print "done handling C\n".  Thus, we get the
"error" on lines 6-7, where f calls SML but doesn't see "handling C".
After that, I guess we just have the threads in a bad enough state that
things don't work.


>From the client side, I would (naively) think that the following
modification would work: i.e., every time the handler gets run,
immediately reinstall it as the handler:

val h = ref true
val rec handler =
  fn () =>
  (print "handling C\n"; push ()
   ; MLton.FFI.handleCallFromC handler
   ; print "C called me\n"
   ; if !h then (h := false ; f ()) else ()
   ; pop (); print "done handling C\n")
val _ = MLton.FFI.handleCallFromC handler

Now, because I know the implementation of handleCallFromC, I know this
won't work.  The "original" handler is still the thread that's suspended
at the call to C and we won't see the newly installed handler until the
handleCallFromC loop get's back to the top and derefs the ref holding the
handler.  Interestingly, though, here is how the code fails:

[fluet@lennon test]$ mlton.cvs.HEAD z.sml f.c ; ./z
calling f
f calling SML
   handling C
      C called me
      calling f
f calling SML
      done calling f
   done handling C
f calling SML again
   handling C
      C called me
   done handling C
f done calling SML
Out of memory: 1,073,854,960 bytes live.

I have no idea why the runtime looking for a gig (and clearly a gig is not
live, as this machine has 512Meg RAM + 128Meg Swap).

So, it seems like we need to go deeper.  Switch z.sml's handler back to
the original (i.e., don't attempt to reinstall the handler on the client
side) and change the basis-library/mlton/thread.sml to:

val setCallFromCHandler =
   let
      val r: (unit -> unit) ref =
	 ref (fn () => raise Fail "no handler for C calls")
      val _ =
	 let
	   fun install () =
	     Prim.setCallFromCHandler
	     (toPrimitive
	      (new (fn () =>
		    let
		      val t = Prim.saved ()
		    in
		      install ()
		      ; !r () handle e => MLtonExn.topLevelHandler e
		      ; Prim.setSaved t
		      ; Prim.returnToC ()
		      ; raise Fail "Thread.setCallFromCHandler"
		    end)))
	 in
	   install ()
	 end
   in
     fn f => r := f
   end

Note, we remove the loop, as the Fail exception is unreachable;
Prim.returnToC doesn't return here.  Now, I get:

[fluet@lennon test]$ mlton.cvs.HEAD z.sml f.c ; ./z
calling f
f calling SML
   handling C
      C called me
      calling f
f calling SML
         handling C
            C called me
         done handling C
f calling SML again
         handling C
            C called me
         done handling C
f done calling SML
      done calling f
   done handling C
f calling SML again
   handling C
      C called me
   done handling C
f done calling SML
done calling f
calling f
f calling SML
   handling C
      C called me
   done handling C
f calling SML again
   handling C
      C called me
   done handling C
f done calling SML
done calling f

which is "more" correct from my point of view.  I had always envisioned C
calling SML as always starting "at the top" of the handler function.  I
don't think there are any major problems with the above.  In a "single
threaded" main program, there will really only ever be one stack of
execution, just chained together through C functions.  Interestingly, this
is precisely what happens on the C side, where the same stack is used for
all the C functions, just peppered with returns to MLton_callFromC that
side-track the execution into ML before returning.  In a "multi threaded"
main program, this should be more robust, since while handling a call from
C to SML in one thread, we might switch to another ML thread that also
calls C that calls SML.

It also seems that we could further simplify setCallFromCHandler as
follows:

val setCallFromCHandler =
  let
    fun install f =
      Prim.setCallFromCHandler
      (toPrimitive
       (new (fn () =>
	     let
	       val t = Prim.saved ()
	     in
	       install f
	       ; f () handle e => MLtonExn.topLevelHandler e
	       ; Prim.setSaved t
	       ; Prim.returnToC ()
	       ; raise Fail "Thread.setCallFromCHandler"
	     end)))
    val _ = install (fn () => raise Fail "no handler for C calls")
  in
    fn f => install f
  end



-------------------------------------------------------
Enterprise Linux Forum Conference & Expo, June 4-6, 2003, Santa Clara
The only event dedicated to issues related to Linux enterprise solutions
www.enterpriselinuxforum.com

_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel