Debugging facility to check whether 'const char *' points to

relocatable data of non-pure Lisp string.
* alloc.c (maybe_lisp_pointer): New function, refactored out of ...
(mark_maybe_pointer): ... adjusted user.
(relocatable_string_data_p): New function.
* lisp.h (relocatable_string_data_p): Add prototype.
* xdisp.c (message_with_string): If ENABLE_CHECKING, make sure
the pointer to relocatable Lisp data is not used.

4 files changed, 52 insertions, 11 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 6ecf7dbee99..a4f1cb7590a 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2014-05-30  Dmitry Antipov  <dmantipov@yandex.ru>
+
+        Debugging facility to check whether 'const char *' points to
+        relocatable data of non-pure Lisp string.
+        * alloc.c (maybe_lisp_pointer): New function, refactored out of ...
+        (mark_maybe_pointer): ... adjusted user.
+        (relocatable_string_data_p): New function.
+        * lisp.h (relocatable_string_data_p): Add prototype.
+        * xdisp.c (message_with_string): If ENABLE_CHECKING, make sure
+        the pointer to relocatable Lisp data is not used.
+
 2014-05-30  Paul Eggert  <eggert@cs.ucla.edu>
 
         Don't let SIGINT handling block SIGCHLD indefinitely (Bug#17561).
diff --git a/src/alloc.c b/src/alloc.c
index ab383f34f04..d728c356109 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -4547,7 +4547,16 @@ mark_maybe_object (Lisp_Object obj)
     }
 }
 
+/* Return true if P can point to Lisp data, and false otherwise.
+   USE_LSB_TAG needs Lisp data to be aligned on multiples of GCALIGNMENT.
+   Otherwise, assume that Lisp data is aligned on even addresses.  */
 
+static bool
+maybe_lisp_pointer (void *p)
+{
+  return !((intptr_t) p % (USE_LSB_TAG ? GCALIGNMENT : 2));
+}
+  
 /* If P points to Lisp data, mark that as live if it isn't already
    marked.  */
 
@@ -4561,10 +4570,7 @@ mark_maybe_pointer (void *p)
     VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p));
 #endif
 
-  /* Quickly rule out some values which can't point to Lisp data.
-     USE_LSB_TAG needs Lisp data to be aligned on multiples of GCALIGNMENT.
-     Otherwise, assume that Lisp data is aligned on even addresses.  */
-  if ((intptr_t) p % (USE_LSB_TAG ? GCALIGNMENT : 2))
+  if (!maybe_lisp_pointer (p))
     return;
 
   m = mem_find (p);
@@ -5007,9 +5013,34 @@ valid_lisp_object_p (Lisp_Object obj)
 #endif
 }
 
+/* If GC_MARK_STACK, return 1 if STR is a relocatable data of Lisp_String
+   (i.e. there is a non-pure Lisp_Object X so that SDATA (X) == STR) and 0
+   if not.  Otherwise we can't rely on valid_lisp_object_p and return -1.
+   This function is slow and should be used for debugging purposes.  */
 
+int
+relocatable_string_data_p (const char *str)
+{
+  if (PURE_POINTER_P (str))
+    return 0;
+#if GC_MARK_STACK  
+  if (str)
+    {
+      struct sdata *sdata
+        = (struct sdata *) (str - offsetof (struct sdata, data));
+
+      if (valid_pointer_p (sdata)
+          && valid_pointer_p (sdata->string)
+          && maybe_lisp_pointer (sdata->string))
+        return (valid_lisp_object_p
+                (make_lisp_ptr (sdata->string, Lisp_String))
+                && (const char *) sdata->string->data == str);
+    }
+  return 0;
+#endif /* GC_MARK_STACK */  
+  return -1;
+}
 
-
 /***********************************************************************
                        Pure Storage Management
  ***********************************************************************/
diff --git a/src/lisp.h b/src/lisp.h
index bbe2e4e9ce2..5002fa2a282 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3747,6 +3747,7 @@ extern void init_alloc (void);
 extern void syms_of_alloc (void);
 extern struct buffer * allocate_buffer (void);
 extern int valid_lisp_object_p (Lisp_Object);
+extern int relocatable_string_data_p (const char *);
 #ifdef GC_CHECK_CONS_LIST
 extern void check_cons_list (void);
 #else
diff --git a/src/xdisp.c b/src/xdisp.c
index 1585164f439..fbe87ed847a 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -10201,19 +10201,17 @@ message_with_string (const char *m, Lisp_Object string, int log)
     {
       if (m)
         {
-          /* ENCODE_SYSTEM below can GC and/or relocate the Lisp
-             String whose data pointer might be passed to us in M.  So
-             we use a local copy.  */
-          char *fmt = xstrdup (m);
+          /* ENCODE_SYSTEM below can GC and/or relocate the
+             Lisp data, so make sure we don't use it here.  */
+          eassert (relocatable_string_data_p (m) != 1);
 
           if (noninteractive_need_newline)
             putc ('\n', stderr);
           noninteractive_need_newline = 0;
-          fprintf (stderr, fmt, SDATA (ENCODE_SYSTEM (string)));
+          fprintf (stderr, m, SDATA (ENCODE_SYSTEM (string)));
           if (!cursor_in_echo_area)
             fprintf (stderr, "\n");
           fflush (stderr);
-          xfree (fmt);
         }
     }
   else if (INTERACTIVE)