diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 7a3a8146cf..a67fb259fa 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -145,9 +145,6 @@ #endif #ifdef FUTURES_ENABLED # include "future.h" -#else -# define LOG_PRIM_START(x) /* empty */ -# define LOG_PRIM_END(x) /* empty */ #endif #define EMBEDDED_DEFINES_START_ANYWHERE 0 @@ -7863,9 +7860,13 @@ scheme_do_eval(Scheme_Object *obj, int num_rands, Scheme_Object **rands, f = prim->prim_val; + #ifdef FUTURES_ENABLED LOG_PRIM_START(f); + #endif v = f(num_rands, rands, (Scheme_Object *)prim); + #ifdef FUTURES_ENABLED LOG_PRIM_END(f); + #endif DEBUG_CHECK_TYPE(v); } else if (type == scheme_closure_type) { diff --git a/src/mzscheme/src/future.c b/src/mzscheme/src/future.c index 52d513f3bf..dfa6130a00 100644 --- a/src/mzscheme/src/future.c +++ b/src/mzscheme/src/future.c @@ -3,9 +3,9 @@ # include "schpriv.h" #endif -#ifdef INSTRUMENT_PRIMITIVES +//This will be TRUE if primitive tracking has been enabled +//by the program int g_print_prims = 0; -#endif #ifndef FUTURES_ENABLED @@ -29,6 +29,18 @@ static Scheme_Object *processor_count(int argc, Scheme_Object *argv[]) return NULL; } +static Scheme_Object *start_primitive_tracking(int argc, Scheme_Object *argv[]) +{ + scheme_signal_error("start-primitive-tracking: not enabled"); + return NULL; +} + +static Scheme_Object *end_primitive_tracking(int argc, Scheme_Object *argv[]) +{ + scheme_signal_error("end-primitive-tracking: not enabled"); + return NULL; +} + # define FUTURE_PRIM_W_ARITY(name, func, a1, a2, env) GLOBAL_PRIM_W_ARITY(name, func, a1, a2, env) void scheme_init_futures(Scheme_Env *env) @@ -41,6 +53,8 @@ void scheme_init_futures(Scheme_Env *env) FUTURE_PRIM_W_ARITY("future", future, 1, 1, newenv); FUTURE_PRIM_W_ARITY("touch", touch, 1, 1, newenv); FUTURE_PRIM_W_ARITY("processor-count", processor_count, 1, 1, newenv); + FUTURE_PRIM_W_ARITY("start-primitive-tracking", start_primitive_tracking, 0, 0, newenv); + FUTURE_PRIM_W_ARITY("end-primitive-tracking", end_primitive_tracking, 0, 0, newenv); scheme_finish_primitive_module(newenv); scheme_protect_primitive_provide(newenv, NULL); @@ -274,7 +288,6 @@ void scheme_init_futures(Scheme_Env *env) 1), newenv); -#ifdef INSTRUMENT_PRIMITIVES scheme_add_global_constant( "start-primitive-tracking", scheme_make_prim_w_arity( @@ -292,7 +305,6 @@ void scheme_init_futures(Scheme_Env *env) 0, 0), newenv); -#endif scheme_finish_primitive_module(newenv); scheme_protect_primitive_provide(newenv, NULL); @@ -436,8 +448,7 @@ void scheme_future_gc_pause() /* Primitive implementations */ /**********************************************************************/ -#ifdef INSTRUMENT_PRIMITIVES -long start_ms = 0; +static long start_ms = 0; Scheme_Object *start_primitive_tracking(int argc, Scheme_Object *argv[]) { @@ -475,7 +486,6 @@ void print_ms_and_us() us = now.tv_usec - (ms * 1000) - (start_ms * 1000); printf("%ld.%ld", ms, us); } -#endif Scheme_Object *future(int argc, Scheme_Object *argv[]) /* Called in runtime thread */ diff --git a/src/mzscheme/src/future.h b/src/mzscheme/src/future.h index 07567968bd..774b7043c9 100644 --- a/src/mzscheme/src/future.h +++ b/src/mzscheme/src/future.h @@ -109,7 +109,6 @@ 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) \ @@ -137,11 +136,6 @@ extern void print_ms_and_us(void); 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] diff --git a/src/mzscheme/src/schnapp.inc b/src/mzscheme/src/schnapp.inc index a12f945453..57f1e38441 100644 --- a/src/mzscheme/src/schnapp.inc +++ b/src/mzscheme/src/schnapp.inc @@ -31,9 +31,13 @@ static MZ_INLINE Scheme_Object *PRIM_APPLY_NAME_FAST(Scheme_Object *rator, } f = (Scheme_Primitive_Closure_Proc *)prim->prim_val; + #ifdef FUTURES_ENABLED LOG_PRIM_START(f); + #endif v = f(argc, argv, (Scheme_Object *)prim); + #ifdef FUTURES_ENABLED LOG_PRIM_END(f); + #endif #if PRIM_CHECK_VALUE if (v == SCHEME_TAIL_CALL_WAITING) {