[MLton-devel] cvs commit: Calling SML from C

[Stephen Weeks]

sweeks      03/05/16 16:44:56

  Modified:    include  c-main.h x86-main.h
               basis-library/mlton thread.sml
  Log:
  Fixing MLton.FFI.handleCallFromC so that it is reentrant and works
  when there are multiple threads.

Revision  Changes    Path
1.3       +1 -0      mlton/include/c-main.h

Index: c-main.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/c-main.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- c-main.h	15 May 2003 14:43:45 -0000	1.2
+++ c-main.h	16 May 2003 23:44:55 -0000	1.3
@@ -21,6 +21,7 @@
 		fprintf (stderr, "MLton_callFromC() starting\n");		\
 	s = &gcState;								\
 	s->savedThread = s->currentThread;					\
+	s->canHandle++;								\
 	/* Return to the C Handler thread. */					\
 	GC_switchToThread (s, s->callFromCHandler);				\
 	nextFun = *(int*)(s->stackTop - WORD_SIZE);				\



1.3       +1 -0      mlton/include/x86-main.h

Index: x86-main.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/x86-main.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- x86-main.h	15 May 2003 14:43:45 -0000	1.2
+++ x86-main.h	16 May 2003 23:44:55 -0000	1.3
@@ -78,6 +78,7 @@
 		fprintf (stderr, "MLton_callFromC() starting\n");	\
 	s = &gcState;							\
 	s->savedThread = s->currentThread;				\
+	s->canHandle++;							\
 	/* Return to the C Handler thread. */				\
 	GC_switchToThread (s, s->callFromCHandler);			\
 	jump = *(pointer*)(s->stackTop - WORD_SIZE);			\



1.18      +10 -4     mlton/basis-library/mlton/thread.sml

Index: thread.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/thread.sml,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- thread.sml	12 May 2003 22:43:51 -0000	1.17
+++ thread.sml	16 May 2003 23:44:56 -0000	1.18
@@ -145,6 +145,8 @@
       Prim.setHandler p
    end
 
+val msg = Primitive.Stdio.print
+   
 val setCallFromCHandler =
    let
       val r: (unit -> unit) ref =
@@ -156,11 +158,15 @@
 		   fun loop (): unit =
 		      let
 			 val t = Prim.saved ()
+			 val _ =
+			    Prim.switchTo
+			    (toPrimitive
+			     (new (fn () => (atomicEnd ()
+					     ; !r ()
+					     ; Prim.setSaved t
+					     ; Prim.returnToC ()))))
 		      in
-			 !r () handle e => MLtonExn.topLevelHandler e
-			 ; Prim.setSaved t
-			 ; Prim.returnToC ()
-			 ; loop ()
+			 loop ()
 		      end
 		in
 		   loop





-------------------------------------------------------
This SF.net email is sponsored by: If flattening out C++ or Java
code to make your application fit in a relational database is painful, 
don't do it! Check out ObjectStore. Now part of Progress Software.
http://www.objectstore.net/sourceforge
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel