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

Change future visualizer trace collection slightly to be more composable

Browse Source 
(cherry picked from commit f0aaca0dde)
This commit is contained in:
James Swaine 2012-07-19 12:04:21 -05:00 committed by Ryan Culpepper
parent 57a4f9f2f3
commit a34b7ea3d9
7 changed files with 67 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/future-visualizer/main.rkt
View File

@ -4,7 +4,7 @@
racket/bool
future-visualizer/trace
"private/visualizer-gui.rkt"
"private/visualizer-drawing.rkt")
"private/visualizer-drawing.rkt")
(provide visualize-futures
(contract-out
@ -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)))

23
collects/future-visualizer/private/visualizer-data.rkt
View File

@ -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)
@ -163,22 +166,30 @@
(define recv #f)
;;start-future-tracing! -> void
(define (start-future-tracing!)
(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)
(define (timeline-events)
(define (timeline-events)
(define sorted (sort (timeline-events/private)
#:key future-event-time
<))

5
collects/future-visualizer/trace.rkt
View File

@ -5,13 +5,15 @@
(struct-out indexed-future-event)
trace-futures
(contract-out
[start-future-tracing! (-> void?)]
[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)))

8
collects/scribblings/reference/futures-trace.scrbl
View File

@ -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.
}

7
collects/scribblings/reference/futures-visualizer.scrbl
View File

@ -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
the visualizer will show data for all events logged in between (via @racket[timeline-events]).
it must be preceded by the following sequence: a call to @racket[start-future-tracing!],
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

37
src/racket/src/future.c
View File

@ -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);
@ -340,7 +346,8 @@ enum {
FEVENT_OVERFLOW,
FEVENT_TOUCH_PAUSE,
FEVENT_TOUCH_RESUME,
FEVENT_MISSING,
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,

2
src/racket/src/schminc.h
View File

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