From 783ee2cf884017c8f4079a3c0a51164c38dd87b6 Mon Sep 17 00:00:00 2001
From: James Swaine <jamesswaine@racket-lang.org>
Date: Tue, 26 Jul 2011 16:20:35 -0500
Subject: [PATCH] Add convenience macros for raising exceptions in C functions
 which may run on future threads

---
 src/racket/src/future.c | 39 +++++----------------------------------
 src/racket/src/future.h |  9 +++++++++
 2 files changed, 14 insertions(+), 34 deletions(-)

diff --git a/src/racket/src/future.c b/src/racket/src/future.c
index 6248f8290f..f38affe0ff 100644
--- a/src/racket/src/future.c
+++ b/src/racket/src/future.c
@@ -285,11 +285,6 @@ static void future_do_runtimecall(struct Scheme_Future_Thread_State *fts,
                                   int is_atomic,
                                   int can_suspend);
 static int capture_future_continuation(future_t *ft, void **storage);
-static void future_raise_wrong_type_exn(const char *who, 
-                                        const char *expected_type, 
-                                        int what, 
-                                        int argc, 
-                                        Scheme_Object **argv);
 
 #define INITIAL_C_STACK_SIZE 500000
 #define FUTURE_RUNSTACK_SIZE 2000
@@ -1297,13 +1292,7 @@ Scheme_Object *scheme_fsemaphore_count(int argc, Scheme_Object **argv)
   fsemaphore_t *sema;
 
   if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_fsemaphore_type)) { 
-    Scheme_Future_Thread_State *fts = scheme_future_thread_state;
-    if (!fts) { 
-      scheme_wrong_type("fsemaphore-count", "fsemaphore", 0, argc, argv);
-    }
-
-    /* On a future thread -- ask the runtime to raise an exception for us */
-    future_raise_wrong_type_exn("fsemaphore-count", "fsemaphore", 0, argc, argv);
+    SCHEME_WRONG_TYPE_MAYBE_IN_FT("fsemaphore-count", "fsemaphore", 0, argc, argv);
   }
 
   sema = (fsemaphore_t*)argv[0]; 
@@ -1362,13 +1351,7 @@ Scheme_Object *scheme_fsemaphore_post(int argc, Scheme_Object **argv)
   int old_count;
 
   if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_fsemaphore_type)) { 
-    Scheme_Future_Thread_State *fts = scheme_future_thread_state;
-    if (!fts) { 
-      scheme_wrong_type("fsemaphore-post", "fsemaphore", 0, argc, argv);
-    }
-
-    /* On a future thread -- ask the runtime to raise an exception for us */
-    future_raise_wrong_type_exn("fsemaphore-post", "fsemaphore", 0, argc, argv);
+    SCHEME_WRONG_TYPE_MAYBE_IN_FT("fsemaphore-post", "fsemaphore", 0, argc, argv);
   }
 
   sema = (fsemaphore_t*)argv[0];
@@ -1428,13 +1411,7 @@ Scheme_Object *scheme_fsemaphore_wait(int argc, Scheme_Object **argv)
   void *storage[3];
 
   if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_fsemaphore_type)) { 
-    Scheme_Future_Thread_State *fts = scheme_future_thread_state;
-    if (!fts) { 
-      scheme_wrong_type("fsemaphore-wait", "fsemaphore", 0, argc, argv);
-    }
-
-    /* On a future thread -- ask the runtime to raise an exception for us */
-    future_raise_wrong_type_exn("fsemaphore-wait", "fsemaphore", 0, argc, argv);
+    SCHEME_WRONG_TYPE_MAYBE_IN_FT("fsemaphore-wait", "fsemaphore", 0, argc, argv);
   }
 
   sema = (fsemaphore_t*)argv[0];
@@ -1546,13 +1523,7 @@ Scheme_Object *scheme_fsemaphore_try_wait(int argc, Scheme_Object **argv)
   Scheme_Object *ret;
 
   if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_fsemaphore_type)) { 
-    Scheme_Future_Thread_State *fts = scheme_future_thread_state;
-    if (!fts) { 
-      scheme_wrong_type("fsemaphore-try-wait?", "fsemaphore", 0, argc, argv);
-    }
-
-    /* On a future thread -- ask the runtime to raise an exception for us */
-    future_raise_wrong_type_exn("fsemaphore-try-wait?", "fsemaphore", 0, argc, argv);
+    SCHEME_WRONG_TYPE_MAYBE_IN_FT("fsemaphore-try-wait?", "fsemaphore", 0, argc, argv);
   }
 
   sema = (fsemaphore_t*)argv[0];
@@ -2510,7 +2481,7 @@ static void future_do_runtimecall(Scheme_Future_Thread_State *fts,
 /**********************************************************************/
 /* Functions for primitive invocation          			      */
 /**********************************************************************/
-static void future_raise_wrong_type_exn(const char *who, const char *expected_type, int what, int argc, Scheme_Object **argv) 
+void scheme_wrong_type_from_ft(const char *who, const char *expected_type, int what, int argc, Scheme_Object **argv) 
   XFORM_SKIP_PROC 
 /* Called in future thread */
 {
diff --git a/src/racket/src/future.h b/src/racket/src/future.h
index 7ddd7139d7..f1c2376fcb 100644
--- a/src/racket/src/future.h
+++ b/src/racket/src/future.h
@@ -158,6 +158,15 @@ typedef struct fsemaphore_t {
 
 /* Primitive instrumentation stuff */
 
+/* Exceptions */ 
+void scheme_wrong_type_from_ft(const char *who, const char *expected_type, int what, int argc, Scheme_Object **argv);
+
+#define SCHEME_WRONG_TYPE_MAYBE_IN_FT(who, expected_type, what, argc, argv) \
+  if (scheme_use_rtcall) \
+    scheme_wrong_type_from_ft(who, expected_type, what, argc, argv); \
+  else \
+    scheme_wrong_type(who, expected_type, what, argc, argv);
+
 /* Signature flags for primitive invocations */
 #define SIG_ON_DEMAND          1
 #define SIG_ALLOC              2