From e45d0ab9d8d3aa4a920110ac609f9c7e6e1ad45f Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 4 Feb 2020 17:36:51 -0700 Subject: [PATCH] add 'GC:major logging Racket CS already had a form of 'GC:major logging, but normalize it and add it to traditional Racket. --- .../scribblings/reference/memory.scrbl | 17 ++++--- racket/src/cs/main.sps | 42 ++++++++--------- racket/src/racket/src/error.c | 45 ++++++++++++------- racket/src/racket/src/schemef.h | 1 + racket/src/racket/src/thread.c | 41 ++++++++++++++--- 5 files changed, 96 insertions(+), 50 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/memory.scrbl b/pkgs/racket-doc/scribblings/reference/memory.scrbl index b1cc902b4e..b7b39d05bd 100644 --- a/pkgs/racket-doc/scribblings/reference/memory.scrbl +++ b/pkgs/racket-doc/scribblings/reference/memory.scrbl @@ -220,12 +220,14 @@ request incremental mode at all times, but calling @racket[(collect-garbage 'incremental)] in a program with a periodic task is generally a better mechanism for requesting incremental mode. -In Racket 3m (the main variant of Racket), each garbage collection -logs a message (see @secref["logging"]) at the @racket['debug] level with topic @racket['GC]. -The data portion of the message is an instance of a @indexed-racket[gc-info] -@tech{prefab} structure type with 10 fields as follows, but future -versions of Racket may use a @racket[gc-info] @tech{prefab} structure -with additional fields: +Each garbage collection logs a message (see @secref["logging"]) at the +@racket['debug] level with topic @racket['GC]. In Racket 3m and CS +variants of Racket, ``major'' collections are also logged at the +@racket['debug] level with the topic @racket['GC:major]. In Racket 3m +and CS variants of Racket, the data portion of the message is an +instance of a @indexed-racket[gc-info] @tech{prefab} structure type +with 10 fields as follows, but future versions of Racket may use a +@racket[gc-info] @tech{prefab} structure with additional fields: @racketblock[ (struct gc-info (mode pre-amount pre-admin-amount code-amount @@ -315,7 +317,8 @@ collection mode, the text has the format @elem{Processor time since startup of garbage collection's start})) ]} -@history[#:changed "6.3.0.7" @elem{Added @envvar{PLT_INCREMENTAL_GC}.}] +@history[#:changed "6.3.0.7" @elem{Added @envvar{PLT_INCREMENTAL_GC}.} + #:changed "7.6.09" @elem{Added major-collection logging for the topic @racket['GC:major].}] @defproc[(collect-garbage [request (or/c 'major 'minor 'incremental) 'major]) void?]{ diff --git a/racket/src/cs/main.sps b/racket/src/cs/main.sps index 9c8d81f3f7..c3183e2ded 100644 --- a/racket/src/cs/main.sps +++ b/racket/src/cs/main.sps @@ -641,10 +641,10 @@ (set! minor-gcs (add1 minor-gcs)) (set! major-gcs (add1 major-gcs))) (set! peak-mem (max peak-mem pre-allocated)) - (let ([debug-GC? (log-level?* root-logger 'debug 'GC)]) - (when (or debug-GC? - (and (not minor?) - (log-level?* root-logger 'debug 'GC:major))) + (let ([debug-GC? (log-level?* root-logger 'debug 'GC)] + [debug-GC:major? (and (not minor?) + (log-level?* root-logger 'debug 'GC:major))]) + (when (or debug-GC? debug-GC:major?) (let ([delta (- pre-allocated post-allocated)] [account-str (let ([proper (if (= post-cpu-time pre-cpu-time) 100 @@ -653,22 +653,24 @@ (if (fx>= proper 99) "" (string-append "[" (number->string (fx- 100 proper)) "%]")))]) - (log-message* root-logger 'debug (if debug-GC? 'GC 'GC:major) - (chez:format "GC: 0:~a~a @ ~a(~a); free ~a(~a) ~ams~a @ ~a" - (if minor? "min" "MAJ") gen - (K "" pre-allocated) (K "+" (- pre-allocated+overhead pre-allocated)) - (K "" delta) (K "+" (- (- pre-allocated+overhead post-allocated+overhead) - delta)) - (- post-cpu-time pre-cpu-time) - account-str - pre-cpu-time) - (make-gc-info (if minor? 'minor 'major) pre-allocated pre-allocated+overhead 0 - post-allocated post-allocated+overhead - pre-cpu-time post-cpu-time - pre-time post-time) - #f - ;; in interrupt: - #t))))))))) + (let ([msg (chez:format "GC: 0:~a~a @ ~a(~a); free ~a(~a) ~ams~a @ ~a" + (if minor? "min" "MAJ") gen + (K "" pre-allocated) (K "+" (- pre-allocated+overhead pre-allocated)) + (K "" delta) (K "+" (- (- pre-allocated+overhead post-allocated+overhead) + delta)) + (- post-cpu-time pre-cpu-time) + account-str + pre-cpu-time)] + [data (make-gc-info (if minor? 'minor 'major) pre-allocated pre-allocated+overhead 0 + post-allocated post-allocated+overhead + pre-cpu-time post-cpu-time + pre-time post-time)] + [in-interrupt? #t]) + (when debug-GC? + (log-message* root-logger 'debug 'GC msg data #f in-interrupt?)) + (when debug-GC:major? + (log-message* root-logger 'debug 'GC:major msg data #f in-interrupt?))))))))))) + (seq (exit-handler (let ([orig (exit-handler)] diff --git a/racket/src/racket/src/error.c b/racket/src/racket/src/error.c index 84198b3d8f..b2f09b417a 100644 --- a/racket/src/racket/src/error.c +++ b/racket/src/racket/src/error.c @@ -1159,20 +1159,6 @@ void scheme_log_w_data(Scheme_Logger *logger, int level, int flags, scheme_log_message(logger, level, buffer, len, data); } -int scheme_log_level_p(Scheme_Logger *logger, int level) -{ - if (!logger) { - Scheme_Config *config; - config = scheme_current_config(); - logger = (Scheme_Logger *)scheme_get_param(config, MZCONFIG_LOGGER); - } - - if (logger->local_timestamp < SCHEME_INT_VAL(logger->root_timestamp[0])) - update_want_level(logger, NULL); - - return (logger->want_level >= level); -} - static char *error_write_to_string_w_max(Scheme_Object *v, int len, intptr_t *lenout) { Scheme_Object *o, *args[2]; @@ -3658,6 +3644,33 @@ static int get_want_level(Scheme_Logger *logger, Scheme_Object *name) } } +int scheme_log_level_topic_p(Scheme_Logger *logger, int level, Scheme_Object *name) +{ + if (!logger) { + Scheme_Config *config; + config = scheme_current_config(); + logger = (Scheme_Logger *)scheme_get_param(config, MZCONFIG_LOGGER); + } + + if (!name) { + if (logger->local_timestamp < SCHEME_INT_VAL(logger->root_timestamp[0])) + update_want_level(logger, NULL); + + return (logger->want_level >= level); + } else { + int want_level; + + want_level = get_want_level(logger, name); + + return (want_level >= level); + } +} + +int scheme_log_level_p(Scheme_Logger *logger, int level) +{ + return scheme_log_level_topic_p(logger, level, NULL); +} + Scheme_Object *extract_all_levels(Scheme_Logger *logger) { Scheme_Hash_Table *names; @@ -3792,7 +3805,7 @@ void scheme_log_name_pfx_message(Scheme_Logger *logger, int level, Scheme_Object } if (extract_spec_level(logger->stderr_level, name) >= level) { - if (name) { + if (name && prefix_msg) { intptr_t slen; slen = SCHEME_SYM_LEN(name); fwrite(SCHEME_SYM_VAL(name), slen, 1, stderr); @@ -3803,7 +3816,7 @@ void scheme_log_name_pfx_message(Scheme_Logger *logger, int level, Scheme_Object } if (extract_spec_level(logger->stdout_level, name) >= level) { - if (name) { + if (name && prefix_msg) { intptr_t slen; slen = SCHEME_SYM_LEN(name); fwrite(SCHEME_SYM_VAL(name), slen, 1, stdout); diff --git a/racket/src/racket/src/schemef.h b/racket/src/racket/src/schemef.h index 425ef4e2eb..bd7a4bd0d9 100644 --- a/racket/src/racket/src/schemef.h +++ b/racket/src/racket/src/schemef.h @@ -204,6 +204,7 @@ MZ_EXTERN void scheme_warning(char *msg, ...); MZ_EXTERN void scheme_raise(Scheme_Object *exn); MZ_EXTERN int scheme_log_level_p(Scheme_Logger *logger, int level); +MZ_EXTERN int scheme_log_level_topic_p(Scheme_Logger *logger, int level, Scheme_Object *name); MZ_EXTERN void scheme_log(Scheme_Logger *logger, int level, int flags, const char *msg, ...); MZ_EXTERN void scheme_log_w_data(Scheme_Logger *logger, int level, int flags, diff --git a/racket/src/racket/src/thread.c b/racket/src/racket/src/thread.c index 5b6ab7adbc..dd4e01a6ad 100644 --- a/racket/src/racket/src/thread.c +++ b/racket/src/racket/src/thread.c @@ -180,6 +180,7 @@ ROSYM static Scheme_Object *read_symbol, *write_symbol, *execute_symbol, *delete ROSYM static Scheme_Object *client_symbol, *server_symbol; ROSYM static Scheme_Object *major_symbol, *minor_symbol, *incremental_symbol; ROSYM static Scheme_Object *cumulative_symbol; +ROSYM static Scheme_Object *gc_symbol, *gc_major_symbol; ROSYM static Scheme_Object *racket_symbol; THREAD_LOCAL_DECL(static int do_atomic = 0); @@ -513,6 +514,11 @@ void scheme_init_thread(Scheme_Startup_Env *env) REGISTER_SO(cumulative_symbol); cumulative_symbol = scheme_intern_symbol("cumulative"); + REGISTER_SO(gc_symbol); + REGISTER_SO(gc_major_symbol); + gc_symbol = scheme_intern_symbol("GC"); + gc_major_symbol = scheme_intern_symbol("GC:major"); + REGISTER_SO(racket_symbol); racket_symbol = scheme_intern_symbol("racket"); @@ -9406,6 +9412,7 @@ static void inform_GC(int master_gc, int major_gc, int inc_gc, intptr_t post_child_places_used) { Scheme_Logger *logger; + int debug_gc = 0, debug_gc_major = 0; if (!master_gc) { if ((pre_used > max_gc_pre_used_bytes) @@ -9421,7 +9428,12 @@ static void inform_GC(int master_gc, int major_gc, int inc_gc, num_minor_garbage_collections++; logger = scheme_get_gc_logger(); - if (logger && scheme_log_level_p(logger, SCHEME_LOG_DEBUG)) { + if (logger && scheme_log_level_topic_p(logger, SCHEME_LOG_DEBUG, gc_symbol)) + debug_gc = 1; + if (logger && major_gc && scheme_log_level_topic_p(logger, SCHEME_LOG_DEBUG, gc_major_symbol)) + debug_gc_major = 1; + + if (debug_gc || debug_gc_major) { /* Don't use scheme_log(), because it wants to allocate a buffer based on the max value-print width, and we may not be at a point where parameters are available. */ @@ -9464,7 +9476,7 @@ static void inform_GC(int master_gc, int major_gc, int inc_gc, delta = pre_used - post_used; admin_delta = (pre_admin - post_admin) - delta; sprintf(buf, - "" PLACE_ID_FORMAT "%s @ %sK(+%sK)[+%sK];" + "GC: " PLACE_ID_FORMAT "%s @ %sK(+%sK)[+%sK];" " free %sK(%s%sK) %" PRIdPTR "ms @ %" PRIdPTR, #ifdef MZ_USE_PLACES scheme_current_place_id, @@ -9479,7 +9491,10 @@ static void inform_GC(int master_gc, int major_gc, int inc_gc, END_XFORM_SKIP; - scheme_log_message(logger, SCHEME_LOG_DEBUG, buf, buflen, vec); + if (debug_gc) + scheme_log_name_pfx_message(logger, SCHEME_LOG_DEBUG, gc_symbol, buf, buflen, vec, 0); + if (debug_gc_major) + scheme_log_name_pfx_message(logger, SCHEME_LOG_DEBUG, gc_major_symbol, buf, buflen, vec, 0); } #ifdef MZ_USE_PLACES @@ -9491,10 +9506,17 @@ static void inform_GC(int master_gc, int major_gc, int inc_gc, static void log_peak_memory_use() { - Scheme_Logger *logger; if (max_gc_pre_used_bytes > 0) { + Scheme_Logger *logger; + int debug_gc = 0, debug_gc_major = 0; + logger = scheme_get_gc_logger(); - if (logger && scheme_log_level_p(logger, SCHEME_LOG_INFO)) { + if (logger && scheme_log_level_topic_p(logger, SCHEME_LOG_INFO, gc_symbol)) + debug_gc = 1; + if (logger && scheme_log_level_topic_p(logger, SCHEME_LOG_INFO, gc_major_symbol)) + debug_gc_major = 1; + + if (debug_gc || debug_gc_major) { char buf[256], nums[128], *num, *numc, *numt, *num2; intptr_t buflen, allocated_bytes; #ifdef MZ_PRECISE_GC @@ -9508,7 +9530,7 @@ static void log_peak_memory_use() numt = gc_num(nums, allocated_bytes); num2 = gc_unscaled_num(nums, scheme_total_gc_time); sprintf(buf, - "" PLACE_ID_FORMAT "atexit peak %sK[+%sK]; alloc %sK; major %d; minor %d; %sms", + "GC: " PLACE_ID_FORMAT "atexit peak %sK[+%sK]; alloc %sK; major %d; minor %d; %sms", #ifdef MZ_USE_PLACES scheme_current_place_id, #endif @@ -9519,7 +9541,12 @@ static void log_peak_memory_use() num_minor_garbage_collections, num2); buflen = strlen(buf); - scheme_log_message(logger, SCHEME_LOG_INFO, buf, buflen, scheme_false); + + if (debug_gc) + scheme_log_name_pfx_message(logger, SCHEME_LOG_INFO, gc_symbol, buf, buflen, scheme_false, 0); + if (debug_gc_major) + scheme_log_name_pfx_message(logger, SCHEME_LOG_INFO, gc_major_symbol, buf, buflen, scheme_false, 0); + /* Setting to a negative value ensures that we log the peak only once: */ max_gc_pre_used_bytes = -1; }