procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Simplify stack-allocated Lisp objects, and make them more portable.

Browse source 
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.
This commit is contained in:
Paul Eggert 2014-09-29 19:43:23 -07:00
parent a19f0977a9
commit dc4525691c
24 changed files with 198 additions and 200 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
src/ChangeLog
View file

@ -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.

12
src/buffer.c
View file

@ -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));

3
src/charset.c
View file

@ -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 ();

2
src/chartab.c
View file

@ -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))

14
src/data.c
View file

@ -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);
}

4
src/doc.c
View file

@ -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 ();

3
src/editfns.c
View file

@ -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,

6
src/emacs.c
View file

@ -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);

14
src/fileio.c
View file

@ -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);

2
src/fns.c
View file

@ -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)

14
src/font.c
View file

@ -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))

2
src/fontset.c
View file

@ -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;

4
src/frame.c
View file

@ -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;

16
src/keyboard.c
View file

@ -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);
}

6
src/keymap.c
View file

@ -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;
}

160
src/lisp.h
View file

@ -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
#ifndef USE_STACK_LISP_OBJECTS
# define USE_STACK_LISP_OBJECTS true
#endif
/* No tricks if struct Lisp_Cons is always aligned. */
/* USE_STACK_LISP_OBJECTS requires GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS. */
# define SCOPED_CONS_INITIALIZER(a, b) &((struct Lisp_Cons) { a, { b } })
#if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
# undef USE_STACK_LISP_OBJECTS
# define USE_STACK_LISP_OBJECTS false
#endif
#else /* not GCALIGNED */
/* 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));
union Aligned_String
{
struct Lisp_String s;
double d; intmax_t i; void *p;
};
# define SCOPED_CONS_INITIALIZER(a, b) \
&((union Aligned_Cons) { { a, { b } } }.s)
/* True for stack-based cons and string implementations. */
#endif /* GCALIGNED */
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)
};
/* Basic stack-based cons allocation. */
/* 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. */
#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
#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))
/* 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. */
#if USE_STACK_LISP_OBJECTS && __GNUC__ && !__clang__
/* Used to check whether stack-allocated strings are ASCII-only. */
/* 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. */
/* 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. */
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__ */
#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.

4
src/lread.c
View file

@ -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)

16
src/menu.c
View file

@ -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),

2
src/minibuf.c
View file

@ -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 }));
}

45
src/process.c
View file

@ -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.

2
src/xdisp.c
View file

@ -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'

10
src/xfns.c
View file

@ -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))
{

4
src/xselect.c
View file

@ -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);

12
src/xterm.c
View file

@ -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")