diff --git a/src/mzscheme/gc2/newgc.c b/src/mzscheme/gc2/newgc.c index 72ac031f91..87a9e98bbe 100644 --- a/src/mzscheme/gc2/newgc.c +++ b/src/mzscheme/gc2/newgc.c @@ -32,10 +32,24 @@ #include #include #include +#include "pthread.h" #include "platforms.h" #include "gc2.h" -#include "gc2_dump.h" +#include "gc2_dump.h" +/* +#ifdef FUTURES_ENABLED +extern pthread_t g_rt_threadid; + +#ifdef DEBUG_FUTURES +extern void dump_state(void); +#endif +#endif +*/ + +#if defined(FUTURES_ENABLED) || defined(INSTRUMENT_PRIMITIVES) +#include "../src/future.h" +#endif /* the number of tags to use for tagged objects */ #define NUMBER_OF_TAGS 512 @@ -771,7 +785,15 @@ inline static void *allocate(const size_t request_size, const int type) GC_gen0_alloc_page_end = NUM(new_mpage->addr) + GEN0_PAGE_SIZE; } else { + #ifdef INSTRUMENT_PRIMITIVES + LOG_PRIM_START(((void*)garbage_collect)); + #endif + garbage_collect(gc, 0); + + #ifdef INSTRUMENT_PRIMITIVES + LOG_PRIM_END(((void*)garbage_collect)); + #endif } newptr = GC_gen0_alloc_page_ptr + allocate_size; ASSERT_VALID_OBJPTR(newptr); @@ -3055,6 +3077,14 @@ extern double scheme_get_inexact_milliseconds(void); static void garbage_collect(NewGC *gc, int force_full) { + #ifdef FUTURES_ENABLED + //Sanity check for FUTURES + if (g_rt_threadid != 0 && pthread_self() != g_rt_threadid) + { + printf("garbage_collect invoked on wrong thread!!!\n"); + } + #endif + unsigned long old_mem_use = gc->memory_in_use; unsigned long old_gen0 = gc->gen0.current_size; int next_gc_full; diff --git a/src/mzscheme/main.c b/src/mzscheme/main.c index b2157d70ab..41c3260aac 100644 --- a/src/mzscheme/main.c +++ b/src/mzscheme/main.c @@ -78,6 +78,10 @@ START_XFORM_SUSPEND; # endif #endif +#ifdef INSTRUMENT_PRIMITIVES +extern int g_print_prims; +#endif + #ifdef MZ_XFORM END_XFORM_SUSPEND; #endif diff --git a/src/mzscheme/src/Makefile.in b/src/mzscheme/src/Makefile.in index 1d45649196..8f389c307b 100644 --- a/src/mzscheme/src/Makefile.in +++ b/src/mzscheme/src/Makefile.in @@ -261,11 +261,13 @@ error.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../incl $(srcdir)/../src/stypes.h eval.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \ $(srcdir)/../src/stypes.h $(srcdir)/mzmark.c \ - $(srcdir)/schmach.h $(srcdir)/mzstkchk.h $(srcdir)/schrunst.h + $(srcdir)/schmach.h $(srcdir)/mzstkchk.h $(srcdir)/schrunst.h \ + $(srcdir)/future.h file.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \ $(srcdir)/../src/stypes.h $(srcdir)/mzmark.c fun.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \ - $(srcdir)/../src/stypes.h $(srcdir)/mzmark.c $(srcdir)/schmap.inc + $(srcdir)/../src/stypes.h $(srcdir)/mzmark.c $(srcdir)/schmap.inc \ + $(srcdir)/future.h future.@LTO@: $(srcdir)/schpriv.h $(srcdir)/future.h $(SCONFIG) $(srcdir)/../include/scheme.h \ $(srcdir)/../src/stypes.h $(srcdir)/mzmark.c hash.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \ @@ -279,7 +281,8 @@ jit.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../includ $(srcdir)/lightning/ppc/core.h $(srcdir)/lightning/ppc/core-common.h \ $(srcdir)/lightning/ppc/asm.h $(srcdir)/lightning/ppc/asm-common.h \ $(srcdir)/lightning/ppc/funcs.h $(srcdir)/lightning/ppc/funcs-common.h \ - $(srcdir)/lightning/ppc/fp.h $(srcdir)/lightning/ppc/fp-common.h + $(srcdir)/lightning/ppc/fp.h $(srcdir)/lightning/ppc/fp-common.h \ + $(srcdir)/future.h list.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \ $(srcdir)/../src/stypes.h module.@LTO@: $(srcdir)/schpriv.h $(srcdir)/schexn.h $(SCONFIG) $(srcdir)/../include/scheme.h \ diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index e08624c04a..daabff018b 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -142,7 +142,9 @@ #include "schmach.h" #ifdef MACOS_STACK_LIMIT #include -#endif +#endif + +#include "future.h" #define EMBEDDED_DEFINES_START_ANYWHERE 0 @@ -7694,6 +7696,10 @@ void scheme_escape_to_continuation(Scheme_Object *obj, int num_rands, Scheme_Obj */ +#ifdef INSTRUMENT_PRIMITIVES +extern int g_print_prims; +#endif + #ifdef REGISTER_POOR_MACHINE # define USE_LOCAL_RUNSTACK 0 # define DELAY_THREAD_RUNSTACK_UPDATE 0 @@ -7852,8 +7858,10 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands, } f = prim->prim_val; - v = f(num_rands, rands, (Scheme_Object *)prim); + LOG_PRIM_START(f); + v = f(num_rands, rands, (Scheme_Object *)prim); + LOG_PRIM_END(f); DEBUG_CHECK_TYPE(v); } else if (type == scheme_closure_type) { Scheme_Closure_Data *data; diff --git a/src/mzscheme/src/fun.c b/src/mzscheme/src/fun.c index f18478e1a5..6631532145 100644 --- a/src/mzscheme/src/fun.c +++ b/src/mzscheme/src/fun.c @@ -2388,10 +2388,14 @@ Scheme_Object *_scheme_apply_multi_with_prompt(Scheme_Object *rator, int num_ran return do_apply_with_prompt(rator, num_rands, rands, 1, 0); } +#ifdef INSTRUMENT_PRIMITIVES +extern int g_print_prims; +#endif Scheme_Object * scheme_tail_apply (Scheme_Object *rator, int num_rands, Scheme_Object **rands) { + /* NOTE: apply_values_execute (in syntax.c) and tail_call_with_values_from_multiple_result (in jit.c) assume that this function won't allocate when @@ -2399,6 +2403,13 @@ scheme_tail_apply (Scheme_Object *rator, int num_rands, Scheme_Object **rands) int i; Scheme_Thread *p = scheme_current_thread; + #ifdef INSTRUMENT_PRIMITIVES + if (g_print_prims) + { + printf("scheme_tail_apply\n"); + } + #endif + p->ku.apply.tail_rator = rator; p->ku.apply.tail_num_rands = num_rands; diff --git a/src/mzscheme/src/future.c b/src/mzscheme/src/future.c index 6be35207d5..ad25b945d1 100644 --- a/src/mzscheme/src/future.c +++ b/src/mzscheme/src/future.c @@ -3,6 +3,10 @@ # include "schpriv.h" #endif +#ifdef INSTRUMENT_PRIMITIVES +int g_print_prims = 0; +#endif + #ifdef FUTURES_ENABLED #include "future.h" @@ -12,8 +16,12 @@ # include "./tests/unit_test.h" #endif -#define THREAD_POOL_SIZE 1 +extern void *on_demand_jit_code; + +#define THREAD_POOL_SIZE 2 static pthread_t g_pool_threads[THREAD_POOL_SIZE]; +static int g_num_avail_threads = 0; +static unsigned long g_cur_cpu_mask = 1; future_t *g_future_queue = NULL; int g_next_futureid = 0; @@ -33,8 +41,6 @@ static pthread_cond_t g_future_pending_cv = PTHREAD_COND_INITIALIZER; //Functions #ifndef UNIT_TEST -static Scheme_Object *future(int argc, Scheme_Object *argv[]); -static Scheme_Object *touch(int argc, Scheme_Object **argv); static void *worker_thread_future_loop(void *arg); static void *invoke_rtcall(future_t *future); static future_t *enqueue_future(void); @@ -54,7 +60,7 @@ Scheme_Object *future_touch(int futureid) Scheme_Object *args[1] = { &futureid }; return touch(1, args); } -#endif +#endif void *g_funcargs[5]; void *func_retval = NULL; @@ -83,16 +89,20 @@ void debug_assert_context(future_t *future) rtcall_context_t *context = future->context; if (MZ_RUNSTACK_START != future->context->mz_runstack_start) { - printf("MZ_RUNSTACK_START was %p, but future runstack start should be %p.\n", + 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, - context->mz_runstack_start); + future->runstack_start); } if (MZ_RUNSTACK != context->mz_runstack) { - printf("MZ_RUNSTACK was %p, but future runstack should be %p.\n", + printf("Future %d (thread %p) reports MZ_RUNSTACK was %p, but future runstack should be %p.\n", + future->id, + future->threadid, MZ_RUNSTACK, - context->mz_runstack); + future->runstack); } } @@ -103,7 +113,6 @@ void debug_kill_context(void) free(future->context); future->context = NULL; } -#endif static Scheme_Object **get_thread_runstack(void) { @@ -116,6 +125,50 @@ static Scheme_Object **get_thread_runstack_start(void) return MZ_RUNSTACK_START; } +void dump_state(void) +{ + future_t *f; + pthread_mutex_lock(&g_future_queue_mutex); + printf("\n"); + printf("FUTURES STATE:\n"); + printf("-------------------------------------------------------------\n"); + if (NULL == g_future_queue) + { + printf("No futures currently running. %d thread(s) available in the thread pool.\n\n", g_num_avail_threads); + pthread_mutex_unlock(&g_future_queue_mutex); + return; + } + + for (f = g_future_queue; f != NULL; f = f->next) + { + printf("Future %d [Thread: %p, Runstack start = %p, Runstack = %p]: ", f->id, f->threadid, f->runstack_start, f->runstack); + fflush(stdout); + switch (f->status) + { + case PENDING: + printf("Waiting to be assigned to thread\n"); + break; + case RUNNING: + printf("Executing JIT code\n"); + break; + case WAITING_FOR_PRIM: + printf("Waiting for runtime primitive invocation (prim=%p)\n", (void*)f->rt_prim); + break; + case FINISHED: + printf("Finished work, waiting for cleanup\n"); + break; + } + + fflush(stdout); + printf("%d thread(s) available in the thread pool.\n", g_num_avail_threads); + printf("\n"); + fflush(stdout); + } + + pthread_mutex_unlock(&g_future_queue_mutex); +} +#endif + /**********************************************************************/ /* Plumbing for MzScheme initialization */ @@ -143,6 +196,15 @@ void scheme_init_futures(Scheme_Env *env) 1), newenv); + scheme_add_global_constant( + "num-processors", + scheme_make_prim_w_arity( + num_processors, + "num-processors", + 0, + 0), + newenv); + scheme_add_global_constant( "touch", scheme_make_prim_w_arity( @@ -152,6 +214,26 @@ void scheme_init_futures(Scheme_Env *env) 1), newenv); + #ifdef INSTRUMENT_PRIMITIVES + scheme_add_global_constant( + "start-primitive-tracking", + scheme_make_prim_w_arity( + start_primitive_tracking, + "start-primitive-tracking", + 0, + 0), + newenv); + + scheme_add_global_constant( + "end-primitive-tracking", + scheme_make_prim_w_arity( + end_primitive_tracking, + "end-primitive-tracking", + 0, + 0), + newenv); + #endif + scheme_finish_primitive_module(newenv); scheme_protect_primitive_provide(newenv, NULL); END_XFORM_SKIP; @@ -164,15 +246,17 @@ void futures_init(void) { int i; pthread_t threadid; - g_rt_threadid = pthread_self(); + g_rt_threadid = pthread_self(); - //Create the worker thread pool. These threads will - //'queue up' and wait for futures to become available - for (i = 0; i < THREAD_POOL_SIZE; i++) - { - pthread_create(&threadid, NULL, worker_thread_future_loop, NULL); - g_pool_threads[i] = threadid; - } + //Create the worker thread pool. These threads will + //'queue up' and wait for futures to become available + for (i = 0; i < THREAD_POOL_SIZE - 1; i++) + { + pthread_create(&threadid, NULL, worker_thread_future_loop, NULL); + g_pool_threads[i] = threadid; + } + + g_num_avail_threads = THREAD_POOL_SIZE; } @@ -180,13 +264,59 @@ void futures_init(void) /* Primitive implementations */ /**********************************************************************/ +#ifdef INSTRUMENT_PRIMITIVES +long start_ms = 0; + +Scheme_Object *start_primitive_tracking(int argc, Scheme_Object *argv[]) +{ + //Get the start time + struct timeval now; + long ms; + gettimeofday(&now, NULL); + + start_ms = now.tv_usec / 1000.0; + + g_print_prims = 1; + printf("Primitive tracking started at "); + print_ms_and_us(); + printf("\n"); + return scheme_void; +} + +Scheme_Object *end_primitive_tracking(int argc, Scheme_Object *argv[]) +{ + g_print_prims = 0; + printf("Primitive tracking ended at "); + print_ms_and_us(); + printf("\n"); + return scheme_void; +} + +void print_ms_and_us() +{ + struct timeval now; + long ms, us; + gettimeofday(&now, NULL); + + //ms = (now.tv_sec * 1000.0) - start_ms; + ms = (now.tv_usec / 1000) - start_ms; + us = now.tv_usec - (ms * 1000) - (start_ms * 1000); + printf("%ld.%ld", ms, us); +} +#endif + Scheme_Object *future(int argc, Scheme_Object *argv[]) { START_XFORM_SKIP; + + #ifdef DEBUG_FUTURES + LOG_THISCALL; + dump_state(); + #endif + int init_runstack_size, main_runstack_size; - int futureid = ++g_next_futureid; + int futureid; future_t *ft; - Scheme_Object **old_rs, **old_rs_start; Scheme_Native_Closure *nc; Scheme_Native_Closure_Data *ncd; Scheme_Object *lambda = argv[0]; @@ -198,34 +328,41 @@ Scheme_Object *future(int argc, Scheme_Object *argv[]) pthread_mutex_lock(&g_future_queue_mutex); ft = enqueue_future(); pthread_cond_init(&ft->can_continue_cv, NULL); + futureid = ++g_next_futureid; ft->id = futureid; ft->orig_lambda = lambda; ft->pending = 1; - //Allocate the runstack and copy the runtime thread's - //runstack - init_runstack_size = MZ_RUNSTACK - MZ_RUNSTACK_START; + //Allocate a new scheme stack for the future + //init_runstack_size = MZ_RUNSTACK - MZ_RUNSTACK_START; + init_runstack_size = 1000; + + #ifdef DEBUG_FUTURES + printf("Allocating Scheme stack of %d bytes for future %d.\n", init_runstack_size, futureid); + #endif ft->runstack_start = scheme_alloc_runstack(init_runstack_size); ft->runstack = ft->runstack_start + init_runstack_size; - //memcpy(ft->runstack_start, MZ_RUNSTACK_START, main_runstack_size); - pthread_mutex_unlock(&g_future_queue_mutex); + //pthread_mutex_unlock(&g_future_queue_mutex); - //JIT compile the code + //JIT compile the code if not already jitted //Temporarily repoint MZ_RUNSTACK //to the worker thread's runstack - //in case the JIT compiler uses the stack address //when generating code - //old_rs = MZ_RUNSTACK; - //old_rs_start = MZ_RUNSTACK_START; - //MZ_RUNSTACK = ft->runstack; - //MZ_RUNSTACK_START = ft->runstack_start; - scheme_on_demand_generate_lambda(nc, 0, NULL); - //MZ_RUNSTACK = old_rs; - //MZ_RUNSTACK_START = old_rs_start; + if (ncd->code == on_demand_jit_code) + { + printf("JIT compiling code.\n"); + scheme_on_demand_generate_lambda(nc, 0, NULL); + printf("Code pointer is now %p, and on_demand_jit_code is %p.\n", ncd->code, on_demand_jit_code); + } + else + { + printf("Code pointer was %p, and on_demand_jit_code was %p. Code is already JIT compiled.\n", ncd->code, on_demand_jit_code); + } - pthread_mutex_lock(&g_future_queue_mutex); + //pthread_mutex_lock(&g_future_queue_mutex); ft->code = (void*)ncd->code; pthread_mutex_unlock(&g_future_queue_mutex); @@ -239,15 +376,26 @@ Scheme_Object *future(int argc, Scheme_Object *argv[]) } +Scheme_Object *num_processors(int argc, Scheme_Object *argv[]) +{ + return scheme_make_integer(THREAD_POOL_SIZE); +} + + Scheme_Object *touch(int argc, Scheme_Object *argv[]) { START_XFORM_SKIP; Scheme_Object *retval = NULL; void *rtcall_retval = NULL; - future_t *ft; - int futureid; + future_t *ft; + int futureid; - futureid = SCHEME_INT_VAL(argv[0]); + futureid = SCHEME_INT_VAL(argv[0]); + + #ifdef DEBUG_FUTURES + LOG("touch (future %d)", futureid); + dump_state(); + #endif pthread_mutex_lock(&g_future_queue_mutex); ft = get_future(futureid); @@ -280,6 +428,8 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) free(ft); } + //Increment the number of available pool threads + g_num_avail_threads++; pthread_mutex_unlock(&g_future_queue_mutex); } else if (ft->rt_prim != NULL) @@ -288,7 +438,9 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) //Release the lock so other threads can manipulate the queue //while the runtime call executes pthread_mutex_unlock(&g_future_queue_mutex); + LOG("Invoking primitive %p on behalf of future %d...", ft->rt_prim, ft->id); rtcall_retval = invoke_rtcall(ft); + LOG("done.\n"); pthread_mutex_lock(&g_future_queue_mutex); ft->rt_prim_retval = rtcall_retval; @@ -301,6 +453,10 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) pthread_cond_signal(&ft->can_continue_cv); pthread_mutex_unlock(&g_future_queue_mutex); + #ifdef DEBUG_FUTURES + dump_state(); + #endif + goto wait_for_rtcall_or_completion; } else @@ -323,26 +479,42 @@ void *worker_thread_future_loop(void *arg) Scheme_Object *v; Scheme_Object* (*jitcode)(Scheme_Object*, int, Scheme_Object**); + //Set processor affinity + pthread_mutex_lock(&g_future_queue_mutex); + if (pthread_setaffinity_np(pthread_self(), sizeof(g_cur_cpu_mask), &g_cur_cpu_mask)) + { + printf( + "Could not set CPU affinity (%lu) for thread %p!\n", + ++g_cur_cpu_mask, + pthread_self()); + } + + pthread_mutex_unlock(&g_future_queue_mutex); + wait_for_work: - LOG("Waiting for new future work..."); + //LOG("Waiting for new future work..."); pthread_mutex_lock(&g_future_pending_mutex); pthread_cond_wait(&g_future_pending_cv, &g_future_pending_mutex); - LOG("Got a signal that a future is pending..."); + //LOG("Got a signal that a future is pending..."); //Work is available for this thread pthread_mutex_lock(&g_future_queue_mutex); future_t *ft = get_pending_future(); ft->pending = 0; + ft->status = RUNNING; ft->threadid = pthread_self(); - //Initialize the runstack for this thread - //MZ_RUNSTACK AND MZ_RUNSTACK_START should be thread-local - MZ_RUNSTACK = ft->runstack; - MZ_RUNSTACK_START = ft->runstack_start; + //Decrement the number of available pool threads + g_num_avail_threads--; - //Set up the JIT compiler for this thread - scheme_jit_fill_threadlocal_table(); + //Initialize the runstack for this thread + //MZ_RUNSTACK AND MZ_RUNSTACK_START should be thread-local + MZ_RUNSTACK = ft->runstack; + MZ_RUNSTACK_START = ft->runstack_start; + + //Set up the JIT compiler for this thread + scheme_jit_fill_threadlocal_table(); jitcode = (Scheme_Object* (*)(Scheme_Object*, int, Scheme_Object**))(ft->code); pthread_mutex_unlock(&g_future_queue_mutex); @@ -355,12 +527,17 @@ void *worker_thread_future_loop(void *arg) //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); + LOG("Finished running JIT code at %p.\n", ft->code); //Set the return val in the descriptor pthread_mutex_lock(&g_future_queue_mutex); ft->work_completed = 1; ft->retval = v; + + //Update the status + ft->status = FINISHED; pthread_mutex_unlock(&g_future_queue_mutex); goto wait_for_work; @@ -400,15 +577,18 @@ int future_do_runtimecall( //pthread_mutex_lock(&future->mutex); pthread_mutex_lock(&g_future_queue_mutex); - //Update the stack pointer for this future - //to be in sync with MZ_RUNSTACK - the runtime thread - //will use this value to temporarily swap its stack - //for the worker thread's - future->runstack = MZ_RUNSTACK; + //Update the stack pointer for this future + //to be in sync with MZ_RUNSTACK - the runtime thread + //will use this value to temporarily swap its stack + //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; + //Wait for the signal that the RT call is finished pthread_cond_wait(&future->can_continue_cv, &g_future_queue_mutex); @@ -441,19 +621,20 @@ int rtcall_void_void(void (*f)()) LOG_RTCALL_VOID_VOID(f); #ifdef DEBUG_FUTURES - debug_save_context(); + //debug_save_context(); #endif data.prim = f; future = get_my_future(); future->rt_prim_sigtype = SIG_VOID_VOID; + future->rt_prim = (void*)f; future->calldata.void_void = data; future_do_runtimecall((void*)f, SIG_VOID_VOID, NULL, NULL); #ifdef DEBUG_FUTURES - debug_kill_context(); + //debug_kill_context(); #endif return 1; @@ -466,7 +647,7 @@ int rtcall_obj_int_pobj_obj( Scheme_Object *a, int b, Scheme_Object **c, - Scheme_Object *retval) + Scheme_Object **retval) { START_XFORM_SKIP; future_t *future; @@ -480,7 +661,7 @@ int rtcall_obj_int_pobj_obj( LOG_RTCALL_OBJ_INT_POBJ_OBJ(f, a, b, c); #ifdef DEBUG_FUTURES - debug_save_context(); + //debug_save_context(); #endif data.prim = f; @@ -490,13 +671,14 @@ int rtcall_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_do_runtimecall((void*)f, SIG_OBJ_INT_POBJ_OBJ, NULL, NULL); - *retval = *(future->calldata.obj_int_pobj_obj.retval); + *retval = future->calldata.obj_int_pobj_obj.retval; #ifdef DEBUG_FUTURES - debug_kill_context(); + //debug_kill_context(); #endif return 1; @@ -519,7 +701,7 @@ void *invoke_rtcall(future_t *future) MZ_RUNSTACK = future->runstack; MZ_RUNSTACK_START = future->runstack_start; #ifdef DEBUG_FUTURES - debug_assert_context(future); + //debug_assert_context(future); g_rtcall_count++; #endif @@ -708,46 +890,47 @@ future_t *get_my_future(void) future_t *get_future_by_threadid(pthread_t threadid) { START_XFORM_SKIP; - future_t *ft = g_future_queue; - if (NULL == ft) + future_t *ft = g_future_queue; + if (NULL == ft) + { + printf("Couldn't find a future with thread ID %p!\n", threadid); + return NULL; + } + + while (1) + { + if (ft->threadid == threadid) { - return ft; - } - - while (ft->threadid != threadid) - { - ft = ft->next; + return ft; } - //Sanity check - if (ft->threadid != threadid) - { - return NULL; - } + ft = ft->next; + } - return ft; - END_XFORM_SKIP; + printf("Couldn't find a future with thread ID %p!\n", threadid); + return NULL; + END_XFORM_SKIP; } future_t *get_future(int futureid) { START_XFORM_SKIP; - future_t *ft = g_future_queue; - if (NULL == ft) + future_t *ft = g_future_queue; + if (NULL == ft) { - return ft; + return ft; } - while (ft->id != futureid) + while (ft->id != futureid) { - ft = ft->next; + ft = ft->next; } //Sanity check - if (ft->id != futureid) + if (ft->id != futureid) { - return NULL; + return NULL; } return ft; diff --git a/src/mzscheme/src/future.h b/src/mzscheme/src/future.h index 36ca694edf..660b4b7e3a 100644 --- a/src/mzscheme/src/future.h +++ b/src/mzscheme/src/future.h @@ -2,6 +2,7 @@ #define SCHEME_FUTURES_H #ifndef UNIT_TEST +#include "schpriv.h" typedef Scheme_Object*(*prim_t)(int, Scheme_Object**); #else #define Scheme_Object void @@ -23,6 +24,11 @@ int scheme_make_prim_w_arity(prim_t func, char *name, int arg1, int arg2); #include extern pthread_t g_rt_threadid; +extern Scheme_Object *start_primitive_tracking(int argc, Scheme_Object *argv[]); +extern Scheme_Object *end_primitive_tracking(int argc, Scheme_Object *argv[]); +extern Scheme_Object *future(int argc, Scheme_Object *argv[]); +extern Scheme_Object *touch(int argc, Scheme_Object *argv[]); +extern Scheme_Object *num_processors(int argc, Scheme_Object *argv[]); extern void scheme_init_futures(Scheme_Env *env); extern int future_do_runtimecall(void *func, int sigtype, void *args, void *retval); extern void futures_init(void); @@ -57,10 +63,16 @@ typedef struct { } calldata; } rtcall_args_t; +#define PENDING 0 +#define RUNNING 1 +#define WAITING_FOR_PRIM 2 +#define FINISHED 3 + typedef struct future { int id; pthread_t threadid; - int pending; + int status; + int pending; int work_completed; pthread_cond_t can_continue_cv; @@ -115,6 +127,41 @@ extern future_t *get_last_future(void); extern void clear_futures(void); #endif +//Primitive instrumentation stuff +#ifdef INSTRUMENT_PRIMITIVES +extern int g_print_prims; +extern void print_ms_and_us(void); +#define LOG_PRIM_START(p) \ + if (g_print_prims) \ + { \ + printf("%p ", p); \ + print_ms_and_us(); \ + printf("\n"); \ + } + +#define LOG_PRIM_END(p) +/* +#define LOG_PRIM_END(p) \ + if (g_print_prims) \ + { \ + print_ms_and_us(); \ + printf("\n"); \ + } +*/ + +#define LOG_PRIM_W_NAME(name) \ + if (g_print_prims) \ + { \ + printf("%s ", name); \ + print_ms_and_us(); \ + printf("\n"); \ + } +#else +#define LOG_PRIM_START(p) +#define LOG_PRIM_END(p) +#define LOG_PRIM_W_NAME(name) +#endif + //Signature flags for primitive invocations //Here the convention is SIG_[arg1type]_[arg2type]..._[return type] #define SIG_VOID_VOID 1 //void -> void @@ -161,7 +208,7 @@ extern int rtcall_obj_int_pobj_obj( Scheme_Object *a, int b, Scheme_Object **c, - Scheme_Object *retval); + Scheme_Object **retval); /* diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index 7b79efd9cd..c0f495043b 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -41,9 +41,7 @@ #include "schpriv.h" #include "schmach.h" -#ifdef FUTURES_ENABLED # include "future.h" -#endif #ifdef MZ_USE_DWARF_LIBUNWIND # include "unwind/libunwind.h" #endif @@ -143,7 +141,7 @@ static void *vector_ref_code, *vector_ref_check_index_code, *vector_set_code, *v static void *string_ref_code, *string_ref_check_index_code, *string_set_code, *string_set_check_index_code; static void *bytes_ref_code, *bytes_ref_check_index_code, *bytes_set_code, *bytes_set_check_index_code; static void *syntax_e_code; -static void *on_demand_jit_code; +void *on_demand_jit_code; static void *on_demand_jit_arity_code; static void *get_stack_pointer_code; static void *stack_cache_pop_code; @@ -2129,6 +2127,10 @@ static jit_insn *generate_proc_struct_retry(mz_jit_state *jitter, int num_rands, return ref2; } +#ifdef INSTRUMENT_PRIMITIVES +extern int g_print_prims; +#endif + /* Support for intercepting direct calls to primitives: */ #ifdef FUTURES_ENABLED # define mz_prepare_direct_prim(n) mz_prepare(n) @@ -2136,13 +2138,25 @@ static jit_insn *generate_proc_struct_retry(mz_jit_state *jitter, int num_rands, # define mz_direct_only(p) /* skip this arg, so that total count <= 3 args */ 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); - return proc(argc, MZ_RUNSTACK); + ret = proc(argc, MZ_RUNSTACK); + LOG_PRIM_END(proc); + + return ret; } static Scheme_Object *prim_indirect(Scheme_Primitive_Closure_Proc proc, int argc, Scheme_Object *self) { + Scheme_Object *ret; + LOG_PRIM_START(proc); + RTCALL_INT_POBJ_OBJ_OBJ(proc, argc, MZ_RUNSTACK, self); - return proc(argc, MZ_RUNSTACK, self); + ret = proc(argc, MZ_RUNSTACK, self); + + LOG_PRIM_END(proc); + return ret; } /* Various specific 'futurized' versions of primitives that may @@ -2152,13 +2166,13 @@ 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 *ret; + Scheme_Object *retptr; if (rtcall_obj_int_pobj_obj(_scheme_apply_multi_from_native, rator, argc, argv, - ret)) { - return ret; + &retptr)) { + return retptr; } return _scheme_apply_multi_from_native(rator, argc, argv); @@ -2167,13 +2181,13 @@ 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 *ret; + Scheme_Object *retptr; if (rtcall_obj_int_pobj_obj(_scheme_apply_from_native, rator, argc, argv, - ret)) { - return ret; + &retptr)) { + return retptr; } return _scheme_apply_from_native(rator, argc, argv); diff --git a/src/mzscheme/src/schnapp.inc b/src/mzscheme/src/schnapp.inc index 275cc877f4..1f0879be29 100644 --- a/src/mzscheme/src/schnapp.inc +++ b/src/mzscheme/src/schnapp.inc @@ -1,3 +1,5 @@ +#include "future.h" + /* For non-tail calls, the native context has already incremented MZ_CONT_MARK_POS. Counter scheme_do_eval()'s increment, because this @@ -30,8 +32,10 @@ static MZ_INLINE Scheme_Object *PRIM_APPLY_NAME_FAST(Scheme_Object *rator, } f = (Scheme_Primitive_Closure_Proc *)prim->prim_val; + LOG_PRIM_START(f); v = f(argc, argv, (Scheme_Object *)prim); - + LOG_PRIM_END(f); + #if PRIM_CHECK_VALUE if (v == SCHEME_TAIL_CALL_WAITING) { int i; @@ -68,6 +72,9 @@ Scheme_Object *PRIM_APPLY_NAME(Scheme_Object *rator, { GC_CAN_IGNORE Scheme_Object *v; MZ_CONT_MARK_POS -= 2; + + LOG_PRIM_W_NAME("_scheme_apply"); + v = _scheme_apply(rator, argc, argv); MZ_CONT_MARK_POS += 2; return v; @@ -75,13 +82,17 @@ Scheme_Object *PRIM_APPLY_NAME(Scheme_Object *rator, #else # if PRIM_CHECK_VALUE { + LOG_PRIM_W_NAME("_scheme_apply_multi"); + GC_CAN_IGNORE Scheme_Object *v; MZ_CONT_MARK_POS -= 2; v = _scheme_apply_multi(rator, argc, argv); MZ_CONT_MARK_POS += 2; return v; } -# else +# else + LOG_PRIM_W_NAME("_scheme_tail_apply"); + return _scheme_tail_apply(rator, argc, argv); # endif #endif diff --git a/src/mzscheme/src/string.c b/src/mzscheme/src/string.c index f2bb274bd9..738982be6b 100644 --- a/src/mzscheme/src/string.c +++ b/src/mzscheme/src/string.c @@ -1872,6 +1872,10 @@ format(int argc, Scheme_Object *argv[]) return scheme_make_sized_utf8_string(s, len); } +#ifdef INSTRUMENT_PRIMITIVES +extern int g_print_prims; +#endif + static Scheme_Object * sch_printf(int argc, Scheme_Object *argv[]) {