From 9765a14a94e60009c2521d0ba4ad9f5d8b4c0c3d Mon Sep 17 00:00:00 2001 From: James Swaine Date: Wed, 18 Nov 2009 15:49:49 +0000 Subject: [PATCH] futures bug fixes svn: r16871 --- src/mzscheme/src/future.c | 343 ++++++++++++++----------------------- src/mzscheme/src/future.h | 347 +++----------------------------------- src/mzscheme/src/jit.c | 31 +++- src/mzscheme/src/mzmark.c | 8 +- 4 files changed, 177 insertions(+), 552 deletions(-) diff --git a/src/mzscheme/src/future.c b/src/mzscheme/src/future.c index bf35938714..0c3c629932 100644 --- a/src/mzscheme/src/future.c +++ b/src/mzscheme/src/future.c @@ -50,7 +50,7 @@ void scheme_init_futures(Scheme_Env *env) extern void *on_demand_jit_code; -#define THREAD_POOL_SIZE 1 +#define THREAD_POOL_SIZE 3 #define INITIAL_C_STACK_SIZE 500000 static pthread_t g_pool_threads[THREAD_POOL_SIZE]; static int *g_fuel_pointers[THREAD_POOL_SIZE]; @@ -126,48 +126,6 @@ void *func_retval = NULL; #ifdef DEBUG_FUTURES int g_rtcall_count = 0; -void debug_save_context(void) -{ - future_t *future; - rtcall_context_t *context; - future = get_my_future(); - context = (rtcall_context_t*)malloc(sizeof(rtcall_context_t)); - - future->context = context; - future->context->mz_runstack_start = MZ_RUNSTACK_START; - future->context->mz_runstack = MZ_RUNSTACK; -} - -void debug_assert_context(future_t *future) -{ - rtcall_context_t *context = future->context; - if (MZ_RUNSTACK_START != future->context->mz_runstack_start) - { - printf("Future %d (thread %p) reports MZ_RUNSTACK_START was %p, but future runstack start should be %p.\n", - future->id, - future->threadid, - MZ_RUNSTACK_START, - future->runstack_start); - } - - if (MZ_RUNSTACK != context->mz_runstack) - { - printf("Future %d (thread %p) reports MZ_RUNSTACK was %p, but future runstack should be %p.\n", - future->id, - future->threadid, - MZ_RUNSTACK, - future->runstack); - } -} - -void debug_kill_context(void) -{ - future_t *future; - future = get_my_future(); - free(future->context); - future->context = NULL; -} - static Scheme_Object **get_thread_runstack(void) { return MZ_RUNSTACK; @@ -322,7 +280,7 @@ void scheme_init_futures(Scheme_Env *env) scheme_finish_primitive_module(newenv); scheme_protect_primitive_provide(newenv, NULL); - REGISTER_SO(g_future_queue); + REGISTER_SO(g_future_queue); } @@ -479,7 +437,7 @@ Scheme_Object *future(int argc, Scheme_Object *argv[]) futureid = ++g_next_futureid; ft->id = futureid; ft->orig_lambda = lambda; - ft->pending = 1; + ft->status = PENDING; //Allocate a new scheme stack for the future //init_runstack_size = MZ_RUNSTACK - MZ_RUNSTACK_START; @@ -568,7 +526,7 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) { retval = ft->retval; - printf("Successfully touched future %d\n", ft->id); + LOG("Successfully touched future %d\n", ft->id); fflush(stdout); //Destroy the future descriptor @@ -578,16 +536,12 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) g_future_queue = ft->next; if (g_future_queue != NULL) g_future_queue->prev = NULL; - - free(ft); } else { ft->prev->next = ft->next; if (NULL != ft->next) ft->next->prev = ft->prev; - - free(ft); } //Increment the number of available pool threads @@ -607,8 +561,6 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) ft->rt_prim_retval = rtcall_retval; ft->rt_prim = NULL; - ft->rt_prim_sigtype = 0; - ft->rt_prim_args = NULL; //Signal the waiting worker thread that it //can continue running machine code @@ -682,8 +634,6 @@ void *worker_thread_future_loop(void *arg) LOG("Got a signal that a future is pending..."); //Work is available for this thread - - ft->pending = 0; ft->status = RUNNING; ft->threadid = pthread_self(); @@ -709,12 +659,11 @@ void *worker_thread_future_loop(void *arg) //function. //From this thread's perspective, this call will never return //until all the work to be done in the future has been completed, - //including runtime calls. - LOG("Running JIT code at %p...\n", ft->code); - v = jitcode(ft->orig_lambda, 0, NULL); + //including runtime calls. + LOG("Running JIT code at %p...\n", ft->code); + v = jitcode(ft->orig_lambda, 0, NULL); LOG("Finished running JIT code at %p.\n", ft->code); - - ft = current_ft; + ft = current_ft; //Set the return val in the descriptor pthread_mutex_lock(&g_future_queue_mutex); @@ -770,8 +719,6 @@ int future_do_runtimecall( //for the worker thread's future->runstack = MZ_RUNSTACK; future->rt_prim = func; - future->rt_prim_sigtype = sigtype; - future->rt_prim_args = args; //Update the future's status to waiting future->status = WAITING_FOR_PRIM; @@ -785,8 +732,6 @@ int future_do_runtimecall( //Clear rt call fields before releasing the lock on the descriptor future->rt_prim = NULL; - future->rt_prim_sigtype = 0; - future->rt_prim_args = NULL; retval = future->rt_prim_retval; pthread_mutex_unlock(&g_future_queue_mutex); @@ -801,32 +746,22 @@ int rtcall_void_void(void (*f)()) { START_XFORM_SKIP; future_t *future; - sig_void_void_t data; - memset(&data, 0, sizeof(sig_void_void_t)); + prim_data_t data; + memset(&data, 0, sizeof(prim_data_t)); if (!IS_WORKER_THREAD) { return 0; } - LOG_RTCALL_VOID_VOID(f); - - #ifdef DEBUG_FUTURES - //debug_save_context(); - #endif - - data.prim = f; + data.prim_void_void = f; + data.sigtype = SIG_VOID_VOID; future = get_my_future(); - future->rt_prim_sigtype = SIG_VOID_VOID; future->rt_prim = (void*)f; - future->calldata.void_void = data; + future->prim_data = data; future_do_runtimecall((void*)f, SIG_VOID_VOID, NULL, NULL); - #ifdef DEBUG_FUTURES - //debug_kill_context(); - #endif - return 1; END_XFORM_SKIP; } @@ -834,50 +769,123 @@ int rtcall_void_void(void (*f)()) int rtcall_obj_int_pobj_obj( Scheme_Object* (*f)(Scheme_Object*, int, Scheme_Object**), - Scheme_Object *a, - int b, - Scheme_Object **c, + Scheme_Object *rator, + int argc, + Scheme_Object **argv, Scheme_Object **retval) { START_XFORM_SKIP; future_t *future; - sig_obj_int_pobj_obj_t data; - memset(&data, 0, sizeof(sig_obj_int_pobj_obj_t)); + prim_data_t data; + memset(&data, 0, sizeof(prim_data_t)); if (!IS_WORKER_THREAD) { return 0; } - LOG_RTCALL_OBJ_INT_POBJ_OBJ(f, a, b, c); - #ifdef DEBUG_FUTURES - //debug_save_context(); - - #endif - printf("scheme_fuel_counter = %d\n", scheme_fuel_counter); printf("scheme_jit_stack_boundary = %p\n", (void*)scheme_jit_stack_boundary); printf("scheme_current_runstack = %p\n", scheme_current_runstack); printf("scheme_current_runstack_start = %p\n", scheme_current_runstack_start); printf("stack address = %p\n", &future); + #endif - data.prim = f; - data.a = a; - data.b = b; - data.c = c; + data.prim_obj_int_pobj_obj = f; + data.p = rator; + data.argc = argc; + data.argv = argv; + data.sigtype = SIG_OBJ_INT_POBJ_OBJ; future = get_my_future(); - future->rt_prim_sigtype = SIG_OBJ_INT_POBJ_OBJ; future->rt_prim = (void*)f; - future->calldata.obj_int_pobj_obj = data; + future->prim_data = data; future_do_runtimecall((void*)f, SIG_OBJ_INT_POBJ_OBJ, NULL, NULL); - *retval = future->calldata.obj_int_pobj_obj.retval; + *retval = future->prim_data.retval; + + return 1; + END_XFORM_SKIP; +} + + +int rtcall_int_pobj_obj( + Scheme_Object* (*f)(int, Scheme_Object**), + int argc, + Scheme_Object **argv, + Scheme_Object **retval) +{ + START_XFORM_SKIP; + future_t *future; + prim_data_t data; + memset(&data, 0, sizeof(prim_data_t)); + if (!IS_WORKER_THREAD) + { + return 0; + } #ifdef DEBUG_FUTURES - //debug_kill_context(); + printf("scheme_fuel_counter = %d\n", scheme_fuel_counter); + printf("scheme_jit_stack_boundary = %p\n", (void*)scheme_jit_stack_boundary); + printf("scheme_current_runstack = %p\n", scheme_current_runstack); + printf("scheme_current_runstack_start = %p\n", scheme_current_runstack_start); + printf("stack address = %p\n", &future); #endif + data.prim_int_pobj_obj = f; + data.argc = argc; + data.argv = argv; + data.sigtype = SIG_INT_OBJARR_OBJ; + + future = get_my_future(); + future->rt_prim = (void*)f; + future->prim_data = data; + + future_do_runtimecall((void*)f, SIG_INT_OBJARR_OBJ, NULL, NULL); + *retval = future->prim_data.retval; + + return 1; + END_XFORM_SKIP; +} + + +int rtcall_int_pobj_obj_obj( + Scheme_Object* (*f)(int, Scheme_Object**, Scheme_Object*), + int argc, + Scheme_Object **argv, + Scheme_Object *p, + Scheme_Object **retval) +{ + START_XFORM_SKIP; + future_t *future; + prim_data_t data; + memset(&data, 0, sizeof(prim_data_t)); + if (!IS_WORKER_THREAD) + { + return 0; + } + + #ifdef DEBUG_FUTURES + printf("scheme_fuel_counter = %d\n", scheme_fuel_counter); + printf("scheme_jit_stack_boundary = %p\n", (void*)scheme_jit_stack_boundary); + printf("scheme_current_runstack = %p\n", scheme_current_runstack); + printf("scheme_current_runstack_start = %p\n", scheme_current_runstack_start); + printf("stack address = %p\n", &future); + #endif + + data.prim_int_pobj_obj_obj = f; + data.argc = argc; + data.argv = argv; + data.p = p; + data.sigtype = SIG_INT_POBJ_OBJ_OBJ; + + future = get_my_future(); + future->rt_prim = (void*)f; + future->prim_data = data; + + future_do_runtimecall((void*)f, SIG_INT_POBJ_OBJ_OBJ, NULL, NULL); + *retval = future->prim_data.retval; + return 1; END_XFORM_SKIP; } @@ -889,8 +897,9 @@ int rtcall_obj_int_pobj_obj( void *invoke_rtcall(future_t *future) { START_XFORM_SKIP; - void *ret = NULL, *dummy_ret, *args = future->rt_prim_args; + void *ret = NULL, *dummy_ret; void **arr = NULL; + prim_data_t *pdata; MZ_MARK_STACK_TYPE lret = 0; //Temporarily use the worker thread's runstack @@ -898,135 +907,43 @@ void *invoke_rtcall(future_t *future) MZ_RUNSTACK = future->runstack; MZ_RUNSTACK_START = future->runstack_start; #ifdef DEBUG_FUTURES - //debug_assert_context(future); g_rtcall_count++; #endif - switch (future->rt_prim_sigtype) + switch (future->prim_data.sigtype) { case SIG_VOID_VOID: { - sig_void_void_t *data = &future->calldata.void_void; - data->prim(); + pdata = &future->prim_data; + pdata->prim_void_void(); - //((void (*)(void))future->rt_prim)(); ret = &dummy_ret; break; } case SIG_OBJ_INT_POBJ_OBJ: { - sig_obj_int_pobj_obj_t *data = &future->calldata.obj_int_pobj_obj; - data->retval = data->prim( - data->a, - data->b, - data->c); - - //arr = (void**)args; - //ret = (void*)((Scheme_Object* (*)(Scheme_Object*, int, Scheme_Object**))future->rt_prim)( - // (Scheme_Object*)arr[0], - // GET_INT(arr[1]), - // (Scheme_Object**)arr[2]); + pdata = &future->prim_data; + pdata->retval = pdata->prim_obj_int_pobj_obj( + pdata->p, + pdata->argc, + pdata->argv); break; } - case SIG_OBJ_INT_POBJ_VOID: - arr = (void**)args; - ((Scheme_Object* (*)(Scheme_Object*, int, Scheme_Object**))future->rt_prim)( - (Scheme_Object*)arr[0], - GET_INT(arr[1]), - (Scheme_Object**)arr[2]); - - ret = (void*)0x1; - case SIG_INT_OBJARR_OBJ: - arr = (void**)args; - ret = (void*)((Scheme_Object* (*)(int, Scheme_Object*[]))future->rt_prim)( - GET_INT(arr[0]), - (Scheme_Object**)arr[1]); - break; - case SIG_LONG_OBJ_OBJ: - arr = (void**)args; - ret = (void*)((Scheme_Object* (*)(long, Scheme_Object*))future->rt_prim)( - GET_LONG(arr[0]), - (Scheme_Object*)arr[1]); - break; - case SIG_OBJ_OBJ: - ret = (void*)((Scheme_Object* (*)(Scheme_Object*))future->rt_prim)((Scheme_Object*)args); - break; - case SIG_OBJ_OBJ_OBJ: - arr = (void**)args; - ret = (void*)((Scheme_Object * (*)(Scheme_Object*, Scheme_Object*))future->rt_prim)( - (Scheme_Object*)arr[0], - (Scheme_Object*)arr[1]); - break; - case SIG_VOID_PVOID: - ret = ((void* (*)(void))future->rt_prim)(); - break; - case SIG_SNCD_OBJ: - ret = (void*)((Scheme_Object* (*)(Scheme_Native_Closure_Data*))future->rt_prim)( - (Scheme_Native_Closure_Data*)args); - break; - case SIG_OBJ_VOID: - ((void (*)(Scheme_Object*))future->rt_prim)((Scheme_Object*)args); - ret = &dummy_ret; - break; - case SIG_LONG_OBJ: - ret = ((Scheme_Object* (*)(long))future->rt_prim)(GET_LONG(args)); - break; - case SIG_BUCKET_OBJ_INT_VOID: - arr = (void**)args; - ((void (*)(Scheme_Bucket*, Scheme_Object*, int))future->rt_prim)( - (Scheme_Bucket*)arr[0], - (Scheme_Object*)arr[1], - GET_INT(arr[2])); - - ret = &dummy_ret; - break; - case SIG_INT_INT_POBJ_VOID: - arr = (void**)args; - ((void (*)(int, int, Scheme_Object**))future->rt_prim)( - GET_INT(arr[0]), - GET_INT(arr[1]), - (Scheme_Object**)arr[2]); - break; - case SIG_OBJ_OBJ_MZST: - arr = (void**)args; - lret = ((MZ_MARK_STACK_TYPE (*)(Scheme_Object*, Scheme_Object*))future->rt_prim)( - (Scheme_Object*)arr[0], - (Scheme_Object*)arr[1]); - - ret = malloc(sizeof(MZ_MARK_STACK_TYPE)); - *((MZ_MARK_STACK_TYPE*)ret) = lret; - break; - case SIG_BUCKET_VOID: - ((void (*)(Scheme_Bucket*))future->rt_prim)((Scheme_Bucket*)args); - ret = &dummy_ret; - break; - case SIG_POBJ_LONG_OBJ: - arr = (void**)args; - ret = ((Scheme_Object* (*)(Scheme_Object**, long))future->rt_prim)( - (Scheme_Object**)arr[0], - GET_LONG(arr[1])); - break; - case SIG_INT_POBJ_INT_OBJ: - arr = (void**)args; - ret = ((Scheme_Object* (*)(int, Scheme_Object**, int))future->rt_prim)( - GET_INT(arr[0]), - (Scheme_Object**)arr[1], - GET_INT(arr[2])); - break; - case SIG_INT_POBJ_OBJ_OBJ: - arr = (void**)args; - ret = ((Scheme_Object* (*)(int, Scheme_Object**, Scheme_Object*))future->rt_prim)( - GET_INT(arr[0]), - (Scheme_Object**)arr[1], - (Scheme_Object*)arr[2]); - break; - case SIG_ENV_ENV_VOID: - arr = (void**)args; - ((void (*)(Scheme_Env*, Scheme_Env*))future->rt_prim)( - GET_SCHEMEENV(arr[0]), - GET_SCHEMEENV(arr[1])); - break; + case SIG_INT_OBJARR_OBJ: + pdata = &future->prim_data; + pdata->retval = pdata->prim_int_pobj_obj( + pdata->argc, + pdata->argv); + + break; + case SIG_INT_POBJ_OBJ_OBJ: + pdata = &future->prim_data; + pdata->retval = pdata->prim_int_pobj_obj_obj( + pdata->argc, + pdata->argv, + pdata->p); + break; } //Restore main thread's runstack @@ -1068,7 +985,7 @@ future_t *get_pending_future(void) future_t *f; for (f = g_future_queue; f != NULL; f = f->next) { - if (f->pending) + if (f->status == PENDING) return f; } diff --git a/src/mzscheme/src/future.h b/src/mzscheme/src/future.h index 7af7e16fce..a390b343fd 100644 --- a/src/mzscheme/src/future.h +++ b/src/mzscheme/src/future.h @@ -32,35 +32,20 @@ extern Scheme_Object *num_processors(int argc, Scheme_Object *argv[]); extern int future_do_runtimecall(void *func, int sigtype, void *args, void *retval); extern void futures_init(void); -#ifdef DEBUG_FUTURES -//Debugging structure that contains -//all relevant data at the time of a -//runtime call. -typedef struct rtcall_context { - Scheme_Object **mz_runstack_start; - Scheme_Object **mz_runstack; -} rtcall_context_t; -#endif - typedef struct { - void (*prim)(); -} sig_void_void_t; + unsigned int sigtype; -typedef struct { - Scheme_Object* (*prim)(Scheme_Object*, int, Scheme_Object**); - Scheme_Object *a; - int b; - Scheme_Object **c; - Scheme_Object *retval; -} sig_obj_int_pobj_obj_t; + Scheme_Object* (*prim_obj_int_pobj_obj)(Scheme_Object* rator, int argc, Scheme_Object** argv); + Scheme_Object* (*prim_int_pobj_obj)(int argc, Scheme_Object** argv); + Scheme_Object* (*prim_int_pobj_obj_obj)(int argc, Scheme_Object** argv, Scheme_Object* p); + void (*prim_void_void)(void); -typedef struct { - int sig_type; - union { - sig_void_void_t void_void; - sig_obj_int_pobj_obj_t obj_int_pobj_obj; - } calldata; -} rtcall_args_t; + Scheme_Object *p; + int argc; + Scheme_Object **argv; + Scheme_Object *retval; + +} prim_data_t; #define PENDING 0 #define RUNNING 1 @@ -73,7 +58,6 @@ typedef struct future { int id; pthread_t threadid; int status; - int pending; int work_completed; pthread_cond_t can_continue_cv; @@ -84,32 +68,15 @@ typedef struct future { //Runtime call stuff void *rt_prim; - int rt_prim_sigtype; - void *rt_prim_args; void *rt_prim_retval; - union { - sig_void_void_t void_void; - sig_obj_int_pobj_obj_t obj_int_pobj_obj; - } calldata; + prim_data_t prim_data; Scheme_Object *retval; struct future *prev; struct future *next; - - #ifdef DEBUG_FUTURES - rtcall_context_t *context; - #endif } future_t; -#ifdef DEBUG_FUTURES -extern void debug_save_context(void); -extern void debug_kill_context(void); -#else -#define debug_save_context(...) -#define debug_kill_context(...) -#endif - #ifdef UNIT_TEST //If unit testing, expose internal functions and vars to //the test suite @@ -167,34 +134,11 @@ extern void print_ms_and_us(void); //Here the convention is SIG_[arg1type]_[arg2type]..._[return type] #define SIG_VOID_VOID 1 //void -> void #define SIG_OBJ_INT_POBJ_OBJ 2 //Scheme_Object* -> int -> Scheme_Object** -> Scheme_Object* -#define SIG_INT_OBJARR_OBJ 3 //int -> Scheme_Object*[] -> Scheme_Object* -#define SIG_LONG_OBJ_OBJ 4 //long -> Scheme_Object* -> Scheme_Object* -#define SIG_OBJ_OBJ 5 //Scheme_Object* -> Scheme_Object* -#define SIG_OBJ_OBJ_OBJ 6 //Scheme_Object* -> Scheme_Object* -> Scheme_Object* -#define SIG_VOID_PVOID 7 //void -> void* -#define SIG_SNCD_OBJ 8 //Scheme_Native_Closure_Data* -> Scheme_Object* -#define SIG_OBJ_VOID 9 //Scheme_Object* -> void -#define SIG_LONG_OBJ 10 //long -> Scheme_Object* -#define SIG_BUCKET_OBJ_INT_VOID 11 //Scheme_Bucket* -> Scheme_Object* -> int -> void -#define SIG_INT_INT_POBJ_VOID 12 //int -> int -> Scheme_Object** -> void -#define SIG_OBJ_OBJ_MZST 13 //Scheme_Object* -> Scheme_Object* -> MZ_MARK_STACK_TYPE -#define SIG_BUCKET_VOID 14 //Scheme_Bucket* -> void -#define SIG_POBJ_LONG_OBJ 15 //Scheme_Object** -> long -> Scheme_Object* -#define SIG_INT_POBJ_INT_OBJ 16 //int -> Scheme_Object** -> int -> Scheme_Object* +#define SIG_INT_OBJARR_OBJ 3 //int -> Scheme_Object*[] -> Scheme_Object #define SIG_INT_POBJ_OBJ_OBJ 17 //int -> Scheme_Object** -> Scheme_Object* -> Scheme_Object* -#define SIG_OBJ_INT_POBJ_VOID 18 //Scheme_Object* -> int -> Scheme_Object** -> void -#define SIG_ENV_ENV_VOID 19 //Scheme_Env* -> Scheme_Env* -> void //Helper macros for argument marshaling #ifdef FUTURES_ENABLED -extern void *g_funcargs[]; -extern void *func_retval; - -#define GET_INT(x) *((int*)(x)) -#define GET_LONG(x) *((long*)(x)) -#define GET_SCHEMEOBJ(x) (Scheme_Object*)(x) -#define GET_PSCHEMEOBJ(x) (Scheme_Object**)(x) -#define GET_SCHEMEENV(x) (Scheme_Env*)(x) #define IS_WORKER_THREAD (g_rt_threadid != 0 && pthread_self() != g_rt_threadid) #define ASSERT_CORRECT_THREAD if (g_rt_threadid != 0 && pthread_self() != g_rt_threadid) \ @@ -211,273 +155,20 @@ extern int rtcall_obj_int_pobj_obj( Scheme_Object **c, Scheme_Object **retval); - -/* -#define RTCALL_VOID_VOID(f) \ - if (IS_WORKER_THREAD) \ - { \ - debug_save_context(); \ - future_do_runtimecall((void*)f, SIG_VOID_VOID, NULL, NULL); \ - debug_kill_context(); \ - return; \ - } -*/ - -/* -#define RTCALL_OBJ_INT_POBJ_OBJ(f,a,b,c) \ - g_funcargs[0] = a; \ - g_funcargs[1] = &b; \ - g_funcargs[2] = c; \ - LOG_RTCALL_OBJ_INT_POBJ_OBJ(a, b, c); \ - if (IS_WORKER_THREAD) \ - { \ - debug_save_context(); \ - future_do_runtimecall((void*)f, SIG_OBJ_INT_POBJ_OBJ, &g_funcargs, func_retval); \ - debug_kill_context(); \ - return (Scheme_Object*)func_retval; \ - } -*/ - -#define RTCALL_OBJ_INT_POBJ_VOID(f,a,b,c) \ - g_funcargs[0] = a; \ - g_funcargs[1] = &b; \ - g_funcargs[2] = c; \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall((void*)f, SIG_OBJ_INT_POBJ_VOID, &g_funcargs, NULL); \ - } - -#define RTCALL_INT_OBJARR_OBJ(f,a,b) \ - g_funcargs[0] = &a; \ - g_funcargs[1] = b; \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_INT_OBJARR_OBJ, \ - &g_funcargs, \ - func_retval); \ -\ - return (Scheme_Object*)func_retval; \ - } - -#define RTCALL_LONG_OBJ_OBJ(f,a,b) \ - g_funcargs[0] = &a; \ - g_funcargs[1] = b; \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_LONG_OBJ_OBJ, \ - &g_funcargs, \ - func_retval); \ -\ - return (Scheme_Object*)func_retval; \ - } - -#define RTCALL_OBJ_OBJ(f,a) \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_OBJ_OBJ, \ - a, \ - func_retval); \ -\ - return (Scheme_Object*)func_retval; \ - } - -#define RTCALL_OBJ_OBJ_OBJ(f,a,b) \ - g_funcargs[0] = a; \ - g_funcargs[1] = b; \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_OBJ_OBJ_OBJ, \ - &g_funcargs, \ - func_retval); \ -\ - return (Scheme_Object*)func_retval; \ - } - -#define RTCALL_SNCD_OBJ(f,a) \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_SNCD_OBJ, \ - (void*)a, \ - func_retval); \ -\ - return (Scheme_Object*)func_retval; \ - } - -#define RTCALL_OBJ_VOID(f,a) \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_OBJ_VOID, \ - (void*)a, \ - NULL); \ -\ - return; \ - } - -#define RTCALL_LONG_OBJ(f,a) \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_LONG_OBJ, \ - &a, \ - func_retval); \ -\ - return (Scheme_Object*)func_retval; \ - } - -#define RTCALL_BUCKET_OBJ_INT_VOID(f,a,b,c) \ - g_funcargs[0] = a; \ - g_funcargs[1] = b; \ - g_funcargs[2] = &c; \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_BUCKET_OBJ_INT_VOID, \ - &g_funcargs, \ - NULL); \ - return; \ - } - -#define RTCALL_INT_INT_POBJ_VOID(f,a,b,c) \ - g_funcargs[0] = &a; \ - g_funcargs[1] = &b; \ - g_funcargs[2] = c; \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_INT_INT_POBJ_VOID, \ - &g_funcargs, \ - NULL); \ - return; \ - } - -#define RTCALL_OBJ_OBJ_MZST(f,a,b) \ - MZ_MARK_STACK_TYPE v; \ - MZ_MARK_STACK_TYPE *r; \ - g_funcargs[0] = a; \ - g_funcargs[1] = b; \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_OBJ_OBJ_MZST, \ - &g_funcargs, \ - func_retval); \ -\ - r = (MZ_MARK_STACK_TYPE*)func_retval; \ - v = *r; \ - free(r); \ - return v; \ - } - -#define RTCALL_BUCKET_VOID(f,a) \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_BUCKET_VOID, \ - (void*)a, \ - NULL); \ - return; \ - } - -#define RTCALL_POBJ_LONG_OBJ(f,a,b) \ - g_funcargs[0] = a; \ - g_funcargs[1] = &b; \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_POBJ_LONG_OBJ, \ - &g_funcargs, \ - func_retval); \ -\ - return (Scheme_Object*)func_retval; \ - } - -#define RTCALL_INT_POBJ_INT_OBJ(f,a,b,c) \ - g_funcargs[0] = &a; \ - g_funcargs[1] = b; \ - g_funcargs[2] = &c; \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_INT_POBJ_INT_OBJ, \ - &g_funcargs, \ - func_retval); \ -\ - return (Scheme_Object*)func_retval; \ - } - -#define RTCALL_INT_POBJ_OBJ_OBJ(f,a,b,c) \ - g_funcargs[0] = &a; \ - g_funcargs[1] = b; \ - g_funcargs[2] = c; \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_INT_POBJ_OBJ_OBJ, \ - &g_funcargs, \ - func_retval); \ -\ - return (Scheme_Object*)func_retval; \ - } - -#define RTCALL_ENV_ENV_VOID(f,a,b) \ - g_funcargs[0] = a; \ - g_funcargs[1] = b; \ - if (IS_WORKER_THREAD) \ - { \ - future_do_runtimecall( \ - (void*)f, \ - SIG_ENV_ENV_VOID, \ - &g_funcargs, \ - func_retval); \ - } +extern int rtcall_int_pobj_obj( + Scheme_Object* (*f)(int, Scheme_Object**), + int argc, + Scheme_Object **argv, + Scheme_Object **retval); #else -#define RTCALL_VOID_VOID(f) -#define RTCALL_OBJ_INT_POBJ_OBJ(f,a,b,c) LOG_RTCALL_OBJ_INT_POBJ_OBJ(a,b,c) -#define RTCALL_OBJ_INT_POBJ_VOID(f,a,b,c) LOG_RTCALL_OBJ_INT_POBJ_VOID(a,b,c) -#define RTCALL_INT_OBJARR_OBJ(f,a,b) LOG_RTCALL_INT_OBJARR_OBJ(a,b) -#define RTCALL_LONG_OBJ_OBJ(f,a,b) LOG_RTCALL_LONG_OBJ_OBJ(a,b) -#define RTCALL_OBJ_OBJ(f,a) LOG_RTCALL_OBJ_OBJ(a) -#define RTCALL_OBJ_OBJ_OBJ(f,a,b) LOG_RTCALL_OBJ_OBJ_OBJ(a,b) -#define RTCALL_SNCD_OBJ(f,a) LOG_RTCALL_SNCD_OBJ(a) -#define RTCALL_OBJ_VOID(f,a) LOG_RTCALL_OBJ_VOID(a) -#define RTCALL_LONG_OBJ(f,a) LOG_RTCALL_LONG_OBJ(a) -#define RTCALL_BUCKET_OBJ_INT_VOID(f,a,b,c) LOG_RTCALL_BUCKET_OBJ_INT_VOID(a,b,c) -#define RTCALL_INT_INT_POBJ_VOID(f,a,b,c) LOG_RTCALL_INT_INT_POBJ_VOID(a,b,c) -#define RTCALL_OBJ_OBJ_MZST(f,a,b) LOG_RTCALL_OBJ_OBJ_MZST(a,b) -#define RTCALL_BUCKET_VOID(f,a) LOG_RTCALL_BUCKET_VOID(a) -#define RTCALL_POBJ_LONG_OBJ(f,a,b) LOG_RTCALL_POBJ_LONG_OBJ(a,b) -#define RTCALL_INT_POBJ_INT_OBJ(f,a,b,c) LOG_RTCALL_INT_POBJ_INT_OBJ(a,b,c) -#define RTCALL_INT_POBJ_OBJ_OBJ(f,a,b,c) LOG_RTCALL_INT_POBJ_OBJ_OBJ(a,b,c) -#define RTCALL_ENV_ENV_VOID(f,a,b) LOG_RTCALL_ENV_ENV_VOID(a,b) - #define IS_WORKER_THREAD 0 #define ASSERT_CORRECT_THREAD #endif -#if 1 +#ifdef DEBUG_FUTURES #define LOG(a...) do { pthread_t self; self = pthread_self(); fprintf(stderr, "%x:%s:%s:%d ", (unsigned) self, __FILE__, __FUNCTION__, __LINE__); fprintf(stderr, a); fprintf(stderr, "\n"); fflush(stdout); } while(0) #define LOG_THISCALL LOG(__FUNCTION__) diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index 18d57e3604..f4d139c302 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -2144,8 +2144,16 @@ static Scheme_Object *noncm_prim_indirect(Scheme_Prim proc, int argc) Scheme_Object *ret; LOG_PRIM_START(proc); - RTCALL_INT_OBJARR_OBJ(proc, argc, MZ_RUNSTACK); - ret = proc(argc, MZ_RUNSTACK); + if (rtcall_int_pobj_obj(proc, + argc, + MZ_RUNSTACK, + &ret)) + { + LOG_PRIM_END(proc); + return ret; + } + + ret = proc(argc, MZ_RUNSTACK); LOG_PRIM_END(proc); return ret; @@ -2155,10 +2163,19 @@ static Scheme_Object *prim_indirect(Scheme_Primitive_Closure_Proc proc, int argc Scheme_Object *ret; LOG_PRIM_START(proc); - RTCALL_INT_POBJ_OBJ_OBJ(proc, argc, MZ_RUNSTACK, self); - ret = proc(argc, MZ_RUNSTACK, self); - + if (rtcall_int_pobj_obj_obj(proc, + argc, + MZ_RUNSTACK, + self, + &ret)) + { + LOG_PRIM_END(proc); + return ret; + } + + ret = proc(argc, MZ_RUNSTACK, self); LOG_PRIM_END(proc); + return ret; } @@ -2168,7 +2185,6 @@ static Scheme_Object *prim_indirect(Scheme_Primitive_Closure_Proc proc, int argc static Scheme_Object *ts_scheme_apply_multi_from_native(Scheme_Object *rator, int argc, Scheme_Object **argv) { - /* RTCALL_OBJ_INT_POBJ_OBJ(_scheme_apply_multi_from_native, rator, argc, argv); */ Scheme_Object *retptr; if (rtcall_obj_int_pobj_obj(_scheme_apply_multi_from_native, rator, @@ -2183,7 +2199,6 @@ static Scheme_Object *ts_scheme_apply_multi_from_native(Scheme_Object *rator, in static Scheme_Object *ts_scheme_apply_from_native(Scheme_Object *rator, int argc, Scheme_Object **argv) { - /* RTCALL_OBJ_INT_POBJ_OBJ(_scheme_apply_from_native, rator, argc, argv); */ Scheme_Object *retptr; if (rtcall_obj_int_pobj_obj(_scheme_apply_from_native, rator, @@ -2198,7 +2213,6 @@ static Scheme_Object *ts_scheme_apply_from_native(Scheme_Object *rator, int argc static Scheme_Object *ts_scheme_tail_apply_from_native(Scheme_Object *rator, int argc, Scheme_Object **argv) { - /* RTCALL_OBJ_INT_POBJ_OBJ(_scheme_tail_apply_from_native, rator, argc, argv); */ Scheme_Object *retptr; if (rtcall_obj_int_pobj_obj(_scheme_tail_apply_from_native, rator, @@ -2213,7 +2227,6 @@ static Scheme_Object *ts_scheme_tail_apply_from_native(Scheme_Object *rator, int static void ts_on_demand(void) { - /* RTCALL_VOID_VOID(on_demand); */ if (rtcall_void_void(on_demand)) { return; } diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index c7b1374560..c099fb0d67 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -5423,8 +5423,10 @@ static int future_MARK(void *p) { gcMARK(f->runstack); gcMARK(f->runstack_start); gcMARK(f->orig_lambda); - gcMARK(f->rt_prim_args); gcMARK(f->rt_prim_retval); + gcMARK(f->prim_data.p); + gcMARK(f->prim_data.argv); + gcMARK(f->prim_data.retval); gcMARK(f->retval); gcMARK(f->prev); gcMARK(f->next); @@ -5437,8 +5439,10 @@ static int future_FIXUP(void *p) { gcFIXUP(f->runstack); gcFIXUP(f->runstack_start); gcFIXUP(f->orig_lambda); - gcFIXUP(f->rt_prim_args); gcFIXUP(f->rt_prim_retval); + gcFIXUP(f->prim_data.p); + gcFIXUP(f->prim_data.argv); + gcFIXUP(f->prim_data.retval); gcFIXUP(f->retval); gcFIXUP(f->prev); gcFIXUP(f->next);