master dd0e4d4: Let the OS clear large new objects

[Paul Eggert]

branch: master
commit dd0e4d4e16fbbba6189610c7abb73d8b0efc6e5e
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    Let the OS clear large new objects
    
    Prefer calloc to malloc+memset when allocating large zeroed objects.
    This avoids page thrashing when (make-vector 1000000000 nil)
    allocates a large nil vector, as Emacs need not touch the
    vector’s pages.  This wins on platforms like GNU/Linux where
    calloc can fiddle with page tables to create a block of memory
    that is lazily zeroed.
    * src/alloc.c (lisp_malloc, lmalloc, allocate_vectorlike):
    New arg CLEARIT to tell callee whether to use malloc or calloc.
    All callers changed.
    (allocate_clear_vector, allocate_nil_vector): New functions.
    * src/alloc.c (xzalloc, make_vector):
    * src/lisp.h (make_nil_vector):
    Prefer calloc to malloc + memset(...,0,...).
---
 src/alloc.c | 87 ++++++++++++++++++++++++++++++++++++++++---------------------
 src/lisp.h  |  5 ++--
 2 files changed, 59 insertions(+), 33 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 1c6b664..dbe37f4 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -694,7 +694,7 @@ malloc_unblock_input (void)
       malloc_probe (size);                     \
   } while (0)
 
-static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
+static void *lmalloc (size_t, bool) ATTRIBUTE_MALLOC_SIZE ((1));
 static void *lrealloc (void *, size_t);
 
 /* Like malloc but check for no memory and block interrupt input.  */
@@ -705,7 +705,7 @@ xmalloc (size_t size)
   void *val;
 
   MALLOC_BLOCK_INPUT;
-  val = lmalloc (size);
+  val = lmalloc (size, false);
   MALLOC_UNBLOCK_INPUT;
 
   if (!val && size)
@@ -722,12 +722,11 @@ xzalloc (size_t size)
   void *val;
 
   MALLOC_BLOCK_INPUT;
-  val = lmalloc (size);
+  val = lmalloc (size, true);
   MALLOC_UNBLOCK_INPUT;
 
   if (!val && size)
     memory_full (size);
-  memset (val, 0, size);
   MALLOC_PROBE (size);
   return val;
 }
@@ -743,7 +742,7 @@ xrealloc (void *block, size_t size)
   /* We must call malloc explicitly when BLOCK is 0, since some
      reallocs don't do this.  */
   if (! block)
-    val = lmalloc (size);
+    val = lmalloc (size, false);
   else
     val = lrealloc (block, size);
   MALLOC_UNBLOCK_INPUT;
@@ -939,7 +938,7 @@ void *lisp_malloc_loser EXTERNALLY_VISIBLE;
 #endif
 
 static void *
-lisp_malloc (size_t nbytes, enum mem_type type)
+lisp_malloc (size_t nbytes, bool clearit, enum mem_type type)
 {
   register void *val;
 
@@ -949,7 +948,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
   allocated_mem_type = type;
 #endif
 
-  val = lmalloc (nbytes);
+  val = lmalloc (nbytes, clearit);
 
 #if ! USE_LSB_TAG
   /* If the memory just allocated cannot be addressed thru a Lisp
@@ -1290,16 +1289,21 @@ laligned (void *p, size_t size)
    that's never really exercised) for little benefit.  */
 
 static void *
-lmalloc (size_t size)
+lmalloc (size_t size, bool clearit)
 {
 #ifdef USE_ALIGNED_ALLOC
   if (! MALLOC_IS_LISP_ALIGNED && size % LISP_ALIGNMENT == 0)
-    return aligned_alloc (LISP_ALIGNMENT, size);
+    {
+      void *p = aligned_alloc (LISP_ALIGNMENT, size);
+      if (clearit && p)
+       memclear (p, size);
+      return p;
+    }
 #endif
 
   while (true)
     {
-      void *p = malloc (size);
+      void *p = clearit ? calloc (1, size) : malloc (size);
       if (laligned (p, size))
        return p;
       free (p);
@@ -1377,7 +1381,7 @@ make_interval (void)
       if (interval_block_index == INTERVAL_BLOCK_SIZE)
        {
          struct interval_block *newi
-           = lisp_malloc (sizeof *newi, MEM_TYPE_NON_LISP);
+           = lisp_malloc (sizeof *newi, false, MEM_TYPE_NON_LISP);
 
          newi->next = interval_block;
          interval_block = newi;
@@ -1730,7 +1734,7 @@ allocate_string (void)
      add all the Lisp_Strings in it to the free-list.  */
   if (string_free_list == NULL)
     {
-      struct string_block *b = lisp_malloc (sizeof *b, MEM_TYPE_STRING);
+      struct string_block *b = lisp_malloc (sizeof *b, false, MEM_TYPE_STRING);
       int i;
 
       b->next = string_blocks;
@@ -1813,7 +1817,7 @@ allocate_string_data (struct Lisp_String *s,
         mallopt (M_MMAP_MAX, 0);
 #endif
 
-      b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
+      b = lisp_malloc (size + GC_STRING_EXTRA, false, MEM_TYPE_NON_LISP);
 
 #ifdef DOUG_LEA_MALLOC
       if (!mmap_lisp_allowed_p ())
@@ -1831,7 +1835,7 @@ allocate_string_data (struct Lisp_String *s,
               < (needed + GC_STRING_EXTRA)))
     {
       /* Not enough room in the current sblock.  */
-      b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP);
+      b = lisp_malloc (SBLOCK_SIZE, false, MEM_TYPE_NON_LISP);
       data = b->data;
       b->next = NULL;
       b->next_free = data;
@@ -3137,7 +3141,7 @@ sweep_vectors (void)
    at most VECTOR_ELTS_MAX.  */
 
 static struct Lisp_Vector *
-allocate_vectorlike (ptrdiff_t len)
+allocate_vectorlike (ptrdiff_t len, bool clearit)
 {
   eassert (0 < len && len <= VECTOR_ELTS_MAX);
   ptrdiff_t nbytes = header_size + len * word_size;
@@ -3151,11 +3155,15 @@ allocate_vectorlike (ptrdiff_t len)
 #endif
 
   if (nbytes <= VBLOCK_BYTES_MAX)
-    p = allocate_vector_from_block (vroundup (nbytes));
+    {
+      p = allocate_vector_from_block (vroundup (nbytes));
+      if (clearit)
+       memclear (p, nbytes);
+    }
   else
     {
       struct large_vector *lv = lisp_malloc (large_vector_offset + nbytes,
-                                            MEM_TYPE_VECTORLIKE);
+                                            clearit, MEM_TYPE_VECTORLIKE);
       lv->next = large_vectors;
       large_vectors = lv;
       p = large_vector_vec (lv);
@@ -3178,20 +3186,37 @@ allocate_vectorlike (ptrdiff_t len)
 }
 
 
-/* Allocate a vector with LEN slots.  */
+/* Allocate a vector with LEN slots.  If CLEARIT, clear its slots;
+   otherwise the vector's slots are uninitialized.  */
 
-struct Lisp_Vector *
-allocate_vector (ptrdiff_t len)
+static struct Lisp_Vector *
+allocate_clear_vector (ptrdiff_t len, bool clearit)
 {
   if (len == 0)
     return XVECTOR (zero_vector);
   if (VECTOR_ELTS_MAX < len)
     memory_full (SIZE_MAX);
-  struct Lisp_Vector *v = allocate_vectorlike (len);
+  struct Lisp_Vector *v = allocate_vectorlike (len, clearit);
   v->header.size = len;
   return v;
 }
 
+/* Allocate a vector with LEN uninitialized slots.  */
+
+struct Lisp_Vector *
+allocate_vector (ptrdiff_t len)
+{
+  return allocate_clear_vector (len, false);
+}
+
+/* Allocate a vector with LEN nil slots.  */
+
+struct Lisp_Vector *
+allocate_nil_vector (ptrdiff_t len)
+{
+  return allocate_clear_vector (len, true);
+}
+
 
 /* Allocate other vector-like structures.  */
 
@@ -3208,7 +3233,7 @@ allocate_pseudovector (int memlen, int lisplen,
   eassert (lisplen <= size_max);
   eassert (memlen <= size_max + rest_max);
 
-  struct Lisp_Vector *v = allocate_vectorlike (memlen);
+  struct Lisp_Vector *v = allocate_vectorlike (memlen, false);
   /* Only the first LISPLEN slots will be traced normally by the GC.  */
   memclear (v->contents, zerolen * word_size);
   XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
@@ -3218,7 +3243,7 @@ allocate_pseudovector (int memlen, int lisplen,
 struct buffer *
 allocate_buffer (void)
 {
-  struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER);
+  struct buffer *b = lisp_malloc (sizeof *b, false, MEM_TYPE_BUFFER);
 
   BUFFER_PVEC_INIT (b);
   /* Put B on the chain of all buffers including killed ones.  */
@@ -3238,7 +3263,7 @@ allocate_record (EMACS_INT count)
   if (count > PSEUDOVECTOR_SIZE_MASK)
     error ("Attempt to allocate a record of %"pI"d slots; max is %d",
           count, PSEUDOVECTOR_SIZE_MASK);
-  struct Lisp_Vector *p = allocate_vectorlike (count);
+  struct Lisp_Vector *p = allocate_vectorlike (count, false);
   p->header.size = count;
   XSETPVECTYPE (p, PVEC_RECORD);
   return p;
@@ -3291,9 +3316,11 @@ See also the function `vector'.  */)
 Lisp_Object
 make_vector (ptrdiff_t length, Lisp_Object init)
 {
-  struct Lisp_Vector *p = allocate_vector (length);
-  for (ptrdiff_t i = 0; i < length; i++)
-    p->contents[i] = init;
+  bool clearit = NIL_IS_ZERO && NILP (init);
+  struct Lisp_Vector *p = allocate_clear_vector (length, clearit);
+  if (!clearit)
+    for (ptrdiff_t i = 0; i < length; i++)
+      p->contents[i] = init;
   return make_lisp_ptr (p, Lisp_Vectorlike);
 }
 
@@ -3442,7 +3469,7 @@ Its value is void, and its function definition and 
property list are nil.  */)
       if (symbol_block_index == SYMBOL_BLOCK_SIZE)
        {
          struct symbol_block *new
-           = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL);
+           = lisp_malloc (sizeof *new, false, MEM_TYPE_SYMBOL);
          new->next = symbol_block;
          symbol_block = new;
          symbol_block_index = 0;
@@ -3904,10 +3931,10 @@ refill_memory_reserve (void)
                                         MEM_TYPE_SPARE);
   if (spare_memory[5] == 0)
     spare_memory[5] = lisp_malloc (sizeof (struct string_block),
-                                  MEM_TYPE_SPARE);
+                                  false, MEM_TYPE_SPARE);
   if (spare_memory[6] == 0)
     spare_memory[6] = lisp_malloc (sizeof (struct string_block),
-                                  MEM_TYPE_SPARE);
+                                  false, MEM_TYPE_SPARE);
   if (spare_memory[0] && spare_memory[1] && spare_memory[5])
     Vmemory_full = Qnil;
 #endif
diff --git a/src/lisp.h b/src/lisp.h
index 8674fe1..356692d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3942,6 +3942,7 @@ extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
 extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object);
 extern void make_byte_code (struct Lisp_Vector *);
 extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
+extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t);
 
 /* Make an uninitialized vector for SIZE objects.  NOTE: you must
    be sure that GC cannot happen until the vector is completely
@@ -3977,9 +3978,7 @@ make_uninit_sub_char_table (int depth, int min_char)
 INLINE Lisp_Object
 make_nil_vector (ptrdiff_t size)
 {
-  Lisp_Object vec = make_uninit_vector (size);
-  memclear (XVECTOR (vec)->contents, size * word_size);
-  return vec;
+  return make_lisp_ptr (allocate_nil_vector (size), Lisp_Vectorlike);
 }
 
 extern struct Lisp_Vector *allocate_pseudovector (int, int, int,