made primitive tracking configurable at runtime

svn: r16906

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

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
+static long start_ms = 0;
-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 */

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]

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