xemacs-beta: src/print.c comparison

comparison src/print.c @ 4847:05c519de7353

be more careful when printing to check for bad objects -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-01-13 Ben Wing <ben@xemacs.org> * print.c: * print.c (internal_object_printer): * print.c (enum printing_badness): * print.c (printing_major_badness): * print.c (print_internal): Clean up the part of the code that looks for things that might lead to crashing in the print code: -- Make the "badness" messages more consistent. -- Move the checks for circularities after the checks for bad memory, since the checks for circularities involve accessing memory (which could be bad). -- Add an extra check to see if the object's implementation structure is bad memory. -- Add extra check for object itself being a null pointer or implementation pointer being null. -- Add some extra comments to help in maintaining the code.

author	Ben Wing <ben@xemacs.org>
date	Wed, 13 Jan 2010 06:02:42 -0600
parents	a98ca4640147
children	ae81a2c00f4f

comparison

equal deleted inserted replaced

-:a98ca4640147
+:05c519de7353
 /* Lisp object printing and output streams.
 Copyright (C) 1985, 1986, 1988, 1992-1995 Free Software Foundation, Inc.
-Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2005 Ben Wing.
+Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2005, 2010 Ben Wing.
 This file is part of XEmacs.
 XEmacs is free software; you can redistribute it and/or modify it
 under the terms of the GNU General Public License as published by the
 void
 internal_object_printer (Lisp_Object obj, Lisp_Object printcharfun,
 			 int UNUSED (escapeflag))
 {
+/* Internal objects shouldn't normally escape to the Lisp level;
+that's why we say "XEmacs bug?".  This can happen, however, when
+printing backtraces. */
 write_fmt_string (printcharfun,
 		    "#<INTERNAL OBJECT (XEmacs bug?) (%s) 0x%lx>",
 		    XRECORD_LHEADER_IMPLEMENTATION (obj)->name,
 		    (unsigned long) XPNTR (obj));
 }
 enum printing_badness
 {
 BADNESS_INTEGER_OBJECT,
 BADNESS_POINTER_OBJECT,
+BADNESS_POINTER_OBJECT_WITH_DATA,
 BADNESS_NO_TYPE
 };
 static void
 printing_major_badness (Lisp_Object printcharfun,
 			const Ascbyte *badness_string, int type, void *val,
-			enum printing_badness badness)
+			void *val2, enum printing_badness badness)
 {
 Ibyte buf[666];
 switch (badness)
 {
 case BADNESS_INTEGER_OBJECT:
-qxesprintf (buf, "%s %d object %ld", badness_string, type,
+qxesprintf (buf, "%s type %d object %ld", badness_string, type,
 		  (EMACS_INT) val);
 break;
 case BADNESS_POINTER_OBJECT:
-qxesprintf (buf, "%s %d object %p", badness_string, type, val);
+qxesprintf (buf, "%s type %d object %p", badness_string, type, val);
+break;
+case BADNESS_POINTER_OBJECT_WITH_DATA:
+qxesprintf (buf, "%s type %d object %p data %p", badness_string, type,
+		  val, val2);
 break;
 case BADNESS_NO_TYPE:
 qxesprintf (buf, "%s object %p", badness_string, val);
 break;
 {
 #ifdef ERROR_CHECK_TYPES
 ABORT ();
 #else  /* not ERROR_CHECK_TYPES */
 if (print_readably)
-	signal_ferror (Qinternal_error, "printing %s", buf);
+	signal_ferror (Qinternal_error, "SERIOUS XEMACS BUG: printing %s; "
+		       "save your buffers immediately and please report "
+		       "this bug", buf);
 #endif /* not ERROR_CHECK_TYPES */
 }
 write_fmt_string (printcharfun,
-		    "#<EMACS BUG: %s Save your buffers immediately and "
+		    "#<SERIOUS XEMACS BUG: %s Save your buffers immediately "
-		    "please report this bug>", buf);
+		    "and please report this bug>", buf);
 }
 void
 print_internal (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 {
 if (gc_in_progress) return;
 #endif
 /* Just to be safe ... */
 GCPRO2 (obj, printcharfun);
+/* WARNING WARNING WARNING!!!  Don't put anything here that might
+dereference memory.  Instead, put it down inside of
+the case Lisp_Type_Record, after the appropriate checks to make sure
+we're not dereferencing bad memory.  The idea is that, ideally,
+calling debug_print() should *NEVER* make the program crash, even when
+something very bad has happened. --ben */
 #ifdef I18N3
 /* #### Both input and output streams should have a flag associated
 with them indicating whether output to that stream, or strings
 read from the stream, get translated using Fgettext().  Such a
 it creates.  This flag should also be user-settable.  Perhaps it
 should be split up into two flags, one for input and one for
 output. */
 #endif
-/* Detect circularities and truncate them.
-No need to offer any alternative--this is better than an error.  */
-if (CONSP (obj) || VECTORP (obj) || COMPILED_FUNCTIONP (obj))
-{
-int i;
-for (i = 0; i < print_depth; i++)
-	if (EQ (obj, being_printed[i]))
-	  {
-	    char buf[DECIMAL_PRINT_SIZE (long) + 1];
-	    *buf = '#';
-	    long_to_string (buf + 1, i);
-	    write_c_string (printcharfun, buf);
-	    UNGCPRO;
-	    return;
-	  }
-}
 being_printed[print_depth] = obj;
 /* Avoid calling internal_bind_int, which conses, when called from
 debug_prin1.  In that case, we have bound print_depth to 0 anyway. */
 if (!inhibit_non_essential_conversion_operations)
 {
 specdepth = internal_bind_int (&print_depth, print_depth + 1);
 if (print_depth > PRINT_CIRCLE)
-	signal_error (Qstack_overflow, "Apparently circular structure being printed", Qunbound);
+	signal_error (Qstack_overflow,
+		      "Apparently circular structure being printed", Qunbound);
 }
 switch (XTYPE (obj))
 {
 case Lisp_Type_Int_Even:
 case Lisp_Type_Record:
 {
 	struct lrecord_header *lheader = XRECORD_LHEADER (obj);
-	/* Try to check for various sorts of bogus pointers if we're in a
+	/* Try to check for various sorts of bogus pointers or bad memory
-	   situation where it may be likely -- i.e. called from
+	   if we're in a situation where it may be likely -- i.e. called
-	   debug_print() or we're already crashing.  In such cases,
+	   from debug_print() or we're already crashing.  In such cases,
-	   (further) crashing is counterproductive. */
+	   (further) crashing is counterproductive.
+	   We don't normally do these because they may be expensive or
+	   weird (e.g. under Unix we typically have to set a SIGSEGV
+	   handler and try to trigger a seg fault). */
+	if (!lheader)
+	  {
+	    /* i.e. EQ Qnull_pointer */
+	    printing_major_badness (printcharfun, "NULL POINTER LRECORD", 0,
+				    0, 0, BADNESS_NO_TYPE);
+	    break;
+	  }
+	/* First check to see if the lrecord header itself is garbage. */
 	if (inhibit_non_essential_conversion_operations &&
 	    !debug_can_access_memory (lheader, sizeof (*lheader)))
-	    {
+	  {
-	      write_fmt_string (printcharfun, "#<EMACS BUG: BAD MEMORY %p>",
+	    printing_major_badness (printcharfun,
-				lheader);
+				    "BAD MEMORY in LRECORD HEADER", 0,
+				    lheader, 0, BADNESS_NO_TYPE);
 	      break;
-	    }
-	if (CONSP (obj) || VECTORP (obj))
-	  {
-	    /* If deeper than spec'd depth, print placeholder.  */
-	    if (INTP (Vprint_level)
-		&& print_depth > XINT (Vprint_level))
-	      {
-		write_c_string (printcharfun, "...");
-		break;
-	      }
 	  }
+	/* Check to see if the lrecord type is garbage. */
 #ifndef NEW_GC
 	if (lheader->type == lrecord_type_free)
 	  {
-	    printing_major_badness (printcharfun, "freed lrecord", 0,
+	    printing_major_badness (printcharfun, "FREED LRECORD", 0,
-				    lheader, BADNESS_NO_TYPE);
+				    lheader, 0, BADNESS_NO_TYPE);
 	    break;
 	  }
-	else if (lheader->type == lrecord_type_undefined)
+	if (lheader->type == lrecord_type_undefined)
 	  {
-	    printing_major_badness (printcharfun, "lrecord_type_undefined", 0,
+	    printing_major_badness (printcharfun, "LRECORD_TYPE_UNDEFINED", 0,
-				    lheader, BADNESS_NO_TYPE);
+				    lheader, 0, BADNESS_NO_TYPE);
 	    break;
 	  }
 #endif /* not NEW_GC */
-	else if ((int) (lheader->type) >= lrecord_type_count)
+	if ((int) (lheader->type) >= lrecord_type_count)
 	  {
-	    printing_major_badness (printcharfun, "illegal lrecord type",
+	    printing_major_badness (printcharfun, "ILLEGAL LRECORD TYPE",
 				    (int) (lheader->type),
-				    lheader, BADNESS_POINTER_OBJECT);
+				    lheader, 0, BADNESS_POINTER_OBJECT);
 	    break;
 	  }
-	/* Further checks for bad memory in critical situations.  We don't
+	/* Check to see if the lrecord implementation is missing or garbage. */
-	   normally do these because they may be expensive or weird
+	{
-	   (e.g. under Unix we typically have to set a SIGSEGV handler and
+	  const struct lrecord_implementation *imp =
-	   try to trigger a seg fault). */
+	    LHEADER_IMPLEMENTATION (lheader);
+	  if (!imp)
+	    {
+	      printing_major_badness
+		(printcharfun, "NO IMPLEMENTATION FOR LRECORD TYPE",
+		 (int) (lheader->type),
+		 lheader, 0, BADNESS_POINTER_OBJECT);
+	      break;
+	    }
+	  if (inhibit_non_essential_conversion_operations)
+	    {
+	      if (!debug_can_access_memory (imp, sizeof (*imp)))
+		{
+		  printing_major_badness
+		    (printcharfun, "BAD MEMORY IN LRECORD IMPLEMENTATION",
+		     (int) (lheader->type),
+		     lheader, 0, BADNESS_POINTER_OBJECT);
+		}
+	    }
+	}
+	/* Check to see if any of the memory of the lrecord is inaccessible.
+	   Note that we already checked above to see if the first part of
+	   the lrecord (the header) is inaccessible, which will catch most
+	   cases of a totally bad pointer.  */
 	if (inhibit_non_essential_conversion_operations)
 	  {
 	    if (!debug_can_access_memory
 		(lheader, detagged_lisp_object_size (lheader)))
 	      {
-		write_fmt_string (printcharfun,
+		printing_major_badness (printcharfun,
-				  "#<EMACS BUG: type %s BAD MEMORY %p>",
+					"BAD MEMORY IN LRECORD",
-				  LHEADER_IMPLEMENTATION (lheader)->name,
+					(int) (lheader->type),
-				  lheader);
+					lheader, 0, BADNESS_POINTER_OBJECT);
 		break;
 	      }
+	    /* For strings, also check the data of the string itself. */
 	    if (STRINGP (obj))
 	      {
 #ifdef NEW_GC
 		if (!debug_can_access_memory (XSTRING_DATA (obj),
 					      XSTRING_LENGTH (obj)))
 		  }
 #else /* not NEW_GC */
 		Lisp_String *l = (Lisp_String *) lheader;
 		if (!debug_can_access_memory (l->data_, l->size_))
 		  {
-		    write_fmt_string
+		    printing_major_badness (printcharfun,
-		      (printcharfun,
+		       "BAD STRING DATA", (int) (lheader->type),
-		       "#<EMACS BUG: %p (BAD STRING DATA %p)>",
+					    lheader, l->data_,
-		       lheader, l->data_);
+					    BADNESS_POINTER_OBJECT_WITH_DATA);
 		    break;
 		  }
 #endif /* not NEW_GC */
+	      }
+	  }
+	/* Detect circularities and truncate them.
+	   No need to offer any alternative--this is better than an error.  */
+	if (CONSP (obj) || VECTORP (obj) || COMPILED_FUNCTIONP (obj))
+	  {
+	    int i;
+	    for (i = 0; i < print_depth - 1; i++)
+	      if (EQ (obj, being_printed[i]))
+		{
+		  Ascbyte buf[DECIMAL_PRINT_SIZE (long) + 1];
+		  *buf = '#';
+		  long_to_string (buf + 1, i);
+		  write_c_string (printcharfun, buf);
+		  break;
+		}
+	    if (i < print_depth - 1) /* Did we print something? */
+	      break;
+	  }
+	if (CONSP (obj) || VECTORP (obj))
+	  {
+	    /* If deeper than spec'd depth, print placeholder.  */
+	    if (INTP (Vprint_level)
+		&& print_depth > XINT (Vprint_level))
+	      {
+		write_c_string (printcharfun, "...");
+		break;
 	      }
 	  }
 	if (LHEADER_IMPLEMENTATION (lheader)->printer)
 	  ((LHEADER_IMPLEMENTATION (lheader)->printer)
 }
 default:
 {
 	/* We're in trouble if this happens! */
-	printing_major_badness (printcharfun, "illegal data type", XTYPE (obj),
+	printing_major_badness (printcharfun, "ILLEGAL LISP OBJECT TAG TYPE",
-				LISP_TO_VOID (obj), BADNESS_INTEGER_OBJECT);
+				XTYPE (obj), LISP_TO_VOID (obj), 0,
+				BADNESS_INTEGER_OBJECT);
 	break;
 }
 }
 if (!inhibit_non_essential_conversion_operations)

Mercurial > hg > xemacs-beta

comparison src/print.c @ 4847:05c519de7353