]> code.delx.au - gnu-emacs/blobdiff - src/alloc.c
Add fullscreen_hook.
[gnu-emacs] / src / alloc.c
index b18e313fc87a0bca7bf9740a26a5548f11cdee08..2fd50009649a5af131fe3f7f5531a02d02271b8e 100644 (file)
@@ -1,6 +1,6 @@
 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
    Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999,
-      2000, 2001, 2002, 2003, 2004, 2005  Free Software Foundation, Inc.
+      2000, 2001, 2002, 2003, 2004, 2005, 2006  Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -23,6 +23,10 @@ Boston, MA 02110-1301, USA.  */
 #include <stdio.h>
 #include <limits.h>            /* For CHAR_BIT.  */
 
+#ifdef STDC_HEADERS
+#include <stddef.h>            /* For offsetof, used by PSEUDOVECSIZE. */
+#endif
+
 #ifdef ALLOC_DEBUG
 #undef INLINE
 #endif
@@ -66,6 +70,19 @@ Boston, MA 02110-1301, USA.  */
 extern POINTER_TYPE *sbrk ();
 #endif
 
+#ifdef HAVE_FCNTL_H
+#define INCLUDED_FCNTL
+#include <fcntl.h>
+#endif
+#ifndef O_WRONLY
+#define O_WRONLY 1
+#endif
+
+#ifdef WINDOWSNT
+#include <fcntl.h>
+#include "w32.h"
+#endif
+
 #ifdef DOUG_LEA_MALLOC
 
 #include <malloc.h>
@@ -113,17 +130,17 @@ static pthread_mutex_t alloc_mutex;
 #define BLOCK_INPUT_ALLOC                       \
   do                                            \
     {                                           \
-      pthread_mutex_lock (&alloc_mutex);        \
-      if (pthread_self () == main_thread)       \
-        BLOCK_INPUT;                            \
+      if (pthread_self () == main_thread)      \
+       BLOCK_INPUT;                            \
+      pthread_mutex_lock (&alloc_mutex);       \
     }                                           \
   while (0)
 #define UNBLOCK_INPUT_ALLOC                     \
   do                                            \
     {                                           \
-      if (pthread_self () == main_thread)       \
-        UNBLOCK_INPUT;                          \
-      pthread_mutex_unlock (&alloc_mutex);      \
+      pthread_mutex_unlock (&alloc_mutex);     \
+      if (pthread_self () == main_thread)      \
+       UNBLOCK_INPUT;                          \
     }                                           \
   while (0)
 
@@ -138,6 +155,8 @@ static pthread_mutex_t alloc_mutex;
 
 static __malloc_size_t bytes_used_when_full;
 
+static __malloc_size_t bytes_used_when_reconsidered;
+
 /* Mark, unmark, query mark bit of a Lisp string.  S must be a pointer
    to a struct Lisp_String.  */
 
@@ -275,10 +294,18 @@ static size_t pure_bytes_used_before_overflow;
       && ((PNTR_COMPARISON_TYPE) (P)                           \
          >= (PNTR_COMPARISON_TYPE) purebeg))
 
-/* Index in pure at which next pure object will be allocated.. */
+/* Total number of bytes allocated in pure storage. */
 
 EMACS_INT pure_bytes_used;
 
+/* Index in pure at which next pure Lisp object will be allocated.. */
+
+static EMACS_INT pure_bytes_used_lisp;
+
+/* Number of bytes allocated for non-Lisp objects in pure storage.  */
+
+static EMACS_INT pure_bytes_used_non_lisp;
+
 /* If nonzero, this is a warning delivered by malloc and not yet
    displayed.  */
 
@@ -358,6 +385,8 @@ enum mem_type
 
 static POINTER_TYPE *lisp_align_malloc P_ ((size_t, enum mem_type));
 static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
+void refill_memory_reserve ();
+
 
 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
 
@@ -458,7 +487,6 @@ static void mem_rotate_right P_ ((struct mem_node *));
 static void mem_delete P_ ((struct mem_node *));
 static void mem_delete_fixup P_ ((struct mem_node *));
 static INLINE struct mem_node *mem_find P_ ((void *));
-void refill_memory_reserve ();
 
 
 #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
@@ -521,7 +549,7 @@ display_malloc_warning ()
 
 
 #ifdef DOUG_LEA_MALLOC
-#  define BYTES_USED (mallinfo ().arena)
+#  define BYTES_USED (mallinfo ().uordblks)
 #else
 #  define BYTES_USED _bytes_used
 #endif
@@ -544,8 +572,7 @@ buffer_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)
-    Fsignal (Qnil, Vmemory_signal_data);
+  xsignal (Qnil, Vmemory_signal_data);
 }
 
 
@@ -872,6 +899,12 @@ lisp_free (block)
 /* The entry point is lisp_align_malloc which returns blocks of at most    */
 /* BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary.  */
 
+/* Use posix_memalloc if the system has it and we're using the system's
+   malloc (because our gmalloc.c routines don't have posix_memalign although
+   its memalloc could be used).  */
+#if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC)
+#define USE_POSIX_MEMALIGN 1
+#endif
 
 /* BLOCK_ALIGN has to be a power of 2.  */
 #define BLOCK_ALIGN (1 << 10)
@@ -937,7 +970,7 @@ struct ablocks
 #define ABLOCKS_BUSY(abase) ((abase)->blocks[0].abase)
 
 /* Pointer to the (not necessarily aligned) malloc block.  */
-#ifdef HAVE_POSIX_MEMALIGN
+#ifdef USE_POSIX_MEMALIGN
 #define ABLOCKS_BASE(abase) (abase)
 #else
 #define ABLOCKS_BASE(abase) \
@@ -978,7 +1011,7 @@ lisp_align_malloc (nbytes, type)
       mallopt (M_MMAP_MAX, 0);
 #endif
 
-#ifdef HAVE_POSIX_MEMALIGN
+#ifdef USE_POSIX_MEMALIGN
       {
        int err = posix_memalign (&base, BLOCK_ALIGN, ABLOCKS_BYTES);
        if (err)
@@ -1094,6 +1127,9 @@ lisp_align_free (block)
        }
       eassert ((aligned & 1) == aligned);
       eassert (i == (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1));
+#ifdef USE_POSIX_MEMALIGN
+      eassert ((unsigned long)ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0);
+#endif
       free (ABLOCKS_BASE (abase));
     }
   UNBLOCK_INPUT;
@@ -1179,8 +1215,8 @@ emacs_blocked_free (ptr, ptr2)
         The code here is correct as long as SPARE_MEMORY
         is substantially larger than the block size malloc uses.  */
       && (bytes_used_when_full
-         > ((bytes_used_now = BYTES_USED)
-            + max (malloc_hysteresis, 4) * SPARE_MEMORY))
+         > ((bytes_used_when_reconsidered = BYTES_USED)
+            + max (malloc_hysteresis, 4) * SPARE_MEMORY)))
     refill_memory_reserve ();
 
   __free_hook = emacs_blocked_free;
@@ -1408,6 +1444,12 @@ make_interval ()
 {
   INTERVAL val;
 
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
+
   if (interval_free_list)
     {
       val = interval_free_list;
@@ -1429,6 +1471,11 @@ make_interval ()
        }
       val = &interval_block->intervals[interval_block_index++];
     }
+
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   consing_since_gc += sizeof (struct interval);
   intervals_consed++;
   RESET_INTERVAL (val);
@@ -1826,6 +1873,12 @@ allocate_string ()
 {
   struct Lisp_String *s;
 
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
+
   /* If the free-list is empty, allocate a new string_block, and
      add all the Lisp_Strings in it to the free-list.  */
   if (string_free_list == NULL)
@@ -1855,6 +1908,10 @@ allocate_string ()
   s = string_free_list;
   string_free_list = NEXT_FREE_LISP_STRING (s);
 
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   /* Probably not strictly necessary, but play it safe.  */
   bzero (s, sizeof *s);
 
@@ -1902,6 +1959,12 @@ allocate_string_data (s, nchars, nbytes)
   /* Determine the number of bytes needed to store NBYTES bytes
      of string data.  */
   needed = SDATA_SIZE (nbytes);
+  old_data = s->data ? SDATA_OF_STRING (s) : NULL;
+  old_nbytes = GC_STRING_BYTES (s);
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
 
   if (nbytes > LARGE_STRING_BYTES)
     {
@@ -1956,10 +2019,13 @@ allocate_string_data (s, nchars, nbytes)
   else
     b = current_sblock;
 
-  old_data = s->data ? SDATA_OF_STRING (s) : NULL;
-  old_nbytes = GC_STRING_BYTES (s);
-
   data = b->next_free;
+  b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA);
+
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   data->string = s;
   s->data = SDATA_DATA (data);
 #ifdef GC_CHECK_STRING_BYTES
@@ -1972,7 +2038,6 @@ allocate_string_data (s, nchars, nbytes)
   bcopy (string_overrun_cookie, (char *) data + needed,
         GC_STRING_OVERRUN_COOKIE_SIZE);
 #endif
-  b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA);
 
   /* If S had already data assigned, mark that as free by setting its
      string back-pointer to null, and recording the size of the data
@@ -2256,7 +2321,7 @@ INIT must be an integer that represents a character.  */)
 
 
 DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
-       doc: /* Return a new bool-vector of length LENGTH, using INIT for as each element.
+       doc: /* Return a new bool-vector of length LENGTH, using INIT for each element.
 LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
      (length, init)
      Lisp_Object length, init;
@@ -2528,7 +2593,7 @@ void
 free_float (ptr)
      struct Lisp_Float *ptr;
 {
-  *(struct Lisp_Float **)&ptr->data = float_free_list;
+  ptr->u.chain = float_free_list;
   float_free_list = ptr;
 }
 
@@ -2541,12 +2606,18 @@ make_float (float_value)
 {
   register Lisp_Object val;
 
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
+
   if (float_free_list)
     {
       /* We use the data field for chaining the free list
         so that we won't use the same field that has the mark bit.  */
       XSETFLOAT (val, float_free_list);
-      float_free_list = *(struct Lisp_Float **)&float_free_list->data;
+      float_free_list = float_free_list->u.chain;
     }
   else
     {
@@ -2566,6 +2637,10 @@ make_float (float_value)
       float_block_index++;
     }
 
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   XFLOAT_DATA (val) = float_value;
   eassert (!FLOAT_MARKED_P (XFLOAT (val)));
   consing_since_gc += sizeof (struct Lisp_Float);
@@ -2646,7 +2721,7 @@ void
 free_cons (ptr)
      struct Lisp_Cons *ptr;
 {
-  *(struct Lisp_Cons **)&ptr->cdr = cons_free_list;
+  ptr->u.chain = cons_free_list;
 #if GC_MARK_STACK
   ptr->car = Vdead;
 #endif
@@ -2660,12 +2735,18 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
 {
   register Lisp_Object val;
 
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
+
   if (cons_free_list)
     {
       /* We use the cdr for chaining the free list
         so that we won't use the same field that has the mark bit.  */
       XSETCONS (val, cons_free_list);
-      cons_free_list = *(struct Lisp_Cons **)&cons_free_list->cdr;
+      cons_free_list = cons_free_list->u.chain;
     }
   else
     {
@@ -2684,6 +2765,10 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
       cons_block_index++;
     }
 
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   XSETCAR (val, car);
   XSETCDR (val, cdr);
   eassert (!CONS_MARKED_P (XCONS (val)));
@@ -2700,11 +2785,18 @@ check_cons_list ()
   struct Lisp_Cons *tail = cons_free_list;
 
   while (tail)
-    tail = *(struct Lisp_Cons **)&tail->cdr;
+    tail = tail->u.chain;
 #endif
 }
 
-/* Make a list of 2, 3, 4 or 5 specified objects.  */
+/* Make a list of 1, 2, 3, 4 or 5 specified objects.  */
+
+Lisp_Object
+list1 (arg1)
+     Lisp_Object arg1;
+{
+  return Fcons (arg1, Qnil);
+}
 
 Lisp_Object
 list2 (arg1, arg2)
@@ -2841,6 +2933,9 @@ allocate_vectorlike (len, type)
   UNBLOCK_INPUT;
 #endif
 
+  /* This gets triggered by code which I haven't bothered to fix.  --Stef  */
+  /* eassert (!handling_signal); */
+
   nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
   p = (struct Lisp_Vector *) lisp_malloc (nbytes, type);
 
@@ -2854,8 +2949,17 @@ allocate_vectorlike (len, type)
   consing_since_gc += nbytes;
   vector_cells_consed += len;
 
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
+
   p->next = all_vectors;
   all_vectors = p;
+
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   ++n_vectors;
   return p;
 }
@@ -2922,13 +3026,17 @@ allocate_frame ()
 struct Lisp_Process *
 allocate_process ()
 {
-  EMACS_INT len = VECSIZE (struct Lisp_Process);
-  struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_PROCESS);
+  /* Memory-footprint of the object in nb of Lisp_Object fields.  */
+  EMACS_INT memlen = VECSIZE (struct Lisp_Process);
+  /* Size if we only count the actual Lisp_Object fields (which need to be
+     traced by the GC).  */
+  EMACS_INT lisplen = PSEUDOVECSIZE (struct Lisp_Process, pid);
+  struct Lisp_Vector *v = allocate_vectorlike (memlen, MEM_TYPE_PROCESS);
   EMACS_INT i;
 
-  for (i = 0; i < len; ++i)
+  for (i = 0; i < lisplen; ++i)
     v->contents[i] = Qnil;
-  v->size = len;
+  v->size = lisplen;
 
   return (struct Lisp_Process *) v;
 }
@@ -3134,10 +3242,16 @@ Its value and function definition are void, and its property list is nil.  */)
 
   CHECK_STRING (name);
 
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
+
   if (symbol_free_list)
     {
       XSETSYMBOL (val, symbol_free_list);
-      symbol_free_list = *(struct Lisp_Symbol **)&symbol_free_list->value;
+      symbol_free_list = symbol_free_list->next;
     }
   else
     {
@@ -3155,6 +3269,10 @@ Its value and function definition are void, and its property list is nil.  */)
       symbol_block_index++;
     }
 
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   p = XSYMBOL (val);
   p->xname = name;
   p->plist = Qnil;
@@ -3214,6 +3332,12 @@ allocate_misc ()
 {
   Lisp_Object val;
 
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
+
   if (marker_free_list)
     {
       XSETMISC (val, marker_free_list);
@@ -3236,6 +3360,10 @@ allocate_misc ()
       marker_block_index++;
     }
 
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   --total_free_markers;
   consing_since_gc += sizeof (union Lisp_Misc);
   misc_objects_consed++;
@@ -3384,8 +3512,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)
-    Fsignal (Qnil, Vmemory_signal_data);
+  xsignal (Qnil, Vmemory_signal_data);
 }
 
 /* If we released our reserve (due to running out of memory),
@@ -4481,10 +4608,116 @@ mark_stack ()
 #endif
 }
 
-
 #endif /* GC_MARK_STACK != 0 */
 
 
+/* Determine whether it is safe to access memory at address P.  */
+int
+valid_pointer_p (p)
+     void *p;
+{
+#ifdef WINDOWSNT
+  return w32_valid_pointer_p (p, 16);
+#else
+  int fd;
+
+  /* Obviously, we cannot just access it (we would SEGV trying), so we
+     trick the o/s to tell us whether p is a valid pointer.
+     Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may
+     not validate p in that case.  */
+
+  if ((fd = emacs_open ("__Valid__Lisp__Object__", O_CREAT | O_WRONLY | O_TRUNC, 0666)) >= 0)
+    {
+      int valid = (emacs_write (fd, (char *)p, 16) == 16);
+      emacs_close (fd);
+      unlink ("__Valid__Lisp__Object__");
+      return valid;
+    }
+
+    return -1;
+#endif
+}
+
+/* Return 1 if OBJ is a valid lisp object.
+   Return 0 if OBJ is NOT a valid lisp object.
+   Return -1 if we cannot validate OBJ.
+   This function can be quite slow,
+   so it should only be used in code for manual debugging.  */
+
+int
+valid_lisp_object_p (obj)
+     Lisp_Object obj;
+{
+  void *p;
+#if GC_MARK_STACK
+  struct mem_node *m;
+#endif
+
+  if (INTEGERP (obj))
+    return 1;
+
+  p = (void *) XPNTR (obj);
+  if (PURE_POINTER_P (p))
+    return 1;
+
+#if !GC_MARK_STACK
+  return valid_pointer_p (p);
+#else
+
+  m = mem_find (p);
+
+  if (m == MEM_NIL)
+    {
+      int valid = valid_pointer_p (p);
+      if (valid <= 0)
+       return valid;
+
+      if (SUBRP (obj))
+       return 1;
+
+      return 0;
+    }
+
+  switch (m->type)
+    {
+    case MEM_TYPE_NON_LISP:
+      return 0;
+
+    case MEM_TYPE_BUFFER:
+      return live_buffer_p (m, p);
+
+    case MEM_TYPE_CONS:
+      return live_cons_p (m, p);
+
+    case MEM_TYPE_STRING:
+      return live_string_p (m, p);
+
+    case MEM_TYPE_MISC:
+      return live_misc_p (m, p);
+
+    case MEM_TYPE_SYMBOL:
+      return live_symbol_p (m, p);
+
+    case MEM_TYPE_FLOAT:
+      return live_float_p (m, p);
+
+    case MEM_TYPE_VECTOR:
+    case MEM_TYPE_PROCESS:
+    case MEM_TYPE_HASH_TABLE:
+    case MEM_TYPE_FRAME:
+    case MEM_TYPE_WINDOW:
+      return live_vector_p (m, p);
+
+    default:
+      break;
+    }
+
+  return 0;
+#endif
+}
+
+
+
 \f
 /***********************************************************************
                       Pure Storage Management
@@ -4492,10 +4725,7 @@ mark_stack ()
 
 /* Allocate room for SIZE bytes from pure Lisp storage and return a
    pointer to it.  TYPE is the Lisp type for which the memory is
-   allocated.  TYPE < 0 means it's not used for a Lisp object.
-
-   If store_pure_type_info is set and TYPE is >= 0, the type of
-   the allocated object is recorded in pure_types.  */
+   allocated.  TYPE < 0 means it's not used for a Lisp object.  */
 
 static POINTER_TYPE *
 pure_alloc (size, type)
@@ -4520,8 +4750,21 @@ pure_alloc (size, type)
 #endif
 
  again:
-  result = ALIGN (purebeg + pure_bytes_used, alignment);
-  pure_bytes_used = ((char *)result - (char *)purebeg) + size;
+  if (type >= 0)
+    {
+      /* Allocate space for a Lisp object from the beginning of the free
+        space with taking account of alignment.  */
+      result = ALIGN (purebeg + pure_bytes_used_lisp, alignment);
+      pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size;
+    }
+  else
+    {
+      /* Allocate space for a non-Lisp object from the end of the free
+        space.  */
+      pure_bytes_used_non_lisp += size;
+      result = purebeg + pure_size - pure_bytes_used_non_lisp;
+    }
+  pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp;
 
   if (pure_bytes_used <= pure_size)
     return result;
@@ -4533,6 +4776,7 @@ pure_alloc (size, type)
   pure_size = 10000;
   pure_bytes_used_before_overflow += pure_bytes_used - size;
   pure_bytes_used = 0;
+  pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
   goto again;
 }
 
@@ -4543,11 +4787,78 @@ void
 check_pure_size ()
 {
   if (pure_bytes_used_before_overflow)
-    message ("Pure Lisp storage overflow (approx. %d bytes needed)",
+    message ("emacs:0:Pure Lisp storage overflow (approx. %d bytes needed)",
             (int) (pure_bytes_used + pure_bytes_used_before_overflow));
 }
 
 
+/* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from
+   the non-Lisp data pool of the pure storage, and return its start
+   address.  Return NULL if not found.  */
+
+static char *
+find_string_data_in_pure (data, nbytes)
+     char *data;
+     int nbytes;
+{
+  int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max;
+  unsigned char *p;
+  char *non_lisp_beg;
+
+  if (pure_bytes_used_non_lisp < nbytes + 1)
+    return NULL;
+
+  /* Set up the Boyer-Moore table.  */
+  skip = nbytes + 1;
+  for (i = 0; i < 256; i++)
+    bm_skip[i] = skip;
+
+  p = (unsigned char *) data;
+  while (--skip > 0)
+    bm_skip[*p++] = skip;
+
+  last_char_skip = bm_skip['\0'];
+
+  non_lisp_beg = purebeg + pure_size - pure_bytes_used_non_lisp;
+  start_max = pure_bytes_used_non_lisp - (nbytes + 1);
+
+  /* See the comments in the function `boyer_moore' (search.c) for the
+     use of `infinity'.  */
+  infinity = pure_bytes_used_non_lisp + 1;
+  bm_skip['\0'] = infinity;
+
+  p = (unsigned char *) non_lisp_beg + nbytes;
+  start = 0;
+  do
+    {
+      /* Check the last character (== '\0').  */
+      do
+       {
+         start += bm_skip[*(p + start)];
+       }
+      while (start <= start_max);
+
+      if (start < infinity)
+       /* Couldn't find the last character.  */
+       return NULL;
+
+      /* No less than `infinity' means we could find the last
+        character at `p[start - infinity]'.  */
+      start -= infinity;
+
+      /* Check the remaining characters.  */
+      if (memcmp (data, non_lisp_beg + start, nbytes) == 0)
+       /* Found.  */
+       return non_lisp_beg + start;
+
+      start += last_char_skip;
+    }
+  while (start <= start_max);
+
+  return NULL;
+}
+
+
 /* Return a string allocated in pure space.  DATA is a buffer holding
    NCHARS characters, and NBYTES bytes of string data.  MULTIBYTE
    non-zero means make the result string multibyte.
@@ -4566,11 +4877,15 @@ make_pure_string (data, nchars, nbytes, multibyte)
   struct Lisp_String *s;
 
   s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
-  s->data = (unsigned char *) pure_alloc (nbytes + 1, -1);
+  s->data = find_string_data_in_pure (data, nbytes);
+  if (s->data == NULL)
+    {
+      s->data = (unsigned char *) pure_alloc (nbytes + 1, -1);
+      bcopy (data, s->data, nbytes);
+      s->data[nbytes] = '\0';
+    }
   s->size = nchars;
   s->size_byte = multibyte ? nbytes : -1;
-  bcopy (data, s->data, nbytes);
-  s->data[nbytes] = '\0';
   s->intervals = NULL_INTERVAL;
   XSETSTRING (string, s);
   return string;
@@ -4630,7 +4945,7 @@ make_pure_vector (len)
 
 
 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
-       doc: /* Make a copy of OBJECT in pure storage.
+       doc: /* Make a copy of object OBJ in pure storage.
 Recursively copies contents of vectors and cons cells.
 Does not copy symbols.  Copies strings without text properties.  */)
      (obj)
@@ -4964,7 +5279,7 @@ returns nil, because real GC can't be done.  */)
       total += total_floats  * sizeof (struct Lisp_Float);
       total += total_intervals * sizeof (struct interval);
       total += total_strings * sizeof (struct Lisp_String);
-      
+
       gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage);
     }
   else
@@ -5371,6 +5686,10 @@ mark_object (arg)
          if (size & PSEUDOVECTOR_FLAG)
            size &= PSEUDOVECTOR_SIZE_MASK;
 
+         /* Note that this size is not the memory-footprint size, but only
+            the number of Lisp_Object fields that we should trace.
+            The distinction is used e.g. by Lisp_Process which places extra
+            non-Lisp_Object fields at the end of the structure.  */
          for (i = 0; i < size; i++) /* and then mark its elements */
            mark_object (ptr->contents[i]);
        }
@@ -5491,14 +5810,14 @@ mark_object (arg)
        CHECK_ALLOCATED_AND_LIVE (live_cons_p);
        CONS_MARK (ptr);
        /* If the cdr is nil, avoid recursion for the car.  */
-       if (EQ (ptr->cdr, Qnil))
+       if (EQ (ptr->u.cdr, Qnil))
          {
            obj = ptr->car;
            cdr_count = 0;
            goto loop;
          }
        mark_object (ptr->car);
-       obj = ptr->cdr;
+       obj = ptr->u.cdr;
        cdr_count++;
        if (cdr_count == mark_object_loop_halt)
          abort ();
@@ -5645,7 +5964,7 @@ gc_sweep ()
          if (!CONS_MARKED_P (&cblk->conses[i]))
            {
              this_free++;
-             *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list;
+             cblk->conses[i].u.chain = cons_free_list;
              cons_free_list = &cblk->conses[i];
 #if GC_MARK_STACK
              cons_free_list->car = Vdead;
@@ -5664,7 +5983,7 @@ gc_sweep ()
          {
            *cprev = cblk->next;
            /* Unhook from the free list.  */
-           cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr;
+           cons_free_list = cblk->conses[0].u.chain;
            lisp_align_free (cblk);
            n_cons_blocks--;
          }
@@ -5695,7 +6014,7 @@ gc_sweep ()
          if (!FLOAT_MARKED_P (&fblk->floats[i]))
            {
              this_free++;
-             *(struct Lisp_Float **)&fblk->floats[i].data = float_free_list;
+             fblk->floats[i].u.chain = float_free_list;
              float_free_list = &fblk->floats[i];
            }
          else
@@ -5711,7 +6030,7 @@ gc_sweep ()
          {
            *fprev = fblk->next;
            /* Unhook from the free list.  */
-           float_free_list = *(struct Lisp_Float **) &fblk->floats[0].data;
+           float_free_list = fblk->floats[0].u.chain;
            lisp_align_free (fblk);
            n_float_blocks--;
          }
@@ -5799,7 +6118,7 @@ gc_sweep ()
 
            if (!sym->gcmarkbit && !pure_p)
              {
-               *(struct Lisp_Symbol **) &sym->value = symbol_free_list;
+               sym->next = symbol_free_list;
                symbol_free_list = sym;
 #if GC_MARK_STACK
                symbol_free_list->function = Vdead;
@@ -5823,7 +6142,7 @@ gc_sweep ()
          {
            *sprev = sblk->next;
            /* Unhook from the free list.  */
-           symbol_free_list = *(struct Lisp_Symbol **)&sblk->symbols[0].value;
+           symbol_free_list = sblk->symbols[0].next;
            lisp_free (sblk);
            n_symbol_blocks--;
          }
@@ -6021,6 +6340,7 @@ init_alloc_once ()
   purebeg = PUREBEG;
   pure_size = PURESIZE;
   pure_bytes_used = 0;
+  pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
   pure_bytes_used_before_overflow = 0;
 
   /* Initialize the list of free aligned blocks.  */