[Emacs-diffs] master 17cb263: New C macro AUTO_STRING_WITH_LEN

[Paul Eggert]

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

    New C macro AUTO_STRING_WITH_LEN
    
    Put a bit less pressure on the garbage collector by defining a
    macro that is like AUTO_STRING but also allows null bytes in strings,
    and by extending AUTO_STRING to work with any unibyte string.
    * src/alloc.c (verify_ascii): Remove; all uses removed.
    AUTO_STRING can now be used on non-ASCII unibyte strings.
    * src/lisp.h (AUTO_STRING): Now allows non-ASCII unibyte strings.
    (AUTO_STRING_WITH_LEN): New macro.
    * src/coding.c (from_unicode_buffer):
    * src/editfns.c (format_time_string):
    * src/emacs-module.c (module_make_string, module_format_fun_env):
    * src/fileio.c (Fexpand_file_name):
    * src/font.c (font_parse_family_registry):
    * src/ftfont.c (ftfont_get_charset):
    * src/keymap.c (silly_event_symbol_error):
    * src/menu.c (single_menu_item):
    * src/sysdep.c (system_process_attributes):
    Use AUTO_STRING_WITH_LEN if possible.
    * src/emacs-module.c (module_make_function):
    * src/fileio.c (report_file_errno, report_file_notify_error):
    * src/fns.c (Flocale_info):
    * src/sysdep.c (system_process_attributes):
    Use AUTO_STRING if possible.  This is doable more often now
    that AUTO_STRING works on any unibyte string.
---
 src/alloc.c        |   15 ---------------
 src/coding.c       |    9 ++++-----
 src/editfns.c      |    7 ++++---
 src/emacs-module.c |   20 ++++++++++++--------
 src/fileio.c       |   14 ++++++--------
 src/fns.c          |    5 ++---
 src/font.c         |    3 ++-
 src/ftfont.c       |    5 ++---
 src/keymap.c       |    2 +-
 src/lisp.h         |   28 +++++++++++++++-------------
 src/menu.c         |    2 +-
 src/sysdep.c       |   30 ++++++++++++++----------------
 12 files changed, 63 insertions(+), 77 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 56a5354..c5a4f42 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -7216,21 +7216,6 @@ die (const char *msg, const char *file, int line)
 
 #if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS
 
-/* Debugging check whether STR is ASCII-only.  */
-
-const char *
-verify_ascii (const char *str)
-{
-  const unsigned char *ptr = (unsigned char *) str, *end = ptr + strlen (str);
-  while (ptr < end)
-    {
-      int c = STRING_CHAR_ADVANCE (ptr);
-      if (!ASCII_CHAR_P (c))
-       emacs_abort ();
-    }
-  return str;
-}
-
 /* Stress alloca with inconveniently sized requests and check
    whether all allocated areas may be used for Lisp_Object.  */
 
diff --git a/src/coding.c b/src/coding.c
index e72d7b7..bcedd7f 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -8419,11 +8419,10 @@ from_unicode (Lisp_Object str)
 Lisp_Object
 from_unicode_buffer (const wchar_t *wstr)
 {
-    return from_unicode (
-        make_unibyte_string (
-            (char *) wstr,
-            /* we get one of the two final 0 bytes for free. */
-            1 + sizeof (wchar_t) * wcslen (wstr)));
+  /* We get one of the two final null bytes for free.  */
+  prtdiff_t len = 1 + sizeof (wchar_t) * wcslen (wstr);
+  AUTO_STRING_WITH_LEN (str, (char *) wstr, len);
+  return from_unicode (str);
 }
 
 wchar_t *
diff --git a/src/editfns.c b/src/editfns.c
index 664a59e..a2d5673 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -2042,7 +2042,6 @@ format_time_string (char const *format, ptrdiff_t 
formatlen,
   char *buf = buffer;
   ptrdiff_t size = sizeof buffer;
   size_t len;
-  Lisp_Object bufstring;
   int ns = t.tv_nsec;
   USE_SAFE_ALLOCA;
 
@@ -2074,9 +2073,11 @@ format_time_string (char const *format, ptrdiff_t 
formatlen,
     }
 
   xtzfree (tz);
-  bufstring = make_unibyte_string (buf, len);
+  AUTO_STRING_WITH_LEN (bufstring, buf, len);
+  Lisp_Object result = code_convert_string_norecord (bufstring,
+                                                    Vlocale_coding_system, 0);
   SAFE_FREE ();
-  return code_convert_string_norecord (bufstring, Vlocale_coding_system, 0);
+  return result;
 }
 
 DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 2, 0,
diff --git a/src/emacs-module.c b/src/emacs-module.c
index b57636e..724d24a 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -395,11 +395,13 @@ module_make_function (emacs_env *env, ptrdiff_t 
min_arity, ptrdiff_t max_arity,
   envptr->data = data;
 
   Lisp_Object envobj = make_save_ptr (envptr);
-  Lisp_Object doc
-    = (documentation
-       ? code_convert_string_norecord (build_unibyte_string (documentation),
-                                      Qutf_8, false)
-       : Qnil);
+  Lisp_Object doc = Qnil;
+  if (documentation)
+    {
+      AUTO_STRING (unibyte_doc, documentation);
+      doc = code_convert_string_norecord (unibyte_doc, Qutf_8, false);
+    }
+
   /* FIXME: Use a bytecompiled object, or even better a subr.  */
   Lisp_Object ret = list4 (Qlambda,
                            list2 (Qand_rest, Qargs),
@@ -537,7 +539,7 @@ static emacs_value
 module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
 {
   MODULE_FUNCTION_BEGIN (module_nil);
-  Lisp_Object lstr = make_unibyte_string (str, length);
+  AUTO_STRING_WITH_LEN (lstr, str, length);
   return lisp_to_value (code_convert_string_norecord (lstr, Qutf_8, false));
 }
 
@@ -992,10 +994,12 @@ module_format_fun_env (const struct module_fun_env *env)
        ? exprintf (&buf, &bufsize, buffer, -1,
                   "#<module function %s from %s>", sym, path)
        : sprintf (buffer, noaddr_format, env->subr));
-  Lisp_Object unibyte_result = make_unibyte_string (buffer, size);
+  AUTO_STRING_WITH_LEN (unibyte_result, buffer, size);
+  Lisp_Object result = code_convert_string_norecord (unibyte_result,
+                                                    Qutf_8, false);
   if (buf != buffer)
     xfree (buf);
-  return code_convert_string_norecord (unibyte_result, Qutf_8, false);
+  return result;
 }
 
 
diff --git a/src/fileio.c b/src/fileio.c
index dfab3de..0a14d64 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -187,9 +187,9 @@ report_file_errno (char const *string, Lisp_Object name, 
int errorno)
   Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
   synchronize_system_messages_locale ();
   char *str = strerror (errorno);
+  AUTO_STRING (unibyte_str, str);
   Lisp_Object errstring
-    = code_convert_string_norecord (build_unibyte_string (str),
-                                   Vlocale_coding_system, 0);
+    = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
   Lisp_Object errdata = Fcons (errstring, data);
 
   if (errorno == EEXIST)
@@ -217,9 +217,9 @@ report_file_notify_error (const char *string, Lisp_Object 
name)
   Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
   synchronize_system_messages_locale ();
   char *str = strerror (errno);
+  AUTO_STRING (unibyte_str, str);
   Lisp_Object errstring
-    = code_convert_string_norecord (build_unibyte_string (str),
-                                   Vlocale_coding_system, 0);
+    = code_convert_string_norecord (unibyte_str, Vlocale_coding_system, 0);
   Lisp_Object errdata = Fcons (errstring, data);
 
   xsignal (Qfile_notify_error, Fcons (build_string (string), errdata));
@@ -1015,11 +1015,9 @@ filesystem tree, not (expand-file-name ".."  dirname).  
*/)
          /* Drive must be set, so this is okay.  */
          if (strcmp (nm - 2, SSDATA (name)) != 0)
            {
-             char temp[] = " :";
-
              name = make_specified_string (nm, -1, p - nm, multibyte);
-             temp[0] = DRIVE_LETTER (drive);
-             AUTO_STRING (drive_prefix, temp);
+             char temp[] = { DRIVE_LETTER (drive), ':', 0 };
+             AUTO_STRING_WITH_LEN (drive_prefix, temp, 2);
              name = concat2 (drive_prefix, name);
            }
 #ifdef WINDOWSNT
diff --git a/src/fns.c b/src/fns.c
index 114a556..1ace3bb 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2999,7 +2999,6 @@ The data read from the system are decoded using 
`locale-coding-system'.  */)
 {
   char *str = NULL;
 #ifdef HAVE_LANGINFO_CODESET
-  Lisp_Object val;
   if (EQ (item, Qcodeset))
     {
       str = nl_langinfo (CODESET);
@@ -3015,7 +3014,7 @@ The data read from the system are decoded using 
`locale-coding-system'.  */)
       for (i = 0; i < 7; i++)
        {
          str = nl_langinfo (days[i]);
-         val = build_unibyte_string (str);
+         AUTO_STRING (val, str);
          /* Fixme: Is this coding system necessarily right, even if
             it is consistent with CODESET?  If not, what to do?  */
          ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
@@ -3035,7 +3034,7 @@ The data read from the system are decoded using 
`locale-coding-system'.  */)
       for (i = 0; i < 12; i++)
        {
          str = nl_langinfo (months[i]);
-         val = build_unibyte_string (str);
+         AUTO_STRING (val, str);
          ASET (v, i, code_convert_string_norecord (val, Vlocale_coding_system,
                                                    0));
        }
diff --git a/src/font.c b/src/font.c
index 2519599..6dbda40 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1771,7 +1771,8 @@ font_parse_family_registry (Lisp_Object family, 
Lisp_Object registry, Lisp_Objec
       p1 = strchr (p0, '-');
       if (! p1)
        {
-         AUTO_STRING (extra, (&"*-*"[len && p0[len - 1] == '*']));
+         bool asterisk = len && p0[len - 1] == '*';
+         AUTO_STRING_WITH_LEN (extra, &"*-*"[asterisk], 3 - asterisk);
          registry = concat2 (registry, extra);
        }
       registry = Fdowncase (registry);
diff --git a/src/ftfont.c b/src/ftfont.c
index 7285aee..1ae3f88 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -568,7 +568,6 @@ ftfont_get_charset (Lisp_Object registry)
   char *str = SSDATA (SYMBOL_NAME (registry));
   USE_SAFE_ALLOCA;
   char *re = SAFE_ALLOCA (SBYTES (SYMBOL_NAME (registry)) * 2 + 1);
-  Lisp_Object regexp;
   int i, j;
 
   for (i = j = 0; i < SBYTES (SYMBOL_NAME (registry)); i++, j++)
@@ -582,13 +581,13 @@ ftfont_get_charset (Lisp_Object registry)
        re[j] = '.';
     }
   re[j] = '\0';
-  regexp = make_unibyte_string (re, j);
-  SAFE_FREE ();
+  AUTO_STRING_WITH_LEN (regexp, re, j);
   for (i = 0; fc_charset_table[i].name; i++)
     if (fast_c_string_match_ignore_case
        (regexp, fc_charset_table[i].name,
         strlen (fc_charset_table[i].name)) >= 0)
       break;
+  SAFE_FREE ();
   if (! fc_charset_table[i].name)
     return -1;
   if (! fc_charset_table[i].fc_charset)
diff --git a/src/keymap.c b/src/keymap.c
index 8ab4c6c..eef1dcd 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1303,7 +1303,7 @@ silly_event_symbol_error (Lisp_Object c)
       *p = 0;
 
       c = reorder_modifiers (c);
-      AUTO_STRING (new_mods_string, new_mods);
+      AUTO_STRING_WITH_LEN (new_mods_string, new_mods, p - new_mods);
       keystring = concat2 (new_mods_string, XCDR (assoc));
 
       error ("To bind the key %s, use [?%s], not [%s]",
diff --git a/src/lisp.h b/src/lisp.h
index 65335fb..170da67 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4609,27 +4609,29 @@ enum
                                                     STACK_CONS (d, Qnil)))) \
         : list4 (a, b, c, d))
 
-/* Check whether stack-allocated strings are ASCII-only.  */
+/* Declare NAME as an auto Lisp string if possible, a GC-based one if not.
+   Take its unibyte value from the null-terminated string STR,
+   an expression that should not have side effects.
+   STR's value is not necessarily copied.  The resulting Lisp string
+   should not be modified or made visible to user code.  */
 
-#if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS
-extern const char *verify_ascii (const char *);
-#else
-# define verify_ascii(str) (str)
-#endif
+#define AUTO_STRING(name, str) \
+  AUTO_STRING_WITH_LEN (name, str, strlen (str))
 
 /* Declare NAME as an auto Lisp string if possible, a GC-based one if not.
-   Take its value from STR.  STR is not necessarily copied and should
-   contain only ASCII characters.  The resulting Lisp string should
-   not be modified or made visible to user code.  */
+   Take its unibyte value from the null-terminated string STR with length LEN.
+   STR may have side effects and may contain null bytes.
+   STR's value is not necessarily copied.  The resulting Lisp string
+   should not be modified or made visible to user code.  */
 
-#define AUTO_STRING(name, str)                                         \
+#define AUTO_STRING_WITH_LEN(name, str, len)                           \
   Lisp_Object name =                                                   \
     (USE_STACK_STRING                                                  \
      ? (make_lisp_ptr                                                  \
        ((&(union Aligned_String)                                       \
-         {{strlen (str), -1, 0, (unsigned char *) verify_ascii (str)}}.s), \
-         Lisp_String))                                                 \
-     : build_string (verify_ascii (str)))
+         {{len, -1, 0, (unsigned char *) (str)}}.s),                   \
+        Lisp_String))                                                  \
+     : make_unibyte_string (str, len))
 
 /* Loop over all tails of a list, checking for cycles.
    FIXME: Make tortoise and n internal declarations.
diff --git a/src/menu.c b/src/menu.c
index 9504cee..737f2b5 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -408,7 +408,7 @@ single_menu_item (Lisp_Object key, Lisp_Object item, 
Lisp_Object dummy, void *sk
 
       if (prefix)
        {
-         AUTO_STRING (prefix_obj, prefix);
+         AUTO_STRING_WITH_LEN (prefix_obj, prefix, 4);
          item_string = concat2 (prefix_obj, item_string);
        }
   }
diff --git a/src/sysdep.c b/src/sysdep.c
index 67c9bd9..1e3b9f1 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -3050,7 +3050,7 @@ system_process_attributes (Lisp_Object pid)
   struct timespec tnow, tstart, tboot, telapsed, us_time;
   double pcpu, pmem;
   Lisp_Object attrs = Qnil;
-  Lisp_Object cmd_str, decoded_cmd;
+  Lisp_Object decoded_cmd;
   ptrdiff_t count;
 
   CHECK_NUMBER_OR_FLOAT (pid);
@@ -3107,7 +3107,7 @@ system_process_attributes (Lisp_Object pid)
       else
        q = NULL;
       /* Command name is encoded in locale-coding-system; decode it.  */
-      cmd_str = make_unibyte_string (cmd, cmdsize);
+      AUTO_STRING_WITH_LEN (cmd_str, cmd, cmdsize);
       decoded_cmd = code_convert_string_norecord (cmd_str,
                                                  Vlocale_coding_system, 0);
       attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
@@ -3240,7 +3240,7 @@ system_process_attributes (Lisp_Object pid)
          sprintf (cmdline, "[%.*s]", cmdsize, cmd);
        }
       /* Command line is encoded in locale-coding-system; decode it.  */
-      cmd_str = make_unibyte_string (q, nread);
+      AUTO_STRING_WITH_LEN (cmd_str, q, nread);
       decoded_cmd = code_convert_string_norecord (cmd_str,
                                                  Vlocale_coding_system, 0);
       unbind_to (count, Qnil);
@@ -3375,13 +3375,13 @@ system_process_attributes (Lisp_Object pid)
                            make_float (100.0 / 0x8000 * pinfo.pr_pctmem)),
                     attrs);
 
-      decoded_cmd = (code_convert_string_norecord
-                    (build_unibyte_string (pinfo.pr_fname),
-                     Vlocale_coding_system, 0));
+      AUTO_STRING (fname, pinfo.pr_fname);
+      decoded_cmd = code_convert_string_norecord (fname,
+                                                 Vlocale_coding_system, 0);
       attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
-      decoded_cmd = (code_convert_string_norecord
-                    (build_unibyte_string (pinfo.pr_psargs),
-                     Vlocale_coding_system, 0));
+      AUTO_STRING (psargs, pinfo.pr_psargs);
+      decoded_cmd = code_convert_string_norecord (psargs,
+                                                 Vlocale_coding_system, 0);
       attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs);
     }
   unbind_to (count, Qnil);
@@ -3446,9 +3446,8 @@ system_process_attributes (Lisp_Object pid)
   if (gr)
     attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
 
-  decoded_comm = (code_convert_string_norecord
-                 (build_unibyte_string (proc.ki_comm),
-                  Vlocale_coding_system, 0));
+  AUTO_STRING (comm, proc.ki_comm);
+  decoded_comm = code_convert_string_norecord (comm, Vlocale_coding_system, 0);
 
   attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs);
   {
@@ -3559,10 +3558,9 @@ system_process_attributes (Lisp_Object pid)
            args[i] = ' ';
        }
 
-      decoded_comm =
-       (code_convert_string_norecord
-        (build_unibyte_string (args),
-         Vlocale_coding_system, 0));
+      AUTO_STRING (comm, args);
+      decoded_comm = code_convert_string_norecord (comm,
+                                                  Vlocale_coding_system, 0);
 
       attrs = Fcons (Fcons (Qargs, decoded_comm), attrs);
     }