(map_char_table): New arg SUBTABLE. Callers changed.

[gnu-emacs] / src / alloc.c

diff --git a/src/alloc.c b/src/alloc.c
index 41857cfba939975221f7b9da91d3c22cc66ecbb3..536286ff16639680681c9962d97076af691d2e42 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1,5 +1,5 @@
 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
-   Copyright (C) 1985, 86, 88, 93, 94, 95 Free Software Foundation, Inc.
+   Copyright (C) 1985, 86, 88, 93, 94, 95, 97 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -37,6 +37,10 @@ Boston, MA 02111-1307, USA.  */
 
 extern char *sbrk ();
 
+#ifdef DOUG_LEA_MALLOC
+#include <malloc.h>
+#define __malloc_size_t int
+#else
 /* The following come from gmalloc.c.  */
 
 #if defined (__STDC__) && __STDC__
@@ -47,6 +51,7 @@ extern char *sbrk ();
 #endif
 extern __malloc_size_t _bytes_used;
 extern int __malloc_extra_blocks;
+#endif /* !defined(DOUG_LEA_MALLOC) */
 
 extern Lisp_Object Vhistory_length;
 
@@ -208,12 +213,18 @@ display_malloc_warning ()
   internal_with_output_to_temp_buffer (" *Danger*", malloc_warning_1, val);
 }
 
+#ifdef DOUG_LEA_MALLOC
+  #define BYTES_USED (mallinfo ().arena)
+#else
+  #define BYTES_USED _bytes_used
+#endif
+
 /* Called if malloc returns zero */
 
 memory_full ()
 {
 #ifndef SYSTEM_MALLOC
-  bytes_used_when_full = _bytes_used;
+  bytes_used_when_full = BYTES_USED;
 #endif
 
   /* The first time we get here, free the spare memory.  */
@@ -333,7 +344,7 @@ emacs_blocked_free (ptr)
         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 + max (malloc_hysteresis, 4) * SPARE_MEMORY))
+         > BYTES_USED + max (malloc_hysteresis, 4) * SPARE_MEMORY))
     spare_memory = (char *) malloc (SPARE_MEMORY);
 
   __free_hook = emacs_blocked_free;
@@ -363,7 +374,11 @@ emacs_blocked_malloc (size)
 
   BLOCK_INPUT;
   __malloc_hook = old_malloc_hook;
-  __malloc_extra_blocks = malloc_hysteresis;
+  #ifdef DOUG_LEA_MALLOC
+    mallopt (M_TOP_PAD, malloc_hysteresis * 4096);
+  #else
+    __malloc_extra_blocks = malloc_hysteresis;
+  #endif
   value = (void *) malloc (size);
   __malloc_hook = emacs_blocked_malloc;
   UNBLOCK_INPUT;
@@ -731,8 +746,16 @@ allocate_vectorlike (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
   p = (struct Lisp_Vector *)xmalloc (sizeof (struct Lisp_Vector)
                                     + (len - 1) * sizeof (Lisp_Object));
+#ifdef DOUG_LEA_MALLOC
+  /* Back to a reasonable maximum of mmap'ed areas. */
+  mallopt (M_MMAP_MAX, 64);
+#endif
   allocating_for_lisp = 0;
   VALIDATE_LISP_STORAGE (p, 0);
   consing_since_gc += (sizeof (struct Lisp_Vector)
@@ -778,20 +801,36 @@ The property's value should be an integer between 0 and 10.")
   Lisp_Object vector;
   Lisp_Object n;
   CHECK_SYMBOL (purpose, 1);
-  /* For a deeper char-table, PURPOSE can be nil.  */
-  n = NILP (purpose) ? 0 : Fget (purpose, Qchar_table_extra_slots);
+  n = Fget (purpose, Qchar_table_extra_slots);
   CHECK_NUMBER (n, 0);
   if (XINT (n) < 0 || XINT (n) > 10)
     args_out_of_range (n, Qnil);
   /* Add 2 to the size for the defalt and parent slots.  */
   vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)),
                         init);
+  XCHAR_TABLE (vector)->top = Qt;
   XCHAR_TABLE (vector)->parent = Qnil;
   XCHAR_TABLE (vector)->purpose = purpose;
   XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
   return vector;
 }
 
+/* Return a newly created sub char table with default value DEFALT.
+   Since a sub char table does not appear as a top level Emacs Lisp
+   object, we don't need a Lisp interface to make it.  */
+
+Lisp_Object
+make_sub_char_table (defalt)
+     Lisp_Object defalt;
+{
+  Lisp_Object vector
+    = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), Qnil);
+  XCHAR_TABLE (vector)->top = Qnil;
+  XCHAR_TABLE (vector)->defalt = defalt;
+  XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
+  return vector;
+}
+
 DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
   "Return a newly created vector with specified arguments as elements.\n\
 Any number of arguments, even zero arguments, are allowed.")
@@ -1164,7 +1203,15 @@ make_uninit_string (length)
     {
       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
       new = (struct string_block *) xmalloc (sizeof (struct string_block_head) + fullsize);
+#ifdef DOUG_LEA_MALLOC
+      /* Back to a reasonable maximum of mmap'ed areas. */
+      mallopt (M_MMAP_MAX, 64);
+#endif
       allocating_for_lisp = 0;
       VALIDATE_LISP_STORAGE (new, 0);
       consing_since_gc += sizeof (struct string_block_head) + fullsize;
@@ -1833,6 +1880,7 @@ mark_object (argptr)
          mark_object (&ptr->face_alist);
          mark_object (&ptr->menu_bar_vector);
          mark_object (&ptr->buffer_predicate);
+         mark_object (&ptr->buffer_list);
        }
       else if (GC_BOOL_VECTOR_P (obj))
        {
@@ -2562,6 +2610,11 @@ init_alloc_once ()
 #endif
   all_vectors = 0;
   ignore_warnings = 1;
+#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 */
+#endif
   init_strings ();
   init_cons ();
   init_symbol ();