From dc4525691c2c236abdb6c074438223413f80091c Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Mon, 29 Sep 2014 19:43:23 -0700
Subject: [PATCH] Simplify stack-allocated Lisp objects, and make them more
portable.
The build_local_string macro was used in two ways: (1) string
literals for which scoped allocation suffices, and (2) file name
components, where it's not safe in general to assume bounded-size
ASCII data. Simplify by defining a new macro SCOPED_STRING that
allocates a block-scope string, and by using SCOPED_STRING for (1)
and build_string for (2). Furthermore, actually use stack
allocation only for objects known to have sufficient alignment.
This simpler implementation means Emacs can make
USE_STACK_LISP_OBJECTS the default unless GC_MARK_STACK !=
GC_MAKE_GCPROS_NOOPS.
* lisp.h (GCALIGNED): Align even if !USE_STACK_LISP_OBJECTS,
for fewer differences among implementations.
(struct Lisp_String): Now GCALIGNED.
(USE_STACK_LISP_OBJECTS): Default to true, since the
implementation no longer insists on a nonempty GCALIGNED.
But make it false if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS.
(SCOPED_CONS_INITIALIZER): Remove, since it's no longer needed
separately. Move definiens to scoped_cons. The old definition
was incorrect when GCALIGNED was defined to be empty.
(union Aligned_String): New type.
(USE_STACK_CONS, USE_STACK_STRING): New constants, so that the
implementation ports to compilers that don't align strictly enough.
Don't worry about the union sizes; it's not worth bothering about.
(scoped_cons, scoped_list1, scoped_list3, scoped_list4):
Rewrite using USE_STACK_CONS.
(scoped_cons): Assume the use of union Aligned_Cons.
(lisp_string_size, make_local_string, build_local_string): Remove.
Unless otherwise specified, all callers of build_local_string
changed to use SCOPED_STRING.
(SCOPED_STRING): New macro.
* data.c (wrong_choice):
* menu.c (single_menu_item):
* process.c (Fformat_network_address):
Hoist use of SCOPED_STRING out of a scope, so that its returned
object lives long enough.
* fileio.c (Fexpand_file_name): Use build_string, not SCOPED_STRING,
as the string might be long or might not be ASCII.
---
src/ChangeLog | 41 ++++++++++++
src/buffer.c | 12 ++--
src/charset.c | 3 +-
src/chartab.c | 2 +-
src/data.c | 14 +++--
src/doc.c | 4 +-
src/editfns.c | 3 +-
src/emacs.c | 6 +-
src/fileio.c | 14 ++---
src/fns.c | 2 +-
src/font.c | 14 ++---
src/fontset.c | 2 +-
src/frame.c | 4 +-
src/keyboard.c | 16 ++---
src/keymap.c | 6 +-
src/lisp.h | 166 ++++++++++++++++++-------------------------------
src/lread.c | 4 +-
src/menu.c | 16 ++---
src/minibuf.c | 2 +-
src/process.c | 45 +++++++-------
src/xdisp.c | 2 +-
src/xfns.c | 10 ++-
src/xselect.c | 4 +-
src/xterm.c | 12 ++--
24 files changed, 201 insertions(+), 203 deletions(-)
diff --git a/src/ChangeLog b/src/ChangeLog
index d2d629f31b4..ae4200e7d09 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,44 @@
+2014-09-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify stack-allocated Lisp objects, and make them more portable.
+ The build_local_string macro was used in two ways: (1) string
+ literals for which scoped allocation suffices, and (2) file name
+ components, where it's not safe in general to assume bounded-size
+ ASCII data. Simplify by defining a new macro SCOPED_STRING that
+ allocates a block-scope string, and by using SCOPED_STRING for (1)
+ and build_string for (2). Furthermore, actually use stack
+ allocation only for objects known to have sufficient alignment.
+ This simpler implementation means Emacs can make
+ USE_STACK_LISP_OBJECTS the default unless GC_MARK_STACK !=
+ GC_MAKE_GCPROS_NOOPS.
+ * lisp.h (GCALIGNED): Align even if !USE_STACK_LISP_OBJECTS,
+ for fewer differences among implementations.
+ (struct Lisp_String): Now GCALIGNED.
+ (USE_STACK_LISP_OBJECTS): Default to true, since the
+ implementation no longer insists on a nonempty GCALIGNED.
+ But make it false if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS.
+ (SCOPED_CONS_INITIALIZER): Remove, since it's no longer needed
+ separately. Move definiens to scoped_cons. The old definition
+ was incorrect when GCALIGNED was defined to be empty.
+ (union Aligned_String): New type.
+ (USE_STACK_CONS, USE_STACK_STRING): New constants, so that the
+ implementation ports to compilers that don't align strictly enough.
+ Don't worry about the union sizes; it's not worth bothering about.
+ (scoped_cons, scoped_list1, scoped_list3, scoped_list4):
+ Rewrite using USE_STACK_CONS.
+ (scoped_cons): Assume the use of union Aligned_Cons.
+ (lisp_string_size, make_local_string, build_local_string): Remove.
+ Unless otherwise specified, all callers of build_local_string
+ changed to use SCOPED_STRING.
+ (SCOPED_STRING): New macro.
+ * data.c (wrong_choice):
+ * menu.c (single_menu_item):
+ * process.c (Fformat_network_address):
+ Hoist use of SCOPED_STRING out of a scope, so that its returned
+ object lives long enough.
+ * fileio.c (Fexpand_file_name): Use build_string, not SCOPED_STRING,
+ as the string might be long or might not be ASCII.
+
2014-09-29 Eli Zaretskii <eliz@gnu.org>
* msdos.c (internal_terminal_init): Bump version to 25.
diff --git a/src/buffer.c b/src/buffer.c
index 39d08950bf8..9d376346a0a 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1552,10 +1552,10 @@ exists, return the buffer `*scratch*' (creating it if necessary). */)
return notsogood;
else
{
- buf = Fget_buffer (build_local_string ("*scratch*"));
+ buf = Fget_buffer (SCOPED_STRING ("*scratch*"));
if (NILP (buf))
{
- buf = Fget_buffer_create (build_local_string ("*scratch*"));
+ buf = Fget_buffer_create (SCOPED_STRING ("*scratch*"));
Fset_buffer_major_mode (buf);
}
return buf;
@@ -1575,10 +1575,10 @@ other_buffer_safely (Lisp_Object buffer)
if (candidate_buffer (buf, buffer))
return buf;
- buf = Fget_buffer (build_local_string ("*scratch*"));
+ buf = Fget_buffer (SCOPED_STRING ("*scratch*"));
if (NILP (buf))
{
- buf = Fget_buffer_create (build_local_string ("*scratch*"));
+ buf = Fget_buffer_create (SCOPED_STRING ("*scratch*"));
Fset_buffer_major_mode (buf);
}
@@ -5289,7 +5289,7 @@ init_buffer (int initialized)
(void) initialized;
#endif /* USE_MMAP_FOR_BUFFERS */
- Fset_buffer (Fget_buffer_create (build_local_string ("*scratch*")));
+ Fset_buffer (Fget_buffer_create (SCOPED_STRING ("*scratch*")));
if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))
Fset_buffer_multibyte (Qnil);
@@ -5328,7 +5328,7 @@ init_buffer (int initialized)
&& strcmp ("/", SSDATA (BVAR (current_buffer, directory))))
bset_directory
(current_buffer,
- concat2 (build_local_string ("/:"), BVAR (current_buffer, directory)));
+ concat2 (SCOPED_STRING ("/:"), BVAR (current_buffer, directory)));
temp = get_minibuffer (0);
bset_directory (XBUFFER (temp), BVAR (current_buffer, directory));
diff --git a/src/charset.c b/src/charset.c
index 9fe3548be08..dee67a30c2e 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -490,8 +490,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
int n_entries;
ptrdiff_t count;
- suffixes = scoped_list2 (build_local_string (".map"),
- build_local_string (".TXT"));
+ suffixes = scoped_list2 (SCOPED_STRING (".map"), SCOPED_STRING (".TXT"));
count = SPECPDL_INDEX ();
record_unwind_protect_nothing ();
diff --git a/src/chartab.c b/src/chartab.c
index 4e4219d8ae3..35362e32a03 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -1302,7 +1302,7 @@ uniprop_table (Lisp_Object prop)
{
struct gcpro gcpro1;
GCPRO1 (val);
- result = Fload (concat2 (build_local_string ("international/"), table),
+ result = Fload (concat2 (SCOPED_STRING ("international/"), table),
Qt, Qt, Qt, Qt);
UNGCPRO;
if (NILP (result))
diff --git a/src/data.c b/src/data.c
index 414da4cf6f7..b71d88506d0 100644
--- a/src/data.c
+++ b/src/data.c
@@ -979,18 +979,20 @@ wrong_choice (Lisp_Object choice, Lisp_Object wrong)
{
ptrdiff_t i = 0, len = XINT (Flength (choice));
Lisp_Object obj, *args;
+ Lisp_Object should_be_specified = SCOPED_STRING (" should be specified");
+ Lisp_Object or = SCOPED_STRING (" or ");
+ Lisp_Object comma = SCOPED_STRING (", ");
USE_SAFE_ALLOCA;
SAFE_ALLOCA_LISP (args, len * 2 + 1);
- args[i++] = build_local_string ("One of ");
+ args[i++] = SCOPED_STRING ("One of ");
for (obj = choice; !NILP (obj); obj = XCDR (obj))
{
args[i++] = SYMBOL_NAME (XCAR (obj));
- args[i++] = build_local_string
- (NILP (XCDR (obj)) ? " should be specified"
- : (NILP (XCDR (XCDR (obj))) ? " or " : ", "));
+ args[i++] = (NILP (XCDR (obj)) ? should_be_specified
+ : NILP (XCDR (XCDR (obj))) ? or : comma);
}
obj = Fconcat (i, args);
@@ -1005,9 +1007,9 @@ static void
wrong_range (Lisp_Object min, Lisp_Object max, Lisp_Object wrong)
{
xsignal2 (Qerror, Fconcat (4, ((Lisp_Object [])
- { build_local_string ("Value should be from "),
+ { SCOPED_STRING ("Value should be from "),
Fnumber_to_string (min),
- build_local_string (" to "),
+ SCOPED_STRING (" to "),
Fnumber_to_string (max) })), wrong);
}
diff --git a/src/doc.c b/src/doc.c
index bbb42c2aa3f..8af2c82a545 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -146,8 +146,8 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
if (fd < 0)
{
SAFE_FREE ();
- return concat3 (build_local_string ("Cannot open doc string file \""),
- file, build_local_string ("\"\n"));
+ return concat3 (SCOPED_STRING ("Cannot open doc string file \""),
+ file, SCOPED_STRING ("\"\n"));
}
}
count = SPECPDL_INDEX ();
diff --git a/src/editfns.c b/src/editfns.c
index 47779914c45..b8a0f6fe637 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -4362,8 +4362,7 @@ usage: (format STRING &rest OBJECTS) */)
Lisp_Object
format2 (const char *string1, Lisp_Object arg0, Lisp_Object arg1)
{
- return Fformat (3, ((Lisp_Object [])
- { build_local_string (string1), arg0, arg1 }));
+ return Fformat (3, (Lisp_Object []) { SCOPED_STRING (string1), arg0, arg1 });
}
DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0,
diff --git a/src/emacs.c b/src/emacs.c
index 241479fecf2..3c31827e994 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -423,7 +423,7 @@ init_cmdargs (int argc, char **argv, int skip_args, char *original_pwd)
if it would otherwise be treated as magic. */
handler = Ffind_file_name_handler (raw_name, Qt);
if (! NILP (handler))
- raw_name = concat2 (build_local_string ("/:"), raw_name);
+ raw_name = concat2 (SCOPED_STRING ("/:"), raw_name);
Vinvocation_name = Ffile_name_nondirectory (raw_name);
Vinvocation_directory = Ffile_name_directory (raw_name);
@@ -441,7 +441,7 @@ init_cmdargs (int argc, char **argv, int skip_args, char *original_pwd)
if it would otherwise be treated as magic. */
handler = Ffind_file_name_handler (found, Qt);
if (! NILP (handler))
- found = concat2 (build_local_string ("/:"), found);
+ found = concat2 (SCOPED_STRING ("/:"), found);
Vinvocation_directory = Ffile_name_directory (found);
}
}
@@ -2323,7 +2323,7 @@ decode_env_path (const char *evarname, const char *defalt, bool empty)
}
if (! NILP (tem))
- element = concat2 (build_local_string ("/:"), element);
+ element = concat2 (SCOPED_STRING ("/:"), element);
} /* !NILP (element) */
lpath = Fcons (element, lpath);
diff --git a/src/fileio.c b/src/fileio.c
index 13e2c889020..2590942d42e 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1111,7 +1111,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
name = make_specified_string (nm, -1, p - nm, multibyte);
temp[0] = DRIVE_LETTER (drive);
- name = concat2 (build_local_string (temp), name);
+ name = concat2 (SCOPED_STRING (temp), name);
}
#ifdef WINDOWSNT
if (!NILP (Vw32_downcase_file_names))
@@ -1162,11 +1162,11 @@ filesystem tree, not (expand-file-name ".." dirname). */)
char newdir_utf8[MAX_UTF8_PATH];
filename_from_ansi (newdir, newdir_utf8);
- tem = build_local_string (newdir_utf8);
+ tem = build_string (newdir_utf8);
}
else
#endif
- tem = build_local_string (newdir);
+ tem = build_string (newdir);
newdirlim = newdir + SBYTES (tem);
if (multibyte && !STRING_MULTIBYTE (tem))
{
@@ -1198,7 +1198,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
/* `getpwnam' may return a unibyte string, which will
bite us since we expect the directory to be
multibyte. */
- tem = build_local_string (newdir);
+ tem = build_string (newdir);
newdirlim = newdir + SBYTES (tem);
if (multibyte && !STRING_MULTIBYTE (tem))
{
@@ -1231,7 +1231,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
adir = NULL;
else if (multibyte)
{
- Lisp_Object tem = build_local_string (adir);
+ Lisp_Object tem = build_string (adir);
tem = DECODE_FILE (tem);
newdirlim = adir + SBYTES (tem);
@@ -1334,7 +1334,7 @@ filesystem tree, not (expand-file-name ".." dirname). */)
getcwd (adir, adir_size);
if (multibyte)
{
- Lisp_Object tem = build_local_string (adir);
+ Lisp_Object tem = build_string (adir);
tem = DECODE_FILE (tem);
newdirlim = adir + SBYTES (tem);
@@ -5420,7 +5420,7 @@ auto_save_error (Lisp_Object error_val)
ring_bell (XFRAME (selected_frame));
msg = Fformat (3, ((Lisp_Object [])
- { build_local_string ("Auto-saving %s: %s"),
+ { SCOPED_STRING ("Auto-saving %s: %s"),
BVAR (current_buffer, name),
Ferror_message_string (error_val) }));
GCPRO1 (msg);
diff --git a/src/fns.c b/src/fns.c
index 836a621cd51..abdc56afdb4 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2726,7 +2726,7 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */)
}
prompt = Fconcat (2, ((Lisp_Object [])
- { prompt, build_local_string ("(yes or no) ") }));
+ { prompt, SCOPED_STRING ("(yes or no) ") }));
GCPRO1 (prompt);
while (1)
diff --git a/src/font.c b/src/font.c
index 673a934f38f..ef48bbdaea6 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1187,12 +1187,12 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
{
val = prop[XLFD_ENCODING_INDEX];
if (! NILP (val))
- val = concat2 (build_local_string ("*-"), SYMBOL_NAME (val));
+ val = concat2 (SCOPED_STRING ("*-"), SYMBOL_NAME (val));
}
else if (NILP (prop[XLFD_ENCODING_INDEX]))
- val = concat2 (SYMBOL_NAME (val), build_local_string ("-*"));
+ val = concat2 (SYMBOL_NAME (val), SCOPED_STRING ("-*"));
else
- val = concat3 (SYMBOL_NAME (val), build_local_string ("-"),
+ val = concat3 (SYMBOL_NAME (val), SCOPED_STRING ("-"),
SYMBOL_NAME (prop[XLFD_ENCODING_INDEX]));
if (! NILP (val))
ASET (font, FONT_REGISTRY_INDEX, Fintern (val, Qnil));
@@ -1790,9 +1790,9 @@ font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Objec
if (! p1)
{
if (SDATA (registry)[len - 1] == '*')
- registry = concat2 (registry, build_local_string ("-*"));
+ registry = concat2 (registry, SCOPED_STRING ("-*"));
else
- registry = concat2 (registry, build_local_string ("*-*"));
+ registry = concat2 (registry, SCOPED_STRING ("*-*"));
}
registry = Fdowncase (registry);
ASET (font_spec, FONT_REGISTRY_INDEX, Fintern (registry, Qnil));
@@ -5019,7 +5019,7 @@ font_add_log (const char *action, Lisp_Object arg, Lisp_Object result)
if (FONTP (arg))
{
Lisp_Object tail, elt;
- Lisp_Object equalstr = build_local_string ("=");
+ Lisp_Object equalstr = SCOPED_STRING ("=");
val = Ffont_xlfd_name (arg, Qt);
for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
@@ -5053,7 +5053,7 @@ font_add_log (const char *action, Lisp_Object arg, Lisp_Object result)
val = Ffont_xlfd_name (result, Qt);
if (! FONT_SPEC_P (result))
val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
- build_local_string (":"), val);
+ SCOPED_STRING (":"), val);
result = val;
}
else if (CONSP (result))
diff --git a/src/fontset.c b/src/fontset.c
index 5e18d14bd65..1b750b05b7b 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1462,7 +1462,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
registry = AREF (font_spec, FONT_REGISTRY_INDEX);
if (! NILP (registry))
registry = Fdowncase (SYMBOL_NAME (registry));
- encoding = find_font_encoding (concat3 (family, build_local_string ("-"),
+ encoding = find_font_encoding (concat3 (family, SCOPED_STRING ("-"),
registry));
if (NILP (encoding))
encoding = Qascii;
diff --git a/src/frame.c b/src/frame.c
index 0eea4f4338a..9bc52f1e88f 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -4149,8 +4149,8 @@ x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
if (attribute && dpyinfo)
{
tem = display_x_get_resource
- (dpyinfo, build_local_string (attribute),
- build_local_string (class), Qnil, Qnil);
+ (dpyinfo, SCOPED_STRING (attribute),
+ SCOPED_STRING (class), Qnil, Qnil);
if (NILP (tem))
return Qunbound;
diff --git a/src/keyboard.c b/src/keyboard.c
index d920ef45f45..37d33a6cdb0 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -566,10 +566,10 @@ echo_add_key (Lisp_Object c)
if (XINT (last_char) == '-' && XINT (prev_char) != ' ')
Faset (echo_string, idx, make_number (' '));
else
- echo_string = concat2 (echo_string, build_local_string (" "));
+ echo_string = concat2 (echo_string, SCOPED_STRING (" "));
}
else if (STRINGP (echo_string) && SCHARS (echo_string) > 0)
- echo_string = concat2 (echo_string, build_local_string (" "));
+ echo_string = concat2 (echo_string, SCOPED_STRING (" "));
kset_echo_string
(current_kboard,
@@ -632,7 +632,7 @@ echo_dash (void)
but make it go away when the next character is added. */
kset_echo_string
(current_kboard,
- concat2 (KVAR (current_kboard, echo_string), build_local_string ("-")));
+ concat2 (KVAR (current_kboard, echo_string), SCOPED_STRING ("-")));
echo_now ();
}
@@ -1896,7 +1896,7 @@ safe_run_hooks_error (Lisp_Object error, ptrdiff_t nargs, Lisp_Object *args)
hook = args[0];
fun = args[1];
Fmessage (4, ((Lisp_Object [])
- { build_local_string ("Error in %s (%S): %S"), hook, fun, error }));
+ { SCOPED_STRING ("Error in %s (%S): %S"), hook, fun, error }));
if (SYMBOLP (hook))
{
@@ -7889,7 +7889,7 @@ parse_menu_item (Lisp_Object item, int inmenubar)
/* The previous code preferred :key-sequence to :keys, so we
preserve this behavior. */
if (STRINGP (keyeq) && !CONSP (keyhint))
- keyeq = concat2 (build_local_string (" "),
+ keyeq = concat2 (SCOPED_STRING (" "),
Fsubstitute_command_keys (keyeq));
else
{
@@ -7933,7 +7933,7 @@ parse_menu_item (Lisp_Object item, int inmenubar)
if (STRINGP (XCDR (prefix)))
tem = concat2 (tem, XCDR (prefix));
}
- keyeq = concat2 (build_local_string (" "), tem);
+ keyeq = concat2 (SCOPED_STRING (" "), tem);
}
else
keyeq = Qnil;
@@ -8638,9 +8638,9 @@ read_char_minibuf_menu_prompt (int commandflag,
Lisp_Object selected
= AREF (item_properties, ITEM_PROPERTY_SELECTED);
if (EQ (tem, QCradio))
- tem = build_local_string (NILP (selected) ? "(*) " : "( ) ");
+ tem = SCOPED_STRING (NILP (selected) ? "(*) " : "( ) ");
else
- tem = build_local_string (NILP (selected) ? "[X] " : "[ ] ");
+ tem = SCOPED_STRING (NILP (selected) ? "[X] " : "[ ] ");
s = concat2 (tem, s);
}
diff --git a/src/keymap.c b/src/keymap.c
index ed572a5a8c1..368903db5e6 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1338,7 +1338,7 @@ silly_event_symbol_error (Lisp_Object c)
*p = 0;
c = reorder_modifiers (c);
- keystring = concat2 (build_local_string (new_mods), XCDR (assoc));
+ keystring = concat2 (SCOPED_STRING (new_mods), XCDR (assoc));
error ("To bind the key %s, use [?%s], not [%s]",
SDATA (SYMBOL_NAME (c)), SDATA (keystring),
@@ -2243,7 +2243,7 @@ around function keys and event symbols. */)
if (CONSP (key) && INTEGERP (XCAR (key)) && INTEGERP (XCDR (key)))
/* An interval from a map-char-table. */
return concat3 (Fsingle_key_description (XCAR (key), no_angles),
- build_local_string (".."),
+ SCOPED_STRING (".."),
Fsingle_key_description (XCDR (key), no_angles));
key = EVENT_HEAD (key);
@@ -3441,7 +3441,7 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
{
Lisp_Object tem;
tem = Fkey_description (prefix, Qnil);
- elt_prefix = concat2 (tem, build_local_string (" "));
+ elt_prefix = concat2 (tem, SCOPED_STRING (" "));
}
prefix = Qnil;
}
diff --git a/src/lisp.h b/src/lisp.h
index d2cac17fbc7..27751af2f5b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -282,23 +282,7 @@ error !;
# endif
#endif
-/* This should work with GCC. Clang has known problems; see
- http://lists.gnu.org/archive/html/emacs-devel/2014-09/msg00506.html. */
-#ifndef USE_STACK_LISP_OBJECTS
-# if defined __GNUC__ && !defined __clang__
- /* 32-bit MinGW builds need at least GCC 4.2 to support this. */
-# if defined __MINGW32__ && !defined _W64 \
- && __GNUC__ + (__GNUC_MINOR__ > 1) < 5
-# define USE_STACK_LISP_OBJECTS false
-# else /* !(__MINGW32__ && __GNUC__ < 4.2) */
-# define USE_STACK_LISP_OBJECTS true
-# endif
-# else
-# define USE_STACK_LISP_OBJECTS false
-# endif
-#endif
-
-#if defined HAVE_STRUCT_ATTRIBUTE_ALIGNED && USE_STACK_LISP_OBJECTS
+#ifdef HAVE_STRUCT_ATTRIBUTE_ALIGNED
# define GCALIGNED __attribute__ ((aligned (GCALIGNMENT)))
#else
# define GCALIGNED /* empty */
@@ -1088,7 +1072,7 @@ CDR_SAFE (Lisp_Object c)
/* In a string or vector, the sign bit of the `size' is the gc mark bit. */
-struct Lisp_String
+struct GCALIGNED Lisp_String
{
ptrdiff_t size;
ptrdiff_t size_byte;
@@ -4598,27 +4582,26 @@ lisp_word_count (ptrdiff_t nbytes)
/* If USE_STACK_LISP_OBJECTS, define macros that and functions that allocate
- block-scoped conses and function-scoped strings. These objects are not
+ block-scoped conses and strings. These objects are not
managed by the garbage collector, so they are dangerous: passing them
out of their scope (e.g., to user code) results in undefined behavior.
Conversely, they have better performance because GC is not involved.
- This feature is experimental and requires careful debugging. It's enabled
- by default if GCC or a compiler that mimics GCC well (like Intel C/C++) is
- used, except clang (see notice above). For other compilers, brave users can
- compile with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS=1' to get into the game.
- Note that this feature requires GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS. */
+ This feature is experimental and requires careful debugging.
+ Build with CPPFLAGS='-DUSE_STACK_LISP_OBJECTS=0' to disable it. */
-#ifdef GCALIGNED
-
-/* No tricks if struct Lisp_Cons is always aligned. */
+#ifndef USE_STACK_LISP_OBJECTS
+# define USE_STACK_LISP_OBJECTS true
+#endif
-# define SCOPED_CONS_INITIALIZER(a, b) &((struct Lisp_Cons) { a, { b } })
+/* USE_STACK_LISP_OBJECTS requires GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS. */
-#else /* not GCALIGNED */
+#if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
+# undef USE_STACK_LISP_OBJECTS
+# define USE_STACK_LISP_OBJECTS false
+#endif
-/* A struct Lisp_Cons inside a union that is no larger and may be
- better-aligned. */
+/* Struct inside unions that are typically no larger and aligned enough. */
union Aligned_Cons
{
@@ -4626,88 +4609,61 @@ union Aligned_Cons
double d; intmax_t i; void *p;
};
-verify (alignof (union Aligned_Cons) % GCALIGNMENT == 0);
-verify (sizeof (struct Lisp_Cons) == sizeof (union Aligned_Cons));
-
-# define SCOPED_CONS_INITIALIZER(a, b) \
- &((union Aligned_Cons) { { a, { b } } }.s)
-
-#endif /* GCALIGNED */
-
-/* Basic stack-based cons allocation. */
-
-#if USE_STACK_LISP_OBJECTS
-# define scoped_cons(a, b) \
- make_lisp_ptr (SCOPED_CONS_INITIALIZER (a, b), Lisp_Cons)
-# define scoped_list1(a) scoped_cons (a, Qnil)
-# define scoped_list2(a, b) scoped_cons (a, scoped_list1 (b))
-# define scoped_list3(a, b, c) scoped_cons (a, scoped_list2 (b, c))
-# define scoped_list4(a, b, c, d) scoped_cons (a, scoped_list3 (b, c, d))
-#else
-# define scoped_cons(a, b) Fcons (a, b)
-# define scoped_list1(a) list1 (a)
-# define scoped_list2(a, b) list2 (a, b)
-# define scoped_list3(a, b, c) list3 (a, b, c)
-# define scoped_list4(a, b, c, d) list4 (a, b, c, d)
-#endif
+union Aligned_String
+{
+ struct Lisp_String s;
+ double d; intmax_t i; void *p;
+};
-/* On-stack string allocation requires __builtin_constant_p, statement
- expressions and GCALIGNMENT-aligned alloca. All from the above is
- assumed for GCC. At least for clang < 3.6, alloca isn't properly
- aligned in some cases. In the absence of solid information, play
- it safe for other non-GCC compilers. */
+/* True for stack-based cons and string implementations. */
-#if USE_STACK_LISP_OBJECTS && __GNUC__ && !__clang__
+enum
+ {
+ USE_STACK_CONS = (USE_STACK_LISP_OBJECTS
+ && alignof (union Aligned_Cons) % GCALIGNMENT == 0),
+ USE_STACK_STRING = (USE_STACK_LISP_OBJECTS
+ && alignof (union Aligned_String) % GCALIGNMENT == 0)
+ };
-/* Used to check whether stack-allocated strings are ASCII-only. */
+/* Build a stack-based Lisp cons or short list if possible, a GC-based
+ one otherwise. The resulting object should not be modified or made
+ visible to user code. */
+
+#define scoped_cons(a, b) \
+ (USE_STACK_CONS \
+ ? make_lisp_ptr (&(union Aligned_Cons) { { a, { b } } }.s, Lisp_Cons) \
+ : Fcons (a, b))
+#define scoped_list1(a) \
+ (USE_STACK_CONS ? scoped_cons (a, Qnil) : list1 (a))
+#define scoped_list2(a, b) \
+ (USE_STACK_CONS ? scoped_cons (a, scoped_list1 (b)) : list2 (a,b))
+#define scoped_list3(a, b, c) \
+ (USE_STACK_CONS ? scoped_cons (a, scoped_list2 (b, c)) : list3 (a, b, c))
+#define scoped_list4(a, b, c, d) \
+ (USE_STACK_CONS \
+ ? scoped_cons (a, scoped_list3 (b, c, d)) : \
+ list4 (a, b, c, d))
+
+/* Check whether stack-allocated strings are ASCII-only. */
#ifdef ENABLE_CHECKING
-extern const char * verify_ascii (const char *);
+extern const char *verify_ascii (const char *);
#else
-#define verify_ascii(str) (str)
+# define verify_ascii(str) (str)
#endif
-/* Return number of bytes needed for Lisp string of length NBYTES. */
-
-INLINE ptrdiff_t
-lisp_string_size (ptrdiff_t nbytes)
-{
- return sizeof (struct Lisp_String) + nbytes + 1;
-}
-
-/* Return function-scoped unibyte Lisp string with contents STR of length
- NBYTES and memory footprint of MEMSIZE bytes if the latter doesn't exceed
- MAX_ALLOCA, abort otherwise. */
-
-# define make_local_string(str, memsize, nbytes) \
- ((memsize < MAX_ALLOCA) \
- ? ({ struct Lisp_String *s_ = alloca (memsize); \
- s_->data = (unsigned char *) (s_ + 1); \
- memcpy (s_->data, verify_ascii (str), nbytes + 1); \
- s_->size = nbytes, s_->size_byte = -1; \
- s_->intervals = NULL; \
- make_lisp_ptr (s_, Lisp_String); }) \
- : (emacs_abort (), Qnil))
-
-/* If STR is a compile-time string constant, build function-scoped Lisp string
- from it, fall back to regular Lisp string otherwise. We assume compile-time
- string constants never exceeds MAX_ALLOCA - sizeof (Lisp_String) - 1. */
-
-# define build_local_string(str) \
- (__builtin_constant_p (str) \
- ? make_local_string \
- (str, lisp_string_size (strlen (str)), strlen (str)) \
- : build_string (str))
-
-#else /* not USE_STACK_LISP_OBJECTS && __GNUC__ && !__clang__ */
-
-INLINE Lisp_Object
-build_local_string (const char *str)
-{
- return build_string (str);
-}
-
-#endif /* not USE_STACK_LISP_OBJECTS && __GNUC__ && !__clang__ */
+/* Build a stack-based Lisp string from STR if possible, a GC-based
+ one if not. 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. */
+
+#define SCOPED_STRING(str) \
+ (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)))
/* Loop over all tails of a list, checking for cycles.
FIXME: Make tortoise and n internal declarations.
diff --git a/src/lread.c b/src/lread.c
index b6f259f1a95..799635e3c83 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -970,7 +970,7 @@ load_warn_old_style_backquotes (Lisp_Object file)
{
if (!NILP (Vold_style_backquotes))
Fmessage (2, ((Lisp_Object [])
- { build_local_string ("Loading `%s': old-style backquotes detected!"),
+ { SCOPED_STRING ("Loading `%s': old-style backquotes detected!"),
file }));
}
@@ -3678,7 +3678,7 @@ read_list (bool flag, Lisp_Object readcharfun)
in the installed Lisp directory.
We don't use Fexpand_file_name because that would make
the directory absolute now. */
- elt = concat2 (build_local_string ("../lisp/"),
+ elt = concat2 (SCOPED_STRING ("../lisp/"),
Ffile_name_nondirectory (elt));
}
else if (EQ (elt, Vload_file_name)
diff --git a/src/menu.c b/src/menu.c
index ea8da7a9d62..e63b21f0e08 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -354,7 +354,7 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
front of them. */
if (!have_boxes ())
{
- Lisp_Object prefix = Qnil;
+ char const *prefix = 0;
Lisp_Object type = AREF (item_properties, ITEM_PROPERTY_TYPE);
if (!NILP (type))
{
@@ -390,7 +390,7 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
if (!submenu && SREF (tem, 0) != '\0'
&& SREF (tem, 0) != '-')
ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME,
- concat2 (build_local_string (" "), tem));
+ concat2 (SCOPED_STRING (" "), tem));
idx += MENU_ITEMS_ITEM_LENGTH;
}
}
@@ -399,24 +399,24 @@ single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *sk
/* Calculate prefix, if any, for this item. */
if (EQ (type, QCtoggle))
- prefix = build_local_string (NILP (selected) ? "[ ] " : "[X] ");
+ prefix = NILP (selected) ? "[ ] " : "[X] ";
else if (EQ (type, QCradio))
- prefix = build_local_string (NILP (selected) ? "( ) " : "(*) ");
+ prefix = NILP (selected) ? "( ) " : "(*) ";
}
/* Not a button. If we have earlier buttons, then we need a prefix. */
else if (!skp->notbuttons && SREF (item_string, 0) != '\0'
&& SREF (item_string, 0) != '-')
- prefix = build_local_string (" ");
+ prefix = " ";
- if (!NILP (prefix))
- item_string = concat2 (prefix, item_string);
+ if (prefix)
+ item_string = concat2 (SCOPED_STRING (prefix), item_string);
}
if ((FRAME_TERMCAP_P (XFRAME (Vmenu_updating_frame))
|| FRAME_MSDOS_P (XFRAME (Vmenu_updating_frame)))
&& !NILP (map))
/* Indicate visually that this is a submenu. */
- item_string = concat2 (item_string, build_local_string (" >"));
+ item_string = concat2 (item_string, SCOPED_STRING (" >"));
push_menu_item (item_string, enabled, key,
AREF (item_properties, ITEM_PROPERTY_DEF),
diff --git a/src/minibuf.c b/src/minibuf.c
index b5e7e4cd76e..ea525ba0f25 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1158,7 +1158,7 @@ function, instead of the usual behavior. */)
}
prompt = Fformat (3, ((Lisp_Object [])
- { build_local_string ("%s (default %s): "),
+ { SCOPED_STRING ("%s (default %s): "),
prompt, CONSP (def) ? XCAR (def) : def }));
}
diff --git a/src/process.c b/src/process.c
index f6484d0370e..6d059af9cc8 100644
--- a/src/process.c
+++ b/src/process.c
@@ -620,7 +620,7 @@ status_message (struct Lisp_Process *p)
if (c1 != c2)
Faset (string, make_number (0), make_number (c2));
}
- string2 = build_local_string (coredump ? " (core dumped)\n" : "\n");
+ string2 = SCOPED_STRING (coredump ? " (core dumped)\n" : "\n");
return concat2 (string, string2);
}
else if (EQ (symbol, Qexit))
@@ -630,15 +630,15 @@ status_message (struct Lisp_Process *p)
if (code == 0)
return build_string ("finished\n");
string = Fnumber_to_string (make_number (code));
- string2 = build_local_string (coredump ? " (core dumped)\n" : "\n");
- return concat3 (build_local_string ("exited abnormally with code "),
+ string2 = SCOPED_STRING (coredump ? " (core dumped)\n" : "\n");
+ return concat3 (SCOPED_STRING ("exited abnormally with code "),
string, string2);
}
else if (EQ (symbol, Qfailed))
{
string = Fnumber_to_string (make_number (code));
- string2 = build_local_string ("\n");
- return concat3 (build_local_string ("failed with code "),
+ string2 = SCOPED_STRING ("\n");
+ return concat3 (SCOPED_STRING ("failed with code "),
string, string2);
}
else
@@ -1302,30 +1302,33 @@ Returns nil if format of ADDRESS is invalid. */)
ptrdiff_t size = p->header.size;
Lisp_Object args[10];
int nargs, i;
+ char const *format;
if (size == 4 || (size == 5 && !NILP (omit_port)))
{
- args[0] = build_local_string ("%d.%d.%d.%d");
+ format = "%d.%d.%d.%d";
nargs = 4;
}
else if (size == 5)
{
- args[0] = build_local_string ("%d.%d.%d.%d:%d");
+ format = "%d.%d.%d.%d:%d";
nargs = 5;
}
else if (size == 8 || (size == 9 && !NILP (omit_port)))
{
- args[0] = build_local_string ("%x:%x:%x:%x:%x:%x:%x:%x");
+ format = "%x:%x:%x:%x:%x:%x:%x:%x";
nargs = 8;
}
else if (size == 9)
{
- args[0] = build_local_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
+ format = "[%x:%x:%x:%x:%x:%x:%x:%x]:%d";
nargs = 9;
}
else
return Qnil;
+ args[0] = SCOPED_STRING (format);
+
for (i = 0; i < nargs; i++)
{
if (! RANGED_INTEGERP (0, p->contents[i], 65535))
@@ -1344,7 +1347,7 @@ Returns nil if format of ADDRESS is invalid. */)
if (CONSP (address))
return Fformat (2, ((Lisp_Object [])
- { build_local_string ("<Family %d>"), Fcar (address) }));
+ { SCOPED_STRING ("<Family %d>"), Fcar (address) }));
return Qnil;
}
@@ -4060,11 +4063,11 @@ server_accept_connection (Lisp_Object server, int channel)
unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
host = Fformat (5, ((Lisp_Object [])
- { build_local_string ("%d.%d.%d.%d"), make_number (ip[0]),
+ { SCOPED_STRING ("%d.%d.%d.%d"), make_number (ip[0]),
make_number (ip[1]), make_number (ip[2]), make_number (ip[3]) }));
service = make_number (ntohs (saddr.in.sin_port));
caller = Fformat (3, ((Lisp_Object [])
- { build_local_string (" <%s:%d>"), host, service }));
+ { SCOPED_STRING (" <%s:%d>"), host, service }));
}
break;
@@ -4075,13 +4078,13 @@ server_accept_connection (Lisp_Object server, int channel)
uint16_t *ip6 = (uint16_t *)&saddr.in6.sin6_addr;
int i;
- args[0] = build_local_string ("%x:%x:%x:%x:%x:%x:%x:%x");
+ args[0] = SCOPED_STRING ("%x:%x:%x:%x:%x:%x:%x:%x");
for (i = 0; i < 8; i++)
args[i + 1] = make_number (ntohs (ip6[i]));
host = Fformat (9, args);
service = make_number (ntohs (saddr.in.sin_port));
caller = Fformat (3, ((Lisp_Object [])
- { build_local_string (" <[%s]:%d>"), host, service }));
+ { SCOPED_STRING (" <[%s]:%d>"), host, service }));
}
break;
#endif
@@ -4092,7 +4095,7 @@ server_accept_connection (Lisp_Object server, int channel)
default:
caller = Fnumber_to_string (make_number (connect_counter));
caller = concat3
- (build_local_string (" <"), caller, build_local_string (">"));
+ (SCOPED_STRING (" <"), caller, SCOPED_STRING (">"));
break;
}
@@ -4191,14 +4194,14 @@ server_accept_connection (Lisp_Object server, int channel)
if (!NILP (ps->log))
call3 (ps->log, server, proc,
- concat3 (build_local_string ("accept from "),
- (STRINGP (host) ? host : build_local_string ("-")),
- build_local_string ("\n")));
+ concat3 (SCOPED_STRING ("accept from "),
+ (STRINGP (host) ? host : SCOPED_STRING ("-")),
+ SCOPED_STRING ("\n")));
exec_sentinel (proc,
- concat3 (build_local_string ("open from "),
- (STRINGP (host) ? host : build_local_string ("-")),
- build_local_string ("\n")));
+ concat3 (SCOPED_STRING ("open from "),
+ (STRINGP (host) ? host : SCOPED_STRING ("-")),
+ SCOPED_STRING ("\n")));
}
/* This variable is different from waiting_for_input in keyboard.c.
diff --git a/src/xdisp.c b/src/xdisp.c
index f5043c3866a..bf620085727 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -20928,7 +20928,7 @@ See also `bidi-paragraph-direction'. */)
the previous non-empty line. */
if (pos >= ZV && pos > BEGV)
DEC_BOTH (pos, bytepos);
- if (fast_looking_at (build_local_string ("[\f\t ]*\n"),
+ if (fast_looking_at (SCOPED_STRING ("[\f\t ]*\n"),
pos, bytepos, ZV, ZV_BYTE, Qnil) > 0)
{
while ((c = FETCH_BYTE (bytepos)) == '\n'
diff --git a/src/xfns.c b/src/xfns.c
index 3b094554577..f474e88ba7e 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1570,11 +1570,9 @@ x_default_scroll_bar_color_parameter (struct frame *f,
/* See if an X resource for the scroll bar color has been
specified. */
tem = display_x_get_resource
- (dpyinfo, build_local_string (foreground_p
- ? "foreground"
- : "background"),
+ (dpyinfo, SCOPED_STRING (foreground_p ? "foreground" : "background"),
empty_unibyte_string,
- build_local_string ("verticalScrollBar"),
+ SCOPED_STRING ("verticalScrollBar"),
empty_unibyte_string);
if (!STRINGP (tem))
{
@@ -4275,8 +4273,8 @@ select_visual (struct x_display_info *dpyinfo)
/* See if a visual is specified. */
Lisp_Object value = display_x_get_resource
- (dpyinfo, build_local_string ("visualClass"),
- build_local_string ("VisualClass"), Qnil, Qnil);
+ (dpyinfo, SCOPED_STRING ("visualClass"),
+ SCOPED_STRING ("VisualClass"), Qnil, Qnil);
if (STRINGP (value))
{
diff --git a/src/xselect.c b/src/xselect.c
index 0bc7fbc204a..d90d056e960 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -2160,7 +2160,7 @@ static Lisp_Object
x_clipboard_manager_error_1 (Lisp_Object err)
{
Fmessage (2, ((Lisp_Object [])
- { build_local_string ("X clipboard manager error: %s\n\
+ { SCOPED_STRING ("X clipboard manager error: %s\n\
If the problem persists, set `x-select-enable-clipboard-manager' to nil."),
CAR (CDR (err)) }));
return Qnil;
@@ -2230,7 +2230,7 @@ x_clipboard_manager_save_all (void)
if (FRAME_LIVE_P (XFRAME (local_frame)))
{
Fmessage (1, ((Lisp_Object [])
- { build_local_string
+ { SCOPED_STRING
("Saving clipboard to X clipboard manager...") }));
internal_condition_case_1 (x_clipboard_manager_save, local_frame,
Qt, x_clipboard_manager_error_2);
diff --git a/src/xterm.c b/src/xterm.c
index 8d52b2a2815..8a0e28a2e1a 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10937,8 +10937,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
{
Lisp_Object value;
value = display_x_get_resource
- (dpyinfo, build_local_string ("privateColormap"),
- build_local_string ("PrivateColormap"), Qnil, Qnil);
+ (dpyinfo, SCOPED_STRING ("privateColormap"),
+ SCOPED_STRING ("PrivateColormap"), Qnil, Qnil);
if (STRINGP (value)
&& (!strcmp (SSDATA (value), "true")
|| !strcmp (SSDATA (value), "on")))
@@ -11146,8 +11146,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
for debugging X code. */
{
Lisp_Object value = display_x_get_resource
- (dpyinfo, build_local_string ("synchronous"),
- build_local_string ("Synchronous"), Qnil, Qnil);
+ (dpyinfo, SCOPED_STRING ("synchronous"),
+ SCOPED_STRING ("Synchronous"), Qnil, Qnil);
if (STRINGP (value)
&& (!strcmp (SSDATA (value), "true")
|| !strcmp (SSDATA (value), "on")))
@@ -11156,8 +11156,8 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
{
Lisp_Object value = display_x_get_resource
- (dpyinfo, build_local_string ("useXIM"),
- build_local_string ("UseXIM"), Qnil, Qnil);
+ (dpyinfo, SCOPED_STRING ("useXIM"),
+ SCOPED_STRING ("UseXIM"), Qnil, Qnil);
#ifdef USE_XIM
if (STRINGP (value)
&& (!strcmp (SSDATA (value), "false")
--
2.39.5