Commit a815e5f1 authored by Paul Eggert's avatar Paul Eggert

Remove interpreter’s byte stack

This improves performance overall on my benchmark on x86-64,
since the interpreted program-counter resides in a machine
register rather than in RAM.
* etc/DEBUG, src/.gdbinit: Remove xbytecode GDB command, as there
is no longer a byte stack to decode.
* src/bytecode.c (struct byte_stack, byte_stack_list)
(relocate_byte_stack): Remove.  All uses removed.
(FETCH): Simplify now that pc is now local (typically, in a
register) and no longer needs to be relocated.
(CHECK_RANGE): Remove.  All uses now done inline, in a different way.
(BYTE_CODE_QUIT): Remove; now done by op_relative_branch.
(exec_byte_code): Allocate a copy of the function’s bytecode,
so that there is no problem if GC moves it.
* src/lisp.h (struct handler): Remove byte_stack member.
All uses removed.
* src/thread.c (unmark_threads): Remove.  All uses removed.
* src/thread.h (struct thread_state): Remove m_byte_stack_list member.
All uses removed.  m_stack_bottom is now the first non-Lisp field.
parent a43cfb1a
......@@ -313,7 +313,7 @@ type. Here are these commands:
xbufobjfwd xkbobjfwd xbuflocal xbuffer xsymbol xstring xvector xframe
xwinconfig xcompiled xcons xcar xcdr xsubr xprocess xfloat xscrollbar
xchartable xsubchartable xboolvector xhashtable xlist xcoding
xcharset xfontset xfont xbytecode
xcharset xfontset xfont
Each one of them applies to a certain type or class of types.
(Some of these types are not visible in Lisp, because they exist only
......
......@@ -1215,21 +1215,6 @@ document xwhichsymbols
maximum number of symbols referencing it to produce.
end
define xbytecode
set $bt = byte_stack_list
while $bt
xgetptr $bt->byte_string
set $ptr = (struct Lisp_String *) $ptr
xprintbytestr $ptr
printf "\n0x%x => ", $bt->byte_string
xwhichsymbols $bt->byte_string 5
set $bt = $bt->next
end
end
document xbytecode
Print a backtrace of the byte code stack.
end
# Show Lisp backtrace after normal backtrace.
define hookpost-backtrace
set $bt = backtrace_top ()
......
......@@ -5883,8 +5883,6 @@ garbage_collect_1 (void *end)
gc_sweep ();
unmark_threads ();
/* Clear the mark bits that we set in certain root slots. */
VECTOR_UNMARK (&buffer_defaults);
VECTOR_UNMARK (&buffer_local_symbols);
......
......@@ -280,59 +280,10 @@ enum byte_code_op
Bset_mark = 0163, /* this loser is no longer generated as of v18 */
#endif
};
/* 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;
/* 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.
byte_stack_list is a macro defined in thread.h. */
/* 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 (struct byte_stack *stack)
{
for (; 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. */
#if 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. */
......@@ -357,29 +308,6 @@ relocate_byte_stack (struct byte_stack *stack)
#define TOP (*top)
#define CHECK_RANGE(ARG) \
(BYTE_CODE_SAFE && bytestr_length <= (ARG) ? emacs_abort () : (void) 0)
/* A version of the QUIT macro which makes sure that the stack top is
set before signaling `quit'. */
#define BYTE_CODE_QUIT \
do { \
if (quitcounter++) \
break; \
maybe_gc (); \
if (!NILP (Vquit_flag) && NILP (Vinhibit_quit)) \
{ \
Lisp_Object flag = Vquit_flag; \
Vquit_flag = Qnil; \
if (EQ (Vthrow_on_input, flag)) \
Fthrow (Vthrow_on_input, Qt); \
quit (); \
} \
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;
......@@ -429,19 +357,18 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
ptrdiff_t bytestr_length = SBYTES (bytestr);
Lisp_Object *vectorp = XVECTOR (vector)->contents;
struct byte_stack stack;
stack.byte_string = bytestr;
stack.pc = stack.byte_string_start = SDATA (bytestr);
unsigned char quitcounter = 0;
unsigned char quitcounter = 1;
EMACS_INT stack_items = XFASTINT (maxdepth) + 1;
USE_SAFE_ALLOCA;
Lisp_Object *stack_base;
SAFE_ALLOCA_LISP (stack_base, stack_items);
SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length);
Lisp_Object *stack_lim = stack_base + stack_items;
Lisp_Object *top = stack_base;
stack.next = byte_stack_list;
byte_stack_list = &stack;
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 (!NILP (args_template))
......@@ -585,11 +512,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
op = FETCH2;
v1 = POP;
if (NILP (v1))
{
BYTE_CODE_QUIT;
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
}
goto op_branch;
NEXT;
}
......@@ -744,10 +667,22 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
NEXT;
CASE (Bgoto):
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):
......@@ -755,77 +690,58 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
op = FETCH2;
Lisp_Object v1 = POP;
if (!NILP (v1))
{
BYTE_CODE_QUIT;
CHECK_RANGE (op);
stack.pc = stack.byte_string_start + op;
}
goto op_branch;
NEXT;
}
CASE (Bgotoifnilelsepop):
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):
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):
BYTE_CODE_QUIT;
stack.pc += (int) *stack.pc - 127;
NEXT;
op = FETCH - 128;
goto op_relative_branch;
CASE (BRgotoifnil):
if (NILP (POP))
{
BYTE_CODE_QUIT;
stack.pc += (int) *stack.pc - 128;
}
stack.pc++;
NEXT;
{
Lisp_Object v1 = POP;
op = FETCH - 128;
if (NILP (v1))
goto op_relative_branch;
NEXT;
}
CASE (BRgotoifnonnil):
if (!NILP (POP))
{
BYTE_CODE_QUIT;
stack.pc += (int) *stack.pc - 128;
}
stack.pc++;
NEXT;
{
Lisp_Object v1 = POP;
op = FETCH - 128;
if (!NILP (v1))
goto op_relative_branch;
NEXT;
}
CASE (BRgotoifnilelsepop):
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):
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):
......@@ -885,15 +801,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
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;
......@@ -1461,7 +1373,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):
......@@ -1521,8 +1433,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
exit:
byte_stack_list = byte_stack_list->next;
/* Binds and unbinds are supposed to be compiled balanced. */
if (SPECPDL_INDEX () != count)
{
......
......@@ -239,7 +239,6 @@ init_eval_once (void)
void
init_eval (void)
{
byte_stack_list = 0;
specpdl_ptr = specpdl;
{ /* Put a dummy catcher at top-level so that handlerlist is never NULL.
This is important since handlerlist->nextfree holds the freelist
......@@ -1156,7 +1155,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
eassert (handlerlist == catch);
byte_stack_list = catch->byte_stack;
lisp_eval_depth = catch->f_lisp_eval_depth;
sys_longjmp (catch->jmp, 1);
......@@ -1451,7 +1449,6 @@ push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype)
c->pdlcount = SPECPDL_INDEX ();
c->poll_suppress_count = poll_suppress_count;
c->interrupt_input_blocked = interrupt_input_blocked;
c->byte_stack = byte_stack_list;
handlerlist = c;
return c;
}
......
......@@ -3282,7 +3282,6 @@ struct handler
ptrdiff_t pdlcount;
int poll_suppress_count;
int interrupt_input_blocked;
struct byte_stack *byte_stack;
};
extern Lisp_Object memory_signal_data;
......@@ -4330,7 +4329,6 @@ extern int read_bytecode_char (bool);
/* Defined in bytecode.c. */
extern void syms_of_bytecode (void);
extern void relocate_byte_stack (struct byte_stack *);
extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, ptrdiff_t, Lisp_Object *);
extern Lisp_Object get_byte_code_arity (Lisp_Object);
......
......@@ -595,16 +595,6 @@ mark_threads (void)
flush_stack_call_func (mark_threads_callback, NULL);
}
void
unmark_threads (void)
{
struct thread_state *iter;
for (iter = all_threads; iter; iter = iter->next_thread)
if (iter->m_byte_stack_list)
relocate_byte_stack (iter->m_byte_stack_list);
}
static void
......@@ -716,7 +706,7 @@ If NAME is given, it must be a string; it names the new thread. */)
struct thread_state *new_thread;
Lisp_Object result;
const char *c_name = NULL;
size_t offset = offsetof (struct thread_state, m_byte_stack_list);
size_t offset = offsetof (struct thread_state, m_stack_bottom);
/* Can't start a thread in temacs. */
if (!initialized)
......@@ -725,7 +715,7 @@ If NAME is given, it must be a string; it names the new thread. */)
if (!NILP (name))
CHECK_STRING (name);
new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, m_byte_stack_list,
new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, m_stack_bottom,
PVEC_THREAD);
memset ((char *) new_thread + offset, 0,
sizeof (struct thread_state) - offset);
......@@ -940,7 +930,7 @@ static void
init_primary_thread (void)
{
primary_thread.header.size
= PSEUDOVECSIZE (struct thread_state, m_byte_stack_list);
= PSEUDOVECSIZE (struct thread_state, m_stack_bottom);
XSETPVECTYPE (&primary_thread, PVEC_THREAD);
primary_thread.m_last_thing_searched = Qnil;
primary_thread.m_saved_last_thing_searched = Qnil;
......
......@@ -56,14 +56,7 @@ struct thread_state
waiting on. */
Lisp_Object event_object;
/* m_byte_stack_list must be the first non-lisp field. */
/* 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 removed the entry again when it is
done. Signaling an error truncates the list. */
struct byte_stack *m_byte_stack_list;
#define byte_stack_list (current_thread->m_byte_stack_list)
/* m_stack_bottom must be the first non-Lisp field. */
/* An address near the bottom of the stack.
Tells GC how to save a copy of the stack. */
char *m_stack_bottom;
......@@ -227,7 +220,6 @@ struct Lisp_CondVar
extern struct thread_state *current_thread;
extern void unmark_threads (void);
extern void finalize_one_thread (struct thread_state *state);
extern void finalize_one_mutex (struct Lisp_Mutex *);
extern void finalize_one_condvar (struct Lisp_CondVar *);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment