+
+extern void
+write_heap_exhaustion_report(FILE *file, long available, long requested,
+ struct thread *thread)
+{
+ fprintf(file,
+ "Heap exhausted during %s: %ld bytes available, %ld requested.\n",
+ gc_active_p ? "garbage collection" : "allocation",
+ available,
+ requested);
+ write_generation_stats(file);
+ fprintf(file, "GC control variables:\n");
+ fprintf(file, " *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(file, " *STOP-FOR-GC-PENDING* = %s\n",
+ SymbolValue(STOP_FOR_GC_PENDING,thread)==NIL ? "false" : "true");
+#endif
+}
+
+extern void
+print_generation_stats(void)
+{
+ 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 logfile: %s\n", logfile);
+ fflush(stderr);
+ }
+ }
+}
+
+extern void
+report_heap_exhaustion(long available, long requested, struct thread *th)
+{
+ if (gc_logfile) {
+ FILE * log = fopen(gc_logfile, "a");
+ if (log) {
+ write_heap_exhaustion_report(log, available, requested, th);
+ fclose(log);
+ } else {
+ fprintf(stderr, "Could not open gc logfile: %s\n", gc_logfile);
+ fflush(stderr);
+ }
+ }
+ /* Always to stderr as well. */
+ write_heap_exhaustion_report(stderr, available, requested, th);
+}