[MLton-devel] cvs commit: Calling SML from C
Stephen Weeks
sweeks@users.sourceforge.net
Fri, 16 May 2003 16:44:56 -0700
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