diff --git a/collects/racket/future/private/visualizer-data.rkt b/collects/racket/future/private/visualizer-data.rkt index 6173815100..070d43d8e2 100644 --- a/collects/racket/future/private/visualizer-data.rkt +++ b/collects/racket/future/private/visualizer-data.rkt @@ -19,7 +19,10 @@ raw-log-output organize-output build-trace - event-has-duration? + event-has-duration? + touch-event? + allocation-event? + jitcompile-event? final-event? relative-time) @@ -107,6 +110,16 @@ [(start-work start-0-work) #t] [else #f])) +(define (touch-event? evt) + (equal? (event-prim-name evt) 'touch)) + +;;allocation-event? : event -> bool +(define (allocation-event? evt) + (equal? (event-prim-name evt) '|[allocate memory|)) + +(define (jitcompile-event? evt) + (equal? (event-prim-name evt) '|[jit_on_demand]|)) + ;;final-event? : event -> bool (define (final-event? evt) (case (event-timeline-position evt) diff --git a/collects/racket/future/private/visualizer-gui.rkt b/collects/racket/future/private/visualizer-gui.rkt index 2fad433552..cf854377ab 100644 --- a/collects/racket/future/private/visualizer-gui.rkt +++ b/collects/racket/future/private/visualizer-gui.rkt @@ -58,11 +58,13 @@ (event-start-time evt)))))] [(block sync) (when (= (event-proc-id evt) RT-THREAD-ID) - (send data-label1 set-label (format "Primitive: ~a" (symbol->string (event-prim-name evt))))) - (when (equal? (event-prim-name evt) 'touch) - (send data-label2 set-label (format "Touching future ~a" (event-user-data evt)))) - (when (equal? (event-prim-name evt) (string->symbol "[allocate memory]")) - (send data-label2 set-label (format "Size: ~a" (event-user-data evt))))] + (send data-label1 set-label (format "Primitive: ~a" (symbol->string (event-prim-name evt))))) + (define label2-txt (cond + [(touch-event? evt) (format "Touching future ~a" (event-user-data evt))] + [(allocation-event? evt) (format "Size: ~a" (event-user-data evt))] + [(jitcompile-event? evt) (format "Jitting: ~a" (event-user-data evt))] + [else ""])) + (send data-label2 set-label label2-txt)] [(create) (send data-label1 set-label (format "Creating future ~a" (event-user-data evt)))] [(touch) diff --git a/src/racket/src/future.c b/src/racket/src/future.c index 6249dc12da..59de44d19f 100644 --- a/src/racket/src/future.c +++ b/src/racket/src/future.c @@ -1061,14 +1061,14 @@ static void end_traversal(Fevent_Buffer *b) b->pos = 0; } -static void log_future_event_with_data(Scheme_Future_State *fs, +static void log_future_event(Scheme_Future_State *fs, const char *msg_str, const char *extra_str, int which, int what, double timestamp, int fid, - int user_data) + Scheme_Object *user_data) { Scheme_Object *data, *v; @@ -1093,7 +1093,10 @@ static void log_future_event_with_data(Scheme_Future_State *fs, ((Scheme_Structure *)data)->slots[4] = scheme_false; /* User data (target fid for creates, alloc amount for allocation */ - ((Scheme_Structure *)data)->slots[5] = scheme_make_integer(user_data); + if (!user_data) + user_data = scheme_false; + + ((Scheme_Structure *)data)->slots[5] = user_data; scheme_log_w_data(scheme_main_logger, SCHEME_LOG_DEBUG, 0, data, @@ -1106,24 +1109,6 @@ static void log_future_event_with_data(Scheme_Future_State *fs, } -static void log_future_event(Scheme_Future_State *fs, - const char *msg_str, - const char *extra_str, - int which, - int what, - double timestamp, - int fid) -{ - log_future_event_with_data(fs, - msg_str, - extra_str, - which, - what, - timestamp, - fid, - 0); -} - static void log_overflow_event(Scheme_Future_State *fs, int which, double timestamp) { log_future_event(fs, @@ -1132,7 +1117,8 @@ static void log_overflow_event(Scheme_Future_State *fs, int which, double timest which, FEVENT_MISSING, timestamp, - 0); + 0, + NULL); } static void flush_future_logs(Scheme_Future_State *fs) @@ -1141,6 +1127,7 @@ static void flush_future_logs(Scheme_Future_State *fs) double t, min_t; int i, min_which, min_set; Fevent_Buffer *b, *min_b; + Scheme_Object *data_val; if (scheme_log_level_p(scheme_main_logger, SCHEME_LOG_DEBUG)) { /* Hold lock while swapping buffers: */ @@ -1209,14 +1196,15 @@ static void flush_future_logs(Scheme_Future_State *fs) if (!min_b) break; - log_future_event_with_data(fs, + data_val = scheme_make_integer(min_b->a[min_b->i].data); + log_future_event(fs, "future %d, process %d: %s%s; time: %f", "", min_which, min_b->a[min_b->i].what, min_b->a[min_b->i].timestamp, min_b->a[min_b->i].fid, - min_b->a[min_b->i].data); + data_val); --min_b->count; min_b->i++; @@ -2084,14 +2072,16 @@ Scheme_Object *touch(int argc, Scheme_Object *argv[]) && ft->in_tracing_mode) { targ_ft = (future_t*)argv[0]; Scheme_Future_State *fs = scheme_future_state; - log_future_event_with_data( fs, - "future %d, process %d: %s: %s; time: %f", - "touch", - -1, - FEVENT_RTCALL_TOUCH, - get_future_timestamp(), - ft->id, - targ_ft->id); + Scheme_Object *targid_obj; + targid_obj = scheme_make_integer(targ_ft->id); + log_future_event(fs, + "future %d, process %d: %s: %s; time: %f", + "touch", + -1, + FEVENT_RTCALL_TOUCH, + get_future_timestamp(), + ft->id, + targid_obj); } return general_touch(argc, argv); @@ -3346,6 +3336,7 @@ static void do_invoke_rtcall(Scheme_Future_State *fs, future_t *future) if (scheme_log_level_p(scheme_main_logger, SCHEME_LOG_DEBUG)) { const char *src; + Scheme_Object *userdata; src = future->source_of_request; if (future->source_type == FSRC_RATOR) { @@ -3365,24 +3356,35 @@ static void do_invoke_rtcall(Scheme_Future_State *fs, future_t *future) flush_future_logs(fs); /* use lg_future_event so we can include `str' in the message: */ - if (future->prim_protocol == SIG_ALLOC) { - log_future_event_with_data(fs, - "future %d, process %d: %s: %s; time: %f", - src, - -1, - (future->rt_prim_is_atomic ? FEVENT_HANDLE_RTCALL_ATOMIC : FEVENT_HANDLE_RTCALL), - get_future_timestamp(), - future->id, - future->arg_i0); - } else { - log_future_event(fs, + userdata = NULL; + switch (future->prim_protocol) + { + case SIG_ALLOC: + { + userdata = scheme_make_integer(future->arg_i0); + break; + } + case SIG_ON_DEMAND: + { + /* Closure is first in runstack */ + GC_CAN_IGNORE Scheme_Object **rs = future->arg_S0; + ADJUST_RS_ARG(future, rs); + userdata = scheme_object_name(rs[0]); + if (!userdata) + userdata = scheme_intern_symbol("[unknown]"); + + break; + } + } + + log_future_event(fs, "future %d, process %d: %s: %s; time: %f", src, -1, (future->rt_prim_is_atomic ? FEVENT_HANDLE_RTCALL_ATOMIC : FEVENT_HANDLE_RTCALL), get_future_timestamp(), - future->id); - } + future->id, + userdata); } if (((future->source_type == FSRC_RATOR) @@ -3398,11 +3400,10 @@ static void do_invoke_rtcall(Scheme_Future_State *fs, future_t *future) case SIG_ON_DEMAND: { GC_CAN_IGNORE Scheme_Object **arg_S0 = future->arg_S0; - future->arg_S0 = NULL; ADJUST_RS_ARG(future, arg_S0); - + scheme_on_demand_with_args(arg_S0, arg_S0, 2); future->retval_is_rs_plus_two = 1;