master cadf985: Let the OS clear new large strings of NUL

[Paul Eggert]

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

    Let the OS clear new large strings of NUL
    
    On my platform, this sped up (make-string 4000000000 0) from 2.5
    to 0.015 seconds (not that people should want to do this much :-).
    * src/alloc.c (allocate_string_data): New arg CLEARIT.
    Callers changed.
    (Fmake_string): Prefer calloc to malloc+memset when allocating a
    large string of NUL bytes.
    (make_clear_string): New function.
    (make_uninit_string): Use it.
    (make_clear_multibyte_string): New function.
    (make_uninit_multibyte_string): Use it.
---
 src/alloc.c | 87 ++++++++++++++++++++++++++++++++++++++++---------------------
 src/data.c  |  2 +-
 src/lisp.h  |  3 ++-
 3 files changed, 61 insertions(+), 31 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 29ccb38..d6d456a 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1782,11 +1782,13 @@ allocate_string (void)
    plus a NUL byte at the end.  Allocate an sdata structure DATA for
    S, and set S->u.s.data to SDATA->u.data.  Store a NUL byte at the
    end of S->u.s.data.  Set S->u.s.size to NCHARS and S->u.s.size_byte
-   to NBYTES.  Free S->u.s.data if it was initially non-null.  */
+   to NBYTES.  Free S->u.s.data if it was initially non-null.
+
+   If CLEARIT, also clear the other bytes of S->u.s.data.  */
 
 void
 allocate_string_data (struct Lisp_String *s,
-                     EMACS_INT nchars, EMACS_INT nbytes)
+                     EMACS_INT nchars, EMACS_INT nbytes, bool clearit)
 {
   sdata *data, *old_data;
   struct sblock *b;
@@ -1817,7 +1819,7 @@ allocate_string_data (struct Lisp_String *s,
         mallopt (M_MMAP_MAX, 0);
 #endif
 
-      b = lisp_malloc (size + GC_STRING_EXTRA, false, MEM_TYPE_NON_LISP);
+      b = lisp_malloc (size + GC_STRING_EXTRA, clearit, MEM_TYPE_NON_LISP);
 
 #ifdef DOUG_LEA_MALLOC
       if (!mmap_lisp_allowed_p ())
@@ -1850,6 +1852,8 @@ allocate_string_data (struct Lisp_String *s,
     {
       b = current_sblock;
       data = b->next_free;
+      if (clearit)
+       memset (SDATA_DATA (data), 0, nbytes);
     }
 
   data->string = s;
@@ -2114,6 +2118,9 @@ string_overflow (void)
   error ("Maximum string size exceeded");
 }
 
+static Lisp_Object make_clear_string (EMACS_INT, bool);
+static Lisp_Object make_clear_multibyte_string (EMACS_INT, EMACS_INT, bool);
+
 DEFUN ("make-string", Fmake_string, Smake_string, 2, 3, 0,
        doc: /* Return a newly created string of length LENGTH, with INIT in 
each element.
 LENGTH must be an integer.
@@ -2122,19 +2129,20 @@ If optional argument MULTIBYTE is non-nil, the result 
will be
 a multibyte string even if INIT is an ASCII character.  */)
   (Lisp_Object length, Lisp_Object init, Lisp_Object multibyte)
 {
-  register Lisp_Object val;
-  int c;
+  Lisp_Object val;
   EMACS_INT nbytes;
 
   CHECK_FIXNAT (length);
   CHECK_CHARACTER (init);
 
-  c = XFIXNAT (init);
+  int c = XFIXNAT (init);
+  bool clearit = !c;
+
   if (ASCII_CHAR_P (c) && NILP (multibyte))
     {
       nbytes = XFIXNUM (length);
-      val = make_uninit_string (nbytes);
-      if (nbytes)
+      val = make_clear_string (nbytes, clearit);
+      if (nbytes && !clearit)
        {
          memset (SDATA (val), c, nbytes);
          SDATA (val)[nbytes] = 0;
@@ -2145,26 +2153,27 @@ a multibyte string even if INIT is an ASCII character.  
*/)
       unsigned char str[MAX_MULTIBYTE_LENGTH];
       ptrdiff_t len = CHAR_STRING (c, str);
       EMACS_INT string_len = XFIXNUM (length);
-      unsigned char *p, *beg, *end;
 
       if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes))
        string_overflow ();
-      val = make_uninit_multibyte_string (string_len, nbytes);
-      for (beg = SDATA (val), p = beg, end = beg + nbytes; p < end; p += len)
+      val = make_clear_multibyte_string (string_len, nbytes, clearit);
+      if (!clearit)
        {
-         /* First time we just copy `str' to the data of `val'.  */
-         if (p == beg)
-           memcpy (p, str, len);
-         else
+         unsigned char *beg = SDATA (val), *end = beg + nbytes;
+         for (unsigned char *p = beg; p < end; p += len)
            {
-             /* Next time we copy largest possible chunk from
-                initialized to uninitialized part of `val'.  */
-             len = min (p - beg, end - p);
-             memcpy (p, beg, len);
+             /* First time we just copy STR to the data of VAL.  */
+             if (p == beg)
+               memcpy (p, str, len);
+             else
+               {
+                 /* Next time we copy largest possible chunk from
+                    initialized to uninitialized part of VAL.  */
+                 len = min (p - beg, end - p);
+                 memcpy (p, beg, len);
+               }
            }
        }
-      if (nbytes)
-       *p = 0;
     }
 
   return val;
@@ -2334,26 +2343,37 @@ make_specified_string (const char *contents,
 
 
 /* Return a unibyte Lisp_String set up to hold LENGTH characters
-   occupying LENGTH bytes.  */
+   occupying LENGTH bytes.  If CLEARIT, clear its contents to null
+   bytes; otherwise, the contents are uninitialized.  */
 
-Lisp_Object
-make_uninit_string (EMACS_INT length)
+static Lisp_Object
+make_clear_string (EMACS_INT length, bool clearit)
 {
   Lisp_Object val;
 
   if (!length)
     return empty_unibyte_string;
-  val = make_uninit_multibyte_string (length, length);
+  val = make_clear_multibyte_string (length, length, clearit);
   STRING_SET_UNIBYTE (val);
   return val;
 }
 
+/* Return a unibyte Lisp_String set up to hold LENGTH characters
+   occupying LENGTH bytes.  */
+
+Lisp_Object
+make_uninit_string (EMACS_INT length)
+{
+  return make_clear_string (length, false);
+}
+
 
 /* Return a multibyte Lisp_String set up to hold NCHARS characters
-   which occupy NBYTES bytes.  */
+   which occupy NBYTES bytes.  If CLEARIT, clear its contents to null
+   bytes; otherwise, the contents are uninitialized.  */
 
-Lisp_Object
-make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
+static Lisp_Object
+make_clear_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes, bool clearit)
 {
   Lisp_Object string;
   struct Lisp_String *s;
@@ -2365,12 +2385,21 @@ make_uninit_multibyte_string (EMACS_INT nchars, 
EMACS_INT nbytes)
 
   s = allocate_string ();
   s->u.s.intervals = NULL;
-  allocate_string_data (s, nchars, nbytes);
+  allocate_string_data (s, nchars, nbytes, clearit);
   XSETSTRING (string, s);
   string_chars_consed += nbytes;
   return string;
 }
 
+/* Return a multibyte Lisp_String set up to hold NCHARS characters
+   which occupy NBYTES bytes.  */
+
+Lisp_Object
+make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
+{
+  return make_clear_multibyte_string (nchars, nbytes, false);
+}
+
 /* Print arguments to BUF according to a FORMAT, then return
    a Lisp_String initialized with the data from BUF.  */
 
diff --git a/src/data.c b/src/data.c
index 56e363f..c8445e7 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2321,7 +2321,7 @@ bool-vector.  IDX starts at 0.  */)
 
              memcpy (str, SDATA (array), nbytes);
              allocate_string_data (XSTRING (array), nchars,
-                                   nbytes + new_bytes - prev_bytes);
+                                   nbytes + new_bytes - prev_bytes, false);
              memcpy (SDATA (array), str, idxval_byte);
              p1 = SDATA (array) + idxval_byte;
              memcpy (p1 + new_bytes, str + idxval_byte + prev_bytes,
diff --git a/src/lisp.h b/src/lisp.h
index 36bb79d..9be7bfe 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3812,7 +3812,8 @@ extern void parse_str_as_multibyte (const unsigned char 
*, ptrdiff_t,
 /* Defined in alloc.c.  */
 extern void *my_heap_start (void);
 extern void check_pure_size (void);
-extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT);
+extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT,
+                                 bool);
 extern void malloc_warning (const char *);
 extern AVOID memory_full (size_t);
 extern AVOID buffer_memory_full (ptrdiff_t);