From 17cb263adb7c37803140604f0a2e4df8a38fbcff Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 4 Apr 2016 10:30:41 -0700 Subject: [PATCH] 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 56a535411c8..c5a4f425f6e 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 e72d7b71867..bcedd7f5eeb 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 664a59e0721..a2d5673a257 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 b57636e54e5..724d24a7768 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, "#", 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 dfab3de9e94..0a14d64456b 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 114a556612a..1ace3bb888e 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 2519599bc63..6dbda40d52f 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 7285aee9bd4..1ae3f88daa3 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 8ab4c6c27ae..eef1dcd39e5 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 65335fbc052..170da67c61c 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 9504cee5923..737f2b55e8b 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 67c9bd90df7..1e3b9f12128 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); } -- 2.39.2