2002-08-10 Andrew Choi <akochoi@shaw.ca>

[gnu-emacs] / src / alloc.c

diff --git a/src/alloc.c b/src/alloc.c
index 94ad4d59df719a0723fc520be20fca0d0939bc2b..1d7c9044c7cbfb2d500c820eadc3ebd446606969 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1,5 +1,5 @@
 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
 /* Storage allocation and gc for GNU Emacs Lisp interpreter.

-   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001
+   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001, 2002

       Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
       Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.


@@ -122,18 +122,18 @@ int consing_since_gc;
 
 /* Count the amount of consing of various sorts of space.  */
 
 
 /* Count the amount of consing of various sorts of space.  */
 

-int cons_cells_consed;
-int floats_consed;
-int vector_cells_consed;
-int symbols_consed;
-int string_chars_consed;
-int misc_objects_consed;
-int intervals_consed;
-int strings_consed;
+EMACS_INT cons_cells_consed;
+EMACS_INT floats_consed;
+EMACS_INT vector_cells_consed;
+EMACS_INT symbols_consed;
+EMACS_INT string_chars_consed;
+EMACS_INT misc_objects_consed;
+EMACS_INT intervals_consed;
+EMACS_INT strings_consed;

 
 /* Number of bytes of consing since GC before another GC should be done. */
 
 
 /* Number of bytes of consing since GC before another GC should be done. */
 

-int gc_cons_threshold;
+EMACS_INT gc_cons_threshold;

 
 /* Nonzero during GC.  */
 
 
 /* Nonzero during GC.  */
 


@@ -155,8 +155,8 @@ int malloc_sbrk_unused;
 
 /* Two limits controlling how much undo information to keep.  */
 
 
 /* Two limits controlling how much undo information to keep.  */
 

-int undo_limit;
-int undo_strong_limit;
+EMACS_INT undo_limit;
+EMACS_INT undo_strong_limit;

 
 /* Number of live and free conses etc.  */
 
 
 /* Number of live and free conses etc.  */
 


@@ -181,6 +181,10 @@ static int malloc_hysteresis;
 
 Lisp_Object Vpurify_flag;
 
 
 Lisp_Object Vpurify_flag;
 

+/* Non-nil means we are handling a memory-full error.  */
+
+Lisp_Object Vmemory_full;
+

 #ifndef HAVE_SHM
 
 /* Force it into data space! */
 #ifndef HAVE_SHM
 
 /* Force it into data space! */


@@ -215,7 +219,7 @@ static size_t pure_bytes_used_before_overflow;
 
 /* Index in pure at which next pure object will be allocated.. */
 
 
 /* Index in pure at which next pure object will be allocated.. */
 

-int pure_bytes_used;
+EMACS_INT pure_bytes_used;

 
 /* If nonzero, this is a warning delivered by malloc and not yet
    displayed.  */
 
 /* If nonzero, this is a warning delivered by malloc and not yet
    displayed.  */


@@ -224,7 +228,7 @@ char *pending_malloc_warning;
 
 /* Pre-computed signal argument for use when memory is exhausted.  */
 
 
 /* Pre-computed signal argument for use when memory is exhausted.  */
 

-Lisp_Object memory_signal_data;
+Lisp_Object Vmemory_signal_data;

 
 /* Maximum amount of C stack to save when a GC happens.  */
 
 
 /* Maximum amount of C stack to save when a GC happens.  */
 


@@ -396,7 +400,7 @@ struct gcpro *gcprolist;
 
 /* Addresses of staticpro'd variables.  */
 
 
 /* Addresses of staticpro'd variables.  */
 

-#define NSTATICS 1024
+#define NSTATICS 1280

 Lisp_Object *staticvec[NSTATICS] = {0};
 
 /* Index of next unused slot in staticvec.  */
 Lisp_Object *staticvec[NSTATICS] = {0};
 
 /* Index of next unused slot in staticvec.  */


@@ -469,6 +473,8 @@ display_malloc_warning ()
 void
 memory_full ()
 {
 void
 memory_full ()
 {

+  Vmemory_full = Qt;
+

 #ifndef SYSTEM_MALLOC
   bytes_used_when_full = BYTES_USED;
 #endif
 #ifndef SYSTEM_MALLOC
   bytes_used_when_full = BYTES_USED;
 #endif


@@ -483,7 +489,7 @@ memory_full ()
   /* This used to call error, but if we've run out of memory, we could
      get infinite recursion trying to build the string.  */
   while (1)
   /* This used to call error, but if we've run out of memory, we could
      get infinite recursion trying to build the string.  */
   while (1)

-    Fsignal (Qnil, memory_signal_data);
+    Fsignal (Qnil, Vmemory_signal_data);

 }
 
 
 }
 
 


@@ -503,10 +509,12 @@ buffer_memory_full ()
   memory_full ();
 #endif
 
   memory_full ();
 #endif
 

+  Vmemory_full = Qt;
+

   /* This used to call error, but if we've run out of memory, we could
      get infinite recursion trying to build the string.  */
   while (1)
   /* This used to call error, but if we've run out of memory, we could
      get infinite recursion trying to build the string.  */
   while (1)

-    Fsignal (Qerror, memory_signal_data);
+    Fsignal (Qnil, Vmemory_signal_data);

 }
 
 
 }
 
 


@@ -567,7 +575,7 @@ xfree (block)
 
 char *
 xstrdup (s)
 
 char *
 xstrdup (s)

-     char *s;
+     const char *s;

 {
   size_t len = strlen (s) + 1;
   char *p = (char *) xmalloc (len);
 {
   size_t len = strlen (s) + 1;
   char *p = (char *) xmalloc (len);


@@ -1020,7 +1028,7 @@ make_number (n)
 
 /* Lisp_Strings are allocated in string_block structures.  When a new
    string_block is allocated, all the Lisp_Strings it contains are
 
 /* Lisp_Strings are allocated in string_block structures.  When a new
    string_block is allocated, all the Lisp_Strings it contains are

-   added to a free-list stiing_free_list.  When a new Lisp_String is
+   added to a free-list string_free_list.  When a new Lisp_String is

    needed, it is taken from that list.  During the sweep phase of GC,
    string_blocks that are entirely free are freed, except two which
    we keep.
    needed, it is taken from that list.  During the sweep phase of GC,
    string_blocks that are entirely free are freed, except two which
    we keep.


@@ -1341,7 +1349,7 @@ allocate_string ()
 
 #ifdef GC_CHECK_STRING_BYTES
   if (!noninteractive
 
 #ifdef GC_CHECK_STRING_BYTES
   if (!noninteractive

-#ifdef macintosh
+#ifdef MAC_OS8

       && current_sblock
 #endif
      )
       && current_sblock
 #endif
      )


@@ -1676,8 +1684,8 @@ Both LENGTH and INIT must be numbers.  */)
     {
       nbytes = XINT (length);
       val = make_uninit_string (nbytes);
     {
       nbytes = XINT (length);
       val = make_uninit_string (nbytes);

-      p = XSTRING (val)->data;
-      end = p + XSTRING (val)->size;
+      p = SDATA (val);
+      end = p + SCHARS (val);

       while (p != end)
        *p++ = c;
     }
       while (p != end)
        *p++ = c;
     }


@@ -1688,7 +1696,7 @@ Both LENGTH and INIT must be numbers.  */)
 
       nbytes = len * XINT (length);
       val = make_uninit_multibyte_string (XINT (length), nbytes);
 
       nbytes = len * XINT (length);
       val = make_uninit_multibyte_string (XINT (length), nbytes);

-      p = XSTRING (val)->data;
+      p = SDATA (val);

       end = p + nbytes;
       while (p != end)
        {
       end = p + nbytes;
       while (p != end)
        {


@@ -1749,7 +1757,7 @@ LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
 
 Lisp_Object
 make_string (contents, nbytes)
 
 Lisp_Object
 make_string (contents, nbytes)

-     char *contents;
+     const char *contents;

      int nbytes;
 {
   register Lisp_Object val;
      int nbytes;
 {
   register Lisp_Object val;


@@ -1770,13 +1778,13 @@ make_string (contents, nbytes)
 
 Lisp_Object
 make_unibyte_string (contents, length)
 
 Lisp_Object
 make_unibyte_string (contents, length)

-     char *contents;
+     const char *contents;

      int length;
 {
   register Lisp_Object val;
   val = make_uninit_string (length);
      int length;
 {
   register Lisp_Object val;
   val = make_uninit_string (length);

-  bcopy (contents, XSTRING (val)->data, length);
-  SET_STRING_BYTES (XSTRING (val), -1);
+  bcopy (contents, SDATA (val), length);
+  STRING_SET_UNIBYTE (val);

   return val;
 }
 
   return val;
 }
 


@@ -1786,12 +1794,12 @@ make_unibyte_string (contents, length)
 
 Lisp_Object
 make_multibyte_string (contents, nchars, nbytes)
 
 Lisp_Object
 make_multibyte_string (contents, nchars, nbytes)

-     char *contents;
+     const char *contents;

      int nchars, nbytes;
 {
   register Lisp_Object val;
   val = make_uninit_multibyte_string (nchars, nbytes);
      int nchars, nbytes;
 {
   register Lisp_Object val;
   val = make_uninit_multibyte_string (nchars, nbytes);

-  bcopy (contents, XSTRING (val)->data, nbytes);
+  bcopy (contents, SDATA (val), nbytes);

   return val;
 }
 
   return val;
 }
 


@@ -1806,9 +1814,9 @@ make_string_from_bytes (contents, nchars, nbytes)
 {
   register Lisp_Object val;
   val = make_uninit_multibyte_string (nchars, nbytes);
 {
   register Lisp_Object val;
   val = make_uninit_multibyte_string (nchars, nbytes);

-  bcopy (contents, XSTRING (val)->data, nbytes);
-  if (STRING_BYTES (XSTRING (val)) == XSTRING (val)->size)
-    SET_STRING_BYTES (XSTRING (val), -1);
+  bcopy (contents, SDATA (val), nbytes);
+  if (SBYTES (val) == SCHARS (val))
+    STRING_SET_UNIBYTE (val);

   return val;
 }
 
   return val;
 }
 


@@ -1825,9 +1833,9 @@ make_specified_string (contents, nchars, nbytes, multibyte)
 {
   register Lisp_Object val;
   val = make_uninit_multibyte_string (nchars, nbytes);
 {
   register Lisp_Object val;
   val = make_uninit_multibyte_string (nchars, nbytes);

-  bcopy (contents, XSTRING (val)->data, nbytes);
+  bcopy (contents, SDATA (val), nbytes);

   if (!multibyte)
   if (!multibyte)

-    SET_STRING_BYTES (XSTRING (val), -1);
+    STRING_SET_UNIBYTE (val);

   return val;
 }
 
   return val;
 }
 


@@ -1837,7 +1845,7 @@ make_specified_string (contents, nchars, nbytes, multibyte)
 
 Lisp_Object
 build_string (str)
 
 Lisp_Object
 build_string (str)

-     char *str;
+     const char *str;

 {
   return make_string (str, strlen (str));
 }
 {
   return make_string (str, strlen (str));
 }


@@ -1852,7 +1860,7 @@ make_uninit_string (length)
 {
   Lisp_Object val;
   val = make_uninit_multibyte_string (length, length);
 {
   Lisp_Object val;
   val = make_uninit_multibyte_string (length, length);

-  SET_STRING_BYTES (XSTRING (val), -1);
+  STRING_SET_UNIBYTE (val);

   return val;
 }
 
   return val;
 }
 


@@ -2545,7 +2553,7 @@ Its value and function definition are void, and its property list is nil.  */)
     }
   
   p = XSYMBOL (val);
     }
   
   p = XSYMBOL (val);

-  p->name = XSTRING (name);
+  p->xname = name;

   p->plist = Qnil;
   p->value = Qunbound;
   p->function = Qunbound;
   p->plist = Qnil;
   p->value = Qunbound;
   p->function = Qunbound;


@@ -2693,10 +2701,10 @@ make_event_array (nargs, args)
     result = Fmake_string (make_number (nargs), make_number (0));
     for (i = 0; i < nargs; i++)
       {
     result = Fmake_string (make_number (nargs), make_number (0));
     for (i = 0; i < nargs; i++)
       {

-       XSTRING (result)->data[i] = XINT (args[i]);
+       SSET (result, i, XINT (args[i]));

        /* Move the meta bit to the right place for a string char.  */
        if (XINT (args[i]) & CHAR_META)
        /* Move the meta bit to the right place for a string char.  */
        if (XINT (args[i]) & CHAR_META)

-         XSTRING (result)->data[i] |= 0x80;
+         SSET (result, i, SREF (result, i) | 0x80);

       }
     
     return result;
       }
     
     return result;


@@ -2711,6 +2719,17 @@ make_event_array (nargs, args)
 
 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
 
 
 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
 

+/* Conservative C stack marking requires a method to identify possibly
+   live Lisp objects given a pointer value.  We do this by keeping
+   track of blocks of Lisp data that are allocated in a red-black tree
+   (see also the comment of mem_node which is the type of nodes in
+   that tree).  Function lisp_malloc adds information for an allocated
+   block to the red-black tree with calls to mem_insert, and function
+   lisp_free removes it with mem_delete.  Functions live_string_p etc
+   call mem_find to lookup information about a given pointer in the
+   tree, and use that to determine if the pointer points to a Lisp
+   object or not.  */
+

 /* Initialize this part of alloc.c.  */
 
 static void
 /* Initialize this part of alloc.c.  */
 
 static void


@@ -3574,7 +3593,7 @@ If you are a system-programmer, or can get the help of a local wizard\n\
 who is, please take a look at the function mark_stack in alloc.c, and\n\
 verify that the methods used are appropriate for your system.\n\
 \n\
 who is, please take a look at the function mark_stack in alloc.c, and\n\
 verify that the methods used are appropriate for your system.\n\
 \n\

-Please mail the result to <gerd@gnu.org>.\n\
+Please mail the result to <emacs-devel@gnu.org>.\n\

 "
 
 #define SETJMP_WILL_NOT_WORK "\
 "
 
 #define SETJMP_WILL_NOT_WORK "\


@@ -3586,7 +3605,7 @@ solution for your system.\n\
 \n\
 Please take a look at the function mark_stack in alloc.c, and\n\
 try to find a way to make it work on your system.\n\
 \n\
 Please take a look at the function mark_stack in alloc.c, and\n\
 try to find a way to make it work on your system.\n\

-Please mail the result to <gerd@gnu.org>.\n\
+Please mail the result to <emacs-devel@gnu.org>.\n\

 "
 
 
 "
 
 


@@ -3723,6 +3742,7 @@ dump_zombies ()
 static void
 mark_stack ()
 {
 static void
 mark_stack ()
 {

+  int i;

   jmp_buf j;
   volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
   void *end;
   jmp_buf j;
   volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
   void *end;


@@ -3758,17 +3778,11 @@ mark_stack ()
   /* This assumes that the stack is a contiguous region in memory.  If
      that's not the case, something has to be done here to iterate
      over the stack segments.  */
   /* This assumes that the stack is a contiguous region in memory.  If
      that's not the case, something has to be done here to iterate
      over the stack segments.  */

-#if GC_LISP_OBJECT_ALIGNMENT == 1
-  mark_memory (stack_base, end);
-  mark_memory ((char *) stack_base + 1, end);
-  mark_memory ((char *) stack_base + 2, end);
-  mark_memory ((char *) stack_base + 3, end);
-#elif GC_LISP_OBJECT_ALIGNMENT == 2
-  mark_memory (stack_base, end);
-  mark_memory ((char *) stack_base + 2, end);
-#else
-  mark_memory (stack_base, end);
+#ifndef GC_LISP_OBJECT_ALIGNMENT
+#define GC_LISP_OBJECT_ALIGNMENT sizeof (Lisp_Object)

 #endif
 #endif

+  for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT)
+    mark_memory ((char *) stack_base + i, end);

 
 #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
   check_gcpros ();
 
 #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
   check_gcpros ();


@@ -3816,8 +3830,11 @@ pure_alloc (size, type)
   
   if (pure_bytes_used + nbytes > pure_size)
     {
   
   if (pure_bytes_used + nbytes > pure_size)
     {

-      beg = purebeg = (char *) xmalloc (PURESIZE);
-      pure_size = PURESIZE;
+      /* Don't allocate a large amount here,
+        because it might get mmap'd and then its address
+        might not be usable.  */
+      beg = purebeg = (char *) xmalloc (10000);
+      pure_size = 10000;

       pure_bytes_used_before_overflow += pure_bytes_used;
       pure_bytes_used = 0;
     }
       pure_bytes_used_before_overflow += pure_bytes_used;
       pure_bytes_used = 0;
     }


@@ -3828,14 +3845,14 @@ pure_alloc (size, type)
 }
 
 
 }
 
 

-/* Signal an error if PURESIZE is too small.  */
+/* Print a warning if PURESIZE is too small.  */

 
 void
 check_pure_size ()
 {
   if (pure_bytes_used_before_overflow)
 
 void
 check_pure_size ()
 {
   if (pure_bytes_used_before_overflow)

-    error ("Pure Lisp storage overflow (approx. %d bytes needed)",
-          (int) (pure_bytes_used + pure_bytes_used_before_overflow));
+    message ("Pure Lisp storage overflow (approx. %d bytes needed)",
+            (int) (pure_bytes_used + pure_bytes_used_before_overflow));

 }
 
 
 }
 
 


@@ -3938,8 +3955,8 @@ Does not copy symbols.  Copies strings without text properties.  */)
   else if (FLOATP (obj))
     return make_pure_float (XFLOAT_DATA (obj));
   else if (STRINGP (obj))
   else if (FLOATP (obj))
     return make_pure_float (XFLOAT_DATA (obj));
   else if (STRINGP (obj))

-    return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size,
-                            STRING_BYTES (XSTRING (obj)),
+    return make_pure_string (SDATA (obj), SCHARS (obj),
+                            SBYTES (obj),

                             STRING_MULTIBYTE (obj));
   else if (COMPILEDP (obj) || VECTORP (obj))
     {
                             STRING_MULTIBYTE (obj));
   else if (COMPILEDP (obj) || VECTORP (obj))
     {


@@ -4011,8 +4028,10 @@ struct backtrace
 int
 inhibit_garbage_collection ()
 {
 int
 inhibit_garbage_collection ()
 {

-  int count = specpdl_ptr - specpdl;
-  specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM));
+  int count = SPECPDL_INDEX ();
+  int nbits = min (VALBITS, BITS_PER_INT);
+
+  specbind (Qgc_cons_threshold, make_number (((EMACS_INT) 1 << (nbits - 1)) - 1));

   return count;
 }
 
   return count;
 }
 


@@ -4037,7 +4056,7 @@ Garbage collection happens automatically if you cons more than
   register int i;
   int message_p;
   Lisp_Object total[8];
   register int i;
   int message_p;
   Lisp_Object total[8];

-  int count = BINDING_STACK_SIZE ();
+  int count = SPECPDL_INDEX ();

 
   /* Can't GC if pure storage overflowed because we can't determine
      if something is a pure object or not.  */
 
   /* Can't GC if pure storage overflowed because we can't determine
      if something is a pure object or not.  */


@@ -4096,6 +4115,24 @@ Garbage collection happens automatically if you cons more than
          nextb->undo_list 
            = truncate_undo_list (nextb->undo_list, undo_limit,
                                  undo_strong_limit);
          nextb->undo_list 
            = truncate_undo_list (nextb->undo_list, undo_limit,
                                  undo_strong_limit);

+
+       /* Shrink buffer gaps, but skip indirect and dead buffers.  */
+       if (nextb->base_buffer == 0 && !NILP (nextb->name))
+         {
+           /* If a buffer's gap size is more than 10% of the buffer
+              size, or larger than 2000 bytes, then shrink it
+              accordingly.  Keep a minimum size of 20 bytes.  */
+           int size = min (2000, max (20, (nextb->text->z_byte / 10)));
+
+           if (nextb->text->gap_size > size)
+             {
+               struct buffer *save_current = current_buffer;
+               current_buffer = nextb;
+               make_gap (-(nextb->text->gap_size - size));
+               current_buffer = save_current;
+             }
+         }
+

        nextb = nextb->next;
       }
   }
        nextb = nextb->next;
       }
   }


@@ -4390,6 +4427,12 @@ mark_image_cache (f)
 Lisp_Object *last_marked[LAST_MARKED_SIZE];
 int last_marked_index;
 
 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;
 void
 mark_object (argptr)
      Lisp_Object *argptr;


@@ -4400,6 +4443,7 @@ mark_object (argptr)
   void *po;
   struct mem_node *m;
 #endif
   void *po;
   struct mem_node *m;
 #endif

+  int cdr_count = 0;

 
  loop:
   obj = *objptr;
 
  loop:
   obj = *objptr;


@@ -4610,6 +4654,10 @@ mark_object (argptr)
          h->size |= ARRAY_MARK_FLAG;
 
          /* Mark contents.  */
          h->size |= ARRAY_MARK_FLAG;
 
          /* Mark contents.  */

+         /* Do not mark next_free or next_weak.
+            Being in the next_weak chain 
+            should not keep the hash table alive.
+            No need to mark `count' since it is an integer.  */

          mark_object (&h->test);
          mark_object (&h->weak);
          mark_object (&h->rehash_size);
          mark_object (&h->test);
          mark_object (&h->weak);
          mark_object (&h->rehash_size);


@@ -4657,9 +4705,9 @@ mark_object (argptr)
        mark_object (&ptr->function);
        mark_object (&ptr->plist);
 
        mark_object (&ptr->function);
        mark_object (&ptr->plist);
 

-       if (!PURE_POINTER_P (ptr->name))
-         MARK_STRING (ptr->name);
-       MARK_INTERVAL_TREE (ptr->name->intervals);
+       if (!PURE_POINTER_P (XSTRING (ptr->xname)))
+         MARK_STRING (XSTRING (ptr->xname));
+       MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname));

        
        /* Note that we do not mark the obarray of the symbol.
           It is safe not to do so because nothing accesses that
        
        /* Note that we do not mark the obarray of the symbol.
           It is safe not to do so because nothing accesses that


@@ -4749,10 +4797,14 @@ mark_object (argptr)
        if (EQ (ptr->cdr, Qnil))
          {
            objptr = &ptr->car;
        if (EQ (ptr->cdr, Qnil))
          {
            objptr = &ptr->car;

+           cdr_count = 0;

            goto loop;
          }
        mark_object (&ptr->car);
        objptr = &ptr->cdr;
            goto loop;
          }
        mark_object (&ptr->car);
        objptr = &ptr->cdr;

+       cdr_count++;
+       if (cdr_count == mark_object_loop_halt)
+         abort ();

        goto loop;
       }
 
        goto loop;
       }
 


@@ -4859,6 +4911,7 @@ mark_kboards ()
       mark_object (&kb->Vsystem_key_alist);
       mark_object (&kb->system_key_syms);
       mark_object (&kb->Vdefault_minibuffer_frame);
       mark_object (&kb->Vsystem_key_alist);
       mark_object (&kb->system_key_syms);
       mark_object (&kb->Vdefault_minibuffer_frame);

+      mark_object (&kb->echo_string);

     }
 }
 
     }
 }
 


@@ -5129,7 +5182,7 @@ gc_sweep ()
            /* Check if the symbol was created during loadup.  In such a case
               it might be pointed to by pure bytecode which we don't trace,
               so we conservatively assume that it is live.  */
            /* Check if the symbol was created during loadup.  In such a case
               it might be pointed to by pure bytecode which we don't trace,
               so we conservatively assume that it is live.  */

-           int pure_p = PURE_POINTER_P (sym->name);
+           int pure_p = PURE_POINTER_P (XSTRING (sym->xname));

            
            if (!XMARKBIT (sym->plist) && !pure_p)
              {
            
            if (!XMARKBIT (sym->plist) && !pure_p)
              {


@@ -5144,7 +5197,7 @@ gc_sweep ()
              {
                ++num_used;
                if (!pure_p)
              {
                ++num_used;
                if (!pure_p)

-                 UNMARK_STRING (sym->name);
+                 UNMARK_STRING (XSTRING (sym->xname));

                XUNMARK (sym->plist);
              }
          }
                XUNMARK (sym->plist);
              }
          }


@@ -5507,11 +5560,17 @@ which includes both saved text and other data.  */);
   Qpost_gc_hook = intern ("post-gc-hook");
   staticpro (&Qpost_gc_hook);
 
   Qpost_gc_hook = intern ("post-gc-hook");
   staticpro (&Qpost_gc_hook);
 

+  DEFVAR_LISP ("memory-signal-data", &Vmemory_signal_data,
+              doc: /* Precomputed `signal' argument for memory-full error.  */);

   /* We build this in advance because if we wait until we need it, we might
      not be able to allocate the memory to hold it.  */
   /* We build this in advance because if we wait until we need it, we might
      not be able to allocate the memory to hold it.  */

-  memory_signal_data
-    = Fcons (Qerror, Fcons (build_string ("Memory exhausted--use M-x save-some-buffers RET"), Qnil));
-  staticpro (&memory_signal_data);
+  Vmemory_signal_data
+    = list2 (Qerror,
+            build_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
+
+  DEFVAR_LISP ("memory-full", &Vmemory_full,
+              doc: /* Non-nil means we are handling a memory-full error.  */);
+  Vmemory_full = Qnil;

 
   staticpro (&Qgc_cons_threshold);
   Qgc_cons_threshold = intern ("gc-cons-threshold");
 
   staticpro (&Qgc_cons_threshold);
   Qgc_cons_threshold = intern ("gc-cons-threshold");