/* Execution of byte code produced by bytecomp.el.
- Copyright (C) 1985-1988, 1993, 2000-2015 Free Software Foundation,
+ Copyright (C) 1985-1988, 1993, 2000-2016 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
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"
#include "xterm.h"
#endif
+/* Work around GCC bug 54561. */
+#if GNUC_PREREQ (4, 3, 0)
+# pragma GCC diagnostic ignored "-Wclobbered"
+#endif
+
/*
* define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
* debugging the byte compiler...)
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 || BYTE_MARK_STACK)
\f
/* Structure describing a value stack used during byte-code execution
in Fbyte_code. */
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. */
+ Storing this here protects it from GC. */
Lisp_Object byte_string;
const unsigned char *byte_string_start;
-#if BYTE_MARK_STACK
- /* The vector of constants used during byte-code execution. Storing
- this here protects it from GC because mark_byte_stack marks it. */
- Lisp_Object constants;
-#endif
-
/* 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 analogous to
- gcprolist. */
+ done. Signaling an error truncates the list. */
struct byte_stack *byte_stack_list;
\f
-/* Mark objects on byte_stack_list. Called during GC. */
-
-#if BYTE_MARK_STACK
-void
-mark_byte_stack (void)
-{
- struct byte_stack *stack;
- Lisp_Object *obj;
-
- for (stack = byte_stack_list; stack; stack = stack->next)
- {
- /* If STACK->top is null here, this means there's an opcode in
- Fbyte_code that wasn't expected to GC, but did. To find out
- which opcode this is, record the value of `stack', and walk
- up the stack in a debugger, stopping in frames of Fbyte_code.
- The culprit is found in the frame of Fbyte_code where the
- address of its local variable `stack' is equal to the
- recorded value of `stack' here. */
- eassert (stack->top);
-
- for (obj = stack->bottom; obj <= stack->top; ++obj)
- mark_object (*obj);
-
- mark_object (stack->byte_string);
- mark_object (stack->constants);
- }
-}
-#endif
-
-/* Unmark objects in the stacks on byte_stack_list. Relocate program
- counters. Called when GC has completed. */
+/* Relocate program counters in the stacks on byte_stack_list. Called
+ when GC has completed. */
void
-unmark_byte_stack (void)
+relocate_byte_stack (void)
{
struct byte_stack *stack;
#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. */
#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
{ \
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 (); \
stack.byte_string = bytestr;
stack.pc = stack.byte_string_start = SDATA (bytestr);
-#if BYTE_MARK_STACK
- stack.constants = vector;
-#endif
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;
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__
#undef DEFINE
};
-#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) || defined __clang__
+#if GNUC_PREREQ (4, 6, 0) || defined __clang__
# pragma GCC diagnostic pop
#endif
|| (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 ();
}
PUSH (v2);
NEXT;
CASE (Bgotoifnil):
{
Lisp_Object v1;
- MAYBE_GC ();
+ maybe_gc ();
op = FETCH2;
v1 = POP;
if (NILP (v1))
TOP = Qnil;
else
{
- BEFORE_POTENTIAL_GC ();
wrong_type_argument (Qlistp, v1);
}
NEXT;
CASE (Bmemq):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fmemq (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
TOP = Qnil;
else
{
- BEFORE_POTENTIAL_GC ();
wrong_type_argument (Qlistp, v1);
}
NEXT;
SET_SYMBOL_VAL (XSYMBOL (sym), val);
else
{
- BEFORE_POTENTIAL_GC ();
set_internal (sym, val, Qnil, 0);
- AFTER_POTENTIAL_GC ();
}
}
(void) POP;
op -= Bvarbind;
varbind:
/* Specbind can signal and thus GC. */
- BEFORE_POTENTIAL_GC ();
specbind (vectorp[op], POP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bcall6):
op -= Bcall;
docall:
{
- BEFORE_POTENTIAL_GC ();
DISCARD (op);
#ifdef BYTE_CODE_METER
if (byte_metering_on && SYMBOLP (TOP))
}
#endif
TOP = Ffuncall (op + 1, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
}
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 ();
+ maybe_gc ();
BYTE_CODE_QUIT;
op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */
CHECK_RANGE (op);
CASE (Bgotoifnonnil):
{
Lisp_Object v1;
- MAYBE_GC ();
+ maybe_gc ();
op = FETCH2;
v1 = POP;
if (!NILP (v1))
}
CASE (Bgotoifnilelsepop):
- MAYBE_GC ();
+ maybe_gc ();
op = FETCH2;
if (NILP (TOP))
{
NEXT;
CASE (Bgotoifnonnilelsepop):
- MAYBE_GC ();
+ maybe_gc ();
op = FETCH2;
if (!NILP (TOP))
{
NEXT;
CASE (BRgoto):
- MAYBE_GC ();
+ maybe_gc ();
BYTE_CODE_QUIT;
stack.pc += (int) *stack.pc - 127;
NEXT;
CASE (BRgotoifnil):
{
Lisp_Object v1;
- MAYBE_GC ();
+ maybe_gc ();
v1 = POP;
if (NILP (v1))
{
CASE (BRgotoifnonnil):
{
Lisp_Object v1;
- MAYBE_GC ();
+ maybe_gc ();
v1 = POP;
if (!NILP (v1))
{
}
CASE (BRgotoifnilelsepop):
- MAYBE_GC ();
+ maybe_gc ();
op = *stack.pc++;
if (NILP (TOP))
{
NEXT;
CASE (BRgotoifnonnilelsepop):
- MAYBE_GC ();
+ maybe_gc ();
op = *stack.pc++;
if (!NILP (TOP))
{
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;
}
CASE (Bcatch): /* Obsolete since 24.4. */
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = internal_catch (TOP, eval_sub, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
type = CATCHER;
goto pushhandler;
CASE (Bpushconditioncase): /* New in 24.4. */
+ type = CONDITION_CASE;
+ pushhandler:
{
- struct handler *c;
- Lisp_Object tag;
- int dest;
-
- type = CONDITION_CASE;
- pushhandler:
- tag = POP;
- dest = FETCH2;
+ Lisp_Object tag = POP;
+ int dest = FETCH2;
- PUSH_HANDLER (c, tag, type);
+ struct handler *c = push_handler (tag, type);
c->bytecode_dest = dest;
c->bytecode_top = top;
Lisp_Object handlers, body;
handlers = POP;
body = POP;
- BEFORE_POTENTIAL_GC ();
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;
temp_output_buffer_show (TOP);
TOP = v1;
/* pop binding of standard-output */
unbind_to (SPECPDL_INDEX () - 1, Qnil);
- AFTER_POTENTIAL_GC ();
NEXT;
}
{
Lisp_Object v1, v2;
EMACS_INT n;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
v2 = TOP;
CHECK_NUMBER (v2);
v1 = XCDR (v1);
immediate_quit = 0;
TOP = CAR (v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
NEXT;
CASE (Blength):
- BEFORE_POTENTIAL_GC ();
TOP = Flength (TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Baref):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Faref (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Baset):
{
Lisp_Object v1, v2;
- BEFORE_POTENTIAL_GC ();
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;
TOP = Fset (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bfset):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Ffset (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bget):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fget (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bsubstring):
{
Lisp_Object v1, v2;
- BEFORE_POTENTIAL_GC ();
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):
}
else
{
- BEFORE_POTENTIAL_GC ();
TOP = Fsub1 (v1);
- AFTER_POTENTIAL_GC ();
}
NEXT;
}
}
else
{
- BEFORE_POTENTIAL_GC ();
TOP = Fadd1 (v1);
- AFTER_POTENTIAL_GC ();
}
NEXT;
}
CASE (Beqlsign):
{
Lisp_Object v1, v2;
- BEFORE_POTENTIAL_GC ();
v2 = POP; v1 = TOP;
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
- AFTER_POTENTIAL_GC ();
if (FLOATP (v1) || FLOATP (v2))
{
double f1, f2;
CASE (Bgtr):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = arithcompare (TOP, v1, ARITH_GRTR);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Blss):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = arithcompare (TOP, v1, ARITH_LESS);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bleq):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bgeq):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
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):
}
else
{
- BEFORE_POTENTIAL_GC ();
TOP = Fminus (1, &TOP);
- AFTER_POTENTIAL_GC ();
}
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;
TOP = Frem (TOP, v1);
- AFTER_POTENTIAL_GC ();
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):
}
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;
}
CASE (Bpreceding_char):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = Fprevious_char ();
- AFTER_POTENTIAL_GC ();
PUSH (v1);
NEXT;
}
CASE (Bcurrent_column):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
XSETFASTINT (v1, current_column ());
- AFTER_POTENTIAL_GC ();
PUSH (v1);
NEXT;
}
CASE (Bindent_to):
- BEFORE_POTENTIAL_GC ();
TOP = Findent_to (TOP, Qnil);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Beolp):
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;
TOP = Fskip_chars_forward (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bskip_chars_backward):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
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);
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
MAKE_CHAR_MULTIBYTE (c);
CASE (Bbuffer_substring):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fbuffer_substring (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bdelete_region):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fdelete_region (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bnarrow_to_region):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
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 ();
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;
CASE (Bstringeqlsign):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fstring_equal (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bstringlss):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fstring_lessp (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bnthcdr):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fnthcdr (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
{
/* Exchange args and then do nth. */
EMACS_INT n;
- BEFORE_POTENTIAL_GC ();
v2 = POP;
v1 = TOP;
CHECK_NUMBER (v2);
- AFTER_POTENTIAL_GC ();
n = XINT (v2);
immediate_quit = 1;
while (--n >= 0 && CONSP (v1))
}
else
{
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Felt (TOP, v1);
- AFTER_POTENTIAL_GC ();
}
NEXT;
}
CASE (Bmember):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fmember (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bassq):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
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;
TOP = Fsetcar (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
CASE (Bsetcdr):
{
Lisp_Object v1;
- BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = Fsetcdr (TOP, v1);
- AFTER_POTENTIAL_GC ();
NEXT;
}
}
CASE (Bnconc):
- BEFORE_POTENTIAL_GC ();
DISCARD (1);
TOP = Fnconc (2, &TOP);
- AFTER_POTENTIAL_GC ();
NEXT;
CASE (Bnumberp):
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
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)
{