diff options
author | Dmitry Antipov <dmantipov@yandex.ru> | 2014-09-29 10:44:31 +0400 |
---|---|---|
committer | Dmitry Antipov <dmantipov@yandex.ru> | 2014-09-29 10:44:31 +0400 |
commit | 71a72686e3e81253f2bc0ad74568aafdbd86879c (patch) | |
tree | e2f2d44e9a01c782e71e8de88e3b345733c86fc7 | |
parent | c3301e3c7f146a3aa017fa24f6ed240d6ecbafb4 (diff) | |
download | emacs-71a72686e3e81253f2bc0ad74568aafdbd86879c.tar.gz |
Keep stack-allocated Lisp objects fast rather than versatile.
* configure.ac (HAVE_STATEMENT_EXPRESSIONS): Remove.
For USE_STACK_LISP_OBJECTS, we always assume __GNUC__.
* lisp.h (union Aligned_Cons) [!GCALIGNED]: Define as such.
(SCOPED_CONS_INITIALIZER): New macro.
(scoped_cons) [USE_STACK_LISP_OBJECTS]: Use it.
(USE_LOCAL_ALLOCA): Remove.
(local_cons, local_list1, local_list2, local_list3, local_list4):
Remove. Stack overflow checking makes them too slow.
(make_local_vector): Likewise. Also we just don't have enough
users for it.
(enum LISP_STRING_OVERHEAD): Remove.
(local_string_init, local_vector_init): Remove prototypes.
(make_local_string, build_local_string): Redesign to target short
compile-time string constants, fall back to regular string allocation
where appropriate.
(lisp_string_size): New function.
(verify_ascii) [ENABLE_CHECKING]: Add prototype.
* alloc.c (local_string_init, local_vector_init): Remove.
(verify_ascii) [ENABLE_CHECKING]: New function.
* buffer.c, charset.c, chartab.c, data.c, editfns.c, emacs.c, fileio.c:
* fns.c, font.c, fontset.c, frame.c, keyboard.c, keymap.c, lread.c:
* menu.c, minibuf.c, process.c, textprop.c, xdisp.c, xfns.c, xfont.c:
* xselect.c, xterm.c: All related users changed.
-rw-r--r-- | ChangeLog | 5 | ||||
-rw-r--r-- | configure.ac | 11 | ||||
-rw-r--r-- | src/ChangeLog | 25 | ||||
-rw-r--r-- | src/alloc.c | 65 | ||||
-rw-r--r-- | src/buffer.c | 3 | ||||
-rw-r--r-- | src/charset.c | 7 | ||||
-rw-r--r-- | src/chartab.c | 4 | ||||
-rw-r--r-- | src/data.c | 1 | ||||
-rw-r--r-- | src/editfns.c | 4 | ||||
-rw-r--r-- | src/emacs.c | 2 | ||||
-rw-r--r-- | src/fileio.c | 1 | ||||
-rw-r--r-- | src/fns.c | 1 | ||||
-rw-r--r-- | src/font.c | 11 | ||||
-rw-r--r-- | src/fontset.c | 1 | ||||
-rw-r--r-- | src/frame.c | 1 | ||||
-rw-r--r-- | src/keyboard.c | 7 | ||||
-rw-r--r-- | src/keymap.c | 2 | ||||
-rw-r--r-- | src/lisp.h | 190 | ||||
-rw-r--r-- | src/lread.c | 2 | ||||
-rw-r--r-- | src/menu.c | 1 | ||||
-rw-r--r-- | src/minibuf.c | 1 | ||||
-rw-r--r-- | src/process.c | 4 | ||||
-rw-r--r-- | src/textprop.c | 6 | ||||
-rw-r--r-- | src/xdisp.c | 1 | ||||
-rw-r--r-- | src/xfns.c | 4 | ||||
-rw-r--r-- | src/xfont.c | 3 | ||||
-rw-r--r-- | src/xselect.c | 2 | ||||
-rw-r--r-- | src/xterm.c | 1 |
28 files changed, 124 insertions, 242 deletions
diff --git a/ChangeLog b/ChangeLog index fce1d1c9ce7..7ce90048509 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2014-09-29 Dmitry Antipov <dmantipov@yandex.ru> + + * configure.ac (HAVE_STATEMENT_EXPRESSIONS): Remove. + For USE_STACK_LISP_OBJECTS, we always assume __GNUC__. + 2014-09-27 Ken Brown <kbrown@cornell.edu> * configure.ac [CYGWIN]: Enable sound support. diff --git a/configure.ac b/configure.ac index 5fd49280dd4..ba23a617260 100644 --- a/configure.ac +++ b/configure.ac @@ -4838,17 +4838,6 @@ if test "$emacs_cv_struct_alignment" = yes; then structure to an N-byte boundary.]) fi -AC_CACHE_CHECK([for statement expressions], - [emacs_cv_statement_expressions], - [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM([], [[return ({ int x = 5; x-x; });]])], - [emacs_cv_statement_expressions=yes], - [emacs_cv_statement_expressions=no])]) -if test "$emacs_cv_statement_expressions" = yes; then - AC_DEFINE([HAVE_STATEMENT_EXPRESSIONS], 1, - [Define to 1 if statement expressions work.]) -fi - if test "${GNU_MALLOC}" = "yes" ; then AC_DEFINE(GNU_MALLOC, 1, [Define to 1 if you want to use the GNU memory allocator.]) diff --git a/src/ChangeLog b/src/ChangeLog index 20f9abd3ebf..89fc763fc53 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,28 @@ +2014-09-29 Dmitry Antipov <dmantipov@yandex.ru> + + Keep stack-allocated Lisp objects fast rather than versatile. + * lisp.h (union Aligned_Cons) [!GCALIGNED]: Define as such. + (SCOPED_CONS_INITIALIZER): New macro. + (scoped_cons) [USE_STACK_LISP_OBJECTS]: Use it. + (USE_LOCAL_ALLOCA): Remove. + (local_cons, local_list1, local_list2, local_list3, local_list4): + Remove. Stack overflow checking makes them too slow. + (make_local_vector): Likewise. Also we just don't have enough + users for it. + (enum LISP_STRING_OVERHEAD): Remove. + (local_string_init, local_vector_init): Remove prototypes. + (make_local_string, build_local_string): Redesign to target short + compile-time string constants, fall back to regular string allocation + where appropriate. + (lisp_string_size): New function. + (verify_ascii) [ENABLE_CHECKING]: Add prototype. + * alloc.c (local_string_init, local_vector_init): Remove. + (verify_ascii) [ENABLE_CHECKING]: New function. + * buffer.c, charset.c, chartab.c, data.c, editfns.c, emacs.c, fileio.c: + * fns.c, font.c, fontset.c, frame.c, keyboard.c, keymap.c, lread.c: + * menu.c, minibuf.c, process.c, textprop.c, xdisp.c, xfns.c, xfont.c: + * xselect.c, xterm.c: All related users changed. + 2014-09-28 Ken Brown <kbrown@cornell.edu> * sheap.c (bss_sbrk_buffer_beg): Remove redundant variable. diff --git a/src/alloc.c b/src/alloc.c index 2dd5fae7d8e..93bdd9a2810 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -69,7 +69,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ static bool valgrind_p; #endif -#ifdef USE_LOCAL_ALLOCATORS +#if USE_STACK_LISP_OBJECTS # if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS # error "Stack-allocated Lisp objects are not compatible with GCPROs" # endif @@ -2232,33 +2232,6 @@ make_string (const char *contents, ptrdiff_t nbytes) return val; } -#ifdef USE_LOCAL_ALLOCATORS - -/* Initialize the string S from DATA and SIZE. S must be followed by - SIZE + 1 bytes of memory that can be used. Return S tagged as a - Lisp object. */ - -Lisp_Object -local_string_init (struct Lisp_String *s, char const *data, ptrdiff_t size) -{ - unsigned char *data_copy = (unsigned char *) (s + 1); - parse_str_as_multibyte ((unsigned char const *) data, - size, &s->size, &s->size_byte); - if (size == s->size || size != s->size_byte) - { - s->size = size; - s->size_byte = -1; - } - s->intervals = NULL; - s->data = data_copy; - memcpy (data_copy, data, size); - data_copy[size] = '\0'; - return make_lisp_ptr (s, Lisp_String); -} - -#endif - - /* Make an unibyte string from LENGTH bytes at CONTENTS. */ Lisp_Object @@ -3320,23 +3293,6 @@ See also the function `vector'. */) return vector; } -#ifdef USE_LOCAL_ALLOCATORS - -/* Initialize V with LENGTH objects each with value INIT, - and return it tagged as a Lisp Object. */ - -Lisp_Object -local_vector_init (struct Lisp_Vector *v, ptrdiff_t length, Lisp_Object init) -{ - v->header.size = length; - for (ptrdiff_t i = 0; i < length; i++) - v->contents[i] = init; - return make_lisp_ptr (v, Lisp_Vectorlike); -} - -#endif - - DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. @@ -7157,7 +7113,22 @@ die (const char *msg, const char *file, int line) #endif /* ENABLE_CHECKING */ -#if defined (ENABLE_CHECKING) && defined (USE_STACK_LISP_OBJECTS) +#if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS + +/* Debugging check whether STR is ASCII-only. */ + +const char * +verify_ascii (const char *str) +{ + const unsigned char *ptr = (unsigned char *) str, *end = ptr + strlen (str); + while (ptr < end) + { + int c = STRING_CHAR_ADVANCE (ptr); + if (!ASCII_CHAR_P (c)) + emacs_abort (); + } + return str; +} /* Stress alloca with inconveniently sized requests and check whether all allocated areas may be used for Lisp_Object. */ @@ -7175,7 +7146,7 @@ verify_alloca (void) } } -#else /* not (ENABLE_CHECKING && USE_STACK_LISP_OBJECTS) */ +#else /* not ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */ #define verify_alloca() ((void) 0) diff --git a/src/buffer.c b/src/buffer.c index 591f585a7a9..39d08950bf8 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1511,7 +1511,6 @@ list first, followed by the list of all buffers. If no other buffer exists, return the buffer `*scratch*' (creating it if necessary). */) (Lisp_Object buffer, Lisp_Object visible_ok, Lisp_Object frame) { - USE_LOCAL_ALLOCA; struct frame *f = decode_any_frame (frame); Lisp_Object tail = f->buffer_list, pred = f->buffer_predicate; Lisp_Object buf, notsogood = Qnil; @@ -1570,7 +1569,6 @@ exists, return the buffer `*scratch*' (creating it if necessary). */) Lisp_Object other_buffer_safely (Lisp_Object buffer) { - USE_LOCAL_ALLOCA; Lisp_Object tail, buf; FOR_EACH_LIVE_BUFFER (tail, buf) @@ -5240,7 +5238,6 @@ init_buffer_once (void) void init_buffer (int initialized) { - USE_LOCAL_ALLOCA; char *pwd; Lisp_Object temp; ptrdiff_t len; diff --git a/src/charset.c b/src/charset.c index 30bcc054221..9fe3548be08 100644 --- a/src/charset.c +++ b/src/charset.c @@ -481,7 +481,6 @@ static void load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int control_flag) { - USE_LOCAL_ALLOCA; unsigned min_code = CHARSET_MIN_CODE (charset); unsigned max_code = CHARSET_MAX_CODE (charset); int fd; @@ -1551,7 +1550,6 @@ If the current buffer is unibyte, the returned list may contain only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) (Lisp_Object beg, Lisp_Object end, Lisp_Object table) { - USE_LOCAL_ALLOCA; Lisp_Object charsets; ptrdiff_t from, from_byte, to, stop, stop_byte; int i; @@ -1572,7 +1570,7 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) from_byte = CHAR_TO_BYTE (from); - charsets = make_local_vector (charset_table_used, Qnil); + charsets = Fmake_vector (make_number (charset_table_used), Qnil); while (1) { find_charsets_in_text (BYTE_POS_ADDR (from_byte), stop - from, @@ -1603,14 +1601,13 @@ If STR is unibyte, the returned list may contain only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) (Lisp_Object str, Lisp_Object table) { - USE_LOCAL_ALLOCA; Lisp_Object charsets; int i; Lisp_Object val; CHECK_STRING (str); - charsets = make_local_vector (charset_table_used, Qnil); + charsets = Fmake_vector (make_number (charset_table_used), Qnil); find_charsets_in_text (SDATA (str), SCHARS (str), SBYTES (str), charsets, table, STRING_MULTIBYTE (str)); diff --git a/src/chartab.c b/src/chartab.c index d25169b7a5e..4e4219d8ae3 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -1249,7 +1249,6 @@ uniprop_encode_value_run_length (Lisp_Object table, Lisp_Object value) static Lisp_Object uniprop_encode_value_numeric (Lisp_Object table, Lisp_Object value) { - USE_LOCAL_ALLOCA; Lisp_Object *value_table = XVECTOR (XCHAR_TABLE (table)->extras[4])->contents; int i, size = ASIZE (XCHAR_TABLE (table)->extras[4]); @@ -1260,7 +1259,7 @@ uniprop_encode_value_numeric (Lisp_Object table, Lisp_Object value) value = make_number (i); if (i == size) set_char_table_extras (table, 4, Fvconcat (2, ((Lisp_Object []) { - XCHAR_TABLE (table)->extras[4], make_local_vector (1, value) }))); + XCHAR_TABLE (table)->extras[4], Fmake_vector (make_number (1), value) }))); return make_number (i); } @@ -1293,7 +1292,6 @@ uniprop_get_encoder (Lisp_Object table) Lisp_Object uniprop_table (Lisp_Object prop) { - USE_LOCAL_ALLOCA; Lisp_Object val, table, result; val = Fassq (prop, Vchar_code_property_alist); diff --git a/src/data.c b/src/data.c index f839cc9d6f8..414da4cf6f7 100644 --- a/src/data.c +++ b/src/data.c @@ -1004,7 +1004,6 @@ wrong_choice (Lisp_Object choice, Lisp_Object wrong) static void wrong_range (Lisp_Object min, Lisp_Object max, Lisp_Object wrong) { - USE_LOCAL_ALLOCA; xsignal2 (Qerror, Fconcat (4, ((Lisp_Object []) { build_local_string ("Value should be from "), Fnumber_to_string (min), diff --git a/src/editfns.c b/src/editfns.c index df5d00702fd..47779914c45 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3531,7 +3531,6 @@ properties to add to the result. usage: (propertize STRING &rest PROPERTIES) */) (ptrdiff_t nargs, Lisp_Object *args) { - USE_LOCAL_ALLOCA; Lisp_Object properties, string; struct gcpro gcpro1, gcpro2; ptrdiff_t i; @@ -3548,7 +3547,7 @@ usage: (propertize STRING &rest PROPERTIES) */) string = Fcopy_sequence (args[0]); for (i = 1; i < nargs; i += 2) - properties = local_cons (args[i], local_cons (args[i + 1], properties)); + properties = Fcons (args[i], Fcons (args[i + 1], properties)); Fadd_text_properties (make_number (0), make_number (SCHARS (string)), @@ -4363,7 +4362,6 @@ usage: (format STRING &rest OBJECTS) */) Lisp_Object format2 (const char *string1, Lisp_Object arg0, Lisp_Object arg1) { - USE_LOCAL_ALLOCA; return Fformat (3, ((Lisp_Object []) { build_local_string (string1), arg0, arg1 })); } diff --git a/src/emacs.c b/src/emacs.c index 4ba51d3a7f5..241479fecf2 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -396,7 +396,6 @@ terminate_due_to_signal (int sig, int backtrace_limit) static void init_cmdargs (int argc, char **argv, int skip_args, char *original_pwd) { - USE_LOCAL_ALLOCA; int i; Lisp_Object name, dir, handler; ptrdiff_t count = SPECPDL_INDEX (); @@ -2209,7 +2208,6 @@ synchronize_system_messages_locale (void) Lisp_Object decode_env_path (const char *evarname, const char *defalt, bool empty) { - USE_LOCAL_ALLOCA; const char *path, *p; Lisp_Object lpath, element, tem; /* Default is to use "." for empty path elements. diff --git a/src/fileio.c b/src/fileio.c index 0379f0e9115..13e2c889020 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -5411,7 +5411,6 @@ An argument specifies the modification time value to use static Lisp_Object auto_save_error (Lisp_Object error_val) { - USE_LOCAL_ALLOCA; Lisp_Object msg; int i; struct gcpro gcpro1; diff --git a/src/fns.c b/src/fns.c index a4836ace68c..836a621cd51 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2706,7 +2706,6 @@ If dialog boxes are supported, a dialog box will be used if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */) (Lisp_Object prompt) { - USE_LOCAL_ALLOCA; Lisp_Object ans; struct gcpro gcpro1; diff --git a/src/font.c b/src/font.c index 3614d97d473..673a934f38f 100644 --- a/src/font.c +++ b/src/font.c @@ -357,7 +357,6 @@ int font_style_to_value (enum font_property_index prop, Lisp_Object val, bool noerror) { - USE_LOCAL_ALLOCA; Lisp_Object table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX); int len; @@ -402,7 +401,7 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, ASET (elt, 1, val); ASET (font_style_table, prop - FONT_WEIGHT_INDEX, Fvconcat (2, ((Lisp_Object []) - { table, make_local_vector (1, elt) }))); + { table, Fmake_vector (make_number (1), elt) }))); return (100 << 8) | (i << 4); } else @@ -1050,7 +1049,6 @@ font_expand_wildcards (Lisp_Object *field, int n) int font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) { - USE_LOCAL_ALLOCA; int i, j, n; char *f[XLFD_LAST_INDEX + 1]; Lisp_Object val; @@ -1760,7 +1758,6 @@ font_parse_name (char *name, ptrdiff_t namelen, Lisp_Object font) void font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Object font_spec) { - USE_LOCAL_ALLOCA; ptrdiff_t len; char *p0, *p1; @@ -2686,7 +2683,6 @@ static Lisp_Object scratch_font_spec, scratch_font_prefer; static Lisp_Object font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size) { - USE_LOCAL_ALLOCA; Lisp_Object entity, val; enum font_property_index prop; ptrdiff_t i; @@ -2717,7 +2713,7 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size) } if (NILP (spec)) { - val = local_cons (entity, val); + val = Fcons (entity, val); continue; } for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++) @@ -2748,7 +2744,7 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size) AREF (entity, FONT_AVGWIDTH_INDEX))) prop = FONT_SPEC_MAX; if (prop < FONT_SPEC_MAX) - val = local_cons (entity, val); + val = Fcons (entity, val); } return (Fvconcat (1, &val)); } @@ -5006,7 +5002,6 @@ static Lisp_Object Vfont_log_deferred; void font_add_log (const char *action, Lisp_Object arg, Lisp_Object result) { - USE_LOCAL_ALLOCA; Lisp_Object val; int i; diff --git a/src/fontset.c b/src/fontset.c index ff92f16a266..5e18d14bd65 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1420,7 +1420,6 @@ to the font specifications for TARGET previously set. If it is appended. By default, FONT-SPEC overrides the previous settings. */) (Lisp_Object name, Lisp_Object target, Lisp_Object font_spec, Lisp_Object frame, Lisp_Object add) { - USE_LOCAL_ALLOCA; Lisp_Object fontset; Lisp_Object font_def, registry, family; Lisp_Object range_list; diff --git a/src/frame.c b/src/frame.c index f1d8662aff1..0eea4f4338a 100644 --- a/src/frame.c +++ b/src/frame.c @@ -4122,7 +4122,6 @@ Lisp_Object x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param, const char *attribute, const char *class, enum resource_types type) { - USE_LOCAL_ALLOCA; Lisp_Object tem; tem = Fassq (param, alist); diff --git a/src/keyboard.c b/src/keyboard.c index fcba475e5ee..d920ef45f45 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -573,7 +573,7 @@ echo_add_key (Lisp_Object c) kset_echo_string (current_kboard, - concat2 (echo_string, make_local_string (buffer, ptr - buffer))); + concat2 (echo_string, make_string (buffer, ptr - buffer))); SAFE_FREE (); } @@ -597,8 +597,6 @@ echo_char (Lisp_Object c) static void echo_dash (void) { - USE_LOCAL_ALLOCA; - /* Do nothing if not echoing at all. */ if (NILP (KVAR (current_kboard, echo_string))) return; @@ -1892,7 +1890,6 @@ safe_run_hooks_1 (ptrdiff_t nargs, Lisp_Object *args) static Lisp_Object safe_run_hooks_error (Lisp_Object error, ptrdiff_t nargs, Lisp_Object *args) { - USE_LOCAL_ALLOCA; Lisp_Object hook, fun; eassert (nargs == 2); @@ -7699,7 +7696,6 @@ menu_item_eval_property (Lisp_Object sexpr) bool parse_menu_item (Lisp_Object item, int inmenubar) { - USE_LOCAL_ALLOCA; Lisp_Object def, tem, item_string, start; Lisp_Object filter; Lisp_Object keyhint; @@ -8523,7 +8519,6 @@ static Lisp_Object read_char_minibuf_menu_prompt (int commandflag, Lisp_Object map) { - USE_LOCAL_ALLOCA; Lisp_Object name; ptrdiff_t nlength; /* FIXME: Use the minibuffer's frame width. */ diff --git a/src/keymap.c b/src/keymap.c index 768df563632..ed572a5a8c1 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1308,7 +1308,6 @@ append_key (Lisp_Object key_sequence, Lisp_Object key) static void silly_event_symbol_error (Lisp_Object c) { - USE_LOCAL_ALLOCA; Lisp_Object parsed, base, name, assoc; int modifiers; @@ -3418,7 +3417,6 @@ describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args, bool partial, Lisp_Object shadow, Lisp_Object entire_map, bool keymap_p, bool mention_shadow) { - USE_LOCAL_ALLOCA; Lisp_Object definition; Lisp_Object tem2; Lisp_Object elt_prefix = Qnil; diff --git a/src/lisp.h b/src/lisp.h index b1f793c7282..d2cac17fbc7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3705,8 +3705,6 @@ extern Lisp_Object make_uninit_bool_vector (EMACS_INT); extern Lisp_Object bool_vector_fill (Lisp_Object, Lisp_Object); extern _Noreturn void string_overflow (void); extern Lisp_Object make_string (const char *, ptrdiff_t); -extern Lisp_Object local_string_init (struct Lisp_String *, char const *, - ptrdiff_t); extern Lisp_Object make_formatted_string (char *, const char *, ...) ATTRIBUTE_FORMAT_PRINTF (2, 3); extern Lisp_Object make_unibyte_string (const char *, ptrdiff_t); @@ -3795,8 +3793,6 @@ extern struct Lisp_Hash_Table *allocate_hash_table (void); extern struct window *allocate_window (void); extern struct frame *allocate_frame (void); extern struct Lisp_Process *allocate_process (void); -extern Lisp_Object local_vector_init (struct Lisp_Vector *, ptrdiff_t, - Lisp_Object); extern struct terminal *allocate_terminal (void); extern bool gc_in_progress; extern bool abort_on_gc; @@ -4602,17 +4598,25 @@ lisp_word_count (ptrdiff_t nbytes) /* If USE_STACK_LISP_OBJECTS, define macros that and functions that allocate - block-scoped conses and function-scoped vectors 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. + block-scoped conses and function-scoped 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' to get into the game. + 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. */ +#ifdef GCALIGNED + +/* No tricks if struct Lisp_Cons is always aligned. */ + +# define SCOPED_CONS_INITIALIZER(a, b) &((struct Lisp_Cons) { a, { b } }) + +#else /* not GCALIGNED */ + /* A struct Lisp_Cons inside a union that is no larger and may be better-aligned. */ @@ -4621,153 +4625,89 @@ union Aligned_Cons struct Lisp_Cons s; double d; intmax_t i; void *p; }; + +verify (alignof (union Aligned_Cons) % GCALIGNMENT == 0); verify (sizeof (struct Lisp_Cons) == sizeof (union Aligned_Cons)); -/* Allocate a block-scoped cons. */ +# define SCOPED_CONS_INITIALIZER(a, b) \ + &((union Aligned_Cons) { { a, { b } } }.s) -#define scoped_cons(car, cdr) \ - ((USE_STACK_LISP_OBJECTS \ - && alignof (union Aligned_Cons) % GCALIGNMENT == 0) \ - ? make_lisp_ptr (&((union Aligned_Cons) {{car, {cdr}}}).s, Lisp_Cons) \ - : Fcons (car, cdr)) +#endif /* GCALIGNED */ -/* Convenient utility macros similar to listX functions. */ +/* 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 -/* Local allocators require both statement expressions and a - GCALIGNMENT-aligned alloca. clang's 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 && HAVE_STATEMENT_EXPRESSIONS \ - && __GNUC__ && !__clang__) -# define USE_LOCAL_ALLOCATORS -#endif +/* 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. */ -/* Any function that uses a local allocator should start with either - 'USE_SAFE_ALLOCA; or 'USE_LOCAL_ALLOCA;' (but not both). */ -#ifdef USE_LOCAL_ALLOCATORS -# define USE_LOCAL_ALLOCA ptrdiff_t sa_avail = MAX_ALLOCA -#else -# define USE_LOCAL_ALLOCA -#endif +#if USE_STACK_LISP_OBJECTS && __GNUC__ && !__clang__ -#ifdef USE_LOCAL_ALLOCATORS - -/* Return a function-scoped cons whose car is X and cdr is Y. */ - -# define local_cons(x, y) \ - (sizeof (struct Lisp_Cons) <= sa_avail \ - ? ({ \ - struct Lisp_Cons *c_ = AVAIL_ALLOCA (sizeof (struct Lisp_Cons)); \ - c_->car = (x); \ - c_->u.cdr = (y); \ - make_lisp_ptr (c_, Lisp_Cons); \ - }) \ - : Fcons (x, y)) - -# define local_list1(a) local_cons (a, Qnil) -# define local_list2(a, b) local_cons (a, local_list1 (b)) -# define local_list3(a, b, c) local_cons (a, local_list2 (b, c)) -# define local_list4(a, b, c, d) local_cons (a, local_list3 (b, c, d)) - -/* Return a function-scoped vector of length SIZE, with each element - being INIT. */ - -# define make_local_vector(size, init) \ - ({ \ - ptrdiff_t size_ = size; \ - Lisp_Object vec_; \ - if (size_ <= lisp_word_count (sa_avail - header_size)) \ - { \ - void *ptr_ = AVAIL_ALLOCA (size_ * word_size + header_size); \ - vec_ = local_vector_init (ptr_, size_, init); \ - } \ - else \ - vec_ = Fmake_vector (make_number (size_), init); \ - vec_; \ - }) - -enum { LISP_STRING_OVERHEAD = sizeof (struct Lisp_String) + 1 }; - -/* Return a function-scoped string with contents DATA and length NBYTES. */ - -# define make_local_string(data, nbytes) \ - ({ \ - ptrdiff_t nbytes_ = nbytes; \ - Lisp_Object string_; \ - if (nbytes_ <= sa_avail - LISP_STRING_OVERHEAD) \ - { \ - struct Lisp_String *ptr_ = AVAIL_ALLOCA (LISP_STRING_OVERHEAD \ - + nbytes_); \ - string_ = local_string_init (ptr_, data, nbytes_); \ - } \ - else \ - string_ = make_string (data, nbytes_); \ - string_; \ - }) - -/* Return a function-scoped string with contents DATA. */ - -# define build_local_string(data) \ - ({ char const *data1_ = (data); \ - make_local_string (data1_, strlen (data1_)); }) +/* Used to check whether stack-allocated strings are ASCII-only. */ +#ifdef ENABLE_CHECKING +extern const char * verify_ascii (const char *); #else +#define verify_ascii(str) (str) +#endif -/* Safer but slower implementations. */ -INLINE Lisp_Object -local_cons (Lisp_Object car, Lisp_Object cdr) -{ - return Fcons (car, cdr); -} -INLINE Lisp_Object -local_list1 (Lisp_Object a) -{ - return list1 (a); -} -INLINE Lisp_Object -local_list2 (Lisp_Object a, Lisp_Object b) -{ - return list2 (a, b); -} -INLINE Lisp_Object -local_list3 (Lisp_Object a, Lisp_Object b, Lisp_Object c) -{ - return list3 (a, b, c); -} -INLINE Lisp_Object -local_list4 (Lisp_Object a, Lisp_Object b, Lisp_Object c, Lisp_Object d) -{ - return list4 (a, b, c, d); -} -INLINE Lisp_Object -make_local_vector (ptrdiff_t size, Lisp_Object init) -{ - return Fmake_vector (make_number (size), init); -} -INLINE Lisp_Object -make_local_string (char const *str, ptrdiff_t nbytes) +/* Return number of bytes needed for Lisp string of length NBYTES. */ + +INLINE ptrdiff_t +lisp_string_size (ptrdiff_t nbytes) { - return make_string (str, 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 +#endif /* not USE_STACK_LISP_OBJECTS && __GNUC__ && !__clang__ */ /* 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 ad4603299af..b6f259f1a95 100644 --- a/src/lread.c +++ b/src/lread.c @@ -968,7 +968,6 @@ load_error_handler (Lisp_Object data) static void load_warn_old_style_backquotes (Lisp_Object file) { - USE_LOCAL_ALLOCA; if (!NILP (Vold_style_backquotes)) Fmessage (2, ((Lisp_Object []) { build_local_string ("Loading `%s': old-style backquotes detected!"), @@ -3639,7 +3638,6 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag) static Lisp_Object read_list (bool flag, Lisp_Object readcharfun) { - USE_LOCAL_ALLOCA; Lisp_Object val, tail; Lisp_Object elt, tem; struct gcpro gcpro1, gcpro2; diff --git a/src/menu.c b/src/menu.c index 8c77f69d995..ea8da7a9d62 100644 --- a/src/menu.c +++ b/src/menu.c @@ -324,7 +324,6 @@ single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name, static void single_menu_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy, void *skp_v) { - USE_LOCAL_ALLOCA; Lisp_Object map, item_string, enabled; struct gcpro gcpro1, gcpro2; bool res; diff --git a/src/minibuf.c b/src/minibuf.c index c5f52f81de4..b5e7e4cd76e 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1123,7 +1123,6 @@ If `read-buffer-function' is non-nil, this works by calling it as a function, instead of the usual behavior. */) (Lisp_Object prompt, Lisp_Object def, Lisp_Object require_match) { - USE_LOCAL_ALLOCA; Lisp_Object result; char *s; ptrdiff_t len; diff --git a/src/process.c b/src/process.c index 28b55d36815..f6484d0370e 100644 --- a/src/process.c +++ b/src/process.c @@ -592,7 +592,6 @@ decode_status (Lisp_Object l, Lisp_Object *symbol, int *code, bool *coredump) static Lisp_Object status_message (struct Lisp_Process *p) { - USE_LOCAL_ALLOCA; Lisp_Object status = p->status; Lisp_Object symbol; int code; @@ -1291,8 +1290,6 @@ number in the string, even when present in ADDRESS. Returns nil if format of ADDRESS is invalid. */) (Lisp_Object address, Lisp_Object omit_port) { - USE_LOCAL_ALLOCA; - if (NILP (address)) return Qnil; @@ -4006,7 +4003,6 @@ static EMACS_INT connect_counter = 0; static void server_accept_connection (Lisp_Object server, int channel) { - USE_LOCAL_ALLOCA; Lisp_Object proc, caller, name, buffer; Lisp_Object contact, host, service; struct Lisp_Process *ps= XPROCESS (server); diff --git a/src/textprop.c b/src/textprop.c index c7185f3daef..146ee9e97d9 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -1913,7 +1913,6 @@ Lisp_Object copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_Object pos, Lisp_Object dest, Lisp_Object prop) { - USE_LOCAL_ALLOCA; INTERVAL i; Lisp_Object res; Lisp_Object stuff; @@ -1967,9 +1966,8 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, if (! NILP (plist)) /* Must defer modifications to the interval tree in case src and dest refer to the same string or buffer. */ - stuff = local_cons - (local_list3 (make_number (p), make_number (p + len), plist), - stuff); + stuff = Fcons (list3 (make_number (p), make_number (p + len), plist), + stuff); i = next_interval (i); if (!i) diff --git a/src/xdisp.c b/src/xdisp.c index 3137c8438fe..f5043c3866a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20892,7 +20892,6 @@ paragraphs, text begins at the right margin and is read from right to left. See also `bidi-paragraph-direction'. */) (Lisp_Object buffer) { - USE_LOCAL_ALLOCA; struct buffer *buf = current_buffer; struct buffer *old = buf; diff --git a/src/xfns.c b/src/xfns.c index d6e4b7bf5ca..3b094554577 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1559,9 +1559,6 @@ x_default_scroll_bar_color_parameter (struct frame *f, const char *xprop, const char *xclass, int foreground_p) { -#ifdef USE_TOOLKIT_SCROLL_BARS - USE_LOCAL_ALLOCA; -#endif struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); Lisp_Object tem; @@ -4273,7 +4270,6 @@ XScreenNumberOfScreen (scr) void select_visual (struct x_display_info *dpyinfo) { - USE_LOCAL_ALLOCA; Display *dpy = dpyinfo->display; Screen *screen = dpyinfo->screen; diff --git a/src/xfont.c b/src/xfont.c index fc2dc195822..5e8dd370120 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -677,7 +677,6 @@ xfont_list_family (struct frame *f) static Lisp_Object xfont_open (struct frame *f, Lisp_Object entity, int pixel_size) { - USE_LOCAL_ALLOCA; Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); Display *display = dpyinfo->display; char name[512]; @@ -776,7 +775,7 @@ xfont_open (struct frame *f, Lisp_Object entity, int pixel_size) if (dashes >= 13) { len = xfont_decode_coding_xlfd (p0, -1, name); - fullname = Fdowncase (make_local_string (name, len)); + fullname = Fdowncase (make_string (name, len)); } XFree (p0); } diff --git a/src/xselect.c b/src/xselect.c index 7e6d699dffa..0bc7fbc204a 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -2159,7 +2159,6 @@ x_clipboard_manager_save (Lisp_Object frame) static Lisp_Object x_clipboard_manager_error_1 (Lisp_Object err) { - USE_LOCAL_ALLOCA; Fmessage (2, ((Lisp_Object []) { build_local_string ("X clipboard manager error: %s\n\ If the problem persists, set `x-select-enable-clipboard-manager' to nil."), @@ -2213,7 +2212,6 @@ void x_clipboard_manager_save_all (void) { /* Loop through all X displays, saving owned clipboards. */ - USE_LOCAL_ALLOCA; struct x_display_info *dpyinfo; Lisp_Object local_selection, local_frame; diff --git a/src/xterm.c b/src/xterm.c index 7a0e861bf77..8d52b2a2815 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10666,7 +10666,6 @@ static unsigned x_display_id; struct x_display_info * x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) { - USE_LOCAL_ALLOCA; Display *dpy; struct terminal *terminal; struct x_display_info *dpyinfo; |