From f71d9c8d57630ca41e149e03305e678cc3e7fc0f Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 30 May 2011 12:00:19 +0000 Subject: [PATCH] 1.0.48.35: SB-EXT:GC-LOGFILE GENCGC only. (SETF SB-EXT:GC-LOGFILE) to a pathname starts logging before/after generation statistics there. Doing the same with NIL stops logging. --- NEWS | 2 ++ doc/manual/beyond-ansi.texinfo | 2 ++ package-data-list.lisp-expr | 1 + src/code/gc.lisp | 24 ++++++++++++++++++ src/runtime/gencgc.c | 55 +++++++++++++++++++++++++++++----------- version.lisp-expr | 2 +- 6 files changed, 70 insertions(+), 16 deletions(-) diff --git a/NEWS b/NEWS index aead0d4..399252a 100644 --- a/NEWS +++ b/NEWS @@ -32,6 +32,8 @@ changes relative to sbcl-1.0.48: standard input. * enhancement: MAKE-ALIEN-STRING provides an easy way to transport lisp strings to foreign memory. + * enhancement: (SETF GC-LOGFILE) allows logging garbage collections to + a file, making it easier to understand heap dynamics. * optimization: using a &REST argument only in APPLY or VALUES-LIST calls allows the compiler to automatically elide rest-list allocation so long as the call sites are in functions that the compiler knows cannot escape. diff --git a/doc/manual/beyond-ansi.texinfo b/doc/manual/beyond-ansi.texinfo index 224a1f7..9e9f5db 100644 --- a/doc/manual/beyond-ansi.texinfo +++ b/doc/manual/beyond-ansi.texinfo @@ -57,6 +57,8 @@ Extensions}. @include var-sb-ext-star-gc-run-time-star.texinfo @include fun-sb-ext-bytes-consed-between-gcs.texinfo +@include fun-sb-ext-setf-gc-logfile.texinfo +@include fun-sb-ext-gc-logfile.texinfo @include fun-sb-ext-generation-average-age.texinfo @include fun-sb-ext-generation-bytes-allocated.texinfo @include fun-sb-ext-generation-bytes-consed-between-gcs.texinfo diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index f821934..642edff 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -609,6 +609,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." "GENERATION-MINIMUM-AGE-BEFORE-GC" "GENERATION-NUMBER-OF-GCS" "GENERATION-NUMBER-OF-GCS-BEFORE-PROMOTION" + "GC-LOGFILE" ;; Stack allocation control "*STACK-ALLOCATE-DYNAMIC-EXTENT*" diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 042ab05..50226ab 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -156,6 +156,30 @@ run in any thread.") (defun gc-stop-the-world ()) (defun gc-start-the-world ())) +#!+gencgc +(progn + (sb!alien:define-alien-variable ("gc_logfile" %gc-logfile) (* char)) + (defun (setf gc-logfile) (pathname) + "Use PATHNAME to log garbage collections. If non-null, the +designated file is opened before and after each collection, and +generation statistics are appended to it. To stop writing the log, use +NIL as the pathname." + (let ((new (when pathname + (sb!alien:make-alien-string + (native-namestring (translate-logical-pathname pathname) + :as-file t)))) + (old %gc-logfile)) + (setf %gc-logfile new) + (when old + (sb!alien:free-alien old)))) + (defun gc-logfile () + "Return the name of the current GC logfile." + (let ((val %gc-logfile)) + (when val + (native-pathname (cast val c-string))))) + (declaim (inline dynamic-space-size)) + (defun dynamic-space-size () + (sb!alien:extern-alien "dynamic_space_size" sb!alien:unsigned-long))) ;;;; SUB-GC diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 288e968..972697c 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -433,10 +433,8 @@ generation_average_age(generation_index_t gen) / ((double)generations[gen].bytes_allocated); } -/* The verbose argument controls how much to print: 0 for normal - * level of detail; 1 for debugging. */ extern void -print_generation_stats() /* FIXME: should take FILE argument, or construct a string */ +write_generation_stats(FILE *file) { generation_index_t i; @@ -453,7 +451,7 @@ print_generation_stats() /* FIXME: should take FILE argument, or construct a str fpu_save(fpu_state); /* Print the heap stats. */ - fprintf(stderr, + fprintf(file, " Gen StaPg UbSta LaSta LUbSt Boxed Unboxed LB LUB !move Alloc Waste Trig WP GCs Mem-age\n"); for (i = 0; i < SCRATCH_GENERATION; i++) { @@ -488,7 +486,7 @@ print_generation_stats() /* FIXME: should take FILE argument, or construct a str gc_assert(generations[i].bytes_allocated == count_generation_bytes_allocated(i)); - fprintf(stderr, + fprintf(file, " %1d: %5ld %5ld %5ld %5ld %5ld %5ld %5ld %5ld %5ld %8ld %5ld %8ld %4ld %3d %7.4f\n", i, generations[i].alloc_start_page, @@ -508,11 +506,36 @@ print_generation_stats() /* FIXME: should take FILE argument, or construct a str generations[i].num_gc, generation_average_age(i)); } - fprintf(stderr," Total bytes allocated = %lu\n", bytes_allocated); - fprintf(stderr," Dynamic-space-size bytes = %u\n", dynamic_space_size); + fprintf(file," Total bytes allocated = %lu\n", bytes_allocated); + fprintf(file," Dynamic-space-size bytes = %lu\n", (unsigned long)dynamic_space_size); fpu_restore(fpu_state); } + +extern void +print_generation_stats() +{ + write_generation_stats(stderr); +} + +extern char* gc_logfile; +char * gc_logfile = NULL; + +extern void +log_generation_stats(char *logfile, char *header) +{ + if (logfile) { + FILE * log = fopen(logfile, "a"); + if (log) { + fprintf(log, "%s\n", header); + write_generation_stats(log); + fclose(log); + } else { + fprintf(stderr, "Could not open gc logile: %s\n", gc_logfile); + fflush(stderr); + } + } +} #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) @@ -1165,15 +1188,15 @@ gc_heap_exhausted_error_or_lose (long available, long requested) gc_active_p ? "garbage collection" : "allocation", available, requested); print_generation_stats(); - fprintf(stderr, "GC control variables:\n"); - fprintf(stderr, " *GC-INHIBIT* = %s\n *GC-PENDING* = %s\n", - SymbolValue(GC_INHIBIT,thread)==NIL ? "false" : "true", - (SymbolValue(GC_PENDING, thread) == T) ? - "true" : ((SymbolValue(GC_PENDING, thread) == NIL) ? - "false" : "in progress")); + fprintf(stderr, "GC control variables:\n"); + fprintf(stderr, " *GC-INHIBIT* = %s\n *GC-PENDING* = %s\n", + SymbolValue(GC_INHIBIT,thread)==NIL ? "false" : "true", + (SymbolValue(GC_PENDING, thread) == T) ? + "true" : ((SymbolValue(GC_PENDING, thread) == NIL) ? + "false" : "in progress")); #ifdef LISP_FEATURE_SB_THREAD - fprintf(stderr, " *STOP-FOR-GC-PENDING* = %s\n", - SymbolValue(STOP_FOR_GC_PENDING,thread)==NIL ? "false" : "true"); + fprintf(stderr, " *STOP-FOR-GC-PENDING* = %s\n", + SymbolValue(STOP_FOR_GC_PENDING,thread)==NIL ? "false" : "true"); #endif if (gc_active_p || (available == 0)) { /* If we are in GC, or totally out of memory there is no way @@ -4259,6 +4282,7 @@ collect_garbage(generation_index_t last_gen) static page_index_t high_water_mark = 0; FSHOW((stderr, "/entering collect_garbage(%d)\n", last_gen)); + log_generation_stats(gc_logfile, "=== GC Start ==="); gc_active_p = 1; @@ -4383,6 +4407,7 @@ collect_garbage(generation_index_t last_gen) gc_active_p = 0; + log_generation_stats(gc_logfile, "=== GC End ==="); SHOW("returning from collect_garbage"); } diff --git a/version.lisp-expr b/version.lisp-expr index 3d414b0..f7ce6cf 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -20,4 +20,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.48.34" +"1.0.48.35" -- 1.7.10.4