*** empty log message ***

[bpt/emacs.git] / src / alloc.c

diff --git a/src/alloc.c b/src/alloc.c
index 6948ff1..be4ab45 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, 1998
+   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999

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


@@ -19,10 +19,15 @@ along with GNU Emacs; see the file COPYING.  If not, write to
 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 Boston, MA 02111-1307, USA.  */
 
 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 Boston, MA 02111-1307, USA.  */
 

+#include <config.h>
+

 /* Note that this declares bzero on OSF/1.  How dumb.  */
 #include <signal.h>
 
 /* Note that this declares bzero on OSF/1.  How dumb.  */
 #include <signal.h>
 

-#include <config.h>
+/* This file is part of the core Lisp implementation, and thus must
+   deal with the real data structures.  If the Lisp implementation is
+   replaced, this file likely will not be used.  */
+#undef HIDE_LISP_IMPLEMENTATION

 #include "lisp.h"
 #include "intervals.h"
 #include "puresize.h"
 #include "lisp.h"
 #include "intervals.h"
 #include "puresize.h"


@@ -42,6 +47,12 @@ extern char *sbrk ();
 #ifdef DOUG_LEA_MALLOC
 #include <malloc.h>
 #define __malloc_size_t int
 #ifdef DOUG_LEA_MALLOC
 #include <malloc.h>
 #define __malloc_size_t int

+
+/* Specify maximum number of areas to mmap.
+   It would be nice to use a value that explicitly
+   means "no limit".  */
+#define MMAP_MAX_AREAS 100000000
+

 #else
 /* The following come from gmalloc.c.  */
 
 #else
 /* The following come from gmalloc.c.  */
 


@@ -55,8 +66,6 @@ extern __malloc_size_t _bytes_used;
 extern int __malloc_extra_blocks;
 #endif /* !defined(DOUG_LEA_MALLOC) */
 
 extern int __malloc_extra_blocks;
 #endif /* !defined(DOUG_LEA_MALLOC) */
 

-extern Lisp_Object Vhistory_length;
-

 #define max(A,B) ((A) > (B) ? (A) : (B))
 #define min(A,B) ((A) < (B) ? (A) : (B))
 
 #define max(A,B) ((A) > (B) ? (A) : (B))
 #define min(A,B) ((A) < (B) ? (A) : (B))
 


@@ -188,9 +197,20 @@ int ignore_warnings;
 
 Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;
 
 
 Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;
 

-static void mark_object (), mark_buffer (), mark_kboards ();
-static void clear_marks (), gc_sweep ();
+static void mark_buffer (), mark_kboards ();
+static void gc_sweep ();

 static void compact_strings ();
 static void compact_strings ();

+static void mark_glyph_matrix P_ ((struct glyph_matrix *));
+static void mark_face_cache P_ ((struct face_cache *));
+#if 0
+static void clear_marks ();
+#endif
+
+#ifdef HAVE_WINDOW_SYSTEM
+static void mark_image P_ ((struct image *));
+static void mark_image_cache P_ ((struct frame *));
+#endif /* HAVE_WINDOW_SYSTEM */
+

 
 extern int message_enable_multibyte;
 \f
 
 extern int message_enable_multibyte;
 \f


@@ -276,7 +296,7 @@ buffer_memory_full ()
     Fsignal (Qerror, memory_signal_data);
 }
 
     Fsignal (Qerror, memory_signal_data);
 }
 

-/* like malloc routines but check for no memory and block interrupt input.  */
+/* Like malloc routines but check for no memory and block interrupt input.  */

 
 long *
 xmalloc (size)
 
 long *
 xmalloc (size)


@@ -321,6 +341,34 @@ xfree (block)
   UNBLOCK_INPUT;
 }
 
   UNBLOCK_INPUT;
 }
 

+/* Like malloc but used for allocating Lisp data.  */
+
+long *
+lisp_malloc (size)
+     int size;
+{
+  register long *val;
+
+  BLOCK_INPUT;
+  allocating_for_lisp++;
+  val = (long *) malloc (size);
+  allocating_for_lisp--;
+  UNBLOCK_INPUT;
+
+  if (!val && size) memory_full ();
+  return val;
+}
+
+void
+lisp_free (block)
+     long *block;
+{
+  BLOCK_INPUT;
+  allocating_for_lisp++;
+  free (block);
+  allocating_for_lisp--;
+  UNBLOCK_INPUT;
+}

 \f
 /* Arranging to disable input signals while we're in malloc.
 
 \f
 /* Arranging to disable input signals while we're in malloc.
 


@@ -419,13 +467,16 @@ emacs_blocked_realloc (ptr, size)
 void
 uninterrupt_malloc ()
 {
 void
 uninterrupt_malloc ()
 {

-  old_free_hook = __free_hook;
+  if (__free_hook != emacs_blocked_free)
+    old_free_hook = __free_hook;

   __free_hook = emacs_blocked_free;
 
   __free_hook = emacs_blocked_free;
 

-  old_malloc_hook = __malloc_hook;
+  if (__malloc_hook != emacs_blocked_malloc)
+    old_malloc_hook = __malloc_hook;

   __malloc_hook = emacs_blocked_malloc;
 
   __malloc_hook = emacs_blocked_malloc;
 

-  old_realloc_hook = __realloc_hook;
+  if (__realloc_hook != emacs_blocked_realloc)
+    old_realloc_hook = __realloc_hook;

   __realloc_hook = emacs_blocked_realloc;
 }
 #endif
   __realloc_hook = emacs_blocked_realloc;
 }
 #endif


@@ -447,17 +498,19 @@ static int interval_block_index;
 
 INTERVAL interval_free_list;
 
 
 INTERVAL interval_free_list;
 

+/* Total number of interval blocks now in use.  */
+int n_interval_blocks;
+

 static void
 init_intervals ()
 {
 static void
 init_intervals ()
 {

-  allocating_for_lisp = 1;

   interval_block
   interval_block

-    = (struct interval_block *) malloc (sizeof (struct interval_block));
-  allocating_for_lisp = 0;
+    = (struct interval_block *) lisp_malloc (sizeof (struct interval_block));

   interval_block->next = 0;
   bzero ((char *) interval_block->intervals, sizeof interval_block->intervals);
   interval_block_index = 0;
   interval_free_list = 0;
   interval_block->next = 0;
   bzero ((char *) interval_block->intervals, sizeof interval_block->intervals);
   interval_block_index = 0;
   interval_free_list = 0;

+  n_interval_blocks = 1;

 }
 
 #define INIT_INTERVALS init_intervals ()
 }
 
 #define INIT_INTERVALS init_intervals ()


@@ -478,14 +531,13 @@ make_interval ()
        {
          register struct interval_block *newi;
 
        {
          register struct interval_block *newi;
 

-         allocating_for_lisp = 1;
-         newi = (struct interval_block *) xmalloc (sizeof (struct interval_block));
+         newi = (struct interval_block *) lisp_malloc (sizeof (struct interval_block));

 
 

-         allocating_for_lisp = 0;

          VALIDATE_LISP_STORAGE (newi, sizeof *newi);
          newi->next = interval_block;
          interval_block = newi;
          interval_block_index = 0;
          VALIDATE_LISP_STORAGE (newi, sizeof *newi);
          newi->next = interval_block;
          interval_block = newi;
          interval_block_index = 0;

+         n_interval_blocks++;

        }
       val = &interval_block->intervals[interval_block_index++];
     }
        }
       val = &interval_block->intervals[interval_block_index++];
     }


@@ -578,18 +630,20 @@ struct float_block
 struct float_block *float_block;
 int float_block_index;
 
 struct float_block *float_block;
 int float_block_index;
 

+/* Total number of float blocks now in use.  */
+int n_float_blocks;
+

 struct Lisp_Float *float_free_list;
 
 void
 init_float ()
 {
 struct Lisp_Float *float_free_list;
 
 void
 init_float ()
 {

-  allocating_for_lisp = 1;
-  float_block = (struct float_block *) malloc (sizeof (struct float_block));
-  allocating_for_lisp = 0;
+  float_block = (struct float_block *) lisp_malloc (sizeof (struct float_block));

   float_block->next = 0;
   bzero ((char *) float_block->floats, sizeof float_block->floats);
   float_block_index = 0;
   float_free_list = 0;
   float_block->next = 0;
   bzero ((char *) float_block->floats, sizeof float_block->floats);
   float_block_index = 0;
   float_free_list = 0;

+  n_float_blocks = 1;

 }
 
 /* Explicitly free a float cell.  */
 }
 
 /* Explicitly free a float cell.  */


@@ -620,17 +674,16 @@ make_float (float_value)
        {
          register struct float_block *new;
 
        {
          register struct float_block *new;
 

-         allocating_for_lisp = 1;
-         new = (struct float_block *) xmalloc (sizeof (struct float_block));
-         allocating_for_lisp = 0;
+         new = (struct float_block *) lisp_malloc (sizeof (struct float_block));

          VALIDATE_LISP_STORAGE (new, sizeof *new);
          new->next = float_block;
          float_block = new;
          float_block_index = 0;
          VALIDATE_LISP_STORAGE (new, sizeof *new);
          new->next = float_block;
          float_block = new;
          float_block_index = 0;

+         n_float_blocks++;

        }
       XSETFLOAT (val, &float_block->floats[float_block_index++]);
     }
        }
       XSETFLOAT (val, &float_block->floats[float_block_index++]);
     }

-  XFLOAT (val)->data = float_value;
+  XFLOAT_DATA (val) = float_value;

   XSETFASTINT (XFLOAT (val)->type, 0); /* bug chasing -wsr */
   consing_since_gc += sizeof (struct Lisp_Float);
   floats_consed++;
   XSETFASTINT (XFLOAT (val)->type, 0); /* bug chasing -wsr */
   consing_since_gc += sizeof (struct Lisp_Float);
   floats_consed++;


@@ -663,16 +716,18 @@ int cons_block_index;
 
 struct Lisp_Cons *cons_free_list;
 
 
 struct Lisp_Cons *cons_free_list;
 

+/* Total number of cons blocks now in use.  */
+int n_cons_blocks;
+

 void
 init_cons ()
 {
 void
 init_cons ()
 {

-  allocating_for_lisp = 1;
-  cons_block = (struct cons_block *) malloc (sizeof (struct cons_block));
-  allocating_for_lisp = 0;
+  cons_block = (struct cons_block *) lisp_malloc (sizeof (struct cons_block));

   cons_block->next = 0;
   bzero ((char *) cons_block->conses, sizeof cons_block->conses);
   cons_block_index = 0;
   cons_free_list = 0;
   cons_block->next = 0;
   bzero ((char *) cons_block->conses, sizeof cons_block->conses);
   cons_block_index = 0;
   cons_free_list = 0;

+  n_cons_blocks = 1;

 }
 
 /* Explicitly free a cons cell.  */
 }
 
 /* Explicitly free a cons cell.  */


@@ -704,18 +759,17 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
       if (cons_block_index == CONS_BLOCK_SIZE)
        {
          register struct cons_block *new;
       if (cons_block_index == CONS_BLOCK_SIZE)
        {
          register struct cons_block *new;

-         allocating_for_lisp = 1;
-         new = (struct cons_block *) xmalloc (sizeof (struct cons_block));
-         allocating_for_lisp = 0;
+         new = (struct cons_block *) lisp_malloc (sizeof (struct cons_block));

          VALIDATE_LISP_STORAGE (new, sizeof *new);
          new->next = cons_block;
          cons_block = new;
          cons_block_index = 0;
          VALIDATE_LISP_STORAGE (new, sizeof *new);
          new->next = cons_block;
          cons_block = new;
          cons_block_index = 0;

+         n_cons_blocks++;

        }
       XSETCONS (val, &cons_block->conses[cons_block_index++]);
     }
        }
       XSETCONS (val, &cons_block->conses[cons_block_index++]);
     }

-  XCONS (val)->car = car;
-  XCONS (val)->cdr = cdr;
+  XCAR (val) = car;
+  XCDR (val) = cdr;

   consing_since_gc += sizeof (struct Lisp_Cons);
   cons_cells_consed++;
   return val;
   consing_since_gc += sizeof (struct Lisp_Cons);
   cons_cells_consed++;
   return val;


@@ -791,28 +845,30 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
 
 struct Lisp_Vector *all_vectors;
 
 
 struct Lisp_Vector *all_vectors;
 

+/* Total number of vectorlike objects now in use.  */
+int n_vectors;
+

 struct Lisp_Vector *
 allocate_vectorlike (len)
      EMACS_INT len;
 {
   struct Lisp_Vector *p;
 
 struct Lisp_Vector *
 allocate_vectorlike (len)
      EMACS_INT len;
 {
   struct Lisp_Vector *p;
 

-  allocating_for_lisp = 1;

 #ifdef DOUG_LEA_MALLOC
   /* Prevent mmap'ing the chunk (which is potentially very large). */
   mallopt (M_MMAP_MAX, 0);
 #endif
 #ifdef DOUG_LEA_MALLOC
   /* Prevent mmap'ing the chunk (which is potentially very large). */
   mallopt (M_MMAP_MAX, 0);
 #endif

-  p = (struct Lisp_Vector *)xmalloc (sizeof (struct Lisp_Vector)
+  p = (struct Lisp_Vector *)lisp_malloc (sizeof (struct Lisp_Vector)

                                     + (len - 1) * sizeof (Lisp_Object));
 #ifdef DOUG_LEA_MALLOC
   /* Back to a reasonable maximum of mmap'ed areas. */
                                     + (len - 1) * sizeof (Lisp_Object));
 #ifdef DOUG_LEA_MALLOC
   /* Back to a reasonable maximum of mmap'ed areas. */

-  mallopt (M_MMAP_MAX, 64);
+  mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);

 #endif
 #endif

-  allocating_for_lisp = 0;

   VALIDATE_LISP_STORAGE (p, 0);
   consing_since_gc += (sizeof (struct Lisp_Vector)
                       + (len - 1) * sizeof (Lisp_Object));
   vector_cells_consed += len;
   VALIDATE_LISP_STORAGE (p, 0);
   consing_since_gc += (sizeof (struct Lisp_Vector)
                       + (len - 1) * sizeof (Lisp_Object));
   vector_cells_consed += len;

+  n_vectors++;

 
   p->next = all_vectors;
   all_vectors = p;
 
   p->next = all_vectors;
   all_vectors = p;


@@ -953,16 +1009,18 @@ int symbol_block_index;
 
 struct Lisp_Symbol *symbol_free_list;
 
 
 struct Lisp_Symbol *symbol_free_list;
 

+/* Total number of symbol blocks now in use.  */
+int n_symbol_blocks;
+

 void
 init_symbol ()
 {
 void
 init_symbol ()
 {

-  allocating_for_lisp = 1;
-  symbol_block = (struct symbol_block *) malloc (sizeof (struct symbol_block));
-  allocating_for_lisp = 0;
+  symbol_block = (struct symbol_block *) lisp_malloc (sizeof (struct symbol_block));

   symbol_block->next = 0;
   bzero ((char *) symbol_block->symbols, sizeof symbol_block->symbols);
   symbol_block_index = 0;
   symbol_free_list = 0;
   symbol_block->next = 0;
   bzero ((char *) symbol_block->symbols, sizeof symbol_block->symbols);
   symbol_block_index = 0;
   symbol_free_list = 0;

+  n_symbol_blocks = 1;

 }
 
 DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
 }
 
 DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,


@@ -986,13 +1044,12 @@ Its value and function definition are void, and its property list is nil.")
       if (symbol_block_index == SYMBOL_BLOCK_SIZE)
        {
          struct symbol_block *new;
       if (symbol_block_index == SYMBOL_BLOCK_SIZE)
        {
          struct symbol_block *new;

-         allocating_for_lisp = 1;
-         new = (struct symbol_block *) xmalloc (sizeof (struct symbol_block));
-         allocating_for_lisp = 0;
+         new = (struct symbol_block *) lisp_malloc (sizeof (struct symbol_block));

          VALIDATE_LISP_STORAGE (new, sizeof *new);
          new->next = symbol_block;
          symbol_block = new;
          symbol_block_index = 0;
          VALIDATE_LISP_STORAGE (new, sizeof *new);
          new->next = symbol_block;
          symbol_block = new;
          symbol_block_index = 0;

+         n_symbol_blocks++;

        }
       XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]);
     }
        }
       XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]);
     }


@@ -1015,7 +1072,7 @@ Its value and function definition are void, and its property list is nil.")
   ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc))
 
 struct marker_block
   ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc))
 
 struct marker_block

-  {
+{

     struct marker_block *next;
     union Lisp_Misc markers[MARKER_BLOCK_SIZE];
   };
     struct marker_block *next;
     union Lisp_Misc markers[MARKER_BLOCK_SIZE];
   };


@@ -1025,16 +1082,18 @@ int marker_block_index;
 
 union Lisp_Misc *marker_free_list;
 
 
 union Lisp_Misc *marker_free_list;
 

+/* Total number of marker blocks now in use.  */
+int n_marker_blocks;
+

 void
 init_marker ()
 {
 void
 init_marker ()
 {

-  allocating_for_lisp = 1;
-  marker_block = (struct marker_block *) malloc (sizeof (struct marker_block));
-  allocating_for_lisp = 0;
+  marker_block = (struct marker_block *) lisp_malloc (sizeof (struct marker_block));

   marker_block->next = 0;
   bzero ((char *) marker_block->markers, sizeof marker_block->markers);
   marker_block_index = 0;
   marker_free_list = 0;
   marker_block->next = 0;
   bzero ((char *) marker_block->markers, sizeof marker_block->markers);
   marker_block_index = 0;
   marker_free_list = 0;

+  n_marker_blocks = 1;

 }
 
 /* Return a newly allocated Lisp_Misc object, with no substructure.  */
 }
 
 /* Return a newly allocated Lisp_Misc object, with no substructure.  */


@@ -1053,13 +1112,12 @@ allocate_misc ()
       if (marker_block_index == MARKER_BLOCK_SIZE)
        {
          struct marker_block *new;
       if (marker_block_index == MARKER_BLOCK_SIZE)
        {
          struct marker_block *new;

-         allocating_for_lisp = 1;
-         new = (struct marker_block *) xmalloc (sizeof (struct marker_block));
-         allocating_for_lisp = 0;
+         new = (struct marker_block *) lisp_malloc (sizeof (struct marker_block));

          VALIDATE_LISP_STORAGE (new, sizeof *new);
          new->next = marker_block;
          marker_block = new;
          marker_block_index = 0;
          VALIDATE_LISP_STORAGE (new, sizeof *new);
          new->next = marker_block;
          marker_block = new;
          marker_block_index = 0;

+         n_marker_blocks++;

        }
       XSETMISC (val, &marker_block->markers[marker_block_index++]);
     }
        }
       XSETMISC (val, &marker_block->markers[marker_block_index++]);
     }


@@ -1167,18 +1225,20 @@ struct string_block *large_string_blocks;
 (((SIZE) + 2 * sizeof (EMACS_INT)) & ~(sizeof (EMACS_INT) - 1))
 #endif
 
 (((SIZE) + 2 * sizeof (EMACS_INT)) & ~(sizeof (EMACS_INT) - 1))
 #endif
 

+/* Total number of string blocks now in use.  */
+int n_string_blocks;
+

 void
 init_strings ()
 {
 void
 init_strings ()
 {

-  allocating_for_lisp = 1;
-  current_string_block = (struct string_block *) malloc (sizeof (struct string_block));
-  allocating_for_lisp = 0;
+  current_string_block = (struct string_block *) lisp_malloc (sizeof (struct string_block));

   first_string_block = current_string_block;
   consing_since_gc += sizeof (struct string_block);
   current_string_block->next = 0;
   current_string_block->prev = 0;
   current_string_block->pos = 0;
   large_string_blocks = 0;
   first_string_block = current_string_block;
   consing_since_gc += sizeof (struct string_block);
   current_string_block->next = 0;
   current_string_block->prev = 0;
   current_string_block->pos = 0;
   large_string_blocks = 0;

+  n_string_blocks = 1;

 }
 \f
 DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
 }
 \f
 DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,


@@ -1239,7 +1299,7 @@ LENGTH must be a number.  INIT matters only in whether it is t or nil.")
   bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR;
 
   length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
   bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR;
 
   length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;

-  length_in_chars = length_in_elts * sizeof (EMACS_INT);
+  length_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) / BITS_PER_CHAR);

 
   /* We must allocate one more elements than LENGTH_IN_ELTS for the
      slot `size' of the struct Lisp_Bool_Vector.  */
 
   /* We must allocate one more elements than LENGTH_IN_ELTS for the
      slot `size' of the struct Lisp_Bool_Vector.  */


@@ -1253,6 +1313,10 @@ LENGTH must be a number.  INIT matters only in whether it is t or nil.")
   real_init = (NILP (init) ? 0 : -1);
   for (i = 0; i < length_in_chars ; i++)
     p->data[i] = real_init;
   real_init = (NILP (init) ? 0 : -1);
   for (i = 0; i < length_in_chars ; i++)
     p->data[i] = real_init;

+  /* Clear the extraneous bits in the last byte.  */
+  if (XINT (length) != length_in_chars * BITS_PER_CHAR)
+    XBOOL_VECTOR (val)->data[length_in_chars - 1]
+      &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1;

 
   return val;
 }
 
   return val;
 }


@@ -1378,17 +1442,16 @@ make_uninit_multibyte_string (length, length_byte)
     /* This string gets its own string block */
     {
       register struct string_block *new;
     /* This string gets its own string block */
     {
       register struct string_block *new;

-      allocating_for_lisp = 1;

 #ifdef DOUG_LEA_MALLOC
       /* Prevent mmap'ing the chunk (which is potentially very large).  */
       mallopt (M_MMAP_MAX, 0);
 #endif
 #ifdef DOUG_LEA_MALLOC
       /* Prevent mmap'ing the chunk (which is potentially very large).  */
       mallopt (M_MMAP_MAX, 0);
 #endif

-      new = (struct string_block *) xmalloc (sizeof (struct string_block_head) + fullsize);
+      new = (struct string_block *) lisp_malloc (sizeof (struct string_block_head) + fullsize);

 #ifdef DOUG_LEA_MALLOC
       /* Back to a reasonable maximum of mmap'ed areas. */
 #ifdef DOUG_LEA_MALLOC
       /* Back to a reasonable maximum of mmap'ed areas. */

-      mallopt (M_MMAP_MAX, 64);
+      mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);

 #endif
 #endif

-      allocating_for_lisp = 0;
+      n_string_blocks++;

       VALIDATE_LISP_STORAGE (new, 0);
       consing_since_gc += sizeof (struct string_block_head) + fullsize;
       new->pos = fullsize;
       VALIDATE_LISP_STORAGE (new, 0);
       consing_since_gc += sizeof (struct string_block_head) + fullsize;
       new->pos = fullsize;


@@ -1402,9 +1465,8 @@ make_uninit_multibyte_string (length, length_byte)
     /* Make a new current string block and start it off with this string */
     {
       register struct string_block *new;
     /* Make a new current string block and start it off with this string */
     {
       register struct string_block *new;

-      allocating_for_lisp = 1;
-      new = (struct string_block *) xmalloc (sizeof (struct string_block));
-      allocating_for_lisp = 0;
+      new = (struct string_block *) lisp_malloc (sizeof (struct string_block));
+      n_string_blocks++;

       VALIDATE_LISP_STORAGE (new, sizeof *new);
       consing_since_gc += sizeof (struct string_block);
       current_string_block->next = new;
       VALIDATE_LISP_STORAGE (new, sizeof *new);
       consing_since_gc += sizeof (struct string_block);
       current_string_block->next = new;


@@ -1509,8 +1571,8 @@ pure_cons (car, cdr)
     error ("Pure Lisp storage exhausted");
   XSETCONS (new, PUREBEG + pureptr);
   pureptr += sizeof (struct Lisp_Cons);
     error ("Pure Lisp storage exhausted");
   XSETCONS (new, PUREBEG + pureptr);
   pureptr += sizeof (struct Lisp_Cons);

-  XCONS (new)->car = Fpurecopy (car);
-  XCONS (new)->cdr = Fpurecopy (cdr);
+  XCAR (new) = Fpurecopy (car);
+  XCDR (new) = Fpurecopy (cdr);

   return new;
 }
 
   return new;
 }
 


@@ -1547,7 +1609,7 @@ make_pure_float (num)
     error ("Pure Lisp storage exhausted");
   XSETFLOAT (new, PUREBEG + pureptr);
   pureptr += sizeof (struct Lisp_Float);
     error ("Pure Lisp storage exhausted");
   XSETFLOAT (new, PUREBEG + pureptr);
   pureptr += sizeof (struct Lisp_Float);

-  XFLOAT (new)->data = num;
+  XFLOAT_DATA (new) = num;

   XSETFASTINT (XFLOAT (new)->type, 0); /* bug chasing -wsr */
   return new;
 }
   XSETFASTINT (XFLOAT (new)->type, 0); /* bug chasing -wsr */
   return new;
 }


@@ -1585,10 +1647,10 @@ Does not copy symbols.")
     return obj;
 
   if (CONSP (obj))
     return obj;
 
   if (CONSP (obj))

-    return pure_cons (XCONS (obj)->car, XCONS (obj)->cdr);
+    return pure_cons (XCAR (obj), XCDR (obj));

 #ifdef LISP_FLOAT_TYPE
   else if (FLOATP (obj))
 #ifdef LISP_FLOAT_TYPE
   else if (FLOATP (obj))

-    return make_pure_float (XFLOAT (obj)->data);
+    return make_pure_float (XFLOAT_DATA (obj));

 #endif /* LISP_FLOAT_TYPE */
   else if (STRINGP (obj))
     return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size,
 #endif /* LISP_FLOAT_TYPE */
   else if (STRINGP (obj))
     return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size,


@@ -1621,7 +1683,7 @@ Does not copy symbols.")
 
 struct gcpro *gcprolist;
 
 
 struct gcpro *gcprolist;
 

-#define NSTATICS 768
+#define NSTATICS 1024

 
 Lisp_Object *staticvec[NSTATICS] = {0};
 
 
 Lisp_Object *staticvec[NSTATICS] = {0};
 


@@ -1691,17 +1753,17 @@ Garbage collection happens automatically if you cons more than\n\
   struct catchtag *catch;
   struct handler *handler;
   register struct backtrace *backlist;
   struct catchtag *catch;
   struct handler *handler;
   register struct backtrace *backlist;

-  register Lisp_Object tem;
-  char *omessage = echo_area_glyphs;
-  int omessage_length = echo_area_glyphs_length;
-  int oldmultibyte = message_enable_multibyte;

   char stack_top_variable;
   register int i;
   char stack_top_variable;
   register int i;

+  int message_p;

 
   /* In case user calls debug_print during GC,
      don't let that cause a recursive GC.  */
   consing_since_gc = 0;
 
 
   /* In case user calls debug_print during GC,
      don't let that cause a recursive GC.  */
   consing_since_gc = 0;
 

+  /* Save what's currently displayed in the echo area.  */
+  message_p = push_message ();
+

   /* Save a copy of the contents of the stack, for debugging.  */
 #if MAX_SAVE_STACK > 0
   if (NILP (Vpurify_flag))
   /* Save a copy of the contents of the stack, for debugging.  */
 #if MAX_SAVE_STACK > 0
   if (NILP (Vpurify_flag))


@@ -1728,15 +1790,11 @@ Garbage collection happens automatically if you cons more than\n\
   if (garbage_collection_messages)
     message1_nolog ("Garbage collecting...");
 
   if (garbage_collection_messages)
     message1_nolog ("Garbage collecting...");
 

-  /* Don't keep command history around forever.  */
-  if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
-    {
-      tem = Fnthcdr (Vhistory_length, Vcommand_history);
-      if (CONSP (tem))
-       XCONS (tem)->cdr = Qnil;
-    }
+  BLOCK_INPUT;
+
+  shrink_regexp_cache ();

 
 

-  /* Likewise for undo information.  */
+  /* Don't keep undo information around forever.  */

   {
     register struct buffer *nextb = all_buffers;
 
   {
     register struct buffer *nextb = all_buffers;
 


@@ -1836,19 +1894,19 @@ Garbage collection happens automatically if you cons more than\n\
            prev = Qnil;
            while (CONSP (tail))
              {
            prev = Qnil;
            while (CONSP (tail))
              {

-               if (GC_CONSP (XCONS (tail)->car)
-                   && GC_MARKERP (XCONS (XCONS (tail)->car)->car)
-                   && ! XMARKBIT (XMARKER (XCONS (XCONS (tail)->car)->car)->chain))
+               if (GC_CONSP (XCAR (tail))
+                   && GC_MARKERP (XCAR (XCAR (tail)))
+                   && ! XMARKBIT (XMARKER (XCAR (XCAR (tail)))->chain))

                  {
                    if (NILP (prev))
                  {
                    if (NILP (prev))

-                     nextb->undo_list = tail = XCONS (tail)->cdr;
+                     nextb->undo_list = tail = XCDR (tail);

                    else
                    else

-                     tail = XCONS (prev)->cdr = XCONS (tail)->cdr;
+                     tail = XCDR (prev) = XCDR (tail);

                  }
                else
                  {
                    prev = tail;
                  }
                else
                  {
                    prev = tail;

-                   tail = XCONS (tail)->cdr;
+                   tail = XCDR (tail);

                  }
              }
          }
                  }
              }
          }


@@ -1877,6 +1935,8 @@ Garbage collection happens automatically if you cons more than\n\
   XUNMARK (buffer_defaults.name);
   XUNMARK (buffer_local_symbols.name);
 
   XUNMARK (buffer_defaults.name);
   XUNMARK (buffer_local_symbols.name);
 

+  UNBLOCK_INPUT;
+

   /* clear_marks (); */
   gc_in_progress = 0;
 
   /* clear_marks (); */
   gc_in_progress = 0;
 


@@ -1886,12 +1946,14 @@ Garbage collection happens automatically if you cons more than\n\
 
   if (garbage_collection_messages)
     {
 
   if (garbage_collection_messages)
     {

-      if (omessage || minibuf_level > 0)
-       message2_nolog (omessage, omessage_length, oldmultibyte);
+      if (message_p || minibuf_level > 0)
+       restore_message ();

       else
        message1_nolog ("Garbage collecting...done");
     }
 
       else
        message1_nolog ("Garbage collecting...done");
     }
 

+  pop_message ();
+  

   return Fcons (Fcons (make_number (total_conses),
                       make_number (total_free_conses)),
                Fcons (Fcons (make_number (total_symbols),
   return Fcons (Fcons (make_number (total_conses),
                       make_number (total_free_conses)),
                Fcons (Fcons (make_number (total_symbols),


@@ -1975,6 +2037,92 @@ clear_marks ()
   }
 }
 #endif
   }
 }
 #endif

+
+/* Mark Lisp objects in glyph matrix MATRIX.  Currently the
+   only interesting objects referenced from glyphs are strings.  */
+
+static void
+mark_glyph_matrix (matrix)
+     struct glyph_matrix *matrix;
+{
+  struct glyph_row *row = matrix->rows;
+  struct glyph_row *end = row + matrix->nrows;
+
+  while (row < end)
+    {
+      if (row->enabled_p)
+       {
+         int area;
+         for (area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area)
+           {
+             struct glyph *glyph = row->glyphs[area];
+             struct glyph *end_glyph = glyph + row->used[area];
+             
+             while (glyph < end_glyph)
+               {
+                 if (GC_STRINGP (glyph->object))
+                   mark_object (&glyph->object);
+                 ++glyph;
+               }
+           }
+       }
+      
+      ++row;
+    }
+}
+
+/* Mark Lisp faces in the face cache C.  */
+
+static void
+mark_face_cache (c)
+     struct face_cache *c;
+{
+  if (c)
+    {
+      int i, j;
+      for (i = 0; i < c->used; ++i)
+       {
+         struct face *face = FACE_FROM_ID (c->f, i);
+
+         if (face)
+           {
+             for (j = 0; j < LFACE_VECTOR_SIZE; ++j)
+               mark_object (&face->lface[j]);
+             mark_object (&face->registry);
+           }
+       }
+    }
+}
+
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* Mark Lisp objects in image IMG.  */
+
+static void
+mark_image (img)
+     struct image *img;
+{
+  mark_object (&img->spec);
+  
+  if (!NILP (img->data.lisp_val))
+    mark_object (&img->data.lisp_val);
+}
+
+
+/* Mark Lisp objects in image cache of frame F.  It's done this way so
+   that we don't have to include xterm.h here.  */
+
+static void
+mark_image_cache (f)
+     struct frame *f;
+{
+  forall_images_in_image_cache (f, mark_image);
+}
+
+#endif /* HAVE_X_WINDOWS */
+
+

 \f
 /* Mark reference to a Lisp_Object.
   If the object referred to has not been seen yet, recursively mark
 \f
 /* Mark reference to a Lisp_Object.
   If the object referred to has not been seen yet, recursively mark


@@ -1990,7 +2138,7 @@ clear_marks ()
 Lisp_Object *last_marked[LAST_MARKED_SIZE];
 int last_marked_index;
 
 Lisp_Object *last_marked[LAST_MARKED_SIZE];
 int last_marked_index;
 

-static void
+void

 mark_object (argptr)
      Lisp_Object *argptr;
 {
 mark_object (argptr)
      Lisp_Object *argptr;
 {


@@ -2100,6 +2248,16 @@ mark_object (argptr)
          mark_object (&ptr->menu_bar_vector);
          mark_object (&ptr->buffer_predicate);
          mark_object (&ptr->buffer_list);
          mark_object (&ptr->menu_bar_vector);
          mark_object (&ptr->buffer_predicate);
          mark_object (&ptr->buffer_list);

+         mark_object (&ptr->menu_bar_window);
+         mark_object (&ptr->tool_bar_window);
+         mark_face_cache (ptr->face_cache);
+#ifdef HAVE_WINDOW_SYSTEM
+         mark_image_cache (ptr);
+         mark_object (&ptr->desired_tool_bar_items);
+         mark_object (&ptr->current_tool_bar_items);
+         mark_object (&ptr->desired_tool_bar_string);
+         mark_object (&ptr->current_tool_bar_string);
+#endif /* HAVE_WINDOW_SYSTEM */

        }
       else if (GC_BOOL_VECTOR_P (obj))
        {
        }
       else if (GC_BOOL_VECTOR_P (obj))
        {


@@ -2109,6 +2267,76 @@ mark_object (argptr)
            break;   /* Already marked */
          ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
        }
            break;   /* Already marked */
          ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
        }

+      else if (GC_WINDOWP (obj))
+       {
+         register struct Lisp_Vector *ptr = XVECTOR (obj);
+         struct window *w = XWINDOW (obj);
+         register EMACS_INT size = ptr->size;
+         /* The reason we use ptr1 is to avoid an apparent hardware bug
+            that happens occasionally on the FSF's HP 300s.
+            The bug is that a2 gets clobbered by recursive calls to mark_object.
+            The clobberage seems to happen during function entry,
+            perhaps in the moveml instruction.
+            Yes, this is a crock, but we have to do it.  */
+         struct Lisp_Vector *volatile ptr1 = ptr;
+         register int i;
+
+         /* Stop if already marked.  */
+         if (size & ARRAY_MARK_FLAG)
+           break;
+
+         /* Mark it.  */
+         ptr->size |= ARRAY_MARK_FLAG;
+
+         /* There is no Lisp data above The member CURRENT_MATRIX in
+            struct WINDOW.  Stop marking when that slot is reached.  */
+         for (i = 0;
+              (char *) &ptr1->contents[i] < (char *) &w->current_matrix;
+              i++)
+           mark_object (&ptr1->contents[i]);
+
+         /* Mark glyphs for leaf windows.  Marking window matrices is
+            sufficient because frame matrices use the same glyph
+            memory.  */
+         if (NILP (w->hchild)
+             && NILP (w->vchild)
+             && w->current_matrix)
+           {
+             mark_glyph_matrix (w->current_matrix);
+             mark_glyph_matrix (w->desired_matrix);
+           }
+       }
+      else if (GC_HASH_TABLE_P (obj))
+       {
+         struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
+         EMACS_INT size = h->size;
+         
+         /* Stop if already marked.  */
+         if (size & ARRAY_MARK_FLAG)
+           break;
+
+         /* Mark it.  */
+         h->size |= ARRAY_MARK_FLAG;
+
+         /* Mark contents.  */
+         mark_object (&h->test);
+         mark_object (&h->weak);
+         mark_object (&h->rehash_size);
+         mark_object (&h->rehash_threshold);
+         mark_object (&h->hash);
+         mark_object (&h->next);
+         mark_object (&h->index);
+         mark_object (&h->user_hash_function);
+         mark_object (&h->user_cmp_function);
+
+         /* If hash table is not weak, mark all keys and values.
+            For weak tables, mark only the vector.  */
+         if (GC_NILP (h->weak))
+           mark_object (&h->key_and_value);
+         else
+           XVECTOR (h->key_and_value)->size |= ARRAY_MARK_FLAG;
+           
+       }

       else
        {
          register struct Lisp_Vector *ptr = XVECTOR (obj);
       else
        {
          register struct Lisp_Vector *ptr = XVECTOR (obj);


@@ -2126,6 +2354,7 @@ mark_object (argptr)
          ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
          if (size & PSEUDOVECTOR_FLAG)
            size &= PSEUDOVECTOR_SIZE_MASK;
          ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
          if (size & PSEUDOVECTOR_FLAG)
            size &= PSEUDOVECTOR_SIZE_MASK;

+

          for (i = 0; i < size; i++) /* and then mark its elements */
            mark_object (&ptr1->contents[i]);
        }
          for (i = 0; i < size; i++) /* and then mark its elements */
            mark_object (&ptr1->contents[i]);
        }


@@ -2143,7 +2372,7 @@ mark_object (argptr)
        mark_object (&ptr->function);
        mark_object (&ptr->plist);
        XSETTYPE (*(Lisp_Object *) &ptr->name, Lisp_String);
        mark_object (&ptr->function);
        mark_object (&ptr->plist);
        XSETTYPE (*(Lisp_Object *) &ptr->name, Lisp_String);

-       mark_object (&ptr->name);
+       mark_object ((Lisp_Object *) &ptr->name);

        /* Note that we do not mark the obarray of the symbol.
           It is safe not to do so because nothing accesses that
           slot except to check whether it is nil.  */
        /* Note that we do not mark the obarray of the symbol.
           It is safe not to do so because nothing accesses that
           slot except to check whether it is nil.  */


@@ -2235,7 +2464,7 @@ mark_object (argptr)
          }
        mark_object (&ptr->car);
        /* See comment above under Lisp_Vector for why not use ptr here.  */
          }
        mark_object (&ptr->car);
        /* See comment above under Lisp_Vector for why not use ptr here.  */

-       objptr = &XCONS (obj)->cdr;
+       objptr = &XCDR (obj);

        goto loop;
       }
 
        goto loop;
       }
 


@@ -2282,11 +2511,11 @@ mark_buffer (buf)
            break;
          XMARK (ptr->car);
          if (GC_CONSP (ptr->car)
            break;
          XMARK (ptr->car);
          if (GC_CONSP (ptr->car)

-             && ! XMARKBIT (XCONS (ptr->car)->car)
-             && GC_MARKERP (XCONS (ptr->car)->car))
+             && ! XMARKBIT (XCAR (ptr->car))
+             && GC_MARKERP (XCAR (ptr->car)))

            {
            {

-             XMARK (XCONS (ptr->car)->car);
-             mark_object (&XCONS (ptr->car)->cdr);
+             XMARK (XCAR (ptr->car));
+             mark_object (&XCDR (ptr->car));

            }
          else
            mark_object (&ptr->car);
            }
          else
            mark_object (&ptr->car);


@@ -2297,7 +2526,7 @@ mark_buffer (buf)
            break;
        }
 
            break;
        }
 

-      mark_object (&XCONS (tail)->cdr);
+      mark_object (&XCDR (tail));

     }
   else
     mark_object (&buffer->undo_list);
     }
   else
     mark_object (&buffer->undo_list);


@@ -2346,19 +2575,117 @@ mark_kboards ()
       if (kb->kbd_macro_buffer)
        for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
          mark_object (p);
       if (kb->kbd_macro_buffer)
        for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
          mark_object (p);

+      mark_object (&kb->Voverriding_terminal_local_map);
+      mark_object (&kb->Vlast_command);
+      mark_object (&kb->Vreal_last_command);

       mark_object (&kb->Vprefix_arg);
       mark_object (&kb->Vprefix_arg);

+      mark_object (&kb->Vlast_prefix_arg);

       mark_object (&kb->kbd_queue);
       mark_object (&kb->kbd_queue);

+      mark_object (&kb->defining_kbd_macro);

       mark_object (&kb->Vlast_kbd_macro);
       mark_object (&kb->Vsystem_key_alist);
       mark_object (&kb->system_key_syms);
       mark_object (&kb->Vlast_kbd_macro);
       mark_object (&kb->Vsystem_key_alist);
       mark_object (&kb->system_key_syms);

+      mark_object (&kb->Vdefault_minibuffer_frame);
+    }
+}
+
+
+/* Value is non-zero if OBJ will survive the current GC because it's
+   either marked or does not need to be marked to survive.  */
+
+int
+survives_gc_p (obj)
+     Lisp_Object obj;
+{
+  int survives_p;
+  
+  switch (XGCTYPE (obj))
+    {
+    case Lisp_Int:
+      survives_p = 1;
+      break;
+
+    case Lisp_Symbol:
+      survives_p = XMARKBIT (XSYMBOL (obj)->plist);
+      break;
+
+    case Lisp_Misc:
+      switch (XMISCTYPE (obj))
+       {
+       case Lisp_Misc_Marker:
+         survives_p = XMARKBIT (obj);
+         break;
+         
+       case Lisp_Misc_Buffer_Local_Value:
+       case Lisp_Misc_Some_Buffer_Local_Value:
+         survives_p = XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);
+         break;
+         
+       case Lisp_Misc_Intfwd:
+       case Lisp_Misc_Boolfwd:
+       case Lisp_Misc_Objfwd:
+       case Lisp_Misc_Buffer_Objfwd:
+       case Lisp_Misc_Kboard_Objfwd:
+         survives_p = 1;
+         break;
+         
+       case Lisp_Misc_Overlay:
+         survives_p = XMARKBIT (XOVERLAY (obj)->plist);
+         break;
+
+       default:
+         abort ();
+       }
+      break;
+
+    case Lisp_String:
+      {
+       struct Lisp_String *s = XSTRING (obj);
+
+       if (s->size & MARKBIT)
+         survives_p = s->size & ARRAY_MARK_FLAG;
+       else
+         survives_p = (s->size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE;
+      }
+      break;
+
+    case Lisp_Vectorlike:
+      if (GC_BUFFERP (obj))
+       survives_p = XMARKBIT (XBUFFER (obj)->name);
+      else if (GC_SUBRP (obj))
+       survives_p = 1;
+      else
+       survives_p = XVECTOR (obj)->size & ARRAY_MARK_FLAG;
+      break;
+
+    case Lisp_Cons:
+      survives_p = XMARKBIT (XCAR (obj));
+      break;
+
+#ifdef LISP_FLOAT_TYPE
+    case Lisp_Float:
+      survives_p = XMARKBIT (XFLOAT (obj)->type);
+      break;
+#endif /* LISP_FLOAT_TYPE */
+
+    default:
+      abort ();

     }
     }

+
+  return survives_p;

 }
 }

+
+

 \f
 /* Sweep: find all structures not marked, and free them. */
 
 static void
 gc_sweep ()
 {
 \f
 /* Sweep: find all structures not marked, and free them. */
 
 static void
 gc_sweep ()
 {

+  /* Remove or mark entries in weak hash tables.
+     This must be done before any object is unmarked.  */
+  sweep_weak_hash_tables ();
+

   total_string_size = 0;
   compact_strings ();
 
   total_string_size = 0;
   compact_strings ();
 


@@ -2396,7 +2723,8 @@ gc_sweep ()
            *cprev = cblk->next;
            /* Unhook from the free list.  */
            cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr;
            *cprev = cblk->next;
            /* Unhook from the free list.  */
            cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr;

-           xfree (cblk);
+           lisp_free (cblk);
+           n_cons_blocks--;

          }
        else
          {
          }
        else
          {


@@ -2443,7 +2771,8 @@ gc_sweep ()
            *fprev = fblk->next;
            /* Unhook from the free list.  */
            float_free_list = *(struct Lisp_Float **) &fblk->floats[0].data;
            *fprev = fblk->next;
            /* Unhook from the free list.  */
            float_free_list = *(struct Lisp_Float **) &fblk->floats[0].data;

-           xfree (fblk);
+           lisp_free (fblk);
+           n_float_blocks--;

          }
        else
          {
          }
        else
          {


@@ -2494,7 +2823,8 @@ gc_sweep ()
            *iprev = iblk->next;
            /* Unhook from the free list.  */
            interval_free_list = iblk->intervals[0].parent;
            *iprev = iblk->next;
            /* Unhook from the free list.  */
            interval_free_list = iblk->intervals[0].parent;

-           xfree (iblk);
+           lisp_free (iblk);
+           n_interval_blocks--;

          }
        else
          {
          }
        else
          {


@@ -2543,7 +2873,8 @@ gc_sweep ()
            *sprev = sblk->next;
            /* Unhook from the free list.  */
            symbol_free_list = *(struct Lisp_Symbol **)&sblk->symbols[0].value;
            *sprev = sblk->next;
            /* Unhook from the free list.  */
            symbol_free_list = *(struct Lisp_Symbol **)&sblk->symbols[0].value;

-           xfree (sblk);
+           lisp_free (sblk);
+           n_symbol_blocks--;

          }
        else
          {
          }
        else
          {


@@ -2630,7 +2961,8 @@ gc_sweep ()
            *mprev = mblk->next;
            /* Unhook from the free list.  */
            marker_free_list = mblk->markers[0].u_free.chain;
            *mprev = mblk->next;
            /* Unhook from the free list.  */
            marker_free_list = mblk->markers[0].u_free.chain;

-           xfree (mblk);
+           lisp_free (mblk);
+           n_marker_blocks--;

          }
        else
          {
          }
        else
          {


@@ -2691,13 +3023,20 @@ gc_sweep ()
     while (vector)
       if (!(vector->size & ARRAY_MARK_FLAG))
        {
     while (vector)
       if (!(vector->size & ARRAY_MARK_FLAG))
        {

+#if 0
+         if ((vector->size & (PSEUDOVECTOR_FLAG | PVEC_HASH_TABLE))
+             == (PSEUDOVECTOR_FLAG | PVEC_HASH_TABLE))
+           fprintf (stderr, "Freeing hash table %p\n", vector);
+#endif

          if (prev)
            prev->next = vector->next;
          else
            all_vectors = vector->next;
          next = vector->next;
          if (prev)
            prev->next = vector->next;
          else
            all_vectors = vector->next;
          next = vector->next;

-         xfree (vector);
+         lisp_free (vector);
+         n_vectors--;

          vector = next;
          vector = next;

+

        }
       else
        {
        }
       else
        {


@@ -2733,8 +3072,9 @@ gc_sweep ()
            else
              large_string_blocks = sb->next;
            next = sb->next;
            else
              large_string_blocks = sb->next;
            next = sb->next;

-           xfree (sb);
+           lisp_free (sb);

            sb = next;
            sb = next;

+           n_string_blocks--;

          }
       }
   }
          }
       }
   }


@@ -2861,7 +3201,8 @@ compact_strings ()
   while (from_sb)
     {
       to_sb = from_sb->next;
   while (from_sb)
     {
       to_sb = from_sb->next;

-      xfree (from_sb);
+      lisp_free (from_sb);
+      n_string_blocks--;

       from_sb = to_sb;
     }
 
       from_sb = to_sb;
     }
 


@@ -2870,13 +3211,14 @@ compact_strings ()
      unlikely that that one will become empty, so why bother checking?  */
 
   from_sb = first_string_block;
      unlikely that that one will become empty, so why bother checking?  */
 
   from_sb = first_string_block;

-  while (to_sb = from_sb->next)
+  while ((to_sb = from_sb->next) != 0)

     {
       if (to_sb->pos == 0)
        {
     {
       if (to_sb->pos == 0)
        {

-         if (from_sb->next = to_sb->next)
+         if ((from_sb->next = to_sb->next) != 0)

            from_sb->next->prev = from_sb;
            from_sb->next->prev = from_sb;

-         xfree (to_sb);
+         lisp_free (to_sb);
+         n_string_blocks--;

        }
       else
        from_sb = to_sb;
        }
       else
        from_sb = to_sb;


@@ -2961,7 +3303,7 @@ init_alloc_once ()
 #ifdef DOUG_LEA_MALLOC
   mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
   mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
 #ifdef DOUG_LEA_MALLOC
   mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
   mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */

-  mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */
+  mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* max. number of mmap'ed areas */

 #endif
   init_strings ();
   init_cons ();
 #endif
   init_strings ();
   init_cons ();