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

cs: fix GC:major logging on exit

Browse Source 
Also, add `PLT_GCS_ON_EXIT` to force 2 major GCs on exit, which
is useful for checking peak and end memory use.
This commit is contained in:
Matthew Flatt 2020-02-15 09:11:44 -08:00
parent e63433c4fd
commit cdd0659438
2 changed files with 23 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
racket/src/cs/main.sps
View File

@ -676,17 +676,24 @@
(let ([orig (exit-handler)] (let ([orig (exit-handler)]
[root-logger (current-logger)]) [root-logger (current-logger)])
(lambda (v) (lambda (v)
(when (log-level? root-logger 'info 'GC) (when gcs-on-exit?
(log-message root-logger 'info 'GC (collect-garbage)
(chez:format "0:atexit peak ~a; alloc ~a; major ~a; minor ~a; ~ams" (collect-garbage))
(let ([debug-GC? (log-level?* root-logger 'debug 'GC)]
[debug-GC:major? (log-level?* root-logger 'debug 'GC:major)])
(when (or debug-GC? debug-GC:major?)
(let ([msg (chez:format "GC: 0:atexit peak ~a; alloc ~a; major ~a; minor ~a; ~ams"
(K "" peak-mem) (K "" peak-mem)
(K "" (- (+ (bytes-deallocated) (bytes-allocated)) (initial-bytes-allocated))) (K "" (- (+ (bytes-deallocated) (bytes-allocated)) (initial-bytes-allocated)))
major-gcs major-gcs
minor-gcs minor-gcs
(let ([t (sstats-gc-cpu (statistics))]) (let ([t (sstats-gc-cpu (statistics))])
(+ (* (time-second t) 1000) (+ (* (time-second t) 1000)
(quotient (time-nanosecond t) 1000000)))) (quotient (time-nanosecond t) 1000000))))])
#f)) (when debug-GC?
(log-message root-logger 'info 'GC msg #f #f))
(when debug-GC:major?
(log-message root-logger 'info 'GC:major msg #f #f)))))
(linklet-performance-report!) (linklet-performance-report!)
(|#%app| orig v))))) (|#%app| orig v)))))
@ -711,6 +718,8 @@
(parse-logging-spec "syslog" spec "in PLTSYSLOG environment variable" #f) (parse-logging-spec "syslog" spec "in PLTSYSLOG environment variable" #f)
'())))) '()))))
(define gcs-on-exit? (and (getenv "PLT_GCS_ON_EXIT")))
(define (initialize-place!) (define (initialize-place!)
(current-command-line-arguments remaining-command-line-arguments) (current-command-line-arguments remaining-command-line-arguments)
(use-compiled-file-paths compiled-file-paths) (use-compiled-file-paths compiled-file-paths)

9
racket/src/racket/src/thread.c
View File

@ -147,6 +147,7 @@ ROSYM Scheme_Object *scheme_break_enabled_key;
THREAD_LOCAL_DECL(static Scheme_Object *configuration_callback_cache[2]); THREAD_LOCAL_DECL(static Scheme_Object *configuration_callback_cache[2]);
static int gcs_on_exit;
THREAD_LOCAL_DECL(intptr_t scheme_total_gc_time); THREAD_LOCAL_DECL(intptr_t scheme_total_gc_time);
THREAD_LOCAL_DECL(static intptr_t start_this_gc_time); THREAD_LOCAL_DECL(static intptr_t start_this_gc_time);
THREAD_LOCAL_DECL(static intptr_t end_this_gc_time); THREAD_LOCAL_DECL(static intptr_t end_this_gc_time);
@ -617,6 +618,9 @@ void scheme_init_thread(Scheme_Startup_Env *env)
ADD_PRIM_W_ARITY("phantom-bytes?", phantom_bytes_p, 1, 1, env); ADD_PRIM_W_ARITY("phantom-bytes?", phantom_bytes_p, 1, 1, env);
ADD_PRIM_W_ARITY("make-phantom-bytes", make_phantom_bytes, 1, 1, env); ADD_PRIM_W_ARITY("make-phantom-bytes", make_phantom_bytes, 1, 1, env);
ADD_PRIM_W_ARITY("set-phantom-bytes!", set_phantom_bytes, 2, 2, env); ADD_PRIM_W_ARITY("set-phantom-bytes!", set_phantom_bytes, 2, 2, env);
if (scheme_getenv("PLT_GCS_ON_EXIT"))
gcs_on_exit = 1;
} }
void void
@ -1954,6 +1958,11 @@ void scheme_run_atexit_closers_on_all(Scheme_Exit_Closer_Func alt)
will have terminated everything else anyway. For a will have terminated everything else anyway. For a
polite exit, other threads can run. */ polite exit, other threads can run. */
if (gcs_on_exit) {
scheme_collect_garbage();
scheme_collect_garbage();
}
log_peak_memory_use(); log_peak_memory_use();
savebuf = scheme_current_thread->error_buf; savebuf = scheme_current_thread->error_buf;