places: improve and extend logging of place-related events

pkgs/base/info.rkt

@@ -12,8 +12,10 @@
 
 (define collection 'multi)
 
-(define deps '("racket-lib"
-               ["racket" #:version "6.0.0.1"]))
+(define version "6.0.0.2")
+
+(define deps `("racket-lib"
+               ["racket" #:version ,version]))
 
 (define implies '(core))
 
@@ -21,4 +23,3 @@
 
 (define pkg-authors '(mflatt))
 
-(define version "6.0.0.1")

pkgs/racket-pkgs/racket-doc/scribblings/reference/futures-logging.scrbl

@@ -18,7 +18,7 @@ a data value that is an instance of a @racket[future-event]
 @tech{prefab} structure:
 
 @racketblock[
-(define-struct future-event (future-id proc-id action time)
+(struct future-event (future-id proc-id action time)
   #:prefab)
 ]
 
@@ -31,7 +31,7 @@ The @racket[proc-id] fields is an exact, non-negative integer that
 identifies a parallel process. Process 0 is the main Racket process,
 where all expressions other than future thunks evaluate.
 
-The @racket[time-id] field is an inexact number that represents time in
+The @racket[time] field is an inexact number that represents time in
 the same way as @racket[current-inexact-milliseconds].
 
 The @racket[action] field is a symbol:

pkgs/racket-pkgs/racket-doc/scribblings/reference/places-logging.scrbl

@@ -0,0 +1,52 @@
+#lang scribble/doc 
+@(require "mz.rkt" (for-label racket/place))
+
+@title[#:tag "place-logging"]{Places Logging}
+
+Place events are reported to a logger named @racket['place].
+In addition to its string message, each event logged for a place has
+a data value that is an instance of a @racket[place-event]
+@tech{prefab} structure:
+
+@racketblock[
+(struct place-event (place-id action value time)
+  #:prefab)
+]
+
+The @racket[place-id] field is an exact integer that identifies a
+place.
+
+The @racket[time] field is an inexact number that represents time in
+the same way as @racket[current-inexact-milliseconds].
+
+The @racket[action] field is a symbol:
+
+@itemlist[
+
+ @item{@racket['create]: a place was created. This event is logged in the
+       creating place, and the event's @racket[value] field has the
+       ID for the created place.}
+
+ @item{@racket['reap]: a place that was previously created in the
+       current place has exited (and that fact has been detected,
+       possibly via @racket[place-wait]). The event's @racket[value]
+       field has the ID for the exited place.}
+
+ @item{@racket['enter]: a place has started, logged within the started
+       place. The event's @racket[value] field has @racket[#f].}
+
+ @item{@racket['exit]: a place is exiting, logged within the exiting
+       place. The event's @racket[value] field has @racket[#f].}
+
+ @item{@racket['put]: a place-channel message has been sent. The
+       event's @racket[value] field is a positive exact integer that
+       approximates the message's size.}
+
+ @item{@racket['get]: a place-channel message has been received. The
+       event's @racket[value] field is a positive exact integer that
+       approximates the message's size.}
+
+]
+
+@history[#:changed "6.0.0.2" @elem{Added logging via @racket['place]
+         and @racket[place-event].}]

pkgs/racket-pkgs/racket-doc/scribblings/reference/places.scrbl

@@ -113,6 +113,9 @@ used: @racket[current-library-collection-paths],
 @racket[current-library-collection-links], and
 @racket[current-compiled-file-roots].
 
+@; ----------------------------------------
+
+@section[#:tag "places-api"]{Using Places}
 
 @defproc[(place-enabled?) boolean?]{
 
@@ -390,3 +393,5 @@ A distributed places note created with @racket[create-place-node]
 is an example of a @tech{place location}.}
 
 @;------------------------------------------------------------------------
+
+@include-section["places-logging.scrbl"]

pkgs/racket-pkgs/racket-test/tests/racket/place-log.rkt

@@ -0,0 +1,29 @@
+#lang racket/base
+(require racket/place
+         rackunit)
+
+(define-struct place-event (place-id what value time)
+    #:prefab)
+
+(define r (make-log-receiver (current-logger) 'debug 'place))
+
+(define (check-log kind [expected-value (void)])
+  (let ([v (vector-ref (sync r) 2)])
+    (check-equal? #t (place-event? v))
+    (check-equal? #t (exact-integer? (place-event-place-id v)))
+    (check-equal? kind (place-event-what v))
+    (unless (void? expected-value )
+      (check-equal? expected-value (place-event-value v)))
+    (place-event-value v)))
+
+(define-values (i o) (place-channel))
+
+(place-channel-put o 17)
+(void (check-log 'put))
+
+(check-equal? 17 (place-channel-get i))
+(void (check-log 'get))
+
+(void (place-wait (dynamic-place 'racket/base 'values)))
+(define v (check-log 'create))
+(void (check-log 'reap v))

racket/src/racket/include/schthread.h

@@ -279,6 +279,7 @@ typedef struct Thread_Local_Variables {
   struct Scheme_Logger *scheme_main_logger_;
   struct Scheme_Logger *scheme_gc_logger_;
   struct Scheme_Logger *scheme_future_logger_;
+  struct Scheme_Logger *scheme_place_logger_;
   int intdef_counter_;
   int builtin_ref_counter_;
   int env_uid_counter_;
@@ -313,6 +314,7 @@ typedef struct Thread_Local_Variables {
   double start_this_gc_real_time_;
   double end_this_gc_real_time_;
   struct Scheme_Struct_Type *gc_info_prefab_;
+  struct Scheme_Struct_Type *place_event_prefab_;
   volatile short delayed_break_ready_;
   struct Scheme_Thread *main_break_target_thread_;
   intptr_t scheme_code_page_total_;
@@ -660,6 +662,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define scheme_main_logger XOA (scheme_get_thread_local_variables()->scheme_main_logger_)
 #define scheme_gc_logger XOA (scheme_get_thread_local_variables()->scheme_gc_logger_)
 #define scheme_future_logger XOA (scheme_get_thread_local_variables()->scheme_future_logger_)
+#define scheme_place_logger XOA (scheme_get_thread_local_variables()->scheme_place_logger_)
 #define intdef_counter XOA (scheme_get_thread_local_variables()->intdef_counter_)
 #define builtin_ref_counter XOA (scheme_get_thread_local_variables()->builtin_ref_counter_)
 #define env_uid_counter XOA (scheme_get_thread_local_variables()->env_uid_counter_)
@@ -694,6 +697,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define start_this_gc_real_time XOA (scheme_get_thread_local_variables()->start_this_gc_real_time_)
 #define end_this_gc_real_time XOA (scheme_get_thread_local_variables()->end_this_gc_real_time_)
 #define gc_info_prefab XOA (scheme_get_thread_local_variables()->gc_info_prefab_)
+#define place_event_prefab XOA (scheme_get_thread_local_variables()->place_event_prefab_)
 #define delayed_break_ready XOA (scheme_get_thread_local_variables()->delayed_break_ready_)
 #define main_break_target_thread XOA (scheme_get_thread_local_variables()->main_break_target_thread_)
 #define scheme_code_page_total XOA (scheme_get_thread_local_variables()->scheme_code_page_total_)

racket/src/racket/src/error.c

@@ -60,6 +60,7 @@ SHARED_OK static Scheme_Object *init_stderr_level = scheme_make_integer(SCHEME_L
 THREAD_LOCAL_DECL(static Scheme_Logger *scheme_main_logger);
 THREAD_LOCAL_DECL(static Scheme_Logger *scheme_gc_logger);
 THREAD_LOCAL_DECL(static Scheme_Logger *scheme_future_logger);
+THREAD_LOCAL_DECL(static Scheme_Logger *scheme_place_logger);
 
 /* readonly globals */
 READ_ONLY const char *scheme_compile_stx_string = "compile";
@@ -795,6 +796,9 @@ void scheme_init_logger()
 
   REGISTER_SO(scheme_future_logger);
   scheme_future_logger = scheme_make_logger(scheme_main_logger, scheme_intern_symbol("future"));
+
+  REGISTER_SO(scheme_place_logger);
+  scheme_place_logger = scheme_make_logger(scheme_main_logger, scheme_intern_symbol("place"));
 }
 
 Scheme_Logger *scheme_get_main_logger() {
@@ -809,6 +813,10 @@ Scheme_Logger *scheme_get_future_logger() {
   return scheme_future_logger;
 }
 
+Scheme_Logger *scheme_get_place_logger() {
+  return scheme_place_logger;
+}
+
 void scheme_init_error_config(void)
 {
   scheme_set_root_param(MZCONFIG_EXIT_HANDLER, scheme_def_exit_proc);

racket/src/racket/src/future.c

@@ -1094,6 +1094,11 @@ static void log_future_event(Scheme_Future_State *fs,
                              Scheme_Object *user_data) 
 {
   Scheme_Object *data, *v;
+  Scheme_Logger *fl;
+
+  fl = scheme_get_future_logger();
+  if (!scheme_log_level_p(fl, SCHEME_LOG_DEBUG))
+    return;
 
   data = scheme_make_blank_prefab_struct_instance(fs->fevent_prefab);
   if (what == FEVENT_MISSING || fid == NO_FUTURE_ID)
@@ -1121,7 +1126,7 @@ static void log_future_event(Scheme_Future_State *fs,
 
   ((Scheme_Structure *)data)->slots[5] = user_data;
   
-  scheme_log_w_data(scheme_get_future_logger(), SCHEME_LOG_DEBUG, 0,
+  scheme_log_w_data(fl, SCHEME_LOG_DEBUG, 0,
                     data,                 
                     msg_str,
                     fid,

racket/src/racket/src/place.c

@@ -47,6 +47,7 @@ SHARED_OK mz_proc_thread *scheme_master_proc_thread;
 THREAD_LOCAL_DECL(static struct Scheme_Place_Object *place_object);
 THREAD_LOCAL_DECL(static Scheme_Place *all_child_places);
 THREAD_LOCAL_DECL(static uintptr_t force_gc_for_place_accounting);
+THREAD_LOCAL_DECL(static Scheme_Struct_Type *place_event_prefab);
 static Scheme_Object *scheme_place(int argc, Scheme_Object *args[]);
 static Scheme_Object *place_pumper_threads(int argc, Scheme_Object *args[]);
 static Scheme_Object *place_wait(int argc, Scheme_Object *args[]);
@@ -93,6 +94,7 @@ static Scheme_Object *places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab
 #endif
 
 static void places_prepare_direct(Scheme_Object *so);
+static void log_place_event(const char *what, const char *tag, int has_amount, intptr_t amount);
 
 # ifdef MZ_PRECISE_GC
 static void register_traversers(void);
@@ -155,6 +157,9 @@ void scheme_init_place(Scheme_Env *env)
 
 #ifdef MZ_USE_PLACES
   REGISTER_SO(all_child_places);
+  
+  REGISTER_SO(place_event_prefab);
+  place_event_prefab = scheme_lookup_prefab_type(scheme_intern_symbol("place-event"), 4);
 #endif
 }
 
@@ -217,6 +222,7 @@ typedef struct Place_Start_Data {
   intptr_t in;
   intptr_t out;
   intptr_t err;
+  Scheme_Object *new_id;
 } Place_Start_Data;
 
 static void null_out_runtime_globals() {
@@ -481,6 +487,8 @@ Scheme_Object *scheme_place(int argc, Scheme_Object *args[]) {
   mzrt_sema_destroy(ready);
   ready = NULL;
 
+  log_place_event("id %d: create %" PRIdPTR, "create", 1, place_data->place_obj->id);
+
   place_data->ready = NULL;
   place_data->place_obj = NULL;
 
@@ -535,6 +543,7 @@ static void do_place_kill(Scheme_Place *place)
 {
   Scheme_Place_Object *place_obj;
   intptr_t refcount;
+  int old_id;
 
   place_obj = place->place_obj;
 
@@ -567,10 +576,14 @@ static void do_place_kill(Scheme_Place *place)
   else
     all_child_places = place->next;
 
+  old_id = place_obj->id;
+
   if (!refcount) {
     destroy_place_object_locks(place_obj);
   }
   place->place_obj = NULL;
+
+  log_place_event("id %d: reap %" PRIdPTR, "reap", 1, old_id);
 }
 
 static int do_place_break(Scheme_Place *place, int kind) 
@@ -2368,6 +2381,36 @@ Scheme_Struct_Type *scheme_make_prefab_struct_type_in_master(Scheme_Object *base
 }
 #endif
 
+static void log_place_event(const char *what, const char *tag, int has_amount, intptr_t amount)
+{
+  int id;
+  Scheme_Logger *pl;
+  Scheme_Object *data, *tag_sym, *t;
+
+  pl = scheme_get_place_logger();
+  if (!scheme_log_level_p(pl, SCHEME_LOG_DEBUG))
+    return;
+
+  id = scheme_current_place_id;
+  tag_sym = scheme_intern_symbol(tag);
+
+  data = scheme_make_blank_prefab_struct_instance(place_event_prefab);
+  ((Scheme_Structure *)data)->slots[0] = scheme_make_integer(id);
+  ((Scheme_Structure *)data)->slots[1] = tag_sym;
+  ((Scheme_Structure *)data)->slots[2] = (has_amount 
+                                          ? scheme_make_integer(amount)
+                                          : scheme_false);
+  t = scheme_make_double(scheme_get_inexact_milliseconds());
+  ((Scheme_Structure *)data)->slots[3] = t;
+
+  if (has_amount)
+    scheme_log_w_data(pl, SCHEME_LOG_DEBUG, 0, data,
+                      what, id, amount);
+  else
+    scheme_log_w_data(pl, SCHEME_LOG_DEBUG, 0, data,
+                      what, id);
+}
+
 static void *place_start_proc(void *data_arg) {
   void *stack_base;
   void *rc;
@@ -2583,7 +2626,7 @@ static void terminate_current_place(Scheme_Object *result)
 
 static Scheme_Object *def_place_exit_handler_proc(int argc, Scheme_Object *argv[])
 {
-  scheme_log(NULL, SCHEME_LOG_DEBUG, 0, "place %d: exiting via (exit)", scheme_current_place_id);
+  log_place_event("id %d: exit (via `exit')", "exit", 0, 0);
 
   terminate_current_place(argv[0]);
 
@@ -2638,7 +2681,7 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
   mzrt_mutex_unlock(id_counter_mutex);
 
   mem_limit = SCHEME_INT_VAL(place_data->cust_limit);
-  
+
   /* scheme_make_thread behaves differently if the above global vars are not null */
   scheme_place_instance_init(stack_base, place_data->parent_gc, mem_limit);
 
@@ -2659,6 +2702,8 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
   place_object = place_obj;
   place_obj->refcount++;
 
+  place_obj->id = scheme_current_place_id;
+  
   {
     void *signal_handle;
     signal_handle = scheme_get_signal_handle();
@@ -2704,7 +2749,7 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
 
   scheme_set_root_param(MZCONFIG_EXIT_HANDLER, scheme_def_place_exit_proc);
 
-  scheme_log(NULL, SCHEME_LOG_DEBUG, 0, "place %d: started", scheme_current_place_id);
+  log_place_event("id %d: enter", "enter", 0, 0);
 
   if (do_embedded_load()) {
     Scheme_Thread * volatile p;
@@ -2735,7 +2780,7 @@ static void *place_start_proc_after_stack(void *data_arg, void *stack_base) {
     result = scheme_make_integer(1);
   }
 
-  scheme_log(NULL, SCHEME_LOG_DEBUG, 0, "place %d: exiting", scheme_current_place_id);
+  log_place_event("id %d: exit", "exit", 0, 0);
 
   terminate_current_place(result);
 
@@ -3200,6 +3245,12 @@ static void place_async_send(Scheme_Place_Async_Channel *ch, Scheme_Object *uo)
     maybe_report_message_size(ch);
   }
 
+  {
+    intptr_t msg_size;
+    msg_size = GC_message_allocator_size(msg_memory);
+    log_place_event("id %d: put message of %" PRIdPTR " bytes", "put", 1, msg_size);
+  }
+
   if (!cnt && ch->wakeup_signal) {
     /*wake up possibly sleeping single receiver */  
     if (SCHEME_PLACE_OBJECTP(ch->wakeup_signal)) {
@@ -3404,6 +3455,12 @@ static Scheme_Object *scheme_place_async_try_receive_raw(Scheme_Place_Async_Chan
     *_no_writers = 1;
   mzrt_mutex_unlock(ch->lock);
 
+  if (msg) {
+    intptr_t msg_size;
+    msg_size = GC_message_allocator_size(msg_memory);
+    log_place_event("id %d: get message of %" PRIdPTR " bytes", "get", 1, msg_size);
+  }
+
   *msg_memory_ptr = msg_memory;
   return msg;
 }

racket/src/racket/src/schpriv.h

@@ -362,6 +362,7 @@ void scheme_init_place_local_symbol_table(void);
 Scheme_Logger *scheme_get_main_logger(void);
 Scheme_Logger *scheme_get_gc_logger(void);
 Scheme_Logger *scheme_get_future_logger(void);
+Scheme_Logger *scheme_get_place_logger(void);
 void scheme_init_logger_config(void);
 
 void register_network_evts();
@@ -4124,6 +4125,7 @@ typedef struct Scheme_Place_Object {
   void *parent_signal_handle; /* set to NULL when the place terminates */
   intptr_t result; /* initialized to 1, reset when parent_signal_handle becomes NULL */
 
+  int id;
   intptr_t memory_use; /* set by inform hook on GC, used by GC for memory accounting */
   intptr_t prev_notify_memory_use; /* if memory_use > use_factor * prev_notify_memory_use, alert parent */
   double use_factor;

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "6.0.0.1"
+#define MZSCHEME_VERSION "6.0.0.2"
 
 #define MZSCHEME_VERSION_X 6
 #define MZSCHEME_VERSION_Y 0
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 1
+#define MZSCHEME_VERSION_W 2
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)