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

made primitive tracking configurable at runtime

Browse Source 
svn: r16906
This commit is contained in:
James Swaine 2009-11-19 23:34:18 +00:00
parent bf8c1826b4
commit ec1cfb5a12
4 changed files with 25 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/mzscheme/src/eval.c
View File

@ -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) {

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

@ -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 */

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

@ -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]

4
src/mzscheme/src/schnapp.inc
View File

@ -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) {