suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

futures bug fixes

Browse Source 
svn: r16871
This commit is contained in:
James Swaine 2009-11-18 15:49:49 +00:00
parent ec7845b135
commit 9765a14a94
4 changed files with 177 additions and 552 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

343
src/mzscheme/src/future.c
View File

@ -50,7 +50,7 @@ void scheme_init_futures(Scheme_Env *env)
extern void *on_demand_jit_code; extern void *on_demand_jit_code;
#define THREAD_POOL_SIZE 1 #define THREAD_POOL_SIZE 3
#define INITIAL_C_STACK_SIZE 500000 #define INITIAL_C_STACK_SIZE 500000
static pthread_t g_pool_threads[THREAD_POOL_SIZE]; static pthread_t g_pool_threads[THREAD_POOL_SIZE];
static int *g_fuel_pointers[THREAD_POOL_SIZE]; static int *g_fuel_pointers[THREAD_POOL_SIZE];
@ -126,48 +126,6 @@ void *func_retval = NULL;
#ifdef DEBUG_FUTURES #ifdef DEBUG_FUTURES
int g_rtcall_count = 0; 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) static Scheme_Object **get_thread_runstack(void)
{ {
return MZ_RUNSTACK; return MZ_RUNSTACK;
@ -322,7 +280,7 @@ void scheme_init_futures(Scheme_Env *env)
scheme_finish_primitive_module(newenv); scheme_finish_primitive_module(newenv);
scheme_protect_primitive_provide(newenv, NULL); 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; futureid = ++g_next_futureid;
ft->id = futureid; ft->id = futureid;
ft->orig_lambda = lambda; ft->orig_lambda = lambda;
ft->pending = 1; ft->status = PENDING;
//Allocate a new scheme stack for the future //Allocate a new scheme stack for the future
//init_runstack_size = MZ_RUNSTACK - MZ_RUNSTACK_START; //init_runstack_size = MZ_RUNSTACK - MZ_RUNSTACK_START;
@ -568,7 +526,7 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[])
{ {
retval = ft->retval; retval = ft->retval;
printf("Successfully touched future %d\n", ft->id); LOG("Successfully touched future %d\n", ft->id);
fflush(stdout); fflush(stdout);
//Destroy the future descriptor //Destroy the future descriptor
@ -578,16 +536,12 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[])
g_future_queue = ft->next; g_future_queue = ft->next;
if (g_future_queue != NULL) if (g_future_queue != NULL)
g_future_queue->prev = NULL; g_future_queue->prev = NULL;
free(ft);
} }
else else
{ {
ft->prev->next = ft->next; ft->prev->next = ft->next;
if (NULL != ft->next) if (NULL != ft->next)
ft->next->prev = ft->prev; ft->next->prev = ft->prev;
free(ft);
} }
//Increment the number of available pool threads //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_retval = rtcall_retval;
ft->rt_prim = NULL; ft->rt_prim = NULL;
ft->rt_prim_sigtype = 0;
ft->rt_prim_args = NULL;
//Signal the waiting worker thread that it //Signal the waiting worker thread that it
//can continue running machine code //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..."); LOG("Got a signal that a future is pending...");
//Work is available for this thread //Work is available for this thread
ft->pending = 0;
ft->status = RUNNING; ft->status = RUNNING;
ft->threadid = pthread_self(); ft->threadid = pthread_self();
@ -709,12 +659,11 @@ void *worker_thread_future_loop(void *arg)
//function. //function.
//From this thread's perspective, this call will never return //From this thread's perspective, this call will never return
//until all the work to be done in the future has been completed, //until all the work to be done in the future has been completed,
//including runtime calls. //including runtime calls.
LOG("Running JIT code at %p...\n", ft->code); LOG("Running JIT code at %p...\n", ft->code);
v = jitcode(ft->orig_lambda, 0, NULL); v = jitcode(ft->orig_lambda, 0, NULL);
LOG("Finished running JIT code at %p.\n", ft->code); LOG("Finished running JIT code at %p.\n", ft->code);
ft = current_ft;
ft = current_ft;
//Set the return val in the descriptor //Set the return val in the descriptor
pthread_mutex_lock(&g_future_queue_mutex); pthread_mutex_lock(&g_future_queue_mutex);
@ -770,8 +719,6 @@ int future_do_runtimecall(
//for the worker thread's //for the worker thread's
future->runstack = MZ_RUNSTACK; future->runstack = MZ_RUNSTACK;
future->rt_prim = func; future->rt_prim = func;
future->rt_prim_sigtype = sigtype;
future->rt_prim_args = args;
//Update the future's status to waiting //Update the future's status to waiting
future->status = WAITING_FOR_PRIM; future->status = WAITING_FOR_PRIM;
@ -785,8 +732,6 @@ int future_do_runtimecall(
//Clear rt call fields before releasing the lock on the descriptor //Clear rt call fields before releasing the lock on the descriptor
future->rt_prim = NULL; future->rt_prim = NULL;
future->rt_prim_sigtype = 0;
future->rt_prim_args = NULL;
retval = future->rt_prim_retval; retval = future->rt_prim_retval;
pthread_mutex_unlock(&g_future_queue_mutex); pthread_mutex_unlock(&g_future_queue_mutex);
@ -801,32 +746,22 @@ int rtcall_void_void(void (*f)())
{ {
START_XFORM_SKIP; START_XFORM_SKIP;
future_t *future; future_t *future;
sig_void_void_t data; prim_data_t data;
memset(&data, 0, sizeof(sig_void_void_t)); memset(&data, 0, sizeof(prim_data_t));
if (!IS_WORKER_THREAD) if (!IS_WORKER_THREAD)
{ {
return 0; return 0;
} }
LOG_RTCALL_VOID_VOID(f); data.prim_void_void = f;
data.sigtype = SIG_VOID_VOID;
#ifdef DEBUG_FUTURES
//debug_save_context();
#endif
data.prim = f;
future = get_my_future(); future = get_my_future();
future->rt_prim_sigtype = SIG_VOID_VOID;
future->rt_prim = (void*)f; future->rt_prim = (void*)f;
future->calldata.void_void = data; future->prim_data = data;
future_do_runtimecall((void*)f, SIG_VOID_VOID, NULL, NULL); future_do_runtimecall((void*)f, SIG_VOID_VOID, NULL, NULL);
#ifdef DEBUG_FUTURES
//debug_kill_context();
#endif
return 1; return 1;
END_XFORM_SKIP; END_XFORM_SKIP;
} }
@ -834,50 +769,123 @@ int rtcall_void_void(void (*f)())
int rtcall_obj_int_pobj_obj( int rtcall_obj_int_pobj_obj(
Scheme_Object* (*f)(Scheme_Object*, int, Scheme_Object**), Scheme_Object* (*f)(Scheme_Object*, int, Scheme_Object**),
Scheme_Object *a, Scheme_Object *rator,
int b, int argc,
Scheme_Object **c, Scheme_Object **argv,
Scheme_Object **retval) Scheme_Object **retval)
{ {
START_XFORM_SKIP; START_XFORM_SKIP;
future_t *future; future_t *future;
sig_obj_int_pobj_obj_t data; prim_data_t data;
memset(&data, 0, sizeof(sig_obj_int_pobj_obj_t)); memset(&data, 0, sizeof(prim_data_t));
if (!IS_WORKER_THREAD) if (!IS_WORKER_THREAD)
{ {
return 0; return 0;
} }
LOG_RTCALL_OBJ_INT_POBJ_OBJ(f, a, b, c);
#ifdef DEBUG_FUTURES #ifdef DEBUG_FUTURES
//debug_save_context();
#endif
printf("scheme_fuel_counter = %d\n", scheme_fuel_counter); printf("scheme_fuel_counter = %d\n", scheme_fuel_counter);
printf("scheme_jit_stack_boundary = %p\n", (void*)scheme_jit_stack_boundary); 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 = %p\n", scheme_current_runstack);
printf("scheme_current_runstack_start = %p\n", scheme_current_runstack_start); printf("scheme_current_runstack_start = %p\n", scheme_current_runstack_start);
printf("stack address = %p\n", &future); printf("stack address = %p\n", &future);
#endif
data.prim = f; data.prim_obj_int_pobj_obj = f;
data.a = a; data.p = rator;
data.b = b; data.argc = argc;
data.c = c; data.argv = argv;
data.sigtype = SIG_OBJ_INT_POBJ_OBJ;
future = get_my_future(); future = get_my_future();
future->rt_prim_sigtype = SIG_OBJ_INT_POBJ_OBJ;
future->rt_prim = (void*)f; 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); 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 #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 #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; return 1;
END_XFORM_SKIP; END_XFORM_SKIP;
} }
@ -889,8 +897,9 @@ int rtcall_obj_int_pobj_obj(
void *invoke_rtcall(future_t *future) void *invoke_rtcall(future_t *future)
{ {
START_XFORM_SKIP; START_XFORM_SKIP;
void *ret = NULL, *dummy_ret, *args = future->rt_prim_args; void *ret = NULL, *dummy_ret;
void **arr = NULL; void **arr = NULL;
prim_data_t *pdata;
MZ_MARK_STACK_TYPE lret = 0; MZ_MARK_STACK_TYPE lret = 0;
//Temporarily use the worker thread's runstack //Temporarily use the worker thread's runstack
@ -898,135 +907,43 @@ void *invoke_rtcall(future_t *future)
MZ_RUNSTACK = future->runstack; MZ_RUNSTACK = future->runstack;
MZ_RUNSTACK_START = future->runstack_start; MZ_RUNSTACK_START = future->runstack_start;
#ifdef DEBUG_FUTURES #ifdef DEBUG_FUTURES
//debug_assert_context(future);
g_rtcall_count++; g_rtcall_count++;
#endif #endif
switch (future->rt_prim_sigtype) switch (future->prim_data.sigtype)
{ {
case SIG_VOID_VOID: case SIG_VOID_VOID:
{ {
sig_void_void_t *data = &future->calldata.void_void; pdata = &future->prim_data;
data->prim(); pdata->prim_void_void();
//((void (*)(void))future->rt_prim)();
ret = &dummy_ret; ret = &dummy_ret;
break; break;
} }
case SIG_OBJ_INT_POBJ_OBJ: case SIG_OBJ_INT_POBJ_OBJ:
{ {
sig_obj_int_pobj_obj_t *data = &future->calldata.obj_int_pobj_obj; pdata = &future->prim_data;
data->retval = data->prim( pdata->retval = pdata->prim_obj_int_pobj_obj(
data->a, pdata->p,
data->b, pdata->argc,
data->c); pdata->argv);
//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]);
break; break;
} }
case SIG_OBJ_INT_POBJ_VOID: case SIG_INT_OBJARR_OBJ:
arr = (void**)args; pdata = &future->prim_data;
((Scheme_Object* (*)(Scheme_Object*, int, Scheme_Object**))future->rt_prim)( pdata->retval = pdata->prim_int_pobj_obj(
(Scheme_Object*)arr[0], pdata->argc,
GET_INT(arr[1]), pdata->argv);
(Scheme_Object**)arr[2]);
break;
ret = (void*)0x1; case SIG_INT_POBJ_OBJ_OBJ:
case SIG_INT_OBJARR_OBJ: pdata = &future->prim_data;
arr = (void**)args; pdata->retval = pdata->prim_int_pobj_obj_obj(
ret = (void*)((Scheme_Object* (*)(int, Scheme_Object*[]))future->rt_prim)( pdata->argc,
GET_INT(arr[0]), pdata->argv,
(Scheme_Object**)arr[1]); pdata->p);
break; 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;
} }
//Restore main thread's runstack //Restore main thread's runstack
@ -1068,7 +985,7 @@ future_t *get_pending_future(void)
future_t *f; future_t *f;
for (f = g_future_queue; f != NULL; f = f->next) for (f = g_future_queue; f != NULL; f = f->next)
{ {
if (f->pending) if (f->status == PENDING)
return f; return f;
} }

347
src/mzscheme/src/future.h
View File

@ -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 int future_do_runtimecall(void *func, int sigtype, void *args, void *retval);
extern void futures_init(void); 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 { typedef struct {
void (*prim)(); unsigned int sigtype;
} sig_void_void_t;
typedef struct { Scheme_Object* (*prim_obj_int_pobj_obj)(Scheme_Object* rator, int argc, Scheme_Object** argv);
Scheme_Object* (*prim)(Scheme_Object*, int, Scheme_Object**); Scheme_Object* (*prim_int_pobj_obj)(int argc, Scheme_Object** argv);
Scheme_Object *a; Scheme_Object* (*prim_int_pobj_obj_obj)(int argc, Scheme_Object** argv, Scheme_Object* p);
int b; void (*prim_void_void)(void);
Scheme_Object **c;
Scheme_Object *retval;
} sig_obj_int_pobj_obj_t;
typedef struct { Scheme_Object *p;
int sig_type; int argc;
union { Scheme_Object **argv;
sig_void_void_t void_void; Scheme_Object *retval;
sig_obj_int_pobj_obj_t obj_int_pobj_obj;
} calldata; } prim_data_t;
} rtcall_args_t;
#define PENDING 0 #define PENDING 0
#define RUNNING 1 #define RUNNING 1
@ -73,7 +58,6 @@ typedef struct future {
int id; int id;
pthread_t threadid; pthread_t threadid;
int status; int status;
int pending;
int work_completed; int work_completed;
pthread_cond_t can_continue_cv; pthread_cond_t can_continue_cv;
@ -84,32 +68,15 @@ typedef struct future {
//Runtime call stuff //Runtime call stuff
void *rt_prim; void *rt_prim;
int rt_prim_sigtype;
void *rt_prim_args;
void *rt_prim_retval; void *rt_prim_retval;
union { prim_data_t prim_data;
sig_void_void_t void_void;
sig_obj_int_pobj_obj_t obj_int_pobj_obj;
} calldata;
Scheme_Object *retval; Scheme_Object *retval;
struct future *prev; struct future *prev;
struct future *next; struct future *next;
#ifdef DEBUG_FUTURES
rtcall_context_t *context;
#endif
} future_t; } 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 #ifdef UNIT_TEST
//If unit testing, expose internal functions and vars to //If unit testing, expose internal functions and vars to
//the test suite //the test suite
@ -167,34 +134,11 @@ extern void print_ms_and_us(void);
//Here the convention is SIG_[arg1type]_[arg2type]..._[return type] //Here the convention is SIG_[arg1type]_[arg2type]..._[return type]
#define SIG_VOID_VOID 1 //void -> void #define SIG_VOID_VOID 1 //void -> void
#define SIG_OBJ_INT_POBJ_OBJ 2 //Scheme_Object* -> int -> Scheme_Object** -> Scheme_Object* #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_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_POBJ_OBJ_OBJ 17 //int -> Scheme_Object** -> 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 //Helper macros for argument marshaling
#ifdef FUTURES_ENABLED #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 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) \ #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 **c,
Scheme_Object **retval); Scheme_Object **retval);
extern int rtcall_int_pobj_obj(
/* Scheme_Object* (*f)(int, Scheme_Object**),
#define RTCALL_VOID_VOID(f) \ int argc,
if (IS_WORKER_THREAD) \ Scheme_Object **argv,
{ \ Scheme_Object **retval);
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); \
}
#else #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 IS_WORKER_THREAD 0
#define ASSERT_CORRECT_THREAD #define ASSERT_CORRECT_THREAD
#endif #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(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__) #define LOG_THISCALL LOG(__FUNCTION__)

31
src/mzscheme/src/jit.c
View File

@ -2144,8 +2144,16 @@ static Scheme_Object *noncm_prim_indirect(Scheme_Prim proc, int argc)
Scheme_Object *ret; Scheme_Object *ret;
LOG_PRIM_START(proc); LOG_PRIM_START(proc);
RTCALL_INT_OBJARR_OBJ(proc, argc, MZ_RUNSTACK); if (rtcall_int_pobj_obj(proc,
ret = proc(argc, MZ_RUNSTACK); argc,
MZ_RUNSTACK,
&ret))
{
LOG_PRIM_END(proc);
return ret;
}
ret = proc(argc, MZ_RUNSTACK);
LOG_PRIM_END(proc); LOG_PRIM_END(proc);
return ret; return ret;
@ -2155,10 +2163,19 @@ static Scheme_Object *prim_indirect(Scheme_Primitive_Closure_Proc proc, int argc
Scheme_Object *ret; Scheme_Object *ret;
LOG_PRIM_START(proc); LOG_PRIM_START(proc);
RTCALL_INT_POBJ_OBJ_OBJ(proc, argc, MZ_RUNSTACK, self); if (rtcall_int_pobj_obj_obj(proc,
ret = proc(argc, MZ_RUNSTACK, self); argc,
MZ_RUNSTACK,
self,
&ret))
{
LOG_PRIM_END(proc);
return ret;
}
ret = proc(argc, MZ_RUNSTACK, self);
LOG_PRIM_END(proc); LOG_PRIM_END(proc);
return ret; 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) 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; Scheme_Object *retptr;
if (rtcall_obj_int_pobj_obj(_scheme_apply_multi_from_native, if (rtcall_obj_int_pobj_obj(_scheme_apply_multi_from_native,
rator, 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) 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; Scheme_Object *retptr;
if (rtcall_obj_int_pobj_obj(_scheme_apply_from_native, if (rtcall_obj_int_pobj_obj(_scheme_apply_from_native,
rator, 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) 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; Scheme_Object *retptr;
if (rtcall_obj_int_pobj_obj(_scheme_tail_apply_from_native, if (rtcall_obj_int_pobj_obj(_scheme_tail_apply_from_native,
rator, rator,
@ -2213,7 +2227,6 @@ static Scheme_Object *ts_scheme_tail_apply_from_native(Scheme_Object *rator, int
static void ts_on_demand(void) static void ts_on_demand(void)
{ {
/* RTCALL_VOID_VOID(on_demand); */
if (rtcall_void_void(on_demand)) { if (rtcall_void_void(on_demand)) {
return; return;
} }

8
src/mzscheme/src/mzmark.c
View File

@ -5423,8 +5423,10 @@ static int future_MARK(void *p) {
gcMARK(f->runstack); gcMARK(f->runstack);
gcMARK(f->runstack_start); gcMARK(f->runstack_start);
gcMARK(f->orig_lambda); gcMARK(f->orig_lambda);
gcMARK(f->rt_prim_args);
gcMARK(f->rt_prim_retval); 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->retval);
gcMARK(f->prev); gcMARK(f->prev);
gcMARK(f->next); gcMARK(f->next);
@ -5437,8 +5439,10 @@ static int future_FIXUP(void *p) {
gcFIXUP(f->runstack); gcFIXUP(f->runstack);
gcFIXUP(f->runstack_start); gcFIXUP(f->runstack_start);
gcFIXUP(f->orig_lambda); gcFIXUP(f->orig_lambda);
gcFIXUP(f->rt_prim_args);
gcFIXUP(f->rt_prim_retval); 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->retval);
gcFIXUP(f->prev); gcFIXUP(f->prev);
gcFIXUP(f->next); gcFIXUP(f->next);