From b1573a97e17b518723ab3f906eb6d521caed196d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 13 Nov 2017 08:51:41 -0800 Subject: Use alignas to fix GCALIGN-related bugs Use alignas and unions to specify alignments of objects needing addresses that are at least a multiple of GCALIGNMENT. Using these standard C facilities should be safer than relying on ad hoc and poorly-understood features like GCC’s __attribute__ ((aligned (N))), the root cause for recent porting bugs like Bug#29040. The alignas macro was standardized by C11 and Gnulib supports alignas for pre-C11 platforms. I have tested this on Sun Studio 12 sparc (2007) and GCC 4.4.7 x86-64 (2012) as well as on more recent platforms like GCC 7.2.1 (2017) on Fedora 26 (both x86-64 and x86). * lib-src/make-docfile.c (close_emacs_globals): lispsym is now just an array of struct Lisp_Symbol, since struct Lisp_Symbol is now properly aligned. All uses changed. * src/alloc.c (NEXT_FREE_LISP_STRING): Just use the new u.next member; this is simpler and safer than casting a pointer that might not be aligned properly. (aligned_Lisp_Symbol): Remove. No longer needed, now that struct Lisp_Symbol is aligned properly. All uses replaced with struct Lisp_Symbol. * src/lisp.h (GCALIGNED): Remove, as it does not work as expected: it can cause the natural alignment to be ignored. All uses replaced by unions with a ‘char alignas (GCALIGNMENT)’ member as described below. (struct Lisp_Symbol, struct Lisp_Cons, struct Lisp_String): Change definition from ‘struct TAG { MEMBERS };’ to ‘struct TAG { union { struct { MEMBERS } s; char alignas (GCALIGNMENT) gcaligned; } u; };’. This guarantees ‘struct TAG’ to have an alignment that at least max (GCALIGNMENT, N) where N is its old alignment. All uses like ‘PTR->MEMBER’ changed to ‘PTR->u.s.MEMBER’; these uses were supposed to be mostly private anyway. Verify that the resulting ‘struct TAG’ is properly aligned for Emacs. (union vectorlike_header): New member ‘gcaligned’ to guarantee that this type, and its containing types like ‘struct Lisp_Subr’, ‘struct buffer’ and ‘struct thread_state’, are all properly aligned for Emacs. (struct Lisp_String): New union member ‘next’, for the benefit of NEXT_FREE_LISP_STRING. (union Aligned_Cons, union Aligned_String): Remove. All uses replaced by struct Lisp_Cons and struct Lisp_String, since they are now properly aligned. (USE_STACK_CONS, USE_STACK_STRING): Simplify now that we can assume struct Lisp_Cons and struct Lisp_String are properly aligned. --- src/bytecode.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 50c7abe2891..ebaf3c3a7fc 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -489,7 +489,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { Lisp_Object v1 = vectorp[op], v2; if (!SYMBOLP (v1) - || XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL + || XSYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL || (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound))) v2 = Fsymbol_value (v1); PUSH (v2); @@ -558,7 +558,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* Inline the most common case. */ if (SYMBOLP (sym) && !EQ (val, Qunbound) - && !XSYMBOL (sym)->redirect + && !XSYMBOL (sym)->u.s.redirect && !SYMBOL_TRAPPED_WRITE_P (sym)) SET_SYMBOL_VAL (XSYMBOL (sym), val); else -- cgit v1.2.1 From ac64fdb248d791b204cf579f878f8542ded0d067 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 26 Nov 2017 19:15:14 -0800 Subject: Harden exec_byte_code against redefining 'error' Problem discovered by configuring with --enable-gcc-warnings on Ubuntu 17.10 x86-64 with gcc (Ubuntu 7.2.0-8ubuntu3). * src/bytecode.c (exec_byte_code): Call the C error function instead of the Lisp one, so that the Emacs interpreter does not go haywire if the user redefines the Lisp error function. --- src/bytecode.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index ebaf3c3a7fc..8746568f166 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1346,10 +1346,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* Actually this is Bstack_ref with offset 0, but we use Bdup for that instead. */ /* CASE (Bstack_ref): */ - call3 (Qerror, - build_string ("Invalid byte opcode: op=%s, ptr=%d"), - make_number (op), - make_number (pc - 1 - bytestr_data)); + error ("Invalid byte opcode: op=%d, ptr=%"pD"d", + op, pc - 1 - bytestr_data); /* Handy byte-codes for lexical binding. */ CASE (Bstack_ref1): -- cgit v1.2.1 From 4295050e1194af13afa26403dd3ebdff80824ae0 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 9 Dec 2017 13:57:38 -0800 Subject: Narrow pointer bounds when appropriate This typically occurs in a storage manager, where the caller is expected to access only the newly-allocated object, instead of using the returned value to access unrelated parts of the heap. * src/alloc.c (allocate_string, allocate_string_data) (compact_small_strings, find_string_data_in_pure) (sweep_strings, setup_on_free_list, allocate_vectorlike (pure_alloc): * src/bytecode.c (exec_byte_code): * src/callint.c (Fcall_interactively): * src/dispnew.c (scrolling): * src/editfns.c (styled_format): * src/frame.c (xrdb_get_resource, x_get_resource_string): * src/fringe.c (Fdefine_fringe_bitmap): * src/gmalloc.c (malloc, realloc, aligned_alloc): Narrow pointer bounds when appropriate. * src/alloc.c (SDATA_OF_STRING): * src/lisp.h (make_lisp_symbol) [__CHKP__]: Widen bounds here, though. * src/bytecode.c, src/callint.c, src/dispnew.c, src/editfns.c: * src/emacs.c, src/frame.c, src/fringe.c: Include ptr-bounds.h. * src/ptr-bounds.h (ptr_bounds_clip): New function. --- src/bytecode.c | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 8746568f166..78207f776c1 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see . */ #include "character.h" #include "buffer.h" #include "keyboard.h" +#include "ptr-bounds.h" #include "syntax.h" #include "window.h" @@ -363,13 +364,15 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, unsigned char quitcounter = 1; EMACS_INT stack_items = XFASTINT (maxdepth) + 1; USE_SAFE_ALLOCA; - Lisp_Object *stack_base; - SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length); - Lisp_Object *stack_lim = stack_base + stack_items; + void *alloc; + SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length); + ptrdiff_t item_bytes = stack_items * word_size; + Lisp_Object *stack_base = ptr_bounds_clip (alloc, item_bytes); Lisp_Object *top = stack_base; - memcpy (stack_lim, SDATA (bytestr), bytestr_length); - void *void_stack_lim = stack_lim; - unsigned char const *bytestr_data = void_stack_lim; + Lisp_Object *stack_lim = stack_base + stack_items; + unsigned char *bytestr_data = alloc; + bytestr_data = ptr_bounds_clip (bytestr_data + item_bytes, bytestr_length); + memcpy (bytestr_data, SDATA (bytestr), bytestr_length); unsigned char const *pc = bytestr_data; ptrdiff_t count = SPECPDL_INDEX (); -- cgit v1.2.1 From 5c7dd8a783fa2503f042f6671279e5fca38c35cb Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 1 Jan 2018 00:21:42 -0800 Subject: Update copyright year to 2018 Run admin/update-copyright. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 8746568f166..e51f9095b36 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1,5 +1,5 @@ /* Execution of byte code produced by bytecomp.el. - Copyright (C) 1985-1988, 1993, 2000-2017 Free Software Foundation, + Copyright (C) 1985-1988, 1993, 2000-2018 Free Software Foundation, Inc. This file is part of GNU Emacs. -- cgit v1.2.1 From a0aa1d4ecc123d652285ef10ea62ed55c6c118d6 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 7 Jun 2018 18:53:27 -0700 Subject: New function record_unwind_protect_excursion This simplifies callers a bit, and will simplify future changes. * src/eval.c (record_unwind_protect_excursion): New function. * src/buffer.c (Fkill_buffer): * src/bytecode.c (exec_byte_code): * src/editfns.c (Fsave_excursion, Freplace_buffer_contents): * src/lread.c (readevalloop, Feval_buffer): * src/window.c (scroll_command): Use it. --- src/bytecode.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 55b193ffb2f..772cc982f9a 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -739,8 +739,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bsave_excursion): - record_unwind_protect (save_excursion_restore, - save_excursion_save ()); + record_unwind_protect_excursion (); NEXT; CASE (Bsave_current_buffer): /* Obsolete since ??. */ -- cgit v1.2.1 From 42fe787b0f26c2df682b2797407a669ef8522ccb Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Fri, 6 Jul 2018 21:56:17 -0600 Subject: Rename integerp->fixnum, etc, in preparation for bignums * src/json.c, src/keyboard.c, src/keyboard.h, src/keymap.c, src/kqueue.c, src/lcms.c, src/lisp.h, src/lread.c, src/macros.c, src/marker.c, src/menu.c, src/minibuf.c, src/msdos.c, src/print.c, src/process.c, src/profiler.c, src/search.c, src/sound.c, src/syntax.c, src/sysdep.c, src/term.c, src/terminal.c, src/textprop.c, src/undo.c, src/w16select.c, src/w32.c, src/w32console.c, src/w32cygwinx.c, src/w32fns.c, src/w32font.c, src/w32inevt.c, src/w32proc.c, src/w32select.c, src/w32term.c, src/w32uniscribe.c, src/widget.c, src/window.c, src/xdisp.c, src/xfaces.c, src/xfns.c, src/xfont.c, src/xftfont.c, src/xmenu.c, src/xrdb.c, src/xselect.c, src/xterm.c, src/xwidget.c: Rename INTEGERP->FIXNUM, make_number->make_fixnum, CHECK_NUMBER->CHECK_FIXNUM, make_natnum->make_fixed_natum, NUMBERP->FIXED_OR_FLOATP, NATNUMP->FIXNATP, CHECK_NATNUM->CHECK_FIXNAT. --- src/bytecode.c | 48 ++++++++++++++++++++++++------------------------ 1 file changed, 24 insertions(+), 24 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 772cc982f9a..282754d22b6 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -346,7 +346,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CHECK_STRING (bytestr); CHECK_VECTOR (vector); - CHECK_NATNUM (maxdepth); + CHECK_FIXNAT (maxdepth); ptrdiff_t const_length = ASIZE (vector); @@ -378,7 +378,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, if (!NILP (args_template)) { - eassert (INTEGERP (args_template)); + eassert (FIXNUMP (args_template)); ptrdiff_t at = XINT (args_template); bool rest = (at & 128) != 0; int mandatory = at & 127; @@ -386,8 +386,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest; if (! (mandatory <= nargs && nargs <= maxargs)) Fsignal (Qwrong_number_of_arguments, - list2 (Fcons (make_number (mandatory), make_number (nonrest)), - make_number (nargs))); + list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)), + make_fixnum (nargs))); ptrdiff_t pushedargs = min (nonrest, nargs); for (ptrdiff_t i = 0; i < pushedargs; i++, args++) PUSH (*args); @@ -621,7 +621,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { Lisp_Object v1 = TOP; Lisp_Object v2 = Fget (v1, Qbyte_code_meter); - if (INTEGERP (v2) + if (FIXNUMP (v2) && XINT (v2) < MOST_POSITIVE_FIXNUM) { XSETINT (v2, XINT (v2) + 1); @@ -832,7 +832,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bnth): { Lisp_Object v2 = POP, v1 = TOP; - CHECK_NUMBER (v1); + CHECK_FIXNUM (v1); for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--) { v2 = XCDR (v2); @@ -972,11 +972,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bsub1): - TOP = INTEGERP (TOP) ? make_number (XINT (TOP) - 1) : Fsub1 (TOP); + TOP = FIXNUMP (TOP) ? make_fixnum (XINT (TOP) - 1) : Fsub1 (TOP); NEXT; CASE (Badd1): - TOP = INTEGERP (TOP) ? make_number (XINT (TOP) + 1) : Fadd1 (TOP); + TOP = FIXNUMP (TOP) ? make_fixnum (XINT (TOP) + 1) : Fadd1 (TOP); NEXT; CASE (Beqlsign): @@ -986,8 +986,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, TOP = arithcompare (v1, v2, ARITH_EQUAL); else { - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1); - CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v1); + CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v2); TOP = EQ (v1, v2) ? Qt : Qnil; } NEXT; @@ -1027,7 +1027,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bnegate): - TOP = INTEGERP (TOP) ? make_number (- XINT (TOP)) : Fminus (1, &TOP); + TOP = FIXNUMP (TOP) ? make_fixnum (- XINT (TOP)) : Fminus (1, &TOP); NEXT; CASE (Bplus): @@ -1063,7 +1063,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } CASE (Bpoint): - PUSH (make_natnum (PT)); + PUSH (make_fixed_natnum (PT)); NEXT; CASE (Bgoto_char): @@ -1089,7 +1089,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } CASE (Bpoint_min): - PUSH (make_natnum (BEGV)); + PUSH (make_fixed_natnum (BEGV)); NEXT; CASE (Bchar_after): @@ -1105,7 +1105,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bcurrent_column): - PUSH (make_natnum (current_column ())); + PUSH (make_fixed_natnum (current_column ())); NEXT; CASE (Bindent_to): @@ -1262,7 +1262,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { /* Exchange args and then do nth. */ Lisp_Object v2 = POP, v1 = TOP; - CHECK_NUMBER (v2); + CHECK_FIXNUM (v2); for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--) { v1 = XCDR (v1); @@ -1324,11 +1324,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bnumberp): - TOP = NUMBERP (TOP) ? Qt : Qnil; + TOP = FIXED_OR_FLOATP (TOP) ? Qt : Qnil; NEXT; CASE (Bintegerp): - TOP = INTEGERP (TOP) ? Qt : Qnil; + TOP = FIXNUMP (TOP) ? Qt : Qnil; NEXT; #if BYTE_CODE_SAFE @@ -1415,7 +1415,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { /* Do a linear search if there are not many cases FIXME: 5 is arbitrarily chosen. */ Lisp_Object hash_code = h->test.cmpfn - ? make_number (h->test.hashfn (&h->test, v1)) : Qnil; + ? make_fixnum (h->test.hashfn (&h->test, v1)) : Qnil; for (i = h->count; 0 <= --i; ) if (EQ (v1, HASH_KEY (h, i)) @@ -1431,7 +1431,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, if (i >= 0) { Lisp_Object val = HASH_VALUE (h, i); - if (BYTE_CODE_SAFE && !INTEGERP (val)) + if (BYTE_CODE_SAFE && !FIXNUMP (val)) emacs_abort (); op = XINT (val); goto op_branch; @@ -1468,14 +1468,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object get_byte_code_arity (Lisp_Object args_template) { - eassert (NATNUMP (args_template)); + eassert (FIXNATP (args_template)); EMACS_INT at = XINT (args_template); bool rest = (at & 128) != 0; int mandatory = at & 127; EMACS_INT nonrest = at >> 8; - return Fcons (make_number (mandatory), - rest ? Qmany : make_number (nonrest)); + return Fcons (make_fixnum (mandatory), + rest ? Qmany : make_fixnum (nonrest)); } void @@ -1500,13 +1500,13 @@ If a symbol has a property named `byte-code-meter' whose value is an integer, it is incremented each time that symbol's function is called. */); byte_metering_on = false; - Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); + Vbyte_code_meter = Fmake_vector (make_fixnum (256), make_fixnum (0)); DEFSYM (Qbyte_code_meter, "byte-code-meter"); { int i = 256; while (i--) ASET (Vbyte_code_meter, i, - Fmake_vector (make_number (256), make_number (0))); + Fmake_vector (make_fixnum (256), make_fixnum (0))); } #endif } -- cgit v1.2.1 From e2a78b0d6d844f29acaaddd775c7b1cd6dec7af8 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Sun, 8 Jul 2018 09:36:37 -0600 Subject: Bignum fixes for byte-compiler and bytecode interpreter * lisp/emacs-lisp/byte-opt.el: Mark bignump and fixnump as side-effect-and-error-free-fns. * src/bytecode.c (exec_byte_code): Handle bignums. --- src/bytecode.c | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 282754d22b6..f87983a59c0 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -972,11 +972,15 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bsub1): - TOP = FIXNUMP (TOP) ? make_fixnum (XINT (TOP) - 1) : Fsub1 (TOP); + TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_NEGATIVE_FIXNUM + ? make_fixnum (XINT (TOP) - 1) + : Fsub1 (TOP)); NEXT; CASE (Badd1): - TOP = FIXNUMP (TOP) ? make_fixnum (XINT (TOP) + 1) : Fadd1 (TOP); + TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_POSITIVE_FIXNUM + ? make_fixnum (XINT (TOP) + 1) + : Fadd1 (TOP)); NEXT; CASE (Beqlsign): @@ -1027,7 +1031,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bnegate): - TOP = FIXNUMP (TOP) ? make_fixnum (- XINT (TOP)) : Fminus (1, &TOP); + TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_NEGATIVE_FIXNUM + ? make_fixnum (- XINT (TOP)) + : Fminus (1, &TOP)); NEXT; CASE (Bplus): @@ -1324,11 +1330,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bnumberp): - TOP = FIXED_OR_FLOATP (TOP) ? Qt : Qnil; + TOP = NUMBERP (TOP) ? Qt : Qnil; NEXT; CASE (Bintegerp): - TOP = FIXNUMP (TOP) ? Qt : Qnil; + TOP = INTEGERP (TOP) ? Qt : Qnil; NEXT; #if BYTE_CODE_SAFE -- cgit v1.2.1 From d1ec3a0a8e4d7d56ebc1e4fa743130b9974ac6a8 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Tue, 7 Aug 2018 18:08:53 -0600 Subject: More macro renamings for bignum * src/alloc.c, src/bidi.c, src/buffer.c, src/buffer.h, src/bytecode.c, src/callint.c, src/callproc.c, src/casefiddle.c, src/casetab.c, src/category.c, src/ccl.c, src/character.c, src/character.h, src/charset.c, src/charset.h, src/chartab.c, src/cmds.c, src/coding.c, src/composite.c, src/composite.h, src/data.c, src/dbusbind.c, src/decompress.c, src/dired.c, src/dispextern.h, src/dispnew.c, src/disptab.h, src/doc.c, src/dosfns.c, src/editfns.c, src/emacs-module.c, src/emacs.c, src/eval.c, src/fileio.c, src/floatfns.c, src/fns.c, src/font.c, src/font.h, src/fontset.c, src/frame.c, src/frame.h, src/fringe.c, src/ftcrfont.c, src/ftfont.c, src/gfilenotify.c, src/gnutls.c, src/gtkutil.c, src/image.c, src/indent.c, src/insdel.c, src/intervals.c, src/json.c, src/keyboard.c, src/keymap.c, src/kqueue.c, src/lcms.c, src/lisp.h, src/lread.c, src/macros.c, src/marker.c, src/menu.c, src/minibuf.c, src/msdos.c, src/print.c, src/process.c, src/profiler.c, src/search.c, src/sound.c, src/syntax.c, src/syntax.h, src/sysdep.c, src/term.c, src/termhooks.h, src/textprop.c, src/undo.c, src/w32.c, src/w32console.c, src/w32fns.c, src/w32font.c, src/w32inevt.c, src/w32proc.c, src/w32select.c, src/w32term.c, src/w32term.h, src/w32uniscribe.c, src/window.c, src/xdisp.c, src/xfaces.c, src/xfns.c, src/xfont.c, src/xftfont.c, src/xmenu.c, src/xml.c, src/xrdb.c, src/xselect.c, src/xsettings.c, src/xterm.c, src/xwidget.c Rename XINT->XFIXNUM, XFASTINT->XFIXNAT, XUINT->XUFIXNUM. --- src/bytecode.c | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index f87983a59c0..b27fa7c5c68 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -63,14 +63,14 @@ along with GNU Emacs. If not, see . */ { \ if (byte_metering_on) \ { \ - if (XFASTINT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM) \ + if (XFIXNAT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM) \ XSETFASTINT (METER_1 (this_code), \ - XFASTINT (METER_1 (this_code)) + 1); \ + XFIXNAT (METER_1 (this_code)) + 1); \ if (last_code \ - && (XFASTINT (METER_2 (last_code, this_code)) \ + && (XFIXNAT (METER_2 (last_code, this_code)) \ < MOST_POSITIVE_FIXNUM)) \ XSETFASTINT (METER_2 (last_code, this_code), \ - XFASTINT (METER_2 (last_code, this_code)) + 1); \ + XFIXNAT (METER_2 (last_code, this_code)) + 1); \ } \ } @@ -362,7 +362,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object *vectorp = XVECTOR (vector)->contents; unsigned char quitcounter = 1; - EMACS_INT stack_items = XFASTINT (maxdepth) + 1; + EMACS_INT stack_items = XFIXNAT (maxdepth) + 1; USE_SAFE_ALLOCA; void *alloc; SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length); @@ -379,7 +379,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, if (!NILP (args_template)) { eassert (FIXNUMP (args_template)); - ptrdiff_t at = XINT (args_template); + ptrdiff_t at = XFIXNUM (args_template); bool rest = (at & 128) != 0; int mandatory = at & 127; ptrdiff_t nonrest = at >> 8; @@ -622,9 +622,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1 = TOP; Lisp_Object v2 = Fget (v1, Qbyte_code_meter); if (FIXNUMP (v2) - && XINT (v2) < MOST_POSITIVE_FIXNUM) + && XFIXNUM (v2) < MOST_POSITIVE_FIXNUM) { - XSETINT (v2, XINT (v2) + 1); + XSETINT (v2, XFIXNUM (v2) + 1); Fput (v1, Qbyte_code_meter, v2); } } @@ -833,7 +833,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { Lisp_Object v2 = POP, v1 = TOP; CHECK_FIXNUM (v1); - for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--) + for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--) { v2 = XCDR (v2); rarely_quit (n); @@ -972,14 +972,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bsub1): - TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_NEGATIVE_FIXNUM - ? make_fixnum (XINT (TOP) - 1) + TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM + ? make_fixnum (XFIXNUM (TOP) - 1) : Fsub1 (TOP)); NEXT; CASE (Badd1): - TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_POSITIVE_FIXNUM - ? make_fixnum (XINT (TOP) + 1) + TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_POSITIVE_FIXNUM + ? make_fixnum (XFIXNUM (TOP) + 1) : Fadd1 (TOP)); NEXT; @@ -1031,8 +1031,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bnegate): - TOP = (FIXNUMP (TOP) && XINT (TOP) != MOST_NEGATIVE_FIXNUM - ? make_fixnum (- XINT (TOP)) + TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM + ? make_fixnum (- XFIXNUM (TOP)) : Fminus (1, &TOP)); NEXT; @@ -1175,7 +1175,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bchar_syntax): { CHECK_CHARACTER (TOP); - int c = XFASTINT (TOP); + int c = XFIXNAT (TOP); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) MAKE_CHAR_MULTIBYTE (c); XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]); @@ -1269,7 +1269,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* Exchange args and then do nth. */ Lisp_Object v2 = POP, v1 = TOP; CHECK_FIXNUM (v2); - for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--) + for (EMACS_INT n = XFIXNUM (v2); 0 < n && CONSP (v1); n--) { v1 = XCDR (v1); rarely_quit (n); @@ -1439,7 +1439,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object val = HASH_VALUE (h, i); if (BYTE_CODE_SAFE && !FIXNUMP (val)) emacs_abort (); - op = XINT (val); + op = XFIXNUM (val); goto op_branch; } } @@ -1475,7 +1475,7 @@ Lisp_Object get_byte_code_arity (Lisp_Object args_template) { eassert (FIXNATP (args_template)); - EMACS_INT at = XINT (args_template); + EMACS_INT at = XFIXNUM (args_template); bool rest = (at & 128) != 0; int mandatory = at & 127; EMACS_INT nonrest = at >> 8; -- cgit v1.2.1 From 81e7eef8224c8a99a207b7a7b9dae1d598392ef7 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 21 Aug 2018 11:40:23 -0700 Subject: Fix bignum bugs with nth, elt, = * src/bytecode.c (exec_byte_code): Support bignums when implementing nth, elt, and =. * src/lisp.h (SMALL_LIST_LEN_MAX): New constant. * src/fns.c (Fnthcdr): Use it. (Felt): Do not reject bignum indexes. --- src/bytecode.c | 39 +++++++++++++-------------------------- 1 file changed, 13 insertions(+), 26 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index b27fa7c5c68..17457fc5742 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -832,13 +832,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bnth): { Lisp_Object v2 = POP, v1 = TOP; - CHECK_FIXNUM (v1); - for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--) + if (RANGED_FIXNUMP (0, v1, SMALL_LIST_LEN_MAX)) { - v2 = XCDR (v2); - rarely_quit (n); + for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--) + v2 = XCDR (v2); + TOP = CAR (v2); } - TOP = CAR (v2); + else + TOP = Fnth (v1, v2); NEXT; } @@ -985,15 +986,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Beqlsign): { - Lisp_Object v2 = POP, v1 = TOP; - if (FLOATP (v1) || FLOATP (v2)) - TOP = arithcompare (v1, v2, ARITH_EQUAL); - else - { - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v1); - CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v2); - TOP = EQ (v1, v2) ? Qt : Qnil; - } + Lisp_Object v1 = POP; + TOP = arithcompare (TOP, v1, ARITH_EQUAL); NEXT; } @@ -1264,23 +1258,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Belt): { - if (CONSP (TOP)) + Lisp_Object v2 = POP, v1 = TOP; + if (CONSP (v1) && RANGED_FIXNUMP (0, v2, SMALL_LIST_LEN_MAX)) { - /* Exchange args and then do nth. */ - Lisp_Object v2 = POP, v1 = TOP; - CHECK_FIXNUM (v2); + /* Like the fast case for Bnth, but with args reversed. */ for (EMACS_INT n = XFIXNUM (v2); 0 < n && CONSP (v1); n--) - { - v1 = XCDR (v1); - rarely_quit (n); - } + v1 = XCDR (v1); TOP = CAR (v1); } else - { - Lisp_Object v1 = POP; - TOP = Felt (TOP, v1); - } + TOP = Felt (v1, v2); NEXT; } -- cgit v1.2.1 From cf486a7a920d3d95fa9aa98d7b03ebc61b17518a Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 30 Oct 2018 20:57:46 -0700 Subject: Improve fix for Bug#33014 Although the previously-applied fix worked for its platform, it doesn’t suffice in general. * src/bytecode.c (exec_byte_code): Save VECTOR into stack slot so that it survives GC. The stack slot was otherwise unused, so this doesn’t cost us memory, only a store insn. * src/eval.c (Ffuncall): Do not make FUN volatile, reverting 2018-10-14T19:12:04Z!gazally@runbox.com. Adding ‘volatile’ does not suffice, since storage for a volatile local can be reclaimed after its last access (e.g., by tail recursion elimination), which would make VECTOR invisible to GC. --- src/bytecode.c | 1 + 1 file changed, 1 insertion(+) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 17457fc5742..40389e08f0e 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -369,6 +369,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, ptrdiff_t item_bytes = stack_items * word_size; Lisp_Object *stack_base = ptr_bounds_clip (alloc, item_bytes); Lisp_Object *top = stack_base; + *top = vector; /* Ensure VECTOR survives GC (Bug#33014). */ Lisp_Object *stack_lim = stack_base + stack_items; unsigned char *bytestr_data = alloc; bytestr_data = ptr_bounds_clip (bytestr_data + item_bytes, bytestr_length); -- cgit v1.2.1 From 1ad2903a48b682985a2bd0709ec05f67a1351a8e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 30 Oct 2018 21:14:10 -0700 Subject: Refer to bytecode constant vectors (Bug#33014) Backport from master. * src/bytecode.c (exec_byte_code): Save VECTOR into stack slot so that it survives GC. The stack slot was otherwise unused, so this doesn’t cost us memory, only a store insn. --- src/bytecode.c | 1 + 1 file changed, 1 insertion(+) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index e51f9095b36..538cd4f3ca7 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -367,6 +367,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length); Lisp_Object *stack_lim = stack_base + stack_items; Lisp_Object *top = stack_base; + *top = vector; /* Ensure VECTOR survives GC (Bug#33014). */ memcpy (stack_lim, SDATA (bytestr), bytestr_length); void *void_stack_lim = stack_lim; unsigned char const *bytestr_data = void_stack_lim; -- cgit v1.2.1 From d79bb75683ceb4eee2f753eb38fa8db99aff4568 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 9 Dec 2018 00:18:36 -0800 Subject: Add make_vector and make_nil_vector This makes the callers a bit easier to read, and doubtless improves efficiency very slightly. It also simplifies possible future changes to allow bignum indexes to buffers. * src/alloc.c (allocate_vectorlike): Prefer ptrdiff_t to size_t when either will do. (make_vector): New function. (Fmake_vector): Use it. * src/buffer.c (syms_of_buffer): * src/bytecode.c (syms_of_bytecode): * src/category.c (Fmake_category_table, init_category_once): * src/ccl.c (syms_of_ccl): * src/character.c (syms_of_character): * src/charset.c (Fdefine_charset_internal) (Ffind_charset_region, Ffind_charset_string): * src/chartab.c (copy_char_table): * src/coding.c (Fdefine_coding_system_internal, syms_of_coding): * src/composite.c (get_composition_id, Fcomposition_get_gstring): * src/composite.h (LGLYPH_NEW): * src/fns.c (concat, Flocale_info, make_hash_table): * src/font.c (font_otf_ValueRecord, font_otf_anchor) (build_style_table, syms_of_font): * src/fontset.c (RFONT_DEF_NEW, fontset_find_font) (dump_fontset, syms_of_fontset): * src/image.c (xpm_make_color_table_v): * src/keyboard.c (modify_event_symbol, menu_bar_items) (parse_menu_item, parse_tool_bar_item, init_tool_bar_items) (syms_of_keyboard): * src/keymap.c (Fdefine_key, describe_map, describe_vector): * src/lread.c (read_vector): * src/macfont.m (macfont_shape): * src/menu.c (init_menu_items): * src/nsfns.m (ns_make_monitor_attribute_list): * src/process.c (conv_sockaddr_to_lisp, network_interface_info): * src/profiler.c (make_log): * src/window.c (Fcurrent_window_configuration): * src/xdisp.c (with_echo_area_buffer_unwind_data) (format_mode_line_unwind_data): * src/xfaces.c (Finternal_make_lisp_face) (Fface_attributes_as_vector): * src/xfns.c (x_make_monitor_attribute_list) (Fx_display_monitor_attributes_list): * src/xfont.c (syms_of_xfont): * src/xselect.c (x_handle_dnd_message): * src/xwidget.c (save_script_callback): Prefer make_nil_vector (N) to Fmake_vector (make_fixnum (N), Qnil). * src/callint.c (Fcall_interactively): * src/charset.c (load_charset_map): * src/chartab.c (Fmake_char_table, uniprop_encode_value_numeric): * src/composite.c (get_composition_id) * src/dispnew.c (Fframe_or_buffer_changed_p) (syms_of_display): * src/fns.c (make_hash_table, maybe_resize_hash_table): * src/font.c (font_style_to_value): * src/fontset.c (FONTSET_ADD, fontset_add): * src/json.c (json_to_lisp): * src/keymap.c (syms_of_keymap): * src/lread.c (init_obarray): * src/profiler.c (make_log, Fprofiler_cpu_log): * src/term.c (term_get_fkeys_1): Prefer make_vector (N, V) to Fmake_vector (make_fixnum (N), V). * src/font.c (build_style_table): * src/macfont.m (macfont_shape): * src/process.c (conv_sockaddr_to_lisp, network_interface_info): Prefer make_uninit_vector if the vector will be initialized soon. * src/lisp.h (make_nil_vector): New function. --- src/bytecode.c | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 40389e08f0e..95f7b32a036 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1494,13 +1494,9 @@ If a symbol has a property named `byte-code-meter' whose value is an integer, it is incremented each time that symbol's function is called. */); byte_metering_on = false; - Vbyte_code_meter = Fmake_vector (make_fixnum (256), make_fixnum (0)); + Vbyte_code_meter = make_nil_vector (256); DEFSYM (Qbyte_code_meter, "byte-code-meter"); - { - int i = 256; - while (i--) - ASET (Vbyte_code_meter, i, - Fmake_vector (make_fixnum (256), make_fixnum (0))); - } + for (int i = 0; i < 256; i++) + ASET (Vbyte_code_meter, i, make_vector (256, make_fixnum (0))); #endif } -- cgit v1.2.1 From 26bed8ba10eeaf0a340a8d0d760c5578dddec867 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 1 Jan 2019 00:59:58 +0000 Subject: Update copyright year to 2019 Run 'TZ=UTC0 admin/update-copyright $(git ls-files)'. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 538cd4f3ca7..a5c7576269f 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1,5 +1,5 @@ /* Execution of byte code produced by bytecomp.el. - Copyright (C) 1985-1988, 1993, 2000-2018 Free Software Foundation, + Copyright (C) 1985-1988, 1993, 2000-2019 Free Software Foundation, Inc. This file is part of GNU Emacs. -- cgit v1.2.1 From d12e5d003d503025c1c9b0335d6518a6c3bdfae1 Mon Sep 17 00:00:00 2001 From: Daniel Colascione Date: Tue, 15 Jan 2019 17:36:54 -0500 Subject: Add portable dumper Add a new portable dumper as an alternative to unexec. Use it by default. * src/dmpstruct.awk: New file. * src/doc.c (get_doc_string): use will_dump_p(). * src/editfns.c (styled_format): silence compiler warning with UNINIT. * src/emacs-module.c (syms_of_module): staticpro ltv_mark. * src/emacs.c (gflags): new variable. (init_cmdargs): unwrap (string_starts_with_p, find_argument, dump_error_to_string) (load_pdump): new functions. (main): detect pdumper and --temacs invocation; actually load portable dump when detected; set gflags as appropriate; changes to init functions throughout to avoid passing explicit 'initialized' argument. * src/eval.c (inhibit_lisp_code): remove unused variable. (init_eval_once_for_pdumper): new function. (init_eval_once): call it. * src/filelock.c: CANNOT_DUMP -> will_dump_p() * src/fingerprint-dummy.c: new file * src/fingerprint.h: new file * src/fns.c: CANNOT_DUMP -> will_dump_p(), etc. (weak_hash_tables): remove (hashfn_equal, hashfn_eql): un-staticify (make_hash_table): set new 'next_weak' hash table field; drop global weak_hash_tables logic. (copy_hash_table): drop global weak_hash_tables logic. (hash_table_rehash): new function. (hash_lookup, hash_put, hash_remove_from_table, hash_clear): rehash if needed. (sweep_weak_table): un-staticify; explain logic; bool-ify. (sweep_weak_hash_tables): remove function. * src/font.c (syms_of_font): remember pdumper stuff. * src/fontset.c (syms_of_fontset): remember pdumper stuff. * src/frame.c (make_initial_frame): don't reset Vframe_list. (init_frame_once_for_pdumper, init_frame_once): new functions. (syms_of_frame): remove redundant staticpro. * src/fringe.c (init_fringe_once_for_pdumper): new functin. (init_fringe_once): call it. * src/ftcrfont.c (syms_of_ftcrfont_for_pdumper): new function. (syms_of_ftcrfont): call it. * src/ftfont.c (syms_of_ftfont_for_pdumper): new function. (syms_of_ftfont): call it. * src/ftxont.c (syms_of_ftxfont_for_pdumper): new function. (syms_of_ftxfont): call it. * src/gmalloc.c: adjust for pdumper througout (DUMPED): remove weird custom dumped indicator. * src/gnutls.c (syms_of_gnutls): pdumper note for gnutls_global_initialized. * src/image.c (syms_of_image): add pdumper comment, initializer note. * src/insdel.c (prepare_to_modify_buffer_1): account for buffer contents possibly being in dump image. * src/keyboard.c (syms_of_keyboard_for_pdumper): new function. (syms_of_keyboard): staticpro more; call pdumper syms function. * src/lisp.h: add comments throughout (gflags): declare. (will_dump_p, will_bootstrap_p, will_dump_with_pdumper_p) (dumped_with_pdumper_p, will_dump_with_unexec_p) (dumped_with_unexec_p, definitely_will_not_unexec_p): new functions. (POWER_OF_2, ROUNDUP): move macros. (PSEUDOVECTOR_TYPE, PSEUDOVECTOR_TYPEP): take vectorlike header pointer instead of vector; constify. (Lisp_Hash_Table): add comment about need to rehash on access; add comment for next_weak. (HASH_KEY, HASH_VALUE, HASH_HASH, HASH_TABLE_SIZE): const-ify. (hash_table_rehash): declare. (hash_rehash_needed_p, hash_rehash_if_needed): new functions. (finalizers, doomed_finalizers): declare extern. (SUBR_SECTION_ATTRIBUTE): new macro. (staticvec, staticidx): un-static-ify. (sweep_weak_hash_tables): remove declaration. (sweep_weak_table): declare. (hashfn_eql, hashfn_equal): declare. (number_finalizers_run): new variable. (Vdead): externify when ENABLE_CHECKING. (gc_root_type): new enumeration. (gc_root_visitor): new struct. (visit_static_gc_roots): declare. (vectorlike_nbytes): declare. (vector_nbytes): define as trivial inline function wrapper for vectorlike_nbytes. (init_obarray_once): change signature. (primary_thread): extern-ify. (init_buffer): change signature. (init_frame_once): declare. * src/lread.c (readevalloop): adjust for new dumped predicates. (init_obarray_once): new function. (ndefsubr): new variable. (defsubr): increment it. (load_path_check): adjust for pdumper. (load_path_default): use pdumper functions; adjust for dump search. * src/macfont.m (macfont_init_font_change_handler): avoid shadowing global. (syms_of_macfont_for_pdumper): new function. (syms_of_macfont): call it. * src/menu.c (syms_of_menu): staticpro more stuff. * src/minibuf.c (Ftry_completion): rehash if needed. (init_minibuf_once_for_pdumper): new function. (init_minibuf_once): call it. * src/nsfont.m (syms_of_nsfns): staticpro more. * src/nsfont.m (syms_of_nsfont_for_pdumper): new function. (syms_of_nsfont): call it. * src/nsterm.m (syms_of_nsfont): remember pdumper stuff. * src/pdumper.c: new file. * src/pdumper.h: new file. * src/process.c (init_process_emacs): use new pdumper functions instead of CANNOT_DUMP. * src/profiler.c (syms_of_profiler_for_pdumper): new function. (syms_of_profiler_for_pdumper): call it. * src/search.c (syms_of_search_for_pdumper): new function. (syms_of_search_for_pdumper): call it. * src/sheap.c (bss_sbrk_did_unexec): remove. * src/sheap.h (bss_sbrk_did_unexec): remove. * src/syntax.c (syms_of_syntax): don't redundantly staticpro re_match_object. * src/sysdep.c: use will_dump_with_unexec_p() instead of bss hack thing. * src/syssignals.h (init_sigsegv): declare. * src/systime.h (init_timefns): remove bool from signature. * src/textprop.c (syms_of_textprop): move staticpro. * src/thread.c (main_thread_p): constify. * src/thread.h (main_thread_p): constify. * src/timefns.c (init_timefns): remove bool from signature. (syms_of_timefns_for_pdumper): new function. (syms_of_timefns): call it. * src/w32.c: rearrange code. * src/w32.h (w32_relocate): declare. * src/w32fns.c (syms_of_w32fns): add pdumper note. * src/w32font.c (syms_of_w32font_for_pdumper): new function. (syms_of_w32font): call it. * src/w32heap.c (using_dynamic_heap): new variable. (init_heap): use it. * src/w32menu.c (syms_of_w32menu): add pdumper note. * src/w32proc.c (ctrl_c_handler, mainCRTStartup, _start, open_input_file) (rva_to_section, close_file_data): move here. * src/w32uniscribe.c (syms_of_w32uniscribe_for_pdumper): new function. (syms_of_w32uniscribe): call it. * src/window.c (init_window_once_for_pdumper): new function. (init_window_once): call it; staticpro more stuff. * src/xfont.c (syms_of_xfont_for_pdumper): new function. (syms_of_xfont): call it. * src/xftfont.c (syms_of_xftfont_for_pdumper): new function. (syms_of_xftfont): call it. * src/xmenu.c (syms_of_xmenu_for_pdumper): new function. (syms_of_xmenu): call it. * src/xselect.c (syms_of_xselect_for_pdumper): new function. (syms_of_xselect): call it. * src/xsettings.c (syms_of_xsettings): add more pdumper notes. * src/term.c (syms_of_xterm): add pdumper note. * src/dispnew.c (init_faces_initial): new function. (init_display_interactive): rename from init_display; use will_dump_p instead of !initialized. Initialize faces early for pdumper if needed. (init_display): new function. (syms_of_display_for_pdumper): new function. (syms_of_display): call it. * src/dbusbind.c (syms_of_dbusbind): Add TODO for bus reset on pdumper load. * src/data.c (Fdefalias): Use will_dump_p instead of Vpurify_flag. (Fmake_variable_buffer_local): silence compiler warning with -Og by making valcontents UNINIT. (arith_driver): silence compiler warning with UNINIT. * src/conf_post.h (ATTRIBUTE_SECTION): new macro. * src/composite.c (composition_gstring_put_cache): rehash hash table if needed. * src/coding.c (init_coding_once, syms_of_coding): remember pdumper stuff. * src/charset.h (charset_table_size, charset_table_user): declare. * src/charset.c (charset_table_used, charset_table_size): un-static. (init_charset_oncem, syms_of_charset): remember pdumper stuff. * src/category.c (category_table_version): remove obsolete variable. * src/callint.c (syms_of_callint): staticpro 'preserved_fns' (init_callproc): use will_dump_p instead of !CANNOT_DUMP. * src/bytecode.c (exec_byte_code): rehash table tables if needed * src/buffer.c (alloc_buffer_text, free_buffer_text): account for pdumper (init_buffer_once): add TODO; remember stuff for pdumper. (init_buffer): don't take initialized argument; adjust for pdumper. * src/atimer.c (init_atimer): initialize subr only if !initialized. * src/alloc.c: (vector_marked_p, set_vector_marked) (vectorlike_marked_p, set_vectorlike_marked, cons_marked_p) (set_cons_marked, string_marked_p, set_string_marked) (symbol_marked_p, set_symbol_marked, interval_marked_p) (set_interval_marked): new accessor routines. Use them instead of raw GC access throughout. (Vdead): make non-static when ENABLE_CHECKING. (vectorlike_nbytes): rename of 'vector_nbytes'; take a vectorlike header as input instead of a vector. (number_finalizers_run): new internal C variable. (mark_maybe_object): check for pdumper objects. (valid_pointer_p): don't be gratuitously inefficient under rr(1). (make_pure_c_string): add support for size_byte = -2 mode indicating that string data points into Emacs image rodata. (visit_vectorlike_root): visits GC roots embedded in vectorlike objects. (visit_buffer_root): visits GC roots embedded in our totally-not-a-buffer buffer global objects. (visit_static_gc_roots): visit GC roots in the Emacs data section. (mark_object_root_visitor): root callback used for conventional GC marking (weak_hash_tables): new internal variable for tracking found weak hash tables during GC. (mark_and_sweep_weak_table_contents): new weak hash table marking. (garbage_collect_1): use new GC root visitor machinery. (mark_vectorlike): accept a vectorlike_header instead of a Lisp_Vector. (mark_frame, mark_window, mark_hash_table): new functions. (mark_object): initialize 'm'; check for pdumper objects and use new mark-bit accessors throughout. Remove some object-specific marking code and move to helper functions above. (survives_gc_p): check for pdumper objects. (gc-sweep): clear pdumper mark bits. (init_alloc_once_for_pdumper): new helper function for early init called both during normal init and pdumper load. (init_alloc_once): pdumper integration. * src/Makefile.in: Rewrite dumping for pdumper; add pdumper.o; invoke temacs with --temacs command line option; build dmpstruct.h from dmpstruct.awk; stop relying on CANNOT_DUMP; clean up pdumper intermediate files during build. * nextstep/Makefile.in: build emacs.pdmp into NS packages * lisp/startup.el: account for new '--temacs' and '--dump-file' command line option. * lisp/loadup.el: rewrite early init to account for pdumper; use injected 'dump-mode' variable (set via the new '--temacs' option) instead of parsing command line. * lisp/cus-start.el: Check 'dump-mode' instead of 'purify-flag', since the new 'dump-mode' * lib-src/make-fingerprint.c: new program * lib-src/Makefile.in: built make-fingerprint utility program * configure.ac: Add --with-pdumper toggle to control pdumper support; add --with-unexec toggle to control unexec support. Add --with-dumping option to control which dumping strategy we use by default. Adjust for pdumper throughout. Check for posix_madvise. * Makefile.in: Add @DUMPING@ substitution; add pdumper mode. * .gitignore: Add make-fingerprint, temacs.in, fingerprint.c, dmpstruct.h, and pdumper dump files. --- src/bytecode.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index bb7d796bac5..40977799bfc 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1398,10 +1398,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, search as the jump table. */ Lisp_Object jmp_table = POP; if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table)) - emacs_abort (); + emacs_abort (); Lisp_Object v1 = POP; ptrdiff_t i; struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table); + hash_rehash_if_needed (h); /* h->count is a faster approximation for HASH_TABLE_SIZE (h) here. */ -- cgit v1.2.1 From 37963ed4991823fd1ee5cd2c485f22ac988259e2 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 4 May 2019 10:16:46 -0700 Subject: Fix bytecode optimization typo Problem reported by Simon Frankau (Bug#35562). * src/bytecode.c (exec_byte_code): Fix typo when optimizing varset. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 40977799bfc..6f601cf0cd5 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -562,7 +562,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* Inline the most common case. */ if (SYMBOLP (sym) && !EQ (val, Qunbound) - && !XSYMBOL (sym)->u.s.redirect + && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL && !SYMBOL_TRAPPED_WRITE_P (sym)) SET_SYMBOL_VAL (XSYMBOL (sym), val); else -- cgit v1.2.1 From 807b21dc40ebdb855e61b4ee6ddf0b227d91b728 Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Sun, 23 Jun 2019 19:35:26 +0200 Subject: src/bytecode.c (exec_byte_code) Unroll Blist3 and Blist4 * src/bytecode.c (exec_byte_code): Unroll Blist3 and Blist4 (bug#35321). --- src/bytecode.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 6f601cf0cd5..29dff44f007 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -884,12 +884,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Blist3): DISCARD (2); - TOP = Flist (3, &TOP); + TOP = list3 (TOP, top[1], top[2]); NEXT; CASE (Blist4): DISCARD (3); - TOP = Flist (4, &TOP); + TOP = list4 (TOP, top[1], top[2], top[3]); NEXT; CASE (BlistN): -- cgit v1.2.1 From b6f194a0fb6dbd1b19aa01f95a955f5b8b23b40e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jul 2019 19:40:03 -0700 Subject: Simplify hashfn/cmpfn calling convention * src/fns.c (cmpfn_eql, cmpfn_equal, cmpfn_user_defined) (hashfn_eq, hashfn_equal, hashfn_eql, hashfn_user_defined): * src/profiler.c (cmpfn_profiler, hashfn_profiler): Use new calling convention where the return value is a fixnum instead of EMACS_UINT. While we’re at it, put the hash table at the end, since that’s a bit simpler and generates better code (at least on the x86-64). All callers changed. * src/fns.c (hash_lookup): Store fixnum rather than EMACS_UINT. All callers changed. (hash_put): Take a fixnum rather than an EMACS_UINT. All callers changed. Remove unnecessary eassert (XUFIXNUM does it). * src/lisp.h (struct hash_table_test): Adjust signatures of cmpfn and hashfn. --- src/bytecode.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 29dff44f007..e82de026a82 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1409,16 +1409,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, if (h->count <= 5) { /* Do a linear search if there are not many cases FIXME: 5 is arbitrarily chosen. */ - Lisp_Object hash_code = h->test.cmpfn - ? make_fixnum (h->test.hashfn (&h->test, v1)) : Qnil; + Lisp_Object hash_code + = h->test.cmpfn ? h->test.hashfn (v1, &h->test) : Qnil; for (i = h->count; 0 <= --i; ) if (EQ (v1, HASH_KEY (h, i)) || (h->test.cmpfn && EQ (hash_code, HASH_HASH (h, i)) - && h->test.cmpfn (&h->test, v1, HASH_KEY (h, i)))) + && !NILP (h->test.cmpfn (v1, HASH_KEY (h, i), + &h->test)))) break; - } else i = hash_lookup (h, v1, NULL); -- cgit v1.2.1 From 515afc9c15870cd7bd6b96e2d8b89938116923ac Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jul 2019 19:40:03 -0700 Subject: Fix crash if user test munges hash table * src/fns.c (restore_mutability) (hash_table_user_defined_call): New functions. (cmpfn_user_defined, hashfn_user_defined): Use them. (make_hash_table, copy_hash_table): Mark new hash table as mutable. (check_mutable_hash_table): New function. (Fclrhash, Fputhash, Fremhash): Use it instead of CHECK_IMPURE. * src/lisp.h (struct hash_table_test): User-defined functions now take pointers to struct Lisp_Hash_Table, not to struct hash_table_test. All uses changed. (struct Lisp_Hash_Table): New member ‘mutable’. * src/pdumper.c (dump_hash_table): Copy it. * test/src/fns-tests.el (test-hash-function-that-mutates-hash-table): New test, which tests for the bug. --- src/bytecode.c | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index e82de026a82..d668a9a6a15 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1410,14 +1410,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { /* Do a linear search if there are not many cases FIXME: 5 is arbitrarily chosen. */ Lisp_Object hash_code - = h->test.cmpfn ? h->test.hashfn (v1, &h->test) : Qnil; + = h->test.cmpfn ? h->test.hashfn (v1, h) : Qnil; for (i = h->count; 0 <= --i; ) if (EQ (v1, HASH_KEY (h, i)) || (h->test.cmpfn && EQ (hash_code, HASH_HASH (h, i)) - && !NILP (h->test.cmpfn (v1, HASH_KEY (h, i), - &h->test)))) + && !NILP (h->test.cmpfn (v1, HASH_KEY (h, i), h)))) break; } else -- cgit v1.2.1 From f378ed1a0b1ca2ceed5afabcf5f303ae339039ba Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 22 Jul 2019 21:27:33 -0700 Subject: Avoid overexposing fixnums for hash codes Following a suggestion by Stefan Monnier in: https://lists.gnu.org/r/emacs-devel/2019-07/msg00530.html * doc/lispref/hash.texi (Creating Hash, Defining Hash): * src/fns.c (Fsxhash_eq, Fsxhash_eql, Fsxhash_equal, Fmake_hash_table): Don’t insist that hash codes be fixnums, reverting the recent doc changes to the contrary. * src/bytecode.c (exec_byte_code): Special-case only the eq case, as the others aren’t worth tuning now that we treat bignum hashes like fixnums. * src/fns.c (hashfn_user_defined): If the hash code is a bignum, reduce its hash down to a fixnum. --- src/bytecode.c | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index d668a9a6a15..9aad1eb642b 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1406,18 +1406,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* h->count is a faster approximation for HASH_TABLE_SIZE (h) here. */ - if (h->count <= 5) + if (h->count <= 5 && !h->test.cmpfn) { /* Do a linear search if there are not many cases FIXME: 5 is arbitrarily chosen. */ - Lisp_Object hash_code - = h->test.cmpfn ? h->test.hashfn (v1, h) : Qnil; - - for (i = h->count; 0 <= --i; ) - if (EQ (v1, HASH_KEY (h, i)) - || (h->test.cmpfn - && EQ (hash_code, HASH_HASH (h, i)) - && !NILP (h->test.cmpfn (v1, HASH_KEY (h, i), h)))) - break; + for (i = h->count; 0 <= --i; ) + if (EQ (v1, HASH_KEY (h, i))) + break; } else i = hash_lookup (h, v1, NULL); -- cgit v1.2.1 From 365e01cc9f64ce6ca947ccfd8612d60763280a37 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 1 Jan 2020 00:19:43 +0000 Subject: Update copyright year to 2020 Run "TZ=UTC0 admin/update-copyright $(git ls-files)". --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 9aad1eb642b..9e75c9012e0 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1,5 +1,5 @@ /* Execution of byte code produced by bytecomp.el. - Copyright (C) 1985-1988, 1993, 2000-2019 Free Software Foundation, + Copyright (C) 1985-1988, 1993, 2000-2020 Free Software Foundation, Inc. This file is part of GNU Emacs. -- cgit v1.2.1 From 35d569482567acffc992e1c8113ea1eb713dde52 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 5 Jan 2020 21:55:20 +0100 Subject: Mark 'catch' and 'condition-case' bytecodes as obsolete They have not been generated by the byte-compiler since Emacs 25. * lisp/emacs-lisp/bytecomp.el (byte-catch, byte-condition-case): * src/bytecode.c (BYTE_CODES, exec_byte_code): Mark as obsolete (since Emacs 25; they were still generated in 24.4). --- src/bytecode.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 9e75c9012e0..4624379756d 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -220,10 +220,10 @@ DEFINE (Bdup, 0211) \ DEFINE (Bsave_excursion, 0212) \ DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \ DEFINE (Bsave_restriction, 0214) \ -DEFINE (Bcatch, 0215) \ +DEFINE (Bcatch, 0215) /* Obsolete since Emacs-25. */ \ \ DEFINE (Bunwind_protect, 0216) \ -DEFINE (Bcondition_case, 0217) \ +DEFINE (Bcondition_case, 0217) /* Obsolete since Emacs-25. */ \ DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \ DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \ \ @@ -763,7 +763,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, save_restriction_save ()); NEXT; - CASE (Bcatch): /* Obsolete since 24.4. */ + CASE (Bcatch): /* Obsolete since 25. */ { Lisp_Object v1 = POP; TOP = internal_catch (TOP, eval_sub, v1); @@ -807,7 +807,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; } - CASE (Bcondition_case): /* Obsolete since 24.4. */ + CASE (Bcondition_case): /* Obsolete since 25. */ { Lisp_Object handlers = POP, body = POP; TOP = internal_lisp_condition_case (TOP, body, handlers); -- cgit v1.2.1 From 27d101832ada36e431ae6cdecb5c82a180566377 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 17 Apr 2020 07:57:25 -0700 Subject: Prefer more inline functions in character.h * src/buffer.h (fetch_char_advance, fetch_char_advance_no_check) (buf_next_char_len, next_char_len, buf_prev_char_len) (prev_char_len, inc_both, dec_both): New inline functions, replacing the old character.h macros FETCH_CHAR_ADVANCE, FETCH_CHAR_ADVANCE_NO_CHECK, BUF_INC_POS, INC_POS, BUF_DEC_POS, DEC_POS, INC_BOTH, DEC_BOTH respectively. All callers changed. These new functions all assume buffer primitives and so need to be here rather than in character.h. * src/casefiddle.c (make_char_unibyte): New static function, replacing the old MAKE_CHAR_UNIBYTE macro. All callers changed. (do_casify_unibyte_string): Use SINGLE_BYTE_CHAR_P instead of open-coding it. * src/ccl.c (GET_TRANSLATION_TABLE): New static function, replacing the old macro of the same name. * src/character.c (string_char): Omit 2nd arg. 3rd arg can no longer be NULL. All callers changed. * src/character.h (SINGLE_BYTE_CHAR_P): Move up. (MAKE_CHAR_UNIBYTE, MAKE_CHAR_MULTIBYTE, PREV_CHAR_BOUNDARY) (STRING_CHAR_AND_LENGTH, STRING_CHAR_ADVANCE) (FETCH_STRING_CHAR_ADVANCE) (FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE) (FETCH_STRING_CHAR_ADVANCE_NO_CHECK, FETCH_CHAR_ADVANCE) (FETCH_CHAR_ADVANCE_NO_CHECK, INC_POS, DEC_POS, INC_BOTH) (DEC_BOTH, BUF_INC_POS, BUF_DEC_POS): Remove. (make_char_multibyte): New static function, replacing the old macro MAKE_CHAR_MULTIBYTE. All callers changed. (CHAR_STRING_ADVANCE): Remove; all callers changed to use CHAR_STRING. (NEXT_CHAR_BOUNDARY): Remove; it was unused. (raw_prev_char_len): New inline function, replacing the old PREV_CHAR_BOUNDARY macro. All callers changed. (string_char_and_length): New inline function, replacing the old STRING_CHAR_AND_LENGTH macro. All callers changed. (STRING_CHAR): Rewrite in terms of string_char_and_length. (string_char_advance): New inline function, replacing the old STRING_CHAR_ADVANCE macro. All callers changed. (fetch_string_char_advance): New inline function, replacing the old FETCH_STRING_CHAR_ADVANCE macro. All callers changed. (fetch_string_char_as_multibyte_advance): New inline function, replacing the old FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE macro. All callers changed. (fetch_string_char_advance_no_check): New inline function, replacing the old FETCH_STRING_CHAR_ADVANCE_NO_CHECK macro. All callers changed. * src/regex-emacs.c (HEAD_ADDR_VSTRING): Remove; no longer used. * src/syntax.c (scan_lists): Use dec_bytepos instead of open-coding it. * src/xdisp.c (string_char_and_length): Rename from string_char_and_length to avoid name conflict with new function in character.h. All callers changed. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 4624379756d..3c90544f3f2 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1172,7 +1172,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CHECK_CHARACTER (TOP); int c = XFIXNAT (TOP); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) - MAKE_CHAR_MULTIBYTE (c); + c = make_char_multibyte (c); XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]); } NEXT; -- cgit v1.2.1 From f0b0105d913a94c66f230874c9269b19dbbc83bd Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 19 May 2020 23:22:40 -0700 Subject: Hoist some byte-code checking out of eval Check Lisp_Compiled objects better as they’re created, so that the byte-code interpreter needn’t do the checks each time it executes them. This improved performance of ‘make compile-always’ by 1.5% on my platform. Also, improve the quality of the (still-incomplete) checks, as this is more practical now that they’re done less often. * src/alloc.c (make_byte_code): Remove. All uses removed. (Fmake_byte_code): Put a better (though still incomplete) check here instead. Simplify by using Fvector instead of make_uninit_vector followed by memcpy, and by using XSETPVECTYPE instead of make_byte_code followed by XSETCOMPILED. * src/bytecode.c (Fbyte_code): Do sanity check and conditional translation to unibyte here instead of each time the function is executed. (exec_byte_code): Omit no-longer-necessary sanity and unibyte checking. Use SCHARS instead of SBYTES where either will do, as SCHARS is faster. * src/eval.c (fetch_and_exec_byte_code): New function. (funcall_lambda): Use it. (funcall_lambda, lambda_arity, Ffetch_bytecode): Omit no-longer-necessary sanity checks. (Ffetch_bytecode): Add sanity check if actually fetching. * src/lisp.h (XSETCOMPILED): Remove. All uses removed. * src/lread.c (read1): Check byte-code objects more thoroughly, albeit still incompletely, and do translation to unibyte here instead of each time the function is executed. (read1): Use XSETPVECYPE instead of make_byte_code. (read_vector): Omit no-longer-necessary sanity check. --- src/bytecode.c | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 3c90544f3f2..5ac30aa1010 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -319,6 +319,19 @@ the third, MAXDEPTH, the maximum stack depth used in this function. If the third argument is incorrect, Emacs may crash. */) (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth) { + if (! (STRINGP (bytestr) && VECTORP (vector) && FIXNATP (maxdepth))) + error ("Invalid byte-code"); + + if (STRING_MULTIBYTE (bytestr)) + { + /* BYTESTR must have been produced by Emacs 20.2 or earlier + because it produced a raw 8-bit string for byte-code and now + such a byte-code string is loaded as multibyte with raw 8-bit + characters converted to multibyte form. Convert them back to + the original unibyte form. */ + bytestr = Fstring_as_unibyte (bytestr); + } + return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); } @@ -344,21 +357,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, int volatile this_op = 0; #endif - CHECK_STRING (bytestr); - CHECK_VECTOR (vector); - CHECK_FIXNAT (maxdepth); + eassert (!STRING_MULTIBYTE (bytestr)); ptrdiff_t const_length = ASIZE (vector); - - if (STRING_MULTIBYTE (bytestr)) - /* BYTESTR must have been produced by Emacs 20.2 or the earlier - because they produced a raw 8-bit string for byte-code and now - such a byte-code string is loaded as multibyte while raw 8-bit - characters converted to multibyte form. Thus, now we must - convert them back to the originally intended unibyte form. */ - bytestr = Fstring_as_unibyte (bytestr); - - ptrdiff_t bytestr_length = SBYTES (bytestr); + ptrdiff_t bytestr_length = SCHARS (bytestr); Lisp_Object *vectorp = XVECTOR (vector)->contents; unsigned char quitcounter = 1; -- cgit v1.2.1 From fe2649528b0b7637e6b6851c41e696a1016d8d53 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 4 Aug 2020 11:09:55 -0700 Subject: Drop support for -fcheck-pointer-bounds GCC has removed the -fcheck-pointer bounds option, and the Linux kernel has also removed support for Intel MPX, so there’s no point to keeping this debugging option within Emacs. * src/bytecode.c (BYTE_CODE_THREADED): * src/lisp.h (DEFINE_LISP_SYMBOL, XSYMBOL, make_lisp_symbol): Assume __CHKP__ is not defined. * src/ptr-bounds.h: Remove. All uses of ptr_bounds_clip, ptr_bounds_copy, ptr_bounds_init, ptr_bounds_set removed. --- src/bytecode.c | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 5ac30aa1010..1913a4812a0 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -24,7 +24,6 @@ along with GNU Emacs. If not, see . */ #include "character.h" #include "buffer.h" #include "keyboard.h" -#include "ptr-bounds.h" #include "syntax.h" #include "window.h" @@ -47,7 +46,7 @@ along with GNU Emacs. If not, see . */ indirect threaded, using GCC's computed goto extension. This code, as currently implemented, is incompatible with BYTE_CODE_SAFE and BYTE_CODE_METER. */ -#if (defined __GNUC__ && !defined __STRICT_ANSI__ && !defined __CHKP__ \ +#if (defined __GNUC__ && !defined __STRICT_ANSI__ \ && !BYTE_CODE_SAFE && !defined BYTE_CODE_METER) #define BYTE_CODE_THREADED #endif @@ -368,14 +367,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, USE_SAFE_ALLOCA; void *alloc; SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length); - ptrdiff_t item_bytes = stack_items * word_size; - Lisp_Object *stack_base = ptr_bounds_clip (alloc, item_bytes); + Lisp_Object *stack_base = alloc; Lisp_Object *top = stack_base; *top = vector; /* Ensure VECTOR survives GC (Bug#33014). */ Lisp_Object *stack_lim = stack_base + stack_items; - unsigned char *bytestr_data = alloc; - bytestr_data = ptr_bounds_clip (bytestr_data + item_bytes, bytestr_length); - memcpy (bytestr_data, SDATA (bytestr), bytestr_length); + unsigned char const *bytestr_data = memcpy (stack_lim, + SDATA (bytestr), bytestr_length); unsigned char const *pc = bytestr_data; ptrdiff_t count = SPECPDL_INDEX (); -- cgit v1.2.1 From 16a16645f524c62f7906036b0e383e4247b58de7 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 11 Aug 2020 02:16:53 -0700 Subject: Rehash hash tables eagerly after loading a dump This simplifies code, and helps performance in some cases (Bug#36597). * src/lisp.h (hash_rehash_needed_p): Remove. All uses removed. (hash_rehash_if_needed): Remove. All uses removed. (struct Lisp_Hash_Table): Remove comment about rehashing hash tables. * src/pdumper.c (thaw_hash_tables): New function. (hash_table_thaw): New function. (hash_table_freeze): New function. (dump_hash_table): Simplify. (dump_hash_table_list): New function. (hash_table_contents): New function. (Fdump_emacs_portable): Handle hash tables by eager rehashing. (pdumper_load): Restore hash tables. (init_pdumper_once): New function. --- src/bytecode.c | 1 - 1 file changed, 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 1913a4812a0..1c3b6eac0d1 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1401,7 +1401,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1 = POP; ptrdiff_t i; struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table); - hash_rehash_if_needed (h); /* h->count is a faster approximation for HASH_TABLE_SIZE (h) here. */ -- cgit v1.2.1 From ba05d005e5a81bc123ad8da928b1bccb6b160e7a Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 1 Jan 2021 01:13:56 -0800 Subject: Update copyright year to 2021 Run "TZ=UTC0 admin/update-copyright". --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 1c3b6eac0d1..4fd41acab85 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1,5 +1,5 @@ /* Execution of byte code produced by bytecomp.el. - Copyright (C) 1985-1988, 1993, 2000-2020 Free Software Foundation, + Copyright (C) 1985-1988, 1993, 2000-2021 Free Software Foundation, Inc. This file is part of GNU Emacs. -- cgit v1.2.1 From 19dcb237b5b02b36580294ab309124f346a66024 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 1 Jan 2022 02:45:51 -0500 Subject: ; Add 2022 to copyright years. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 4fd41acab85..472992be180 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1,5 +1,5 @@ /* Execution of byte code produced by bytecomp.el. - Copyright (C) 1985-1988, 1993, 2000-2021 Free Software Foundation, + Copyright (C) 1985-1988, 1993, 2000-2022 Free Software Foundation, Inc. This file is part of GNU Emacs. -- cgit v1.2.1 From b929bdaeb6bcb919d4d1a5d02713cdcac3fc44d0 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 16 Jan 2022 11:58:00 +0100 Subject: Fix Fchar_syntax for non-ASCII in unibyte buffers Fchar_syntax did not convert unibyte characters to multibyte when the current buffer was unibyte, in contrast to `char-syntax` in byte-compiled code (bug#53260). * src/bytecode.c (exec_byte_code): Call out to Fchar_syntax; the dynamic frequency is too low to justify inlining here, and it did lead to implementations diverging. * src/syntax.c (Fchar_syntax): Convert non-ASCII unibyte values to multibyte. * test/src/syntax-tests.el (syntax-char-syntax): New test. --- src/bytecode.c | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 472992be180..b7e65d05aef 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1167,13 +1167,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bchar_syntax): - { - CHECK_CHARACTER (TOP); - int c = XFIXNAT (TOP); - if (NILP (BVAR (current_buffer, enable_multibyte_characters))) - c = make_char_multibyte (c); - XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]); - } + TOP = Fchar_syntax (TOP); NEXT; CASE (Bbuffer_substring): -- cgit v1.2.1 From 15961108c9acbef5b7e7daeb47f026969b7a5407 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 28 Dec 2021 16:50:07 +0100 Subject: Short-circuit the recursive bytecode funcall chain Inline parts of the code for function calls to speed up the common case of calling lexbound byte-code. By eliminating intermediate functions, this also reduces C stack usage a little. * src/bytecode.c (exec_byte_code): Inline parts of Ffuncall, funcall_lambda and fetch_and_exec_byte_code in the Bcall opcode handler. * src/eval.c (backtrace_debug_on_exit): Inline and move to lisp.h. (do_debug_on_call): Make global so that it can be called from bytecode.c. (funcall_general): New function, essentially the meat of Ffuncall. * src/lisp.h (backtrace_debug_on_exit): Moved here from eval.c. --- src/bytecode.c | 48 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 47 insertions(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index b7e65d05aef..2be558d7472 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -629,7 +629,53 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } } #endif - TOP = Ffuncall (op + 1, &TOP); + maybe_quit (); + + if (++lisp_eval_depth > max_lisp_eval_depth) + { + if (max_lisp_eval_depth < 100) + max_lisp_eval_depth = 100; + if (lisp_eval_depth > max_lisp_eval_depth) + error ("Lisp nesting exceeds `max-lisp-eval-depth'"); + } + + ptrdiff_t numargs = op; + Lisp_Object fun = TOP; + Lisp_Object *args = &TOP + 1; + + ptrdiff_t count1 = record_in_backtrace (fun, args, numargs); + maybe_gc (); + if (debug_on_next_call) + do_debug_on_call (Qlambda, count1); + + Lisp_Object original_fun = fun; + if (SYMBOLP (fun)) + fun = XSYMBOL (fun)->u.s.function; + Lisp_Object template; + Lisp_Object bytecode; + Lisp_Object val; + if (COMPILEDP (fun) + // Lexical binding only. + && (template = AREF (fun, COMPILED_ARGLIST), + FIXNUMP (template)) + // No autoloads. + && (bytecode = AREF (fun, COMPILED_BYTECODE), + !CONSP (bytecode))) + val = exec_byte_code (bytecode, + AREF (fun, COMPILED_CONSTANTS), + AREF (fun, COMPILED_STACK_DEPTH), + template, numargs, args); + else if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) + val = funcall_subr (XSUBR (fun), numargs, args); + else + val = funcall_general (original_fun, numargs, args); + + lisp_eval_depth--; + if (backtrace_debug_on_exit (specpdl + count1)) + val = call_debugger (list2 (Qexit, val)); + specpdl_ptr--; + + TOP = val; NEXT; } -- cgit v1.2.1 From 6c000af611419745cc7f6c5ea1df1ed961cd6ec3 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 30 Dec 2021 18:48:53 +0100 Subject: Inline fixnum operations in bytecode interpreter Since numeric operations are mostly done on fixnums, this gives a speed-up for common code. * src/bytecode.c (exec_byte_code): Inline fixnum comparisons and operations with fixnum results: =, >, <, <=, >=, -, +, -, *, /, %, max and min. --- src/bytecode.c | 138 ++++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 108 insertions(+), 30 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 2be558d7472..c5c86ba8f05 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1032,43 +1032,72 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Beqlsign): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_EQUAL); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = EQ (v1, v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_EQUAL); NEXT; } CASE (Bgtr): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_GRTR); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) > XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_GRTR); NEXT; } CASE (Blss): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_LESS); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) < XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_LESS); NEXT; } CASE (Bleq): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) <= XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_LESS_OR_EQUAL); NEXT; } CASE (Bgeq): { - Lisp_Object v1 = POP; - TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + TOP = XFIXNUM (v1) >= XFIXNUM (v2) ? Qt : Qnil; + else + TOP = arithcompare (v1, v2, ARITH_GRTR_OR_EQUAL); NEXT; } CASE (Bdiff): - DISCARD (1); - TOP = Fminus (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + EMACS_INT res; + if (FIXNUMP (v1) && FIXNUMP (v2) + && (res = XFIXNUM (v1) - XFIXNUM (v2), + !FIXNUM_OVERFLOW_P (res))) + TOP = make_fixnum (res); + else + TOP = Fminus (2, &TOP); + NEXT; + } CASE (Bnegate): TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM @@ -1077,34 +1106,83 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bplus): - DISCARD (1); - TOP = Fplus (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + EMACS_INT res; + if (FIXNUMP (v1) && FIXNUMP (v2) + && (res = XFIXNUM (v1) + XFIXNUM (v2), + !FIXNUM_OVERFLOW_P (res))) + TOP = make_fixnum (res); + else + TOP = Fplus (2, &TOP); + NEXT; + } CASE (Bmax): - DISCARD (1); - TOP = Fmax (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + { + if (XFIXNUM (v2) > XFIXNUM (v1)) + TOP = v2; + } + else + TOP = Fmax (2, &TOP); + NEXT; + } CASE (Bmin): - DISCARD (1); - TOP = Fmin (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2)) + { + if (XFIXNUM (v2) < XFIXNUM (v1)) + TOP = v2; + } + else + TOP = Fmin (2, &TOP); + NEXT; + } CASE (Bmult): - DISCARD (1); - TOP = Ftimes (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + intmax_t res; + if (FIXNUMP (v1) && FIXNUMP (v2) + && !INT_MULTIPLY_WRAPV (XFIXNUM (v1), XFIXNUM (v2), &res) + && !FIXNUM_OVERFLOW_P (res)) + TOP = make_fixnum (res); + else + TOP = Ftimes (2, &TOP); + NEXT; + } CASE (Bquo): - DISCARD (1); - TOP = Fquo (2, &TOP); - NEXT; + { + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + EMACS_INT res; + if (FIXNUMP (v1) && FIXNUMP (v2) && XFIXNUM (v2) != 0 + && (res = XFIXNUM (v1) / XFIXNUM (v2), + !FIXNUM_OVERFLOW_P (res))) + TOP = make_fixnum (res); + else + TOP = Fquo (2, &TOP); + NEXT; + } CASE (Brem): { - Lisp_Object v1 = POP; - TOP = Frem (TOP, v1); + Lisp_Object v2 = POP; + Lisp_Object v1 = TOP; + if (FIXNUMP (v1) && FIXNUMP (v2) && XFIXNUM (v2) != 0) + TOP = make_fixnum (XFIXNUM (v1) % XFIXNUM (v2)); + else + TOP = Frem (v1, v2); NEXT; } -- cgit v1.2.1 From ce1de3a8d9723305f48fd4527fbceaff3cec50ba Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 31 Dec 2021 16:47:56 +0100 Subject: Inline setcar and setcdr in byte-code interpreter The function call overhead is nontrivial in comparison to the actual code which makes this worthwhile. * src/bytecode.c (exec_byte_code): Inline code from Fsetcar and Fsetcdr. --- src/bytecode.c | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index c5c86ba8f05..37da0858ab4 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -26,6 +26,7 @@ along with GNU Emacs. If not, see . */ #include "keyboard.h" #include "syntax.h" #include "window.h" +#include "puresize.h" /* Work around GCC bug 54561. */ #if GNUC_PREREQ (4, 3, 0) @@ -1409,15 +1410,23 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bsetcar): { - Lisp_Object v1 = POP; - TOP = Fsetcar (TOP, v1); + Lisp_Object newval = POP; + Lisp_Object cell = TOP; + CHECK_CONS (cell); + CHECK_IMPURE (cell, XCONS (cell)); + XSETCAR (cell, newval); + TOP = newval; NEXT; } CASE (Bsetcdr): { - Lisp_Object v1 = POP; - TOP = Fsetcdr (TOP, v1); + Lisp_Object newval = POP; + Lisp_Object cell = TOP; + CHECK_CONS (cell); + CHECK_IMPURE (cell, XCONS (cell)); + XSETCDR (cell, newval); + TOP = newval; NEXT; } -- cgit v1.2.1 From 65caf5b205d22f76bb4ec85cfe597b621a83afb3 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 31 Dec 2021 17:24:31 +0100 Subject: Pin bytecode strings to avoid copy at call time Avoid making a copy (in the interpreter C stack frame) of the bytecode string by making sure it won't be moved by the GC. This is done by reallocating it to the heap normally only used for large strings, which isn't compacted. This requires that we retain an explicit reference to the bytecode string object (`bytestr`) lest it be GCed away should all other references vanish during execution. We allocate an extra stack slot for that, as we already do for the constant vector object. * src/alloc.c (allocate_string_data): Add `immovable` argument. (resize_string_data, make_clear_multibyte_string): Use it. (pin_string): New. * src/pdumper.c (dump_string): Fix incorrect comment. Update hash for Lisp_String (only comments changed, not contents). * src/lread.c (read1): * src/alloc.c (Fmake_byte_code, purecopy): * src/bytecode.c (Fbyte_code): Pin bytecode on object creation. (exec_byte_code): Don't copy bytecode. Retain `bytestr` explicitly. * src/lisp.h (Lisp_String): Explain special size_byte values. (string_immovable_p): New. --- src/bytecode.c | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 37da0858ab4..0d0a28cd0bb 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -331,6 +331,7 @@ If the third argument is incorrect, Emacs may crash. */) the original unibyte form. */ bytestr = Fstring_as_unibyte (bytestr); } + pin_string (bytestr); // Bytecode must be immovable. return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); } @@ -358,22 +359,28 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, #endif eassert (!STRING_MULTIBYTE (bytestr)); + eassert (string_immovable_p (bytestr)); ptrdiff_t const_length = ASIZE (vector); ptrdiff_t bytestr_length = SCHARS (bytestr); Lisp_Object *vectorp = XVECTOR (vector)->contents; unsigned char quitcounter = 1; - EMACS_INT stack_items = XFIXNAT (maxdepth) + 1; + /* Allocate two more slots than required, because... */ + EMACS_INT stack_items = XFIXNAT (maxdepth) + 2; USE_SAFE_ALLOCA; void *alloc; - SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length); + SAFE_ALLOCA_LISP (alloc, stack_items); Lisp_Object *stack_base = alloc; - Lisp_Object *top = stack_base; - *top = vector; /* Ensure VECTOR survives GC (Bug#33014). */ - Lisp_Object *stack_lim = stack_base + stack_items; - unsigned char const *bytestr_data = memcpy (stack_lim, - SDATA (bytestr), bytestr_length); + /* ... we plonk BYTESTR and VECTOR there to ensure that they survive + GC (bug#33014), since these variables aren't used directly beyond + the interpreter prologue and wouldn't be found in the stack frame + otherwise. */ + stack_base[0] = bytestr; + stack_base[1] = vector; + Lisp_Object *top = stack_base + 1; + Lisp_Object *stack_lim = top + stack_items; + unsigned char const *bytestr_data = SDATA (bytestr); unsigned char const *pc = bytestr_data; ptrdiff_t count = SPECPDL_INDEX (); @@ -1564,6 +1571,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, exit: + eassert (SDATA (bytestr) == bytestr_data); + /* Binds and unbinds are supposed to be compiled balanced. */ if (SPECPDL_INDEX () != count) { -- cgit v1.2.1 From 7392f2dc4102fcc5bc4e8a9752db589f75ab9f52 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 31 Dec 2021 19:44:02 +0100 Subject: Byte code arity check micro-optimisation * src/bytecode.c (exec_byte_code): Slight simplification. --- src/bytecode.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 0d0a28cd0bb..00db29b0140 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -391,8 +391,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, bool rest = (at & 128) != 0; int mandatory = at & 127; ptrdiff_t nonrest = at >> 8; - ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest; - if (! (mandatory <= nargs && nargs <= maxargs)) + if (! (mandatory <= nargs && (rest || nargs <= nonrest))) Fsignal (Qwrong_number_of_arguments, list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)), make_fixnum (nargs))); -- cgit v1.2.1 From d05f387407858672ff0d10b963dbdeaf2a9163e0 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 1 Jan 2022 15:33:27 +0100 Subject: ; * src/bytecode.c (exec_byte_code): Cosmetic improvement Implement point_max in the same way as point_min. --- src/bytecode.c | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 00db29b0140..7a9966e20ef 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1212,12 +1212,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bpoint_max): - { - Lisp_Object v1; - XSETFASTINT (v1, ZV); - PUSH (v1); - NEXT; - } + PUSH (make_fixed_natnum (ZV)); + NEXT; CASE (Bpoint_min): PUSH (make_fixed_natnum (BEGV)); -- cgit v1.2.1 From b3377e67a7b20a9a53aa2129b2c3951be67ad102 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 1 Jan 2022 22:39:17 +0100 Subject: Remove nil check in exec_byte_code Since we pass no arguments to a non-lexbind bytecode function, we can specify its arity as 0 instead of nil and save a test and branch. * src/bytecode.c (Fbyte_code, exec_byte_code): * src/eval.c (fetch_and_exec_byte_code, funcall_lambda): * src/lisp.h: Change the args_template parameter type to ptrdiff_t, since it is now always a small integer, in exec_byte_code and fetch_and_exec_byte_code, all callers adjusted. --- src/bytecode.c | 54 ++++++++++++++++++++++++++---------------------------- 1 file changed, 26 insertions(+), 28 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 7a9966e20ef..8e0f3d3e4b2 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -333,7 +333,7 @@ If the third argument is incorrect, Emacs may crash. */) } pin_string (bytestr); // Bytecode must be immovable. - return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); + return exec_byte_code (bytestr, vector, maxdepth, 0, 0, NULL); } static void @@ -344,15 +344,14 @@ bcall0 (Lisp_Object f) /* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect, - emacs may crash!). If ARGS_TEMPLATE is non-nil, it should be a lisp - argument list (including &rest, &optional, etc.), and ARGS, of size - NARGS, should be a vector of the actual arguments. The arguments in - ARGS are pushed on the stack according to ARGS_TEMPLATE before - executing BYTESTR. */ + emacs may crash!). ARGS_TEMPLATE is the function arity encoded as an + integer, and ARGS, of size NARGS, should be a vector of the actual + arguments. The arguments in ARGS are pushed on the stack according + to ARGS_TEMPLATE before executing BYTESTR. */ Lisp_Object exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, - Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args) + ptrdiff_t args_template, ptrdiff_t nargs, Lisp_Object *args) { #ifdef BYTE_CODE_METER int volatile this_op = 0; @@ -384,26 +383,25 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, unsigned char const *pc = bytestr_data; ptrdiff_t count = SPECPDL_INDEX (); - if (!NILP (args_template)) - { - eassert (FIXNUMP (args_template)); - ptrdiff_t at = XFIXNUM (args_template); - bool rest = (at & 128) != 0; - int mandatory = at & 127; - ptrdiff_t nonrest = at >> 8; - if (! (mandatory <= nargs && (rest || nargs <= nonrest))) - Fsignal (Qwrong_number_of_arguments, - list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)), - make_fixnum (nargs))); - ptrdiff_t pushedargs = min (nonrest, nargs); - for (ptrdiff_t i = 0; i < pushedargs; i++, args++) - PUSH (*args); - if (nonrest < nargs) - PUSH (Flist (nargs - nonrest, args)); - else - for (ptrdiff_t i = nargs - rest; i < nonrest; i++) - PUSH (Qnil); - } + /* ARGS_TEMPLATE is composed of bit fields: + bits 0..6 minimum number of arguments + bits 7 1 iff &rest argument present + bits 8..14 maximum number of arguments */ + bool rest = (args_template & 128) != 0; + int mandatory = args_template & 127; + ptrdiff_t nonrest = args_template >> 8; + if (! (mandatory <= nargs && (rest || nargs <= nonrest))) + Fsignal (Qwrong_number_of_arguments, + list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)), + make_fixnum (nargs))); + ptrdiff_t pushedargs = min (nonrest, nargs); + for (ptrdiff_t i = 0; i < pushedargs; i++, args++) + PUSH (*args); + if (nonrest < nargs) + PUSH (Flist (nargs - nonrest, args)); + else + for (ptrdiff_t i = nargs - rest; i < nonrest; i++) + PUSH (Qnil); while (true) { @@ -671,7 +669,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, val = exec_byte_code (bytecode, AREF (fun, COMPILED_CONSTANTS), AREF (fun, COMPILED_STACK_DEPTH), - template, numargs, args); + XFIXNUM (template), numargs, args); else if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) val = funcall_subr (XSUBR (fun), numargs, args); else -- cgit v1.2.1 From 4ff1fb8eb475a540c094878db1811797e2ca2368 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 2 Jan 2022 11:15:41 +0100 Subject: Move a runtime interpreter check to debug mode * src/bytecode.c (exec_byte_code): Perform bytecode unwinding error check only when building with debugging (NDEBUG not defined, checking enabled, or BYTE_CODE_SAFE enabled). This improves speed in several ways. --- src/bytecode.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 8e0f3d3e4b2..75f1a6b43e5 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1564,15 +1564,17 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, exit: - eassert (SDATA (bytestr) == bytestr_data); - - /* Binds and unbinds are supposed to be compiled balanced. */ +#if BYTE_CODE_SAFE || !defined NDEBUG if (SPECPDL_INDEX () != count) { + /* Binds and unbinds are supposed to be compiled balanced. */ if (SPECPDL_INDEX () > count) unbind_to (count, Qnil); error ("binding stack not balanced (serious byte compiler bug)"); } +#endif + /* The byte code should have been properly pinned. */ + eassert (SDATA (bytestr) == bytestr_data); Lisp_Object result = TOP; SAFE_FREE (); -- cgit v1.2.1 From 721357b86856505324b5f32584d5eae0ba9ab4ac Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 2 Jan 2022 11:35:16 +0100 Subject: Remove the unused unbind-all bytecode It was implemented but never generated, originally intended for TCO in the pre-lexbind era (which was semantically dubious anyway). Removing it speeds up the interpreter because there is no longer any need for the outermost `count` variable unless checking is enabled. * lisp/emacs-lisp/bytecomp.el: * lisp/emacs-lisp/comp.el (comp-limplify-lap-inst): * src/bytecode.c (BYTE_CODES, exec_byte_code): Remove definition and implementation of unbind-all, freeing up the opcode for other purposes. --- src/bytecode.c | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 75f1a6b43e5..b2e8f4a9166 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -227,7 +227,7 @@ DEFINE (Bcondition_case, 0217) /* Obsolete since Emacs-25. */ \ DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \ DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \ \ -DEFINE (Bunbind_all, 0222) /* Obsolete. Never used. */ \ +/* 0222 was Bunbind_all, never used. */ \ \ DEFINE (Bset_marker, 0223) \ DEFINE (Bmatch_beginning, 0224) \ @@ -703,12 +703,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, unbind_to (SPECPDL_INDEX () - op, Qnil); NEXT; - CASE (Bunbind_all): /* Obsolete. Never used. */ - /* To unbind back to the beginning of this frame. Not used yet, - but will be needed for tail-recursion elimination. */ - unbind_to (count, Qnil); - NEXT; - CASE (Bgoto): op = FETCH2; op_branch: -- cgit v1.2.1 From 11e1abd5cc76c9adc72746c25688cf23365a9eb0 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 2 Jan 2022 12:19:54 +0100 Subject: Open-code aref and aset in bytecode interpreter * src/bytecode.c (exec_byte_code): Inline aref and aset for vectors and records, since this is important for code that makes heavy use of arrays and/or objects. --- src/bytecode.c | 32 ++++++++++++++++++++++++++++---- 1 file changed, 28 insertions(+), 4 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index b2e8f4a9166..76ef2fb661c 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -948,15 +948,39 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Baref): { - Lisp_Object v1 = POP; - TOP = Faref (TOP, v1); + Lisp_Object idxval = POP; + Lisp_Object arrayval = TOP; + ptrdiff_t size; + ptrdiff_t idx; + if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true)) + || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true))) + && FIXNUMP (idxval) + && (idx = XFIXNUM (idxval), + idx >= 0 && idx < size)) + TOP = AREF (arrayval, idx); + else + TOP = Faref (arrayval, idxval); NEXT; } CASE (Baset): { - Lisp_Object v2 = POP, v1 = POP; - TOP = Faset (TOP, v1, v2); + Lisp_Object newelt = POP; + Lisp_Object idxval = POP; + Lisp_Object arrayval = TOP; + ptrdiff_t size; + ptrdiff_t idx; + if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true)) + || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true))) + && FIXNUMP (idxval) + && (idx = XFIXNUM (idxval), + idx >= 0 && idx < size)) + { + ASET (arrayval, idx, newelt); + TOP = newelt; + } + else + TOP = Faset (arrayval, idxval, newelt); NEXT; } -- cgit v1.2.1 From 067e84116dde36a2e058e3915fe81c818a21e40a Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 24 Jan 2022 15:02:17 +0100 Subject: ; * src/bytecode.c (exec_byte_code): Silence GCC warning --- src/bytecode.c | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 76ef2fb661c..da1855d6bab 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -381,7 +381,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object *stack_lim = top + stack_items; unsigned char const *bytestr_data = SDATA (bytestr); unsigned char const *pc = bytestr_data; +#if BYTE_CODE_SAFE || !defined NDEBUG ptrdiff_t count = SPECPDL_INDEX (); +#endif /* ARGS_TEMPLATE is composed of bit fields: bits 0..6 minimum number of arguments -- cgit v1.2.1 From a8245e122075175df2f124b20e9e5b1b583eff89 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 12 Feb 2022 16:05:17 +0100 Subject: Replace ptrdiff_t with new specpdl_ref type for specpdl references The specpdl_ref type is just an alias for ptrdiff_t; the compiled code remains the same. All operations on specpdl_ref (arithmetic, comparison etc) now go through inline functions. The bulk of the change is almost completely mechanical. It is done to prepare for a type-safe representation and subsequent performance improvement. * src/lisp.h (specpdl_ref, specpdl_count_to_ref, specpdl_ref_to_count) (specpdl_ref_eq, specpdl_ref_lt, specpdl_ref_valid_p) (make_invalid_specpdl_ref, specpdl_ref_add, specpdl_ref_to_ptr): New. (SPECPDL_INDEX, struct handler, USE_SAFE_ALLOCA, safe_free) (safe_free_unbind_to): * src/alloc.c (run_finalizer_function, inhibit_garbage_collection) (garbage_collect, Fgarbage_collect, which_symbols): * src/bidi.c (bidi_at_paragraph_end, bidi_find_paragraph_start): * src/buffer.c (Fkill_buffer, Fset_buffer_major_mode, Fmove_overlay) (Fdelete_overlay): * src/bytecode.c (exec_byte_code): * src/callint.c (Ffuncall_interactively, Fcall_interactively): * src/callproc.c (Fcall_process, call_process, create_temp_file) (Fcall_process_region): * src/charset.c (load_charset_map_from_file): * src/coding.c (decode_coding_gap, decode_coding_object) (encode_coding_object, Fread_coding_system): * src/comp.c (emit_static_object, helper_unbind_n, load_comp_unit): * src/composite.c (update_compositions, autocmp_chars): * src/cygw32.c (conv_filename_to_w32_unicode) (conv_filename_from_w32_unicode): * src/data.c (notify_variable_watchers): * src/decompress.c (Fzlib_decompress_region): * src/dired.c (directory_files_internal, file_name_completion) (file_attributes): * src/dispnew.c (Fredisplay): * src/doc.c (get_doc_string, Fsnarf_documentation): * src/editfns.c (Fsave_excursion, Fsave_current_buffer) (Freplace_buffer_contents, Fsubst_char_in_region, Fsave_restriction) (styled_format): * src/emacs-module.c (Fmodule_load, funcall_module): * src/emacs.c (init_cmdargs, Fdump_emacs): * src/eval.c (call_debugger, do_debug_on_call, FletX, Flet) (Ffuncall_with_delayed_message, Funwind_protect) (internal_lisp_condition_case, signal_or_quit) (load_with_autoload_queue, Feval, grow_specpdl_allocation) (record_in_backtrace, eval_sub, Ffuncall, apply_lambda) (funcall_lambda, clear_unwind_protect, set_unwind_protect) (set_unwind_protect_ptr, unbind_to, Fbacktrace_eval): * src/fileio.c (Fmake_temp_file_internal, Fcopy_file, Frename_file) (Finsert_file_contents, write_region, Fdo_auto_save): * src/fns.c (Fyes_or_no_p, Frequire, hash_table_user_defined_call): * src/fringe.c (update_window_fringes): * src/gtkutil.c (xg_dialog_run): * src/haiku_io.c (c_specpdl_idx_from_cxx): * src/haiku_support.cc (be_popup_file_dialog): * src/haiku_support.h (c_specpdl_idx_from_cxx): * src/haikufns.c (haiku_create_frame, haiku_create_tip_frame) (haiku_hide_tip, Fx_show_tip, Fhaiku_read_file_name): * src/haikumenu.c (haiku_popup_dialog, set_frame_menubar): * src/image.c (slurp_file): * src/indent.c (line_number_display_width, Fvertical_motion): * src/insdel.c (signal_before_change, signal_after_change) (Fcombine_after_change_execute): * src/intervals.c (get_local_map): * src/json.c (lisp_to_json_nonscalar_1, Fjson_serialize, Fjson_insert) (Fjson_parse_string, Fjson_parse_buffer): * src/keyboard.c (recursive_edit_1, Frecursive_edit, cmd_error) (Finternal_track_mouse, command_loop_1, read_menu_command) (safe_run_hooks, read_event_from_main_queue, read_char, timer_check_2) (menu_item_eval_property, read_key_sequence, read_key_sequence_vs) (Fsuspend_emacs): * src/keymap.c (Fcurrent_active_maps, Fdescribe_vector) (Fhelp__describe_vector): * src/lread.c (Fload, save_match_data_load, readevalloop) (Feval_buffer, Feval_region, grow_read_buffer, read_integer, read1): * src/macros.c (Fexecute_kbd_macro): * src/menu.c (x_popup_menu_1): * src/minibuf.c (read_minibuf, set_minibuffer_mode) (read_minibuf_unwind, Fread_string, Fread_buffer): * src/nsfns.m (Fx_create_frame, Fx_show_tip): * src/nsmenu.m (ns_update_menubar, ns_menu_show, ns_popup_dialog): * src/pdumper.c (Fdump_emacs_portable): * src/pgtkfns.c (Fx_create_frame, x_create_tip_frame, x_hide_tip) (Fx_show_tip, Fpgtk_print_frames_dialog, Fx_file_dialog, Fx_select_font): * src/pgtkmenu.c (set_frame_menubar, create_and_show_popup_menu) (pgtk_menu_show, create_and_show_dialog, pgtk_dialog_show) (pgtk_popup_dialog): * src/pgtkterm.c (pgtk_cr_export_frames): * src/print.c (PRINTPREPARE, temp_output_buffer_setup) (Fprin1_to_string, print_vectorlike): * src/process.c (Fmake_process, create_process, Fmake_pipe_process) (Fmake_serial_process, connect_network_socket, Fmake_network_process) (network_interface_info, server_accept_connection) (wait_reading_process_output, read_process_output, exec_sentinel): * src/regex-emacs.c (re_match_2_internal): * src/search.c (looking_at_1, fast_looking_at, search_buffer_re): * src/sound.c (Fplay_sound_internal): * src/sysdep.c (system_process_attributes): * src/term.c (tty_menu_show): * src/textprop.c (Fnext_single_char_property_change) (Fprevious_single_char_property_change, add_text_properties_1) (set_text_properties, set_text_properties_1, Fremove_text_properties) (Fremove_list_of_text_properties): * src/thread.c (Fmutex_lock, invoke_thread_function): * src/undo.c (truncate_undo_list): * src/w32fns.c (Fx_create_frame, w32_create_tip_frame, w32_hide_tip) (Fx_show_tip, Fx_file_dialog): * src/w32font.c (Fx_select_font): * src/w32menu.c (set_frame_menubar): * src/window.c (window_list, next_window, window_list_1) (run_window_configuration_change_hook, Frun_window_scroll_functions) (run_window_change_functions, set_window_buffer) (temp_output_buffer_show, window_scroll, scroll_command) (Fscroll_other_window, Fscroll_other_window_down): * src/xdisp.c (safe__call, handle_fontified_prop, handle_face_prop) (handle_single_display_spec, Fbuffer_text_pixel_size) (message_dolog, with_echo_area_buffer, setup_echo_area_for_printing) (display_echo_area, set_message, clear_message, echo_area_display) (gui_consider_frame_title, prepare_menu_bars, update_menu_bar) (update_tab_bar, update_tool_bar, redisplay_internal) (redisplay_preserve_echo_area, run_window_scroll_functions) (redisplay_window, extend_face_to_end_of_line) (display_count_lines_logically, display_count_lines_visually) (display_mode_lines, display_mode_line, Fformat_mode_line) (decode_mode_spec): * src/xfns.c (Fx_create_frame, x_create_tip_frame, x_hide_tip) (Fx_show_tip, Fx_file_dialog, Fx_select_font, Fx_print_frames_dialog): * src/xmenu.c (set_frame_menubar, create_and_show_popup_menu) (x_menu_show, create_and_show_dialog, x_dialog_show) (xw_popup_dialog): * src/xselect.c (x_get_local_selection, x_reply_selection_request) (x_handle_selection_request, wait_for_property_change): * src/xterm.c (x_cr_export_frames, x_connection_closed): Replace ptrdiff_t with specpdl_ref for referencing specpdl and use the corresponding functions instead of direct arithmetic. --- src/bytecode.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index da1855d6bab..1018e81d24c 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -382,7 +382,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, unsigned char const *bytestr_data = SDATA (bytestr); unsigned char const *pc = bytestr_data; #if BYTE_CODE_SAFE || !defined NDEBUG - ptrdiff_t count = SPECPDL_INDEX (); + specpdl_ref count = SPECPDL_INDEX (); #endif /* ARGS_TEMPLATE is composed of bit fields: @@ -650,7 +650,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object fun = TOP; Lisp_Object *args = &TOP + 1; - ptrdiff_t count1 = record_in_backtrace (fun, args, numargs); + specpdl_ref count1 = record_in_backtrace (fun, args, numargs); maybe_gc (); if (debug_on_next_call) do_debug_on_call (Qlambda, count1); @@ -678,7 +678,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, val = funcall_general (original_fun, numargs, args); lisp_eval_depth--; - if (backtrace_debug_on_exit (specpdl + count1)) + if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count1))) val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; @@ -702,7 +702,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bunbind5): op -= Bunbind; dounbind: - unbind_to (SPECPDL_INDEX () - op, Qnil); + unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -op), Qnil); NEXT; CASE (Bgoto): @@ -796,7 +796,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bsave_window_excursion): /* Obsolete since 24.1. */ { - ptrdiff_t count1 = SPECPDL_INDEX (); + specpdl_ref count1 = SPECPDL_INDEX (); record_unwind_protect (restore_window_configuration, Fcurrent_window_configuration (Qnil)); TOP = Fprogn (TOP); @@ -872,7 +872,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, temp_output_buffer_show (TOP); TOP = v1; /* pop binding of standard-output */ - unbind_to (SPECPDL_INDEX () - 1, Qnil); + unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -1), Qnil); NEXT; } @@ -1585,10 +1585,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, exit: #if BYTE_CODE_SAFE || !defined NDEBUG - if (SPECPDL_INDEX () != count) + if (!specpdl_ref_eq (SPECPDL_INDEX (), count)) { /* Binds and unbinds are supposed to be compiled balanced. */ - if (SPECPDL_INDEX () > count) + if (specpdl_ref_lt (count, SPECPDL_INDEX ())) unbind_to (count, Qnil); error ("binding stack not balanced (serious byte compiler bug)"); } -- cgit v1.2.1 From 89bb5a5f357e911aeb0b9f14e8b2f7c5a5fbabf7 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 3 Feb 2022 10:26:27 +0100 Subject: Speed up `=` on fixnums in bytecode Now that EQ has become expensive, use BASE_EQ where possible. * src/bytecode.c (exec_byte_code): Use cheaper operation for Beqlsign. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 1018e81d24c..bda9a39b7f3 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1060,7 +1060,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v2 = POP; Lisp_Object v1 = TOP; if (FIXNUMP (v1) && FIXNUMP (v2)) - TOP = EQ (v1, v2) ? Qt : Qnil; + TOP = BASE_EQ(v1, v2) ? Qt : Qnil; else TOP = arithcompare (v1, v2, ARITH_EQUAL); NEXT; -- cgit v1.2.1 From c1111e944784f68593964e528a9bd0dd6a6314fb Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 17 Feb 2022 14:39:42 +0100 Subject: Fix or remove outdated comments * src/eval.c (funcall_lambda): Rewrite obsolete comment. * src/bytecode.c (exec_byte_code): Remove lying comment and unneeded #define. * lisp/emacs-lisp/byte-opt.el: Remove car. Keep pig. (byte-compile-log-lap-1): Remove obsolete and irrelevant comment. --- src/bytecode.c | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index bda9a39b7f3..96f1f905812 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -458,17 +458,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, #ifdef BYTE_CODE_THREADED - /* A convenience define that saves us a lot of typing and makes - the table clearer. */ -#define LABEL(OP) [OP] = &&insn_ ## OP - /* This is the dispatch table for the threaded interpreter. */ static const void *const targets[256] = { [0 ... (Bconstant - 1)] = &&insn_default, [Bconstant ... 255] = &&insn_Bconstant, -#define DEFINE(name, value) LABEL (name) , +#define DEFINE(name, value) [name] = &&insn_ ## name, BYTE_CODES #undef DEFINE }; -- cgit v1.2.1 From 2fb98486e18f8a3275adc56d2740901ef5cb6e8b Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 3 Mar 2022 13:57:26 +0100 Subject: Faster bytecode immediate argument fetching * src/bytecode.c (FETCH2): Use `|` instead of `+` to combine the bytes forming a 16-bit immediate argument so that GCC (prior to version 12) recognises the idiom and generates a 16-bit load. This applies for little-endian machines with cheap unaligned accesses such as x86[-64], arm64 and power64le. This 1-character change results in a measurable speed gain on many kinds of Lisp code, as 16-bit immediates are used by all jump instructions. Clang performs this optimisation for both `+` and `|` from version 10. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 96f1f905812..c5cc6590121 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -291,7 +291,7 @@ enum byte_code_op /* Fetch two bytes from the bytecode stream and make a 16-bit number out of them. */ -#define FETCH2 (op = FETCH, op + (FETCH << 8)) +#define FETCH2 (op = FETCH, op | (FETCH << 8)) /* Push X onto the execution stack. The expression X should not contain TOP, to avoid competing side effects. */ -- cgit v1.2.1 From 88889212c7d74fb189131dcae4abaabd05eb1870 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 3 Mar 2022 19:46:13 +0100 Subject: Remove debug code for opcodes long gone * src/bytecode.c (BYTE_CODES, enum byte_code_op, exec_byte_code): Don't display custom messages in debug mode for Bscan_buffer and Bset_mark which were removed long ago. --- src/bytecode.c | 20 ++------------------ 1 file changed, 2 insertions(+), 18 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index c5cc6590121..8d3817e64c6 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -186,6 +186,7 @@ DEFINE (Bfollowing_char, 0147) \ DEFINE (Bpreceding_char, 0150) \ DEFINE (Bcurrent_column, 0151) \ DEFINE (Bindent_to, 0152) \ +/* 0153 was Bscan_buffer in v17. */ \ DEFINE (Beolp, 0154) \ DEFINE (Beobp, 0155) \ DEFINE (Bbolp, 0156) \ @@ -193,6 +194,7 @@ DEFINE (Bbobp, 0157) \ DEFINE (Bcurrent_buffer, 0160) \ DEFINE (Bset_buffer, 0161) \ DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \ +/* 0163 was Bset_mark in v17. */ \ DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1. */ \ \ DEFINE (Bforward_char, 0165) \ @@ -277,11 +279,6 @@ enum byte_code_op #define DEFINE(name, value) name = value, BYTE_CODES #undef DEFINE - -#if BYTE_CODE_SAFE - Bscan_buffer = 0153, /* No longer generated as of v18. */ - Bset_mark = 0163, /* this loser is no longer generated as of v18 */ -#endif }; /* Fetch the next byte from the bytecode stream. */ @@ -1467,19 +1464,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, TOP = INTEGERP (TOP) ? Qt : Qnil; NEXT; -#if BYTE_CODE_SAFE - /* These are intentionally written using 'case' syntax, - because they are incompatible with the threaded - interpreter. */ - - case Bset_mark: - error ("set-mark is an obsolete bytecode"); - break; - case Bscan_buffer: - error ("scan-buffer is an obsolete bytecode"); - break; -#endif - CASE_ABORT: /* Actually this is Bstack_ref with offset 0, but we use Bdup for that instead. */ -- cgit v1.2.1 From 2c54e9a1dd6b4ea561be10567a7363012e70fa28 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 3 Mar 2022 19:50:46 +0100 Subject: Remove never-used relative jump opcodes * src/bytecode.c (BYTE_CODES, exec_byte_code): Remove relative jump opcodes that seem to have been a short-lived experiment, never used in a release. --- src/bytecode.c | 37 +------------------------------------ 1 file changed, 1 insertion(+), 36 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 8d3817e64c6..286a8d675d4 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -255,11 +255,7 @@ DEFINE (Brem, 0246) \ DEFINE (Bnumberp, 0247) \ DEFINE (Bintegerp, 0250) \ \ -DEFINE (BRgoto, 0252) \ -DEFINE (BRgotoifnil, 0253) \ -DEFINE (BRgotoifnonnil, 0254) \ -DEFINE (BRgotoifnilelsepop, 0255) \ -DEFINE (BRgotoifnonnilelsepop, 0256) \ +/* 0252-0256 were relative jumps, apparently never used. */ \ \ DEFINE (BlistN, 0257) \ DEFINE (BconcatN, 0260) \ @@ -702,7 +698,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, op = FETCH2; op_branch: op -= pc - bytestr_data; - op_relative_branch: if (BYTE_CODE_SAFE && ! (bytestr_data - pc <= op && op < bytestr_data + bytestr_length - pc)) @@ -737,36 +732,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, DISCARD (1); NEXT; - CASE (BRgoto): - op = FETCH - 128; - goto op_relative_branch; - - CASE (BRgotoifnil): - op = FETCH - 128; - if (NILP (POP)) - goto op_relative_branch; - NEXT; - - CASE (BRgotoifnonnil): - op = FETCH - 128; - if (!NILP (POP)) - goto op_relative_branch; - NEXT; - - CASE (BRgotoifnilelsepop): - op = FETCH - 128; - if (NILP (TOP)) - goto op_relative_branch; - DISCARD (1); - NEXT; - - CASE (BRgotoifnonnilelsepop): - op = FETCH - 128; - if (!NILP (TOP)) - goto op_relative_branch; - DISCARD (1); - NEXT; - CASE (Breturn): goto exit; -- cgit v1.2.1 From 267f41c7ce1e02f392b57aa338d387e7627df184 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Tue, 18 Jan 2022 13:10:05 +0100 Subject: Simplify exec_byte_code arguments Pass the function object and encoded arity, not the other components. This speeds up several call paths and is necessary for improvements to come. * src/bytecode.c (Fbyte_code): Make a new byte code object for execution. This is slower but performance isn't critical here. (exec_byte_code): Retrieve components from the passed function. * src/eval.c (fetch_and_exec_byte_code): * src/lisp.h (exec_byte_code): Update signature. --- src/bytecode.c | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 286a8d675d4..7c390c0d40e 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -324,9 +324,8 @@ If the third argument is incorrect, Emacs may crash. */) the original unibyte form. */ bytestr = Fstring_as_unibyte (bytestr); } - pin_string (bytestr); // Bytecode must be immovable. - - return exec_byte_code (bytestr, vector, maxdepth, 0, 0, NULL); + Lisp_Object args[] = {0, bytestr, vector, maxdepth}; + return exec_byte_code (Fmake_byte_code (4, args), 0, 0, NULL); } static void @@ -335,24 +334,26 @@ bcall0 (Lisp_Object f) Ffuncall (1, &f); } -/* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and - MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect, - emacs may crash!). ARGS_TEMPLATE is the function arity encoded as an - integer, and ARGS, of size NARGS, should be a vector of the actual - arguments. The arguments in ARGS are pushed on the stack according - to ARGS_TEMPLATE before executing BYTESTR. */ +/* Execute the byte-code in FUN. ARGS_TEMPLATE is the function arity + encoded as an integer (the one in FUN is ignored), and ARGS, of + size NARGS, should be a vector of the actual arguments. The + arguments in ARGS are pushed on the stack according to + ARGS_TEMPLATE before executing FUN. */ Lisp_Object -exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, - ptrdiff_t args_template, ptrdiff_t nargs, Lisp_Object *args) +exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, + ptrdiff_t nargs, Lisp_Object *args) { #ifdef BYTE_CODE_METER int volatile this_op = 0; #endif + Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); + eassert (!STRING_MULTIBYTE (bytestr)); eassert (string_immovable_p (bytestr)); - + Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); + Lisp_Object maxdepth = AREF (fun, COMPILED_STACK_DEPTH); ptrdiff_t const_length = ASIZE (vector); ptrdiff_t bytestr_length = SCHARS (bytestr); Lisp_Object *vectorp = XVECTOR (vector)->contents; @@ -657,10 +658,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, // No autoloads. && (bytecode = AREF (fun, COMPILED_BYTECODE), !CONSP (bytecode))) - val = exec_byte_code (bytecode, - AREF (fun, COMPILED_CONSTANTS), - AREF (fun, COMPILED_STACK_DEPTH), - XFIXNUM (template), numargs, args); + val = exec_byte_code (fun, XFIXNUM (template), numargs, args); else if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) val = funcall_subr (XSUBR (fun), numargs, args); else -- cgit v1.2.1 From 3ed79cdbf21039fa209c421f746c0b49ec33f4da Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 13 Mar 2022 17:26:05 +0100 Subject: Separate bytecode stack Use a dedicated stack for bytecode, instead of using the C stack. Stack frames are managed explicitly and we stay in the same exec_byte_code activation throughout bytecode function calls and returns. In other words, exec_byte_code no longer uses recursion for calling bytecode functions. This results in better performance, and bytecode recursion is no longer limited by the size of the C stack. The bytecode stack is currently of fixed size but overflow is handled gracefully by signalling a Lisp error instead of the hard crash that we get now. In addition, GC marking of the stack is now faster and more precise. Full precision could be attained if desired. * src/alloc.c (ATTRIBUTE_NO_SANITIZE_ADDRESS): Make non-static. * src/bytecode.c (enum stack_frame_index, BC_STACK_SIZE) (sf_get_ptr, sf_set_ptr, sf_get_lisp_ptr, sf_set_lisp_ptr) (sf_get_saved_pc, sf_set_saved_pc, init_bc_thread, free_bc_thread) (mark_bytecode, Finternal_stack_stats, valid_sp): New. (exec_byte_code): Adapt to use the new bytecode stack. (syms_of_bytecode): Add defsubr. * src/eval.c (unwind_to_catch): Restore saved stack frame. (push_handler_nosignal): Save stack frame. * src/lisp.h (struct handler): Add act_rec member. (get_act_rec, set_act_rec): New. * src/thread.c (mark_one_thread): Call mark_bytecode. (finalize_one_thread): Free bytecode thread state. (Fmake_thread, init_threads): Set up bytecode thread state. * src/thread.h (struct bc_thread_state): New. (struct thread_state): Add bytecode thread state. --- src/bytecode.c | 318 ++++++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 268 insertions(+), 50 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 7c390c0d40e..9356ebeb6cb 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -334,6 +334,166 @@ bcall0 (Lisp_Object f) Ffuncall (1, &f); } +/* Layout of the stack frame header. */ +enum stack_frame_index { + SFI_SAVED_FP, /* previous frame pointer */ + + /* In a frame called directly from C, the following two members are NULL. */ + SFI_SAVED_TOP, /* previous stack pointer */ + SFI_SAVED_PC, /* previous program counter */ + + SFI_FUN, /* current function object */ + + SF_SIZE /* number of words in the header */ +}; + +/* The bytecode stack size in Lisp words. + This is a fairly generous amount, but: + - if users need more, we could allocate more, or just reserve the address + space and allocate on demand + - if threads are used more, then it might be a good idea to reduce the + per-thread overhead in time and space + - for maximum flexibility but a small runtime penalty, we could allocate + the stack in smaller chunks as needed +*/ +#define BC_STACK_SIZE (512 * 1024) + +/* Bytecode interpreter stack: + + |--------------| -- + |fun | | ^ stack growth + |saved_pc | | | direction + |saved_top ------- | + fp--->|saved_fp ---- | | current frame + |--------------| | | | (called from bytecode in this example) + | (free) | | | | + top-->| ...stack... | | | | + : ... : | | | + |incoming args | | | | + |--------------| | | -- + |fun | | | | + |saved_pc | | | | + |saved_top | | | | + |saved_fp |<- | | previous frame + |--------------| | | + | (free) | | | + | ...stack... |<---- | + : ... : | + |incoming args | | + |--------------| -- + : : +*/ + +INLINE void * +sf_get_ptr (Lisp_Object *fp, enum stack_frame_index index) +{ + return XLP (fp[index]); +} + +INLINE void +sf_set_ptr (Lisp_Object *fp, enum stack_frame_index index, void *value) +{ + fp[index] = XIL ((EMACS_INT)value); +} + +INLINE Lisp_Object * +sf_get_lisp_ptr (Lisp_Object *fp, enum stack_frame_index index) +{ + return sf_get_ptr (fp, index); +} + +INLINE void +sf_set_lisp_ptr (Lisp_Object *fp, enum stack_frame_index index, + Lisp_Object *value) +{ + sf_set_ptr (fp, index, value); +} + +INLINE const unsigned char * +sf_get_saved_pc (Lisp_Object *fp) +{ + return sf_get_ptr (fp, SFI_SAVED_PC); +} + +INLINE void +sf_set_saved_pc (Lisp_Object *fp, const unsigned char *value) +{ + sf_set_ptr (fp, SFI_SAVED_PC, (unsigned char *)value); +} + +void +init_bc_thread (struct bc_thread_state *bc) +{ + bc->stack = xmalloc (BC_STACK_SIZE * sizeof *bc->stack); + bc->stack_end = bc->stack + BC_STACK_SIZE; + /* Put a dummy header at the bottom to indicate the first free location. */ + bc->fp = bc->stack; + memset (bc->fp, 0, SF_SIZE * sizeof *bc->stack); +} + +void +free_bc_thread (struct bc_thread_state *bc) +{ + xfree (bc->stack); +} + +void +mark_bytecode (struct bc_thread_state *bc) +{ + Lisp_Object *fp = bc->fp; + Lisp_Object *top = NULL; /* stack pointer of topmost frame not known */ + for (;;) + { + Lisp_Object *next_fp = sf_get_lisp_ptr (fp, SFI_SAVED_FP); + /* Only the dummy frame at the bottom has saved_fp = NULL. */ + if (!next_fp) + break; + mark_object (fp[SFI_FUN]); + Lisp_Object *frame_base = next_fp + SF_SIZE; + if (top) + { + /* The stack pointer of a frame is known: mark the part of the stack + above it conservatively. This includes any outgoing arguments. */ + mark_memory (top + 1, fp); + /* Mark the rest of the stack precisely. */ + mark_objects (frame_base, top + 1 - frame_base); + } + else + { + /* The stack pointer is unknown -- mark everything conservatively. */ + mark_memory (frame_base, fp); + } + top = sf_get_lisp_ptr (fp, SFI_SAVED_TOP); + fp = next_fp; + } +} + +DEFUN ("internal-stack-stats", Finternal_stack_stats, Sinternal_stack_stats, + 0, 0, 0, + doc: /* internal */) + (void) +{ + struct bc_thread_state *bc = ¤t_thread->bc; + int nframes = 0; + int nruns = 0; + for (Lisp_Object *fp = bc->fp; fp; fp = sf_get_lisp_ptr (fp, SFI_SAVED_FP)) + { + nframes++; + if (sf_get_lisp_ptr (fp, SFI_SAVED_TOP) == NULL) + nruns++; + } + fprintf (stderr, "%d stack frames, %d runs\n", nframes, nruns); + return Qnil; +} + +/* Whether a stack pointer is valid in the current frame. */ +INLINE bool +valid_sp (struct bc_thread_state *bc, Lisp_Object *sp) +{ + Lisp_Object *fp = bc->fp; + return sp < fp && sp + 1 >= sf_get_lisp_ptr (fp, SFI_SAVED_FP) + SF_SIZE; +} + /* Execute the byte-code in FUN. ARGS_TEMPLATE is the function arity encoded as an integer (the one in FUN is ignored), and ARGS, of size NARGS, should be a vector of the actual arguments. The @@ -347,37 +507,49 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, #ifdef BYTE_CODE_METER int volatile this_op = 0; #endif + unsigned char quitcounter = 1; + struct bc_thread_state *bc = ¤t_thread->bc; + + /* Values used for the first stack record when called from C. */ + Lisp_Object *top = NULL; + unsigned char const *pc = NULL; Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); + setup_frame: ; eassert (!STRING_MULTIBYTE (bytestr)); eassert (string_immovable_p (bytestr)); + /* FIXME: in debug mode (!NDEBUG, BYTE_CODE_SAFE or enabled checking), + save the specpdl index on function entry and check that it is the same + when returning, to detect unwind imbalances. This would require adding + a field to the frame header. */ + Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); Lisp_Object maxdepth = AREF (fun, COMPILED_STACK_DEPTH); ptrdiff_t const_length = ASIZE (vector); ptrdiff_t bytestr_length = SCHARS (bytestr); Lisp_Object *vectorp = XVECTOR (vector)->contents; - unsigned char quitcounter = 1; - /* Allocate two more slots than required, because... */ - EMACS_INT stack_items = XFIXNAT (maxdepth) + 2; - USE_SAFE_ALLOCA; - void *alloc; - SAFE_ALLOCA_LISP (alloc, stack_items); - Lisp_Object *stack_base = alloc; - /* ... we plonk BYTESTR and VECTOR there to ensure that they survive - GC (bug#33014), since these variables aren't used directly beyond - the interpreter prologue and wouldn't be found in the stack frame - otherwise. */ - stack_base[0] = bytestr; - stack_base[1] = vector; - Lisp_Object *top = stack_base + 1; - Lisp_Object *stack_lim = top + stack_items; + EMACS_INT max_stack = XFIXNAT (maxdepth); + Lisp_Object *frame_base = bc->fp + SF_SIZE; + Lisp_Object *fp = frame_base + max_stack; + + if (fp + SF_SIZE > bc->stack_end) + error ("Bytecode stack overflow"); + + /* Save the function object so that the bytecode and vector are + held from removal by the GC. */ + fp[SFI_FUN] = fun; + /* Save previous stack pointer and pc in the new frame. If we came + directly from outside, these will be NULL. */ + sf_set_lisp_ptr (fp, SFI_SAVED_TOP, top); + sf_set_saved_pc (fp, pc); + sf_set_lisp_ptr (fp, SFI_SAVED_FP, bc->fp); + bc->fp = fp; + + top = frame_base - 1; unsigned char const *bytestr_data = SDATA (bytestr); - unsigned char const *pc = bytestr_data; -#if BYTE_CODE_SAFE || !defined NDEBUG - specpdl_ref count = SPECPDL_INDEX (); -#endif + pc = bytestr_data; /* ARGS_TEMPLATE is composed of bit fields: bits 0..6 minimum number of arguments @@ -404,7 +576,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, int op; enum handlertype type; - if (BYTE_CODE_SAFE && ! (stack_base <= top && top < stack_lim)) + if (BYTE_CODE_SAFE && !valid_sp (bc, top)) emacs_abort (); #ifdef BYTE_CODE_METER @@ -636,36 +808,45 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, error ("Lisp nesting exceeds `max-lisp-eval-depth'"); } - ptrdiff_t numargs = op; - Lisp_Object fun = TOP; - Lisp_Object *args = &TOP + 1; + ptrdiff_t call_nargs = op; + Lisp_Object call_fun = TOP; + Lisp_Object *call_args = &TOP + 1; - specpdl_ref count1 = record_in_backtrace (fun, args, numargs); + specpdl_ref count1 = record_in_backtrace (call_fun, + call_args, call_nargs); maybe_gc (); if (debug_on_next_call) do_debug_on_call (Qlambda, count1); - Lisp_Object original_fun = fun; - if (SYMBOLP (fun)) - fun = XSYMBOL (fun)->u.s.function; + Lisp_Object original_fun = call_fun; + if (SYMBOLP (call_fun)) + call_fun = XSYMBOL (call_fun)->u.s.function; Lisp_Object template; Lisp_Object bytecode; - Lisp_Object val; - if (COMPILEDP (fun) + if (COMPILEDP (call_fun) // Lexical binding only. - && (template = AREF (fun, COMPILED_ARGLIST), + && (template = AREF (call_fun, COMPILED_ARGLIST), FIXNUMP (template)) // No autoloads. - && (bytecode = AREF (fun, COMPILED_BYTECODE), + && (bytecode = AREF (call_fun, COMPILED_BYTECODE), !CONSP (bytecode))) - val = exec_byte_code (fun, XFIXNUM (template), numargs, args); - else if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun)) - val = funcall_subr (XSUBR (fun), numargs, args); + { + fun = call_fun; + bytestr = bytecode; + args_template = XFIXNUM (template); + nargs = call_nargs; + args = call_args; + goto setup_frame; + } + + Lisp_Object val; + if (SUBRP (call_fun) && !SUBR_NATIVE_COMPILED_DYNP (call_fun)) + val = funcall_subr (XSUBR (call_fun), call_nargs, call_args); else - val = funcall_general (original_fun, numargs, args); + val = funcall_general (original_fun, call_nargs, call_args); lisp_eval_depth--; - if (backtrace_debug_on_exit (specpdl_ref_to_ptr (count1))) + if (backtrace_debug_on_exit (specpdl_ptr - 1)) val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; @@ -731,7 +912,40 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, NEXT; CASE (Breturn): - goto exit; + { + Lisp_Object *saved_top = sf_get_lisp_ptr (bc->fp, SFI_SAVED_TOP); + if (saved_top) + { + Lisp_Object val = TOP; + + lisp_eval_depth--; + if (backtrace_debug_on_exit (specpdl_ptr - 1)) + val = call_debugger (list2 (Qexit, val)); + specpdl_ptr--; + + top = saved_top; + pc = sf_get_saved_pc (bc->fp); + Lisp_Object *fp = sf_get_lisp_ptr (bc->fp, SFI_SAVED_FP); + bc->fp = fp; + + Lisp_Object fun = fp[SFI_FUN]; + Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); + Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); + bytestr_data = SDATA (bytestr); + vectorp = XVECTOR (vector)->contents; + if (BYTE_CODE_SAFE) + { + /* Only required for checking, not for execution. */ + const_length = ASIZE (vector); + bytestr_length = SCHARS (bytestr); + } + + TOP = val; + NEXT; + } + else + goto exit; + } CASE (Bdiscard): DISCARD (1); @@ -786,9 +1000,23 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, if (sys_setjmp (c->jmp)) { struct handler *c = handlerlist; + handlerlist = c->next; top = c->bytecode_top; op = c->bytecode_dest; - handlerlist = c->next; + Lisp_Object *fp = bc->fp; + + Lisp_Object fun = fp[SFI_FUN]; + Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); + Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); + bytestr_data = SDATA (bytestr); + vectorp = XVECTOR (vector)->contents; + if (BYTE_CODE_SAFE) + { + /* Only required for checking, not for execution. */ + const_length = ASIZE (vector); + bytestr_length = SCHARS (bytestr); + } + pc = bytestr_data; PUSH (c->val); goto op_branch; } @@ -1527,20 +1755,9 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, exit: -#if BYTE_CODE_SAFE || !defined NDEBUG - if (!specpdl_ref_eq (SPECPDL_INDEX (), count)) - { - /* Binds and unbinds are supposed to be compiled balanced. */ - if (specpdl_ref_lt (count, SPECPDL_INDEX ())) - unbind_to (count, Qnil); - error ("binding stack not balanced (serious byte compiler bug)"); - } -#endif - /* The byte code should have been properly pinned. */ - eassert (SDATA (bytestr) == bytestr_data); + bc->fp = sf_get_lisp_ptr (bc->fp, SFI_SAVED_FP); Lisp_Object result = TOP; - SAFE_FREE (); return result; } @@ -1562,6 +1779,7 @@ void syms_of_bytecode (void) { defsubr (&Sbyte_code); + defsubr (&Sinternal_stack_stats); #ifdef BYTE_CODE_METER -- cgit v1.2.1 From edb8481ce15404d9157e104958aef22b05b606a7 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 13 Mar 2022 19:35:50 +0100 Subject: * src/bytecode.c (sf_set_ptr): Cast pointer to type of right size. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 9356ebeb6cb..b26146c27f3 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -393,7 +393,7 @@ sf_get_ptr (Lisp_Object *fp, enum stack_frame_index index) INLINE void sf_set_ptr (Lisp_Object *fp, enum stack_frame_index index, void *value) { - fp[index] = XIL ((EMACS_INT)value); + fp[index] = XIL ((uintptr_t)value); } INLINE Lisp_Object * -- cgit v1.2.1 From 485a8fcbf4974466022798c0159e954af9482cf1 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 13 Mar 2022 18:03:11 -0700 Subject: * src/bytecode.c: Include sysstdio.h, for fprint, stderr. ; Ref https://hydra.nixos.org/build/169207408 --- src/bytecode.c | 1 + 1 file changed, 1 insertion(+) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index b26146c27f3..8704e6069dd 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -21,6 +21,7 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "blockinput.h" +#include "sysstdio.h" #include "character.h" #include "buffer.h" #include "keyboard.h" -- cgit v1.2.1 From 0d0703e9c4fb5ebcd4a87e5ebe78e5f53496621e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 14 Mar 2022 08:55:46 -0700 Subject: Prefer CALLN * src/bytecode.c (Fbyte_code): * src/composite.c (Fclear_composition_cache): Prefer CALLN to doing it by hand. * src/fns.c (ccall2): Remove. All uses replaced by CALLN. --- src/bytecode.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 8704e6069dd..65c3ad4da70 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -325,8 +325,8 @@ If the third argument is incorrect, Emacs may crash. */) the original unibyte form. */ bytestr = Fstring_as_unibyte (bytestr); } - Lisp_Object args[] = {0, bytestr, vector, maxdepth}; - return exec_byte_code (Fmake_byte_code (4, args), 0, 0, NULL); + Lisp_Object fun = CALLN (Fmake_byte_code, 0, bytestr, vector, maxdepth); + return exec_byte_code (fun, 0, 0, NULL); } static void -- cgit v1.2.1 From 751c8f88c4faddb2b4f5d5ba3f051e8cd2c0153c Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 14 Mar 2022 12:57:29 +0100 Subject: Put bytecode stack frame metadata in a struct Using a plain C struct instead of type-punning Lisp_Object stack slots makes the bytecode interpreter code more type-safe and potentially faster (from better alias analysis), and the special-purpose accessors are no longer needed. It also reduces the stack requirements when using 64-bit Lisp_Object on 32-bit platforms. * src/bytecode.c (enum stack_frame_index) (sf_get_ptr, sf_set_ptr, sf_get_lisp_ptr, sf_set_lisp_ptr, sf_get_saved_pc, sf_set_saved_pc): Remove. (BC_STACK_SIZE): Now in bytes, not Lisp words. (struct bc_frame): New. (init_bc_thread, mark_bytecode, Finternal_stack_stats, valid_sp) (exec_byte_code): * src/lisp.h (struct handler, get_act_rec, set_act_rec): Adapt to new struct bc_frame. --- src/bytecode.c | 112 ++++++++++++++++++++------------------------------------- 1 file changed, 38 insertions(+), 74 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 65c3ad4da70..ed1f6ca4a85 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -335,20 +335,7 @@ bcall0 (Lisp_Object f) Ffuncall (1, &f); } -/* Layout of the stack frame header. */ -enum stack_frame_index { - SFI_SAVED_FP, /* previous frame pointer */ - - /* In a frame called directly from C, the following two members are NULL. */ - SFI_SAVED_TOP, /* previous stack pointer */ - SFI_SAVED_PC, /* previous program counter */ - - SFI_FUN, /* current function object */ - - SF_SIZE /* number of words in the header */ -}; - -/* The bytecode stack size in Lisp words. +/* The bytecode stack size in bytes. This is a fairly generous amount, but: - if users need more, we could allocate more, or just reserve the address space and allocate on demand @@ -357,7 +344,7 @@ enum stack_frame_index { - for maximum flexibility but a small runtime penalty, we could allocate the stack in smaller chunks as needed */ -#define BC_STACK_SIZE (512 * 1024) +#define BC_STACK_SIZE (512 * 1024 * sizeof (Lisp_Object)) /* Bytecode interpreter stack: @@ -385,51 +372,28 @@ enum stack_frame_index { : : */ -INLINE void * -sf_get_ptr (Lisp_Object *fp, enum stack_frame_index index) -{ - return XLP (fp[index]); -} - -INLINE void -sf_set_ptr (Lisp_Object *fp, enum stack_frame_index index, void *value) -{ - fp[index] = XIL ((uintptr_t)value); -} - -INLINE Lisp_Object * -sf_get_lisp_ptr (Lisp_Object *fp, enum stack_frame_index index) -{ - return sf_get_ptr (fp, index); -} +/* bytecode stack frame header (footer, actually) */ +struct bc_frame { + struct bc_frame *saved_fp; /* previous frame pointer, + NULL if bottommost frame */ -INLINE void -sf_set_lisp_ptr (Lisp_Object *fp, enum stack_frame_index index, - Lisp_Object *value) -{ - sf_set_ptr (fp, index, value); -} + /* In a frame called directly from C, the following two members are NULL. */ + Lisp_Object *saved_top; /* previous stack pointer */ + const unsigned char *saved_pc; /* previous program counter */ -INLINE const unsigned char * -sf_get_saved_pc (Lisp_Object *fp) -{ - return sf_get_ptr (fp, SFI_SAVED_PC); -} + Lisp_Object fun; /* current function object */ -INLINE void -sf_set_saved_pc (Lisp_Object *fp, const unsigned char *value) -{ - sf_set_ptr (fp, SFI_SAVED_PC, (unsigned char *)value); -} + Lisp_Object next_stack[]; /* data stack of next frame */ +}; void init_bc_thread (struct bc_thread_state *bc) { - bc->stack = xmalloc (BC_STACK_SIZE * sizeof *bc->stack); + bc->stack = xmalloc (BC_STACK_SIZE); bc->stack_end = bc->stack + BC_STACK_SIZE; /* Put a dummy header at the bottom to indicate the first free location. */ - bc->fp = bc->stack; - memset (bc->fp, 0, SF_SIZE * sizeof *bc->stack); + bc->fp = (struct bc_frame *)bc->stack; + memset (bc->fp, 0, sizeof *bc->fp); } void @@ -441,16 +405,16 @@ free_bc_thread (struct bc_thread_state *bc) void mark_bytecode (struct bc_thread_state *bc) { - Lisp_Object *fp = bc->fp; + struct bc_frame *fp = bc->fp; Lisp_Object *top = NULL; /* stack pointer of topmost frame not known */ for (;;) { - Lisp_Object *next_fp = sf_get_lisp_ptr (fp, SFI_SAVED_FP); + struct bc_frame *next_fp = fp->saved_fp; /* Only the dummy frame at the bottom has saved_fp = NULL. */ if (!next_fp) break; - mark_object (fp[SFI_FUN]); - Lisp_Object *frame_base = next_fp + SF_SIZE; + mark_object (fp->fun); + Lisp_Object *frame_base = next_fp->next_stack; if (top) { /* The stack pointer of a frame is known: mark the part of the stack @@ -464,7 +428,7 @@ mark_bytecode (struct bc_thread_state *bc) /* The stack pointer is unknown -- mark everything conservatively. */ mark_memory (frame_base, fp); } - top = sf_get_lisp_ptr (fp, SFI_SAVED_TOP); + top = fp->saved_top; fp = next_fp; } } @@ -477,10 +441,10 @@ DEFUN ("internal-stack-stats", Finternal_stack_stats, Sinternal_stack_stats, struct bc_thread_state *bc = ¤t_thread->bc; int nframes = 0; int nruns = 0; - for (Lisp_Object *fp = bc->fp; fp; fp = sf_get_lisp_ptr (fp, SFI_SAVED_FP)) + for (struct bc_frame *fp = bc->fp; fp; fp = fp->saved_fp) { nframes++; - if (sf_get_lisp_ptr (fp, SFI_SAVED_TOP) == NULL) + if (fp->saved_top == NULL) nruns++; } fprintf (stderr, "%d stack frames, %d runs\n", nframes, nruns); @@ -491,8 +455,8 @@ DEFUN ("internal-stack-stats", Finternal_stack_stats, Sinternal_stack_stats, INLINE bool valid_sp (struct bc_thread_state *bc, Lisp_Object *sp) { - Lisp_Object *fp = bc->fp; - return sp < fp && sp + 1 >= sf_get_lisp_ptr (fp, SFI_SAVED_FP) + SF_SIZE; + struct bc_frame *fp = bc->fp; + return sp < (Lisp_Object *)fp && sp + 1 >= fp->saved_fp->next_stack; } /* Execute the byte-code in FUN. ARGS_TEMPLATE is the function arity @@ -532,20 +496,20 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, Lisp_Object *vectorp = XVECTOR (vector)->contents; EMACS_INT max_stack = XFIXNAT (maxdepth); - Lisp_Object *frame_base = bc->fp + SF_SIZE; - Lisp_Object *fp = frame_base + max_stack; + Lisp_Object *frame_base = bc->fp->next_stack; + struct bc_frame *fp = (struct bc_frame *)(frame_base + max_stack); - if (fp + SF_SIZE > bc->stack_end) + if ((char *)fp->next_stack > bc->stack_end) error ("Bytecode stack overflow"); /* Save the function object so that the bytecode and vector are held from removal by the GC. */ - fp[SFI_FUN] = fun; + fp->fun = fun; /* Save previous stack pointer and pc in the new frame. If we came directly from outside, these will be NULL. */ - sf_set_lisp_ptr (fp, SFI_SAVED_TOP, top); - sf_set_saved_pc (fp, pc); - sf_set_lisp_ptr (fp, SFI_SAVED_FP, bc->fp); + fp->saved_top = top; + fp->saved_pc = pc; + fp->saved_fp = bc->fp; bc->fp = fp; top = frame_base - 1; @@ -914,7 +878,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, CASE (Breturn): { - Lisp_Object *saved_top = sf_get_lisp_ptr (bc->fp, SFI_SAVED_TOP); + Lisp_Object *saved_top = bc->fp->saved_top; if (saved_top) { Lisp_Object val = TOP; @@ -925,11 +889,11 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, specpdl_ptr--; top = saved_top; - pc = sf_get_saved_pc (bc->fp); - Lisp_Object *fp = sf_get_lisp_ptr (bc->fp, SFI_SAVED_FP); + pc = bc->fp->saved_pc; + struct bc_frame *fp = bc->fp->saved_fp; bc->fp = fp; - Lisp_Object fun = fp[SFI_FUN]; + Lisp_Object fun = fp->fun; Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); bytestr_data = SDATA (bytestr); @@ -1004,9 +968,9 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, handlerlist = c->next; top = c->bytecode_top; op = c->bytecode_dest; - Lisp_Object *fp = bc->fp; + struct bc_frame *fp = bc->fp; - Lisp_Object fun = fp[SFI_FUN]; + Lisp_Object fun = fp->fun; Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE); Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS); bytestr_data = SDATA (bytestr); @@ -1756,7 +1720,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, exit: - bc->fp = sf_get_lisp_ptr (bc->fp, SFI_SAVED_FP); + bc->fp = bc->fp->saved_fp; Lisp_Object result = TOP; return result; -- cgit v1.2.1 From c11b4758b7bd971fcbb824638a06f52c7768d268 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 19 Mar 2022 12:35:04 -0700 Subject: valid_sp inline fix * src/bytecode.c (valid_sp): static, not INLINE, as INLINE should be used only in headers and between INLINE_HEADER_BEGIN and INLINE_HEADER_END. No need for ‘inline’ here. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index ed1f6ca4a85..62464986160 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -452,7 +452,7 @@ DEFUN ("internal-stack-stats", Finternal_stack_stats, Sinternal_stack_stats, } /* Whether a stack pointer is valid in the current frame. */ -INLINE bool +static bool valid_sp (struct bc_thread_state *bc, Lisp_Object *sp) { struct bc_frame *fp = bc->fp; -- cgit v1.2.1 From 71005decb4fb447635d7b2367104dd18bdfa64ac Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 19 Apr 2022 08:25:19 -0400 Subject: Fix GCC warnings when CHECK_LISP_OBJECT_TYPE * src/lisp.h (lisp_h_Qni): New macro. (DEFUN): Use it. * src/alloc.c (syms_of_alloc): Use it. * src/bytecode.c (Fbyte_code): Fix Lisp_Object/int mixup. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 62464986160..74b7d16affd 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -325,7 +325,7 @@ If the third argument is incorrect, Emacs may crash. */) the original unibyte form. */ bytestr = Fstring_as_unibyte (bytestr); } - Lisp_Object fun = CALLN (Fmake_byte_code, 0, bytestr, vector, maxdepth); + Lisp_Object fun = CALLN (Fmake_byte_code, Qnil, bytestr, vector, maxdepth); return exec_byte_code (fun, 0, 0, NULL); } -- cgit v1.2.1 From 0e5623b491cb4158d8055b9c2ee7963fee8c75de Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 12 May 2022 09:32:10 +0200 Subject: ; * src/bytecode.c (exec_byte_code): Fix white space. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 74b7d16affd..a0bcbb48481 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1209,7 +1209,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, Lisp_Object v2 = POP; Lisp_Object v1 = TOP; if (FIXNUMP (v1) && FIXNUMP (v2)) - TOP = BASE_EQ(v1, v2) ? Qt : Qnil; + TOP = BASE_EQ (v1, v2) ? Qt : Qnil; else TOP = arithcompare (v1, v2, ARITH_EQUAL); NEXT; -- cgit v1.2.1 From bab1d412801eead715f1465131aa3734558f35ab Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 12 Jun 2022 12:05:03 +0200 Subject: Use BASE_EQ when comparing with Qunbound Qunbound is uninterned and can therefore never be EQ to any symbol with position. * src/buffer.c (Fbuffer_local_value, buffer_lisp_local_variables) (buffer_local_variables_1): * src/bytecode.c (exec_byte_code): * src/comp.c (compile_function, Fcomp__compile_ctxt_to_file): * src/composite.c (composition_gstring_cache_clear_font): * src/data.c (Fboundp, Fsymbol_value, set_internal) (Fdefault_boundp, Fdefault_value, Fmake_variable_buffer_local): * src/emacs-module.c (module_global_reference_p): * src/eval.c (Fdefault_toplevel_value, defvar) (run_hook_with_args): * src/fns.c (hash_put, Fmaphash): * src/font.c (font_put_extra): * src/frame.c (gui_set_frame_parameters) (gui_frame_get_and_record_arg, gui_default_parameter) (gui_figure_window_size): * src/haikufns.c (get_geometry_from_preferences) (haiku_create_frame, haiku_create_tip_frame): * src/haikuterm.c (haiku_draw_text_decoration) (haiku_default_font_parameter): * src/json.c (lisp_to_json_nonscalar_1): * src/keymap.c (access_keymap_1, access_keymap, current_minor_maps): * src/lread.c (readevalloop, define_symbol): * src/minibuf.c (read_minibuf, Ftry_completion): (Fall_completions, Ftest_completion): * src/pgtkfns.c (pgtk_default_font_parameter, Fx_create_frame) (x_create_tip_frame): * src/pgtkselect.c (Fpgtk_own_selection_internal): * src/print.c (print): * src/profiler.c (evict_lower_half, record_backtrace): * src/terminal.c (create_terminal): * src/textprop.c (set_properties): * src/w32fns.c (my_create_window, w32_icon) (w32_default_font_parameter, Fx_create_frame) (w32_create_tip_frame): * src/w32term.c (w32_draw_glyph_string): * src/xdisp.c (handle_single_display_spec) (cursor_row_fully_visible_p, calc_pixel_width_or_height): * src/xfns.c (x_default_scroll_bar_color_parameter, x_icon_verify) (x_icon, x_default_font_parameter, Fx_create_frame) (x_create_tip_frame): * src/xselect.c (x_handle_selection_request): * src/xterm.c (x_draw_glyph_string, x_term_init): Use BASE_EQ instead of EQ when comparing with Qunbound. --- src/bytecode.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index a0bcbb48481..fa068e1ec6b 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -627,7 +627,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, Lisp_Object v1 = vectorp[op], v2; if (!SYMBOLP (v1) || XSYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL - || (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound))) + || (v2 = SYMBOL_VAL (XSYMBOL (v1)), BASE_EQ (v2, Qunbound))) v2 = Fsymbol_value (v1); PUSH (v2); NEXT; @@ -694,7 +694,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, /* Inline the most common case. */ if (SYMBOLP (sym) - && !EQ (val, Qunbound) + && !BASE_EQ (val, Qunbound) && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL && !SYMBOL_TRAPPED_WRITE_P (sym)) SET_SYMBOL_VAL (XSYMBOL (sym), val); -- cgit v1.2.1 From 253a4a2c689d757cb798cfb9f51b2110283d7146 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 24 Jun 2022 11:48:42 +0200 Subject: Bytecode opcode comments update This is a cosmetic change only; there is no change in behaviour. * lisp/emacs-lisp/bytecomp.el: * src/bytecode.c (BYTE_CODES, exec_byte_code): Update and/or remove incorrect, outdated or useless comments. Clarify. Reorder where appropriate. Rename Bsave_current_buffer to Bsave_current_buffer_OBSOLETE and Bsave_current_buffer_1 to Bsave_current_buffer, reflecting the state since 1996. --- src/bytecode.c | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index fa068e1ec6b..d75767bb0c5 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -176,8 +176,8 @@ DEFINE (Bmin, 0136) \ DEFINE (Bmult, 0137) \ \ DEFINE (Bpoint, 0140) \ -/* Was Bmark in v17. */ \ -DEFINE (Bsave_current_buffer, 0141) /* Obsolete. */ \ +/* 0141 was Bmark in v17, Bsave_current_buffer in 18-19. */ \ +DEFINE (Bsave_current_buffer_OBSOLETE, 0141) /* Obsolete since 20. */ \ DEFINE (Bgoto_char, 0142) \ DEFINE (Binsert, 0143) \ DEFINE (Bpoint_max, 0144) \ @@ -194,7 +194,7 @@ DEFINE (Bbolp, 0156) \ DEFINE (Bbobp, 0157) \ DEFINE (Bcurrent_buffer, 0160) \ DEFINE (Bset_buffer, 0161) \ -DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \ +DEFINE (Bsave_current_buffer, 0162) \ /* 0163 was Bset_mark in v17. */ \ DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1. */ \ \ @@ -924,8 +924,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, record_unwind_protect_excursion (); NEXT; - CASE (Bsave_current_buffer): /* Obsolete since ??. */ - CASE (Bsave_current_buffer_1): + CASE (Bsave_current_buffer_OBSOLETE): /* Obsolete since 20. */ + CASE (Bsave_current_buffer): record_unwind_current_buffer (); NEXT; @@ -1678,6 +1678,12 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, /* TODO: Perhaps introduce another byte-code for switch when the number of cases is less, which uses a simple vector for linear search as the jump table. */ + + /* TODO: Instead of pushing the table in a separate + Bconstant op, use an immediate argument (maybe separate + switch opcodes for 1-byte and 2-byte constant indices). + This would also get rid of some hacks that assume each + Bswitch to be preceded by a Bconstant. */ Lisp_Object jmp_table = POP; if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table)) emacs_abort (); -- cgit v1.2.1 From d3c4833d1350e26a2ae35e00eaf2d6bef1724679 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Thu, 28 Jul 2022 20:37:49 +0000 Subject: Add an optional 'lock' parameter to 'narrow-to-region' * src/editfns.c (Fnarrow_to_region): Add the parameter to the function, and handle it. Update docstring. (unwind_locked_begv, unwind_locked_zv): New functions. (Fwiden): Do nothing when restrictions are locked. Update docstring. (syms_of_editfns): Replace the 'inhibit-widen' symbol and variable with a 'restrictions-locked' symbol and variable. Update docstring. * src/xdisp.c (handle_fontified_prop): Use Fnarrow_to_region with the new parameter. (unwind_narrowed_zv): Remove function. * src/process.c (Finternal_default_process_filter): Add a third argument to Fnarrow_to_region. * src/lread.c (readevalloop): Add a third argument to Fnarrow_to_region. * src/bytecode.c (exec_byte_code): Add a third argument to Fnarrow_to_region. * etc/NEWS (like): Mention the new parameter of 'narrow-to-region'. * doc/lispref/positions.texi (Narrowing): Document it. --- src/bytecode.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index d75767bb0c5..241cbaf04f6 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1481,7 +1481,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, CASE (Bnarrow_to_region): { Lisp_Object v1 = POP; - TOP = Fnarrow_to_region (TOP, v1); + TOP = Fnarrow_to_region (TOP, v1, Qnil); NEXT; } -- cgit v1.2.1 From a5adcbdf28eb8ad376a1004f4a6c9eda1f1447fb Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Sat, 30 Jul 2022 12:02:28 +0000 Subject: Handle the optional argument of 'narrow-to-region' in byte-compiled code. * lisp/emacs-lisp/bytecomp.el: Adapt the specifications. * src/bytecode.c (exec_byte_code): Get the optional argument. --- src/bytecode.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 241cbaf04f6..2b1eccdc518 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1480,8 +1480,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, CASE (Bnarrow_to_region): { - Lisp_Object v1 = POP; - TOP = Fnarrow_to_region (TOP, v1, Qnil); + Lisp_Object v2 = POP, v1 = POP; + TOP = Fnarrow_to_region (TOP, v1, v2); NEXT; } -- cgit v1.2.1 From 9d8a6c82838f2f24e76a67379b02956aa668d7cf Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Mon, 1 Aug 2022 19:11:01 +0000 Subject: Fix the bytecode incompatibility due to the change to 'narrow-to-region'. * src/editfns.c (narrow_to_region_internal): New function, which contains the body previously in 'Fnarrow_to_region' but accepts a third argument. (Fnarrow_to_region): Use the new function. Update the docstring. (Fwiden): Update the docstring. * src/lisp.h: Prototype of the new function. * src/xdisp.c (handle_fontified_prop): Use the new function instead of 'Fnarrow_to_region'. * src/process.c (Finternal_default_process_filter): * src/lread.c (readevalloop): Remove the third argument to 'Fnarrow_to_region'. * src/bytecode.c (exec_byte_code): * lisp/emacs-lisp/comp.el (comp-limplify-lap-inst): * lisp/emacs-lisp/bytecomp.el: Restore the statu quo ante. * etc/NEWS: Remove the entry about the new optional argument. * doc/lispref/positions.texi (Narrowing): Update the documentation. --- src/bytecode.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index 2b1eccdc518..d75767bb0c5 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1480,8 +1480,8 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, CASE (Bnarrow_to_region): { - Lisp_Object v2 = POP, v1 = POP; - TOP = Fnarrow_to_region (TOP, v1, v2); + Lisp_Object v1 = POP; + TOP = Fnarrow_to_region (TOP, v1); NEXT; } -- cgit v1.2.1 From 5b3c4004a9647aa2068e54c358e202f57d0ece3c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Mon, 19 Sep 2022 10:01:52 +0800 Subject: Remove calls to intern with a static string from code that runs on X * Makefile.in (actual-all): Reword build failure advice. * src/bytecode.c (exec_byte_code, syms_of_bytecode): * src/font.c (syms_of_font): * src/hbfont.c (uni_combining): * src/xfns.c (Fx_display_backing_store, Fx_display_visual_class) (x_create_tip_frame, Fx_show_tip, syms_of_xfns): * src/xfont.c (xfont_supported_scripts, xfont_driver) (syms_of_xfont): * src/xsmfns.c (Fhandle_save_session, syms_of_xsmfns): Remove calls to intern with a static string. --- src/bytecode.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/bytecode.c') diff --git a/src/bytecode.c b/src/bytecode.c index d75767bb0c5..c765e1be2bc 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1431,7 +1431,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, NEXT; CASE (Binteractive_p): /* Obsolete since 24.1. */ - PUSH (call0 (intern ("interactive-p"))); + PUSH (call0 (Qinteractive_p)); NEXT; CASE (Bforward_char): @@ -1749,6 +1749,8 @@ get_byte_code_arity (Lisp_Object args_template) void syms_of_bytecode (void) { + DEFSYM (Qinteractive_p, "interactive-p"); + defsubr (&Sbyte_code); defsubr (&Sinternal_stack_stats); -- cgit v1.2.1