Change future visualizer trace collection slightly to be more composable

(cherry picked from commit f0aaca0dde)

collects/future-visualizer/main.rkt

@@ -38,6 +38,7 @@
 (define-syntax-rule (visualize-futures e ...) 
   (begin (start-future-tracing!) 
          (begin0 (begin e ...) 
+                 (stop-future-tracing!)
                  (show-visualizer))))
 
 ;;visualize-futures-thunk : (-> any/c) -> any/c
@@ -45,6 +46,7 @@
   (start-future-tracing!) 
   (begin0 
     (thunk) 
+    (stop-future-tracing!)
     (show-visualizer)))
                   
                   

collects/future-visualizer/private/visualizer-data.rkt

@@ -6,9 +6,12 @@
          racket/set 
          "constants.rkt"
          "graph-drawing.rkt" 
-         (only-in '#%futures init-visualizer-tracking!)) 
+         (only-in '#%futures 
+                  reset-future-logs-for-tracing! 
+                  mark-future-trace-end!)) 
 
 (provide start-future-tracing! 
+         stop-future-tracing!
          (struct-out future-event)
          (struct-out indexed-future-event)
          (struct-out trace) 
@@ -164,17 +167,25 @@
 
 ;;start-future-tracing! -> void
 (define (start-future-tracing!)
+  (reset-future-logs-for-tracing!)
   (when (not recv) 
-    (set! recv (make-log-receiver (init-visualizer-tracking!) 'debug))))
+    (set! recv (make-log-receiver (current-logger) 'debug))))
 
+;;stop-future-tracing! -> void
+(define (stop-future-tracing!) 
+  (mark-future-trace-end!))
+
+;;timeline-events/private : -> void
 (define (timeline-events/private) 
   (let ([info (sync/timeout 0 recv)]) 
     (if info 
         (let ([v (vector-ref info 2)]) 
           (if (future-event? v) 
-              (cons v (timeline-events/private)) 
+              (case (future-event-what v) 
+                [(stop-trace) '()] 
+                [else (cons v (timeline-events/private))]) 
               (timeline-events/private))) 
-        '())))
+        (timeline-events/private))))
           
 ;Gets log events for an execution timeline
 ;;timeline-events : (listof indexed-future-event)

collects/future-visualizer/trace.rkt

@@ -6,12 +6,14 @@
          trace-futures 
          (contract-out
           [start-future-tracing! (-> void?)] 
+          [stop-future-tracing! (-> void?)]
           [timeline-events (-> (listof indexed-future-event?))]
           [trace-futures-thunk ((-> any/c) . -> . (listof indexed-future-event?))]))
 
 (define-syntax-rule (trace-futures e ...) 
   (begin (start-future-tracing!) 
          (begin (begin e ...) 
+                (stop-future-tracing!)
                 (timeline-events))))
 
 ;;trace-futures-thunk : (-> any) -> (listof indexed-future-event)
@@ -19,4 +21,5 @@
   (start-future-tracing!) 
   (begin
     (thunk) 
+    (stop-future-tracing!)
     (timeline-events)))

collects/scribblings/reference/futures-trace.scrbl

@@ -40,19 +40,25 @@ the execution of parallel programs written using @racket[future].
     (let ([f (future (lambda () ...))]) 
       ... 
       (touch f)) 
-    
+    (stop-future-tracing!)
     (timeline-events)
  ]
 }
 
 @deftogether[(
   @defproc[(start-future-tracing!) void?]
+  @defproc[(stop-future-tracing!) void?]
   @defproc[(timeline-events) (listof indexed-future-event?)]
 )]{
  The @racket[start-future-tracing!] procedure enables the collection 
  of future-related execution data.  This function should be called immediately 
  prior to executing code the programmer wishes to profile. 
  
+ The @racket[stop-future-tracing!] procedure must be used to indicate the 
+ end of code the programmer wishes to trace.  Tracing works by simply using a 
+ log receiver to record all future-related log events; this procedure logs a 
+ special message that is well-known to the log receiver to mean 'stop recording'.
+ 
  The @racket[timeline-events] procedure returns the program trace as 
  a list of @racket[indexed-future-event] structures. 
 }

collects/scribblings/reference/futures-visualizer.scrbl

@@ -46,15 +46,16 @@ at any point during the program's lifetime.
     (let ([f (future (lambda () ...))]) 
       ... 
       (touch f)) 
-    
+    (stop-future-tracing!)
     (show-visualizer)
  ]
 }
 
 @defproc[(show-visualizer [#:timeline timeline (listof indexed-future-event?)]) void?]{
  Displays the visualizer window.  If the function is called with no arguments, 
- it must be preceded by a call to @racket[start-future-tracing!] -- in which case 
+ it must be preceded by the following sequence: a call to @racket[start-future-tracing!], 
- the visualizer will show data for all events logged in between (via @racket[timeline-events]).  
+ program code that is being traced, and a call to @racket[stop-future-tracing!] -- in which case 
+ the visualizer will show data for all events logged in between those calls (via @racket[timeline-events]).  
  Note that @racket[visualize-futures] and @racket[visualize-futures-thunk] are simpler alternatives to using these 
  primitives directly.
  The @racket[timeline] argument can be used to show the visualizer for a previously-generated 

src/racket/src/future.c

@@ -242,6 +242,11 @@ static Scheme_Object *reset_future_logs_for_tracking(int argc, Scheme_Object *ar
   return scheme_void;
 }
 
+static Scheme_Object *mark_future_trace_end(int argc, Scheme_Object *argv[])
+{
+  return scheme_void;
+}
+
 # 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 *newenv)
@@ -259,7 +264,8 @@ void scheme_init_futures(Scheme_Env *newenv)
   FUTURE_PRIM_W_ARITY("fsemaphore-count", scheme_fsemaphore_count, 1, 1, newenv);
   FUTURE_PRIM_W_ARITY("would-be-future", would_be_future, 1, 1, newenv);
   FUTURE_PRIM_W_ARITY("futures-enabled?", futures_enabled, 0, 0, newenv);
-  FUTURE_PRIM_W_ARITY("init-visualizer-tracking!", reset_future_logs_for_tracking, 0, 0, newenv);
+  FUTURE_PRIM_W_ARITY("reset-future-logs-for-tracing!", reset_future_logs_for_tracking, 0, 0, newenv);
+  GLOBAL_PRIM_W_ARITY("mark-future-trace-end!", mark_future_trace_end, 0, 0, newenv);
 
   scheme_finish_primitive_module(newenv);
   scheme_protect_primitive_provide(newenv, NULL);
@@ -341,6 +347,7 @@ enum {
   FEVENT_TOUCH_PAUSE,
   FEVENT_TOUCH_RESUME,
   FEVENT_MISSING, 
+  FEVENT_STOP_TRACE, 
   _FEVENT_COUNT_
 };
 
@@ -350,7 +357,7 @@ static const char * const fevent_strs[] = { "create", "complete",
                                             "sync", "sync", "block", "touch", "block",
                                             "result", "result", "abort", "abort", 
                                             "suspend", "overflow",
-                                            "touch-pause", "touch-resume", "missing" };
+                                            "touch-pause", "touch-resume", "missing", "stop-trace" };
 static const char * const fevent_long_strs[] = { "created", "completed",
                                                  "started work", "started (process 0, only)", "started (overflow)", 
                                                  "ended work",
@@ -360,7 +367,7 @@ static const char * const fevent_long_strs[] = { "created", "completed",
                                                  "abort from process 0", "abort determined",
                                                  "suspended", "overflow",
                                                  "paused for touch", "resumed for touch",
-                                                 "events missing" };
+                                                 "events missing", "stop future tracing" };
 
 
 typedef struct Scheme_Future_State {
@@ -429,6 +436,7 @@ static void pop_suspended_lw(Scheme_Future_State *fs, future_t *ft);
 static Scheme_Object *bad_multi_result_proc;
 static Scheme_Object *bad_multi_result(int argc, Scheme_Object **argv);
 static Scheme_Object *reset_future_logs_for_tracking(int argc, Scheme_Object *argv[]);
+static Scheme_Object *mark_future_trace_end(int argc, Scheme_Object *argv[]);
 
 READ_ONLY static int cpucount;
 static void init_cpucount(void);
@@ -554,7 +562,8 @@ void scheme_init_futures(Scheme_Env *newenv)
 
   GLOBAL_PRIM_W_ARITY("would-be-future", would_be_future, 1, 1, newenv);
   GLOBAL_PRIM_W_ARITY("futures-enabled?", futures_enabled, 0, 0, newenv);
-  GLOBAL_PRIM_W_ARITY("init-visualizer-tracking!", reset_future_logs_for_tracking, 0, 0, newenv);
+  GLOBAL_PRIM_W_ARITY("reset-future-logs-for-tracing!", reset_future_logs_for_tracking, 0, 0, newenv);
+  GLOBAL_PRIM_W_ARITY("mark-future-trace-end!", mark_future_trace_end, 0, 0, newenv);
 
   scheme_finish_primitive_module(newenv);
   scheme_protect_primitive_provide(newenv, NULL);
@@ -985,7 +994,7 @@ static Scheme_Object *reset_future_logs_for_tracking(int argc, Scheme_Object **a
 
   }
 
-  return logger;
+  return scheme_void;
 }
 
 static double get_future_timestamp() XFORM_SKIP_PROC {
@@ -1111,6 +1120,22 @@ static void log_future_event(Scheme_Future_State *fs,
 
 }
 
+static Scheme_Object *mark_future_trace_end(int argc, Scheme_Object **argv) 
+{
+  Scheme_Future_State *fs;
+  fs = scheme_future_state;
+  log_future_event(fs,
+                   "future %d, process %d: %s: %s; time: %f",
+                   "tracing",
+                   -1, 
+                   FEVENT_STOP_TRACE, 
+                   get_future_timestamp(),
+                   0, 
+                   0);
+
+  return scheme_void;
+}
+
 static void log_overflow_event(Scheme_Future_State *fs, int which, double timestamp)
 {
   log_future_event(fs,

src/racket/src/schminc.h

@@ -17,7 +17,7 @@
 #define EXPECTED_PRIM_COUNT 1064
 #define EXPECTED_UNSAFE_COUNT 79
 #define EXPECTED_FLFXNUM_COUNT 69
-#define EXPECTED_FUTURES_COUNT 14
+#define EXPECTED_FUTURES_COUNT 15
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP