/* 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
};
/* Whether to maintain a `top' and `bottom' field in the stack frame. */
-#define BYTE_MAINTAIN_TOP (BYTE_CODE_SAFE || BYTE_MARK_STACK)
+#define BYTE_MAINTAIN_TOP BYTE_CODE_SAFE
\f
/* Structure describing a value stack used during byte-code execution
in Fbyte_code. */
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. */
+/* Relocate program counters in the stacks on byte_stack_list. Called
+ when GC has completed. */
-#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. */
-
-void
-unmark_byte_stack (void)
+relocate_byte_stack (void)
{
struct byte_stack *stack;
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);
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;
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)
{