diff options
author | Paul Eggert <eggert@cs.ucla.edu> | 2014-09-29 19:43:23 -0700 |
---|---|---|
committer | Paul Eggert <eggert@cs.ucla.edu> | 2014-09-29 19:43:23 -0700 |
commit | dc4525691c2c236abdb6c074438223413f80091c (patch) | |
tree | 86305e7415bcf1b5cc6ddad6879e922f9e5e163c /src | |
parent | a19f0977a96ee74b96410b41a8ea793c86f64b58 (diff) | |
download | emacs-dc4525691c2c236abdb6c074438223413f80091c.tar.gz |
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.
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 41 | ||||
-rw-r--r-- | src/buffer.c | 12 | ||||
-rw-r--r-- | src/charset.c | 3 | ||||
-rw-r--r-- | src/chartab.c | 2 | ||||
-rw-r--r-- | src/data.c | 14 | ||||
-rw-r--r-- | src/doc.c | 4 | ||||
-rw-r--r-- | src/editfns.c | 3 | ||||
-rw-r--r-- | src/emacs.c | 6 | ||||
-rw-r--r-- | src/fileio.c | 14 | ||||
-rw-r--r-- | src/fns.c | 2 | ||||
-rw-r--r-- | src/font.c | 14 | ||||
-rw-r--r-- | src/fontset.c | 2 | ||||
-rw-r--r-- | src/frame.c | 4 | ||||
-rw-r--r-- | src/keyboard.c | 16 | ||||
-rw-r--r-- | src/keymap.c | 6 | ||||
-rw-r--r-- | src/lisp.h | 166 | ||||
-rw-r--r-- | src/lread.c | 4 | ||||
-rw-r--r-- | src/menu.c | 16 | ||||
-rw-r--r-- | src/minibuf.c | 2 | ||||
-rw-r--r-- | src/process.c | 45 | ||||
-rw-r--r-- | src/xdisp.c | 2 | ||||
-rw-r--r-- | src/xfns.c | 10 | ||||
-rw-r--r-- | src/xselect.c | 4 | ||||
-rw-r--r-- | 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") |