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.

diff --git a/NEWS b/NEWS
index aead0d4..399252a 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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)))
 \f
 ;;;; SUB-GC
 

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 288e968..972697c 100644 (file)
--- 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);
+        }
+    }
+}
 \f
 
 #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 (file)
--- 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"