changeset 4880:ae81a2c00f4f

try harder to avoid crashing when debug-printing -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-01-18 Ben Wing <ben@xemacs.org> * lisp.h: * print.c: New variable `in_debug_print'. * alloc.c: * alloc.c (free_managed_lcrecord): If gc_in_progress and in_debug_print, just return instead of crashing. This only happens when the programmer calls debug_print() or a variation inside of a debugger, and is probably already diagnosing a crash. * print.c (struct debug_bindings): * print.c (debug_prin1_exit): * print.c (debug_prin1): At entrance, record the old value of in_debug_print in the debug_bindings, set up an unwind-protect to restore the old value, and set in_debug_print to 1. In the unwind-protect, restore the old value.
author Ben Wing <ben@xemacs.org>
date Mon, 18 Jan 2010 06:05:21 -0600
parents c356806cc933
children a4322ac49e37 a47abe9c47f2
files src/ChangeLog src/alloc.c src/lisp.h src/print.c
diffstat 4 files changed, 40 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Sat Jan 16 06:50:01 2010 -0600
+++ b/src/ChangeLog	Mon Jan 18 06:05:21 2010 -0600
@@ -1,3 +1,25 @@
+2010-01-18  Ben Wing  <ben@xemacs.org>
+
+	* lisp.h:
+	* print.c:
+	New variable `in_debug_print'.
+	
+	* alloc.c:
+	* alloc.c (free_managed_lcrecord):
+	If gc_in_progress and in_debug_print, just return instead of
+	crashing. This only happens when the programmer calls debug_print()
+	or a variation inside of a debugger, and is probably already
+	diagnosing a crash.
+	
+	* print.c (struct debug_bindings):
+	* print.c (debug_prin1_exit):
+	* print.c (debug_prin1):
+	At entrance, record the old value of in_debug_print in the
+	debug_bindings, set up an unwind-protect to restore the old value,
+	and set in_debug_print to 1.  In the unwind-protect, restore the
+	old value.
+	
+
 2010-01-16  Ben Wing  <ben@xemacs.org>
 
 	* win32.c (mswindows_read_link_1):
--- a/src/alloc.c	Sat Jan 16 06:50:01 2010 -0600
+++ b/src/alloc.c	Mon Jan 18 06:05:21 2010 -0600
@@ -1,7 +1,7 @@
 /* Storage allocation and gc for XEmacs Lisp interpreter.
    Copyright (C) 1985-1998 Free Software Foundation, Inc.
    Copyright (C) 1995 Sun Microsystems, Inc.
-   Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005 Ben Wing.
+   Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005, 2010 Ben Wing.
 
 This file is part of XEmacs.
 
@@ -3117,6 +3117,14 @@
   const struct lrecord_implementation *implementation
     = LHEADER_IMPLEMENTATION (lheader);
 
+  /* If we try to debug-print during GC, we'll likely get a crash on the
+     following assert (called from Lstream_delete(), from prin1_to_string()).
+     Instead, just don't do anything.  Worst comes to worst, we have a
+     small memory leak -- and programs being debugged usually won't be
+     super long-lived afterwards, anyway. */
+  if (gc_in_progress && in_debug_print)
+    return;
+
   /* Finalizer methods may try to free objects within them, which typically
      won't be marked and thus are scheduled for demolition.  Putting them
      on the free list would be very bad, as we'd have xfree()d memory in
--- a/src/lisp.h	Sat Jan 16 06:50:01 2010 -0600
+++ b/src/lisp.h	Mon Jan 18 06:05:21 2010 -0600
@@ -5318,6 +5318,7 @@
 void ulong_to_bit_string (char *, unsigned long);
 extern int print_escape_newlines;
 extern MODULE_API int print_readably;
+extern int in_debug_print;
 Lisp_Object internal_with_output_to_temp_buffer (Lisp_Object,
 						 Lisp_Object (*) (Lisp_Object),
 						 Lisp_Object, Lisp_Object);
--- a/src/print.c	Sat Jan 16 06:50:01 2010 -0600
+++ b/src/print.c	Mon Jan 18 06:05:21 2010 -0600
@@ -114,6 +114,9 @@
 /* Force immediate output of all printed data.  Used for debugging. */
 int print_unbuffered;
 
+/* Non-zero if in debug-printing */
+int in_debug_print;
+
 FILE *termscript;	/* Stdio stream being used for copy of all output.  */
 
 static void write_string_to_alternate_debugging_output (const Ibyte *str,
@@ -127,6 +130,7 @@
   int print_depth;
   int print_readably;
   int print_unbuffered;
+  int in_debug_print;
   int gc_currently_forbidden;
   Lisp_Object Vprint_length;
   Lisp_Object Vprint_level;
@@ -2243,6 +2247,7 @@
   print_depth = bindings->print_depth;
   print_readably = bindings->print_readably;
   print_unbuffered = bindings->print_unbuffered;
+  in_debug_print = bindings->in_debug_print;
   gc_currently_forbidden = bindings->gc_currently_forbidden;
   Vprint_length = bindings->Vprint_length;
   Vprint_level = bindings->Vprint_level;
@@ -2270,6 +2275,7 @@
   bindings->print_depth = print_depth;
   bindings->print_readably = print_readably;
   bindings->print_unbuffered = print_unbuffered;
+  bindings->in_debug_print = in_debug_print;
   bindings->gc_currently_forbidden = gc_currently_forbidden;
   bindings->Vprint_length = Vprint_length;
   bindings->Vprint_level = Vprint_level;
@@ -2280,6 +2286,8 @@
   print_depth = 0;
   print_readably = debug_print_readably != -1 ? debug_print_readably : 0;
   print_unbuffered++;
+  in_debug_print = 1;
+  gc_currently_forbidden = 1;
   if (debug_print_length > 0)
     Vprint_length = make_int (debug_print_length);
   if (debug_print_level > 0)