diff options
Diffstat (limited to 'src/bytecode.c')
| -rw-r--r-- | src/bytecode.c | 1007 |
1 files changed, 235 insertions, 772 deletions
diff --git a/src/bytecode.c b/src/bytecode.c index fa942fc4e1b..a64bc171d14 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -17,22 +17,6 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ -/* -hacked on by jwz@lucid.com 17-jun-91 - o added a compile-time switch to turn on simple sanity checking; - o put back the obsolete byte-codes for error-detection; - o added a new instruction, unbind_all, which I will use for - tail-recursion elimination; - o made temp_output_buffer_show be called with the right number - of args; - o made the new bytecodes be called with args in the right order; - o added metering support. - -by Hallvard: - o added relative jump instructions; - o all conditionals now only do QUIT if they jump. - */ - #include <config.h> #include "lisp.h" @@ -43,33 +27,35 @@ by Hallvard: #include "syntax.h" #include "window.h" -#ifdef CHECK_FRAME_FONT -#include "frame.h" -#include "xterm.h" +/* Work around GCC bug 54561. */ +#if GNUC_PREREQ (4, 3, 0) +# pragma GCC diagnostic ignored "-Wclobbered" +#endif + +/* Define BYTE_CODE_SAFE true to enable some minor sanity checking, + useful for debugging the byte compiler. It defaults to false. */ + +#ifndef BYTE_CODE_SAFE +# define BYTE_CODE_SAFE false #endif -/* - * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for - * debugging the byte compiler...) - * - * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. - */ -/* #define BYTE_CODE_SAFE */ +/* Define BYTE_CODE_METER to generate a byte-op usage histogram. */ /* #define BYTE_CODE_METER */ /* If BYTE_CODE_THREADED is defined, then the interpreter will be 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 BYTE_CODE_SAFE && !defined BYTE_CODE_METER) +#if (defined __GNUC__ && !defined __STRICT_ANSI__ && !defined __CHKP__ \ + && !BYTE_CODE_SAFE && !defined BYTE_CODE_METER) #define BYTE_CODE_THREADED #endif #ifdef BYTE_CODE_METER -#define METER_2(code1, code2) AREF (AREF (Vbyte_code_meter, code1), code2) +#define METER_2(code1, code2) \ + (*aref_addr (AREF (Vbyte_code_meter, code1), code2)) #define METER_1(code) METER_2 (0, code) #define METER_CODE(last_code, this_code) \ @@ -289,87 +275,25 @@ enum byte_code_op BYTE_CODES #undef DEFINE -#ifdef BYTE_CODE_SAFE +#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 }; - -/* Whether to maintain a `top' and `bottom' field in the stack frame. */ -#define BYTE_MAINTAIN_TOP BYTE_CODE_SAFE - -/* Structure describing a value stack used during byte-code execution - in Fbyte_code. */ - -struct byte_stack -{ - /* Program counter. This points into the byte_string below - and is relocated when that string is relocated. */ - const unsigned char *pc; - - /* Top and bottom of stack. The bottom points to an area of memory - allocated with alloca in Fbyte_code. */ -#if BYTE_MAINTAIN_TOP - Lisp_Object *top, *bottom; -#endif - - /* The string containing the byte-code, and its current address. - Storing this here protects it from GC because mark_byte_stack - marks it. */ - Lisp_Object byte_string; - const unsigned char *byte_string_start; - - /* Next entry in byte_stack_list. */ - struct byte_stack *next; -}; - -/* A list of currently active byte-code execution value stacks. - Fbyte_code adds an entry to the head of this list before it starts - processing byte-code, and it removes the entry again when it is - done. Signaling an error truncates the list. */ - -struct byte_stack *byte_stack_list; - - -/* Relocate program counters in the stacks on byte_stack_list. Called - when GC has completed. */ - -void -relocate_byte_stack (void) -{ - struct byte_stack *stack; - - for (stack = byte_stack_list; stack; stack = stack->next) - { - if (stack->byte_string_start != SDATA (stack->byte_string)) - { - ptrdiff_t offset = stack->pc - stack->byte_string_start; - stack->byte_string_start = SDATA (stack->byte_string); - stack->pc = stack->byte_string_start + offset; - } - } -} - /* Fetch the next byte from the bytecode stream. */ -#ifdef BYTE_CODE_SAFE -#define FETCH (eassert (stack.byte_string_start == SDATA (stack.byte_string)), *stack.pc++) -#else -#define FETCH *stack.pc++ -#endif +#define FETCH (*pc++) /* Fetch two bytes from the bytecode stream and make a 16-bit number out of them. */ #define FETCH2 (op = FETCH, op + (FETCH << 8)) -/* Push x onto the execution stack. This used to be #define PUSH(x) - (*++stackp = (x)) This oddity is necessary because Alliant can't be - bothered to compile the preincrement operator properly, as of 4/91. - -JimB */ +/* Push X onto the execution stack. The expression X should not + contain TOP, to avoid competing side effects. */ -#define PUSH(x) (top++, *top = (x)) +#define PUSH(x) (*++top = (x)) /* Pop a value off the execution stack. */ @@ -384,60 +308,6 @@ relocate_byte_stack (void) #define TOP (*top) -/* Actions that must be performed before and after calling a function - that might GC. */ - -#if !BYTE_MAINTAIN_TOP -#define BEFORE_POTENTIAL_GC() ((void)0) -#define AFTER_POTENTIAL_GC() ((void)0) -#else -#define BEFORE_POTENTIAL_GC() stack.top = top -#define AFTER_POTENTIAL_GC() stack.top = NULL -#endif - -/* Garbage collect if we have consed enough since the last time. - We do this at every branch, to avoid loops that never GC. */ - -#define MAYBE_GC() \ - do { \ - BEFORE_POTENTIAL_GC (); \ - maybe_gc (); \ - AFTER_POTENTIAL_GC (); \ - } while (0) - -/* Check for jumping out of range. */ - -#ifdef BYTE_CODE_SAFE - -#define CHECK_RANGE(ARG) \ - if (ARG >= bytestr_length) emacs_abort () - -#else /* not BYTE_CODE_SAFE */ - -#define CHECK_RANGE(ARG) - -#endif /* not BYTE_CODE_SAFE */ - -/* A version of the QUIT macro which makes sure that the stack top is - set before signaling `quit'. */ - -#define BYTE_CODE_QUIT \ - do { \ - if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \ - { \ - Lisp_Object flag = Vquit_flag; \ - Vquit_flag = Qnil; \ - BEFORE_POTENTIAL_GC (); \ - if (EQ (Vthrow_on_input, flag)) \ - Fthrow (Vthrow_on_input, Qt); \ - Fsignal (Qquit, Qnil); \ - AFTER_POTENTIAL_GC (); \ - } \ - else if (pending_signals) \ - process_pending_signals (); \ - } while (0) - - DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, doc: /* Function used internally in byte-compiled code. The first argument, BYTESTR, is a string of byte code; @@ -467,41 +337,15 @@ 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 count = SPECPDL_INDEX (); #ifdef BYTE_CODE_METER int volatile this_op = 0; - int prev_op; -#endif - int op; - /* Lisp_Object v1, v2; */ - Lisp_Object *vectorp; -#ifdef BYTE_CODE_SAFE - ptrdiff_t const_length; - Lisp_Object *stacke; - ptrdiff_t bytestr_length; -#endif - struct byte_stack stack; - Lisp_Object *top; - Lisp_Object result; - enum handlertype type; - -#if 0 /* CHECK_FRAME_FONT */ - { - struct frame *f = SELECTED_FRAME (); - if (FRAME_X_P (f) - && FRAME_FONT (f)->direction != 0 - && FRAME_FONT (f)->direction != 1) - emacs_abort (); - } #endif CHECK_STRING (bytestr); CHECK_VECTOR (vector); CHECK_NATNUM (maxdepth); -#ifdef BYTE_CODE_SAFE - const_length = ASIZE (vector); -#endif + ptrdiff_t const_length = ASIZE (vector); if (STRING_MULTIBYTE (bytestr)) /* BYTESTR must have been produced by Emacs 20.2 or the earlier @@ -511,90 +355,59 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, convert them back to the originally intended unibyte form. */ bytestr = Fstring_as_unibyte (bytestr); -#ifdef BYTE_CODE_SAFE - bytestr_length = SBYTES (bytestr); -#endif - vectorp = XVECTOR (vector)->contents; - - stack.byte_string = bytestr; - stack.pc = stack.byte_string_start = SDATA (bytestr); - if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth)) - memory_full (SIZE_MAX); - top = alloca ((XFASTINT (maxdepth) + 1) * sizeof *top); -#if BYTE_MAINTAIN_TOP - stack.bottom = top + 1; - stack.top = NULL; -#endif - stack.next = byte_stack_list; - byte_stack_list = &stack; - -#ifdef BYTE_CODE_SAFE - stacke = stack.bottom - 1 + XFASTINT (maxdepth); -#endif + ptrdiff_t bytestr_length = SBYTES (bytestr); + Lisp_Object *vectorp = XVECTOR (vector)->contents; + + 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; + 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; + unsigned char const *pc = bytestr_data; + ptrdiff_t count = SPECPDL_INDEX (); - if (INTEGERP (args_template)) + if (!NILP (args_template)) { + eassert (INTEGERP (args_template)); ptrdiff_t at = XINT (args_template); bool rest = (at & 128) != 0; int mandatory = at & 127; ptrdiff_t nonrest = at >> 8; - eassert (mandatory <= nonrest); - if (nargs <= nonrest) - { - ptrdiff_t i; - for (i = 0 ; i < nargs; i++, args++) - PUSH (*args); - if (nargs < mandatory) - /* Too few arguments. */ - Fsignal (Qwrong_number_of_arguments, - list2 (Fcons (make_number (mandatory), - rest ? Qand_rest : make_number (nonrest)), - make_number (nargs))); - else - { - for (; i < nonrest; i++) - PUSH (Qnil); - if (rest) - PUSH (Qnil); - } - } - else if (rest) - { - ptrdiff_t i; - for (i = 0 ; i < nonrest; i++, args++) - PUSH (*args); - PUSH (Flist (nargs - nonrest, args)); - } - else - /* Too many arguments. */ + 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))); - } - else if (! NILP (args_template)) - /* We should push some arguments on the stack. */ - { - error ("Unknown args template!"); + 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 (1) + while (true) { -#ifdef BYTE_CODE_SAFE - if (top > stacke) - emacs_abort (); - else if (top < stack.bottom - 1) + int op; + enum handlertype type; + + if (BYTE_CODE_SAFE && ! (stack_base <= top && top < stack_lim)) emacs_abort (); -#endif #ifdef BYTE_CODE_METER - prev_op = this_op; + int prev_op = this_op; this_op = op = FETCH; METER_CODE (prev_op, op); -#else -#ifndef BYTE_CODE_THREADED +#elif !defined BYTE_CODE_THREADED op = FETCH; #endif -#endif /* The interpreter can be compiled one of two ways: as an ordinary switch-based interpreter, or as a threaded @@ -637,7 +450,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, the table clearer. */ #define LABEL(OP) [OP] = &&insn_ ## OP -#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) +#if GNUC_PREREQ (4, 6, 0) # pragma GCC diagnostic push # pragma GCC diagnostic ignored "-Woverride-init" #elif defined __clang__ @@ -656,7 +469,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, #undef DEFINE }; -#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) || defined __clang__ +#if GNUC_PREREQ (4, 6, 0) || defined __clang__ # pragma GCC diagnostic pop #endif @@ -675,7 +488,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bvarref3): CASE (Bvarref4): CASE (Bvarref5): - op = op - Bvarref; + op -= Bvarref; goto varref; /* This seems to be the most frequently executed byte-code @@ -684,92 +497,51 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, op = FETCH; varref: { - Lisp_Object v1, v2; - - v1 = vectorp[op]; - if (SYMBOLP (v1)) - { - if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL - || (v2 = SYMBOL_VAL (XSYMBOL (v1)), - EQ (v2, Qunbound))) - { - BEFORE_POTENTIAL_GC (); - v2 = Fsymbol_value (v1); - AFTER_POTENTIAL_GC (); - } - } - else - { - BEFORE_POTENTIAL_GC (); - v2 = Fsymbol_value (v1); - AFTER_POTENTIAL_GC (); - } + Lisp_Object v1 = vectorp[op], v2; + if (!SYMBOLP (v1) + || XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL + || (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound))) + v2 = Fsymbol_value (v1); PUSH (v2); NEXT; } CASE (Bgotoifnil): { - Lisp_Object v1; - MAYBE_GC (); + Lisp_Object v1 = POP; op = FETCH2; - v1 = POP; if (NILP (v1)) - { - BYTE_CODE_QUIT; - CHECK_RANGE (op); - stack.pc = stack.byte_string_start + op; - } + goto op_branch; NEXT; } CASE (Bcar): - { - Lisp_Object v1; - v1 = TOP; - if (CONSP (v1)) - TOP = XCAR (v1); - else if (NILP (v1)) - TOP = Qnil; - else - { - BEFORE_POTENTIAL_GC (); - wrong_type_argument (Qlistp, v1); - } - NEXT; - } + if (CONSP (TOP)) + TOP = XCAR (TOP); + else if (!NILP (TOP)) + wrong_type_argument (Qlistp, TOP); + NEXT; CASE (Beq): { - Lisp_Object v1; - v1 = POP; + Lisp_Object v1 = POP; TOP = EQ (v1, TOP) ? Qt : Qnil; NEXT; } CASE (Bmemq): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fmemq (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bcdr): { - Lisp_Object v1; - v1 = TOP; - if (CONSP (v1)) - TOP = XCDR (v1); - else if (NILP (v1)) - TOP = Qnil; - else - { - BEFORE_POTENTIAL_GC (); - wrong_type_argument (Qlistp, v1); - } + if (CONSP (TOP)) + TOP = XCDR (TOP); + else if (!NILP (TOP)) + wrong_type_argument (Qlistp, TOP); NEXT; } @@ -790,31 +562,23 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, op = FETCH; varset: { - Lisp_Object sym, val; - - sym = vectorp[op]; - val = TOP; + Lisp_Object sym = vectorp[op]; + Lisp_Object val = POP; /* Inline the most common case. */ if (SYMBOLP (sym) && !EQ (val, Qunbound) && !XSYMBOL (sym)->redirect - && !SYMBOL_CONSTANT_P (sym)) + && !SYMBOL_TRAPPED_WRITE_P (sym)) SET_SYMBOL_VAL (XSYMBOL (sym), val); else - { - BEFORE_POTENTIAL_GC (); - set_internal (sym, val, Qnil, 0); - AFTER_POTENTIAL_GC (); - } + set_internal (sym, val, Qnil, SET_INTERNAL_SET); } - (void) POP; NEXT; CASE (Bdup): { - Lisp_Object v1; - v1 = TOP; + Lisp_Object v1 = TOP; PUSH (v1); NEXT; } @@ -838,9 +602,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, op -= Bvarbind; varbind: /* Specbind can signal and thus GC. */ - BEFORE_POTENTIAL_GC (); specbind (vectorp[op], POP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bcall6): @@ -860,15 +622,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, op -= Bcall; docall: { - BEFORE_POTENTIAL_GC (); DISCARD (op); #ifdef BYTE_CODE_METER if (byte_metering_on && SYMBOLP (TOP)) { - Lisp_Object v1, v2; - - v1 = TOP; - v2 = Fget (v1, Qbyte_code_meter); + Lisp_Object v1 = TOP; + Lisp_Object v2 = Fget (v1, Qbyte_code_meter); if (INTEGERP (v2) && XINT (v2) < MOST_POSITIVE_FIXNUM) { @@ -878,7 +637,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } #endif TOP = Ffuncall (op + 1, &TOP); - AFTER_POTENTIAL_GC (); NEXT; } @@ -898,124 +656,85 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bunbind5): op -= Bunbind; dounbind: - BEFORE_POTENTIAL_GC (); unbind_to (SPECPDL_INDEX () - op, Qnil); - AFTER_POTENTIAL_GC (); 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. */ - BEFORE_POTENTIAL_GC (); unbind_to (count, Qnil); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bgoto): - MAYBE_GC (); - BYTE_CODE_QUIT; - op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */ - CHECK_RANGE (op); - stack.pc = stack.byte_string_start + op; + 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)) + emacs_abort (); + quitcounter += op < 0; + if (!quitcounter) + { + quitcounter = 1; + maybe_gc (); + QUIT; + } + pc += op; NEXT; CASE (Bgotoifnonnil): - { - Lisp_Object v1; - MAYBE_GC (); - op = FETCH2; - v1 = POP; - if (!NILP (v1)) - { - BYTE_CODE_QUIT; - CHECK_RANGE (op); - stack.pc = stack.byte_string_start + op; - } - NEXT; - } + op = FETCH2; + if (!NILP (POP)) + goto op_branch; + NEXT; CASE (Bgotoifnilelsepop): - MAYBE_GC (); op = FETCH2; if (NILP (TOP)) - { - BYTE_CODE_QUIT; - CHECK_RANGE (op); - stack.pc = stack.byte_string_start + op; - } - else DISCARD (1); + goto op_branch; + DISCARD (1); NEXT; CASE (Bgotoifnonnilelsepop): - MAYBE_GC (); op = FETCH2; if (!NILP (TOP)) - { - BYTE_CODE_QUIT; - CHECK_RANGE (op); - stack.pc = stack.byte_string_start + op; - } - else DISCARD (1); + goto op_branch; + DISCARD (1); NEXT; CASE (BRgoto): - MAYBE_GC (); - BYTE_CODE_QUIT; - stack.pc += (int) *stack.pc - 127; - NEXT; + op = FETCH - 128; + goto op_relative_branch; CASE (BRgotoifnil): - { - Lisp_Object v1; - MAYBE_GC (); - v1 = POP; - if (NILP (v1)) - { - BYTE_CODE_QUIT; - stack.pc += (int) *stack.pc - 128; - } - stack.pc++; - NEXT; - } + op = FETCH - 128; + if (NILP (POP)) + goto op_relative_branch; + NEXT; CASE (BRgotoifnonnil): - { - Lisp_Object v1; - MAYBE_GC (); - v1 = POP; - if (!NILP (v1)) - { - BYTE_CODE_QUIT; - stack.pc += (int) *stack.pc - 128; - } - stack.pc++; - NEXT; - } + op = FETCH - 128; + if (!NILP (POP)) + goto op_relative_branch; + NEXT; CASE (BRgotoifnilelsepop): - MAYBE_GC (); - op = *stack.pc++; + op = FETCH - 128; if (NILP (TOP)) - { - BYTE_CODE_QUIT; - stack.pc += op - 128; - } - else DISCARD (1); + goto op_relative_branch; + DISCARD (1); NEXT; CASE (BRgotoifnonnilelsepop): - MAYBE_GC (); - op = *stack.pc++; + op = FETCH - 128; if (!NILP (TOP)) - { - BYTE_CODE_QUIT; - stack.pc += op - 128; - } - else DISCARD (1); + goto op_relative_branch; + DISCARD (1); NEXT; CASE (Breturn): - result = POP; goto exit; CASE (Bdiscard): @@ -1041,10 +760,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, ptrdiff_t count1 = SPECPDL_INDEX (); record_unwind_protect (restore_window_configuration, Fcurrent_window_configuration (Qnil)); - BEFORE_POTENTIAL_GC (); TOP = Fprogn (TOP); unbind_to (count1, TOP); - AFTER_POTENTIAL_GC (); NEXT; } @@ -1055,11 +772,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bcatch): /* Obsolete since 24.4. */ { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = internal_catch (TOP, eval_sub, v1); - AFTER_POTENTIAL_GC (); NEXT; } @@ -1070,93 +784,69 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, type = CONDITION_CASE; pushhandler: { - Lisp_Object tag = POP; - int dest = FETCH2; - - struct handler *c = push_handler (tag, type); - c->bytecode_dest = dest; + struct handler *c = push_handler (POP, type); + c->bytecode_dest = FETCH2; c->bytecode_top = top; if (sys_setjmp (c->jmp)) { struct handler *c = handlerlist; - int dest; top = c->bytecode_top; - dest = c->bytecode_dest; + op = c->bytecode_dest; handlerlist = c->next; PUSH (c->val); - CHECK_RANGE (dest); - /* Might have been re-set by longjmp! */ - stack.byte_string_start = SDATA (stack.byte_string); - stack.pc = stack.byte_string_start + dest; + goto op_branch; } NEXT; } CASE (Bpophandler): /* New in 24.4. */ - { - handlerlist = handlerlist->next; - NEXT; - } + handlerlist = handlerlist->next; + NEXT; CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */ { Lisp_Object handler = POP; /* Support for a function here is new in 24.4. */ - record_unwind_protect (NILP (Ffunctionp (handler)) - ? unwind_body : bcall0, + record_unwind_protect (FUNCTIONP (handler) ? bcall0 : prog_ignore, handler); NEXT; } CASE (Bcondition_case): /* Obsolete since 24.4. */ { - Lisp_Object handlers, body; - handlers = POP; - body = POP; - BEFORE_POTENTIAL_GC (); + Lisp_Object handlers = POP, body = POP; TOP = internal_lisp_condition_case (TOP, body, handlers); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1. */ - BEFORE_POTENTIAL_GC (); CHECK_STRING (TOP); temp_output_buffer_setup (SSDATA (TOP)); - AFTER_POTENTIAL_GC (); TOP = Vstandard_output; NEXT; CASE (Btemp_output_buffer_show): /* Obsolete since 24.1. */ { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; temp_output_buffer_show (TOP); TOP = v1; /* pop binding of standard-output */ unbind_to (SPECPDL_INDEX () - 1, Qnil); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bnth): { - Lisp_Object v1, v2; - EMACS_INT n; - BEFORE_POTENTIAL_GC (); - v1 = POP; - v2 = TOP; - CHECK_NUMBER (v2); - n = XINT (v2); - immediate_quit = 1; - while (--n >= 0 && CONSP (v1)) - v1 = XCDR (v1); - immediate_quit = 0; - TOP = CAR (v1); - AFTER_POTENTIAL_GC (); + Lisp_Object v2 = POP, v1 = TOP; + CHECK_NUMBER (v1); + EMACS_INT n = XINT (v1); + immediate_quit = true; + while (--n >= 0 && CONSP (v2)) + v2 = XCDR (v2); + immediate_quit = false; + TOP = CAR (v2); NEXT; } @@ -1182,8 +872,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bcons): { - Lisp_Object v1; - v1 = POP; + Lisp_Object v1 = POP; TOP = Fcons (TOP, v1); NEXT; } @@ -1194,8 +883,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Blist2): { - Lisp_Object v1; - v1 = POP; + Lisp_Object v1 = POP; TOP = list2 (TOP, v1); NEXT; } @@ -1217,305 +905,191 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Blength): - BEFORE_POTENTIAL_GC (); TOP = Flength (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Baref): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Faref (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Baset): { - Lisp_Object v1, v2; - BEFORE_POTENTIAL_GC (); - v2 = POP; v1 = POP; + Lisp_Object v2 = POP, v1 = POP; TOP = Faset (TOP, v1, v2); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bsymbol_value): - BEFORE_POTENTIAL_GC (); TOP = Fsymbol_value (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bsymbol_function): - BEFORE_POTENTIAL_GC (); TOP = Fsymbol_function (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bset): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fset (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bfset): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Ffset (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bget): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fget (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bsubstring): { - Lisp_Object v1, v2; - BEFORE_POTENTIAL_GC (); - v2 = POP; v1 = POP; + Lisp_Object v2 = POP, v1 = POP; TOP = Fsubstring (TOP, v1, v2); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bconcat2): - BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fconcat (2, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bconcat3): - BEFORE_POTENTIAL_GC (); DISCARD (2); TOP = Fconcat (3, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bconcat4): - BEFORE_POTENTIAL_GC (); DISCARD (3); TOP = Fconcat (4, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (BconcatN): op = FETCH; - BEFORE_POTENTIAL_GC (); DISCARD (op - 1); TOP = Fconcat (op, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bsub1): - { - Lisp_Object v1; - v1 = TOP; - if (INTEGERP (v1)) - { - XSETINT (v1, XINT (v1) - 1); - TOP = v1; - } - else - { - BEFORE_POTENTIAL_GC (); - TOP = Fsub1 (v1); - AFTER_POTENTIAL_GC (); - } - NEXT; - } + TOP = INTEGERP (TOP) ? make_number (XINT (TOP) - 1) : Fsub1 (TOP); + NEXT; CASE (Badd1): - { - Lisp_Object v1; - v1 = TOP; - if (INTEGERP (v1)) - { - XSETINT (v1, XINT (v1) + 1); - TOP = v1; - } - else - { - BEFORE_POTENTIAL_GC (); - TOP = Fadd1 (v1); - AFTER_POTENTIAL_GC (); - } - NEXT; - } + TOP = INTEGERP (TOP) ? make_number (XINT (TOP) + 1) : Fadd1 (TOP); + NEXT; CASE (Beqlsign): { - Lisp_Object v1, v2; - BEFORE_POTENTIAL_GC (); - v2 = POP; v1 = TOP; + Lisp_Object v2 = POP, v1 = TOP; CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1); CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2); - AFTER_POTENTIAL_GC (); + bool equal; if (FLOATP (v1) || FLOATP (v2)) { - double f1, f2; - - f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1)); - f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2)); - TOP = (f1 == f2 ? Qt : Qnil); + double f1 = FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1); + double f2 = FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2); + equal = f1 == f2; } else - TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil); + equal = XINT (v1) == XINT (v2); + TOP = equal ? Qt : Qnil; NEXT; } CASE (Bgtr): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = arithcompare (TOP, v1, ARITH_GRTR); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Blss): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = arithcompare (TOP, v1, ARITH_LESS); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bleq): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bgeq): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bdiff): - BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fminus (2, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bnegate): - { - Lisp_Object v1; - v1 = TOP; - if (INTEGERP (v1)) - { - XSETINT (v1, - XINT (v1)); - TOP = v1; - } - else - { - BEFORE_POTENTIAL_GC (); - TOP = Fminus (1, &TOP); - AFTER_POTENTIAL_GC (); - } - NEXT; - } + TOP = INTEGERP (TOP) ? make_number (- XINT (TOP)) : Fminus (1, &TOP); + NEXT; CASE (Bplus): - BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fplus (2, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bmax): - BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fmax (2, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bmin): - BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fmin (2, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bmult): - BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Ftimes (2, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bquo): - BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fquo (2, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Brem): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Frem (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bpoint): - { - Lisp_Object v1; - XSETFASTINT (v1, PT); - PUSH (v1); - NEXT; - } + PUSH (make_natnum (PT)); + NEXT; CASE (Bgoto_char): - BEFORE_POTENTIAL_GC (); TOP = Fgoto_char (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Binsert): - BEFORE_POTENTIAL_GC (); TOP = Finsert (1, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (BinsertN): op = FETCH; - BEFORE_POTENTIAL_GC (); DISCARD (op - 1); TOP = Finsert (op, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bpoint_max): @@ -1527,53 +1101,27 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } CASE (Bpoint_min): - { - Lisp_Object v1; - XSETFASTINT (v1, BEGV); - PUSH (v1); - NEXT; - } + PUSH (make_natnum (BEGV)); + NEXT; CASE (Bchar_after): - BEFORE_POTENTIAL_GC (); TOP = Fchar_after (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bfollowing_char): - { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = Ffollowing_char (); - AFTER_POTENTIAL_GC (); - PUSH (v1); - NEXT; - } + PUSH (Ffollowing_char ()); + NEXT; CASE (Bpreceding_char): - { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = Fprevious_char (); - AFTER_POTENTIAL_GC (); - PUSH (v1); - NEXT; - } + PUSH (Fprevious_char ()); + NEXT; CASE (Bcurrent_column): - { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - XSETFASTINT (v1, current_column ()); - AFTER_POTENTIAL_GC (); - PUSH (v1); - NEXT; - } + PUSH (make_natnum (current_column ())); + NEXT; CASE (Bindent_to): - BEFORE_POTENTIAL_GC (); TOP = Findent_to (TOP, Qnil); - AFTER_POTENTIAL_GC (); NEXT; CASE (Beolp): @@ -1597,63 +1145,43 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bset_buffer): - BEFORE_POTENTIAL_GC (); TOP = Fset_buffer (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Binteractive_p): /* Obsolete since 24.1. */ - BEFORE_POTENTIAL_GC (); PUSH (call0 (intern ("interactive-p"))); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bforward_char): - BEFORE_POTENTIAL_GC (); TOP = Fforward_char (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bforward_word): - BEFORE_POTENTIAL_GC (); TOP = Fforward_word (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bskip_chars_forward): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fskip_chars_forward (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bskip_chars_backward): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fskip_chars_backward (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bforward_line): - BEFORE_POTENTIAL_GC (); TOP = Fforward_line (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bchar_syntax): { - int c; - - BEFORE_POTENTIAL_GC (); CHECK_CHARACTER (TOP); - AFTER_POTENTIAL_GC (); - c = XFASTINT (TOP); + int c = XFASTINT (TOP); if (NILP (BVAR (current_buffer, enable_multibyte_characters))) MAKE_CHAR_MULTIBYTE (c); XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]); @@ -1662,239 +1190,169 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bbuffer_substring): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fbuffer_substring (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bdelete_region): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fdelete_region (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bnarrow_to_region): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fnarrow_to_region (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bwiden): - BEFORE_POTENTIAL_GC (); PUSH (Fwiden ()); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bend_of_line): - BEFORE_POTENTIAL_GC (); TOP = Fend_of_line (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bset_marker): { - Lisp_Object v1, v2; - BEFORE_POTENTIAL_GC (); - v1 = POP; - v2 = POP; - TOP = Fset_marker (TOP, v2, v1); - AFTER_POTENTIAL_GC (); + Lisp_Object v2 = POP, v1 = POP; + TOP = Fset_marker (TOP, v1, v2); NEXT; } CASE (Bmatch_beginning): - BEFORE_POTENTIAL_GC (); TOP = Fmatch_beginning (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bmatch_end): - BEFORE_POTENTIAL_GC (); TOP = Fmatch_end (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bupcase): - BEFORE_POTENTIAL_GC (); TOP = Fupcase (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bdowncase): - BEFORE_POTENTIAL_GC (); TOP = Fdowncase (TOP); - AFTER_POTENTIAL_GC (); - NEXT; + NEXT; - CASE (Bstringeqlsign): + CASE (Bstringeqlsign): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fstring_equal (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bstringlss): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fstring_lessp (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bequal): { - Lisp_Object v1; - v1 = POP; + Lisp_Object v1 = POP; TOP = Fequal (TOP, v1); NEXT; } CASE (Bnthcdr): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fnthcdr (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Belt): { - Lisp_Object v1, v2; if (CONSP (TOP)) { /* Exchange args and then do nth. */ - EMACS_INT n; - BEFORE_POTENTIAL_GC (); - v2 = POP; - v1 = TOP; + Lisp_Object v2 = POP, v1 = TOP; CHECK_NUMBER (v2); - AFTER_POTENTIAL_GC (); - n = XINT (v2); - immediate_quit = 1; + EMACS_INT n = XINT (v2); + immediate_quit = true; while (--n >= 0 && CONSP (v1)) v1 = XCDR (v1); - immediate_quit = 0; + immediate_quit = false; TOP = CAR (v1); } else { - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Felt (TOP, v1); - AFTER_POTENTIAL_GC (); } NEXT; } CASE (Bmember): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fmember (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bassq): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fassq (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bnreverse): - BEFORE_POTENTIAL_GC (); TOP = Fnreverse (TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bsetcar): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fsetcar (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bsetcdr): { - Lisp_Object v1; - BEFORE_POTENTIAL_GC (); - v1 = POP; + Lisp_Object v1 = POP; TOP = Fsetcdr (TOP, v1); - AFTER_POTENTIAL_GC (); NEXT; } CASE (Bcar_safe): - { - Lisp_Object v1; - v1 = TOP; - TOP = CAR_SAFE (v1); - NEXT; - } + TOP = CAR_SAFE (TOP); + NEXT; CASE (Bcdr_safe): - { - Lisp_Object v1; - v1 = TOP; - TOP = CDR_SAFE (v1); - NEXT; - } + TOP = CDR_SAFE (TOP); + NEXT; CASE (Bnconc): - BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fnconc (2, &TOP); - AFTER_POTENTIAL_GC (); NEXT; CASE (Bnumberp): - TOP = (NUMBERP (TOP) ? Qt : Qnil); + TOP = NUMBERP (TOP) ? Qt : Qnil; NEXT; CASE (Bintegerp): TOP = INTEGERP (TOP) ? Qt : Qnil; NEXT; -#ifdef BYTE_CODE_SAFE +#if BYTE_CODE_SAFE /* These are intentionally written using 'case' syntax, because they are incompatible with the threaded interpreter. */ case Bset_mark: - BEFORE_POTENTIAL_GC (); error ("set-mark is an obsolete bytecode"); - AFTER_POTENTIAL_GC (); break; case Bscan_buffer: - BEFORE_POTENTIAL_GC (); error ("scan-buffer is an obsolete bytecode"); - AFTER_POTENTIAL_GC (); break; #endif @@ -1905,7 +1363,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, call3 (Qerror, build_string ("Invalid byte opcode: op=%s, ptr=%d"), make_number (op), - make_number ((stack.pc - 1) - stack.byte_string_start)); + make_number (pc - 1 - bytestr_data)); /* Handy byte-codes for lexical binding. */ CASE (Bstack_ref1): @@ -1914,32 +1372,32 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bstack_ref4): CASE (Bstack_ref5): { - Lisp_Object *ptr = top - (op - Bstack_ref); - PUSH (*ptr); + Lisp_Object v1 = top[Bstack_ref - op]; + PUSH (v1); NEXT; } CASE (Bstack_ref6): { - Lisp_Object *ptr = top - (FETCH); - PUSH (*ptr); + Lisp_Object v1 = top[- FETCH]; + PUSH (v1); NEXT; } CASE (Bstack_ref7): { - Lisp_Object *ptr = top - (FETCH2); - PUSH (*ptr); + Lisp_Object v1 = top[- FETCH2]; + PUSH (v1); NEXT; } CASE (Bstack_set): /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */ { - Lisp_Object *ptr = top - (FETCH); + Lisp_Object *ptr = top - FETCH; *ptr = POP; NEXT; } CASE (Bstack_set2): { - Lisp_Object *ptr = top - (FETCH2); + Lisp_Object *ptr = top - FETCH2; *ptr = POP; NEXT; } @@ -1955,27 +1413,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE_DEFAULT CASE (Bconstant): -#ifdef BYTE_CODE_SAFE - if (op < Bconstant) - { - emacs_abort (); - } - if ((op -= Bconstant) >= const_length) - { - emacs_abort (); - } - PUSH (vectorp[op]); -#else + if (BYTE_CODE_SAFE + && ! (Bconstant <= op && op < Bconstant + const_length)) + emacs_abort (); PUSH (vectorp[op - Bconstant]); -#endif NEXT; } } exit: - byte_stack_list = byte_stack_list->next; - /* Binds and unbinds are supposed to be compiled balanced. */ if (SPECPDL_INDEX () != count) { @@ -1984,9 +1431,25 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, error ("binding stack not balanced (serious byte compiler bug)"); } + Lisp_Object result = TOP; + SAFE_FREE (); return result; } +/* `args_template' has the same meaning as in exec_byte_code() above. */ +Lisp_Object +get_byte_code_arity (Lisp_Object args_template) +{ + eassert (NATNUMP (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)); +} + void syms_of_bytecode (void) { @@ -2008,7 +1471,7 @@ The variable byte-code-meter indicates how often each byte opcode is used. 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 = 0; + byte_metering_on = false; Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); DEFSYM (Qbyte_code_meter, "byte-code-meter"); { |