(redisplay_window) <force-start case>:

[gnu-emacs] / src / alloc.c

diff --git a/src/alloc.c b/src/alloc.c
index 470cb9277bb25666de1548598219c9edf67e7cf9..8a487214479414311141418f6d243351fcb8c8ba 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -22,6 +22,10 @@ Boston, MA 02111-1307, USA.  */
 #include <config.h>
 #include <stdio.h>
 
+#ifdef ALLOC_DEBUG
+#undef INLINE
+#endif
+
 /* Note that this declares bzero on OSF/1.  How dumb.  */
 
 #include <signal.h>
@@ -422,23 +426,7 @@ static POINTER_TYPE *pure_alloc P_ ((size_t, int));
                                Malloc
  ************************************************************************/
 
-/* Write STR to Vstandard_output plus some advice on how to free some
-   memory.  Called when memory gets low.  */
-
-Lisp_Object
-malloc_warning_1 (str)
-     Lisp_Object str;
-{
-  Fprinc (str, Vstandard_output);
-  write_string ("\nKilling some buffers may delay running out of memory.\n", -1);
-  write_string ("However, certainly by the time you receive the 95% warning,\n", -1);
-  write_string ("you should clean up, kill this Emacs, and start a new one.", -1);
-  return Qnil;
-}
-
-
-/* Function malloc calls this if it finds we are near exhausting
-   storage.  */
+/* Function malloc calls this if it finds we are near exhausting storage.  */
 
 void
 malloc_warning (str)
@@ -448,16 +436,16 @@ malloc_warning (str)
 }
 
 
-/* Display a malloc warning in buffer *Danger*.  */
+/* Display an already-pending malloc warning.  */
 
 void
 display_malloc_warning ()
 {
-  register Lisp_Object val;
-
-  val = build_string (pending_malloc_warning);
+  call3 (intern ("display-warning"),
+        intern ("alloc"),
+        build_string (pending_malloc_warning),
+        intern ("emergency"));
   pending_malloc_warning = 0;
-  internal_with_output_to_temp_buffer (" *Danger*", malloc_warning_1, val);
 }
 
 
@@ -575,7 +563,7 @@ xfree (block)
 
 char *
 xstrdup (s)
-     char *s;
+     const char *s;
 {
   size_t len = strlen (s) + 1;
   char *p = (char *) xmalloc (len);
@@ -1757,7 +1745,7 @@ LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
 
 Lisp_Object
 make_string (contents, nbytes)
-     char *contents;
+     const char *contents;
      int nbytes;
 {
   register Lisp_Object val;
@@ -1778,7 +1766,7 @@ make_string (contents, nbytes)
 
 Lisp_Object
 make_unibyte_string (contents, length)
-     char *contents;
+     const char *contents;
      int length;
 {
   register Lisp_Object val;
@@ -1794,7 +1782,7 @@ make_unibyte_string (contents, length)
 
 Lisp_Object
 make_multibyte_string (contents, nchars, nbytes)
-     char *contents;
+     const char *contents;
      int nchars, nbytes;
 {
   register Lisp_Object val;
@@ -1845,7 +1833,7 @@ make_specified_string (contents, nchars, nbytes, multibyte)
 
 Lisp_Object
 build_string (str)
-     char *str;
+     const char *str;
 {
   return make_string (str, strlen (str));
 }
@@ -4427,6 +4415,12 @@ mark_image_cache (f)
 Lisp_Object *last_marked[LAST_MARKED_SIZE];
 int last_marked_index;
 
+/* For debugging--call abort when we cdr down this many
+   links of a list, in mark_object.  In debugging,
+   the call to abort will hit a breakpoint.
+   Normally this is zero and the check never goes off.  */
+int mark_object_loop_halt;
+
 void
 mark_object (argptr)
      Lisp_Object *argptr;
@@ -4437,6 +4431,7 @@ mark_object (argptr)
   void *po;
   struct mem_node *m;
 #endif
+  int cdr_count = 0;
 
  loop:
   obj = *objptr;
@@ -4790,10 +4785,14 @@ mark_object (argptr)
        if (EQ (ptr->cdr, Qnil))
          {
            objptr = &ptr->car;
+           cdr_count = 0;
            goto loop;
          }
        mark_object (&ptr->car);
        objptr = &ptr->cdr;
+       cdr_count++;
+       if (cdr_count == mark_object_loop_halt)
+         abort ();
        goto loop;
       }