[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 644fc17 4/5: Remove interpreter’s byte stack
|
From: |
Paul Eggert |
|
Subject: |
[Emacs-diffs] master 644fc17 4/5: Remove interpreter’s byte stack |
|
Date: |
Tue, 9 Aug 2016 08:31:27 +0000 (UTC) |
branch: master
commit 644fc17b9ae181174a842e3876e887666d505666
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>
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.
(SAFE_ALLOCA_LISP_EXTRA): New macro, a generalization of
SAFE_ALLOCA_LISP.
(SAFE_ALLOCA_LISP): Use it.
---
etc/DEBUG | 2 +-
src/.gdbinit | 15 -----
src/alloc.c | 2 -
src/bytecode.c | 188 +++++++++++++-------------------------------------------
src/eval.c | 3 -
src/lisp.h | 13 ++--
6 files changed, 53 insertions(+), 170 deletions(-)
diff --git a/etc/DEBUG b/etc/DEBUG
index d5d5829..656e29a 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -282,7 +282,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
diff --git a/src/.gdbinit b/src/.gdbinit
index a4e9f70..8e7ac3c 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -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 ()
diff --git a/src/alloc.c b/src/alloc.c
index e25d91f..db16575 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5799,8 +5799,6 @@ garbage_collect_1 (void *end)
gc_sweep ();
- relocate_byte_stack ();
-
/* Clear the mark bits that we set in certain root slots. */
VECTOR_UNMARK (&buffer_defaults);
VECTOR_UNMARK (&buffer_local_symbols);
diff --git a/src/bytecode.c b/src/bytecode.c
index 0c5b849..995d37c 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -281,59 +281,9 @@ enum byte_code_op
#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. */
- 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. */
-#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. */
@@ -358,32 +308,6 @@ relocate_byte_stack (void)
#define TOP (*top)
-/* Check for jumping out of range. */
-
-#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;
@@ -423,7 +347,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector,
Lisp_Object maxdepth,
Lisp_Object *vectorp;
ptrdiff_t const_length;
ptrdiff_t bytestr_length;
- struct byte_stack stack;
Lisp_Object *top;
Lisp_Object result;
enum handlertype type;
@@ -445,16 +368,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector,
Lisp_Object maxdepth,
bytestr_length = SBYTES (bytestr);
vectorp = XVECTOR (vector)->contents;
- 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;
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;
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))
@@ -608,11 +531,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;
}
@@ -791,10 +710,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):
@@ -803,51 +734,35 @@ 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;
}
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):
{
Lisp_Object v1;
v1 = POP;
+ op = FETCH - 128;
if (NILP (v1))
- {
- BYTE_CODE_QUIT;
- stack.pc += (int) *stack.pc - 128;
- }
- stack.pc++;
+ goto op_relative_branch;
NEXT;
}
@@ -855,33 +770,24 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector,
Lisp_Object maxdepth,
{
Lisp_Object v1;
v1 = POP;
+ op = FETCH - 128;
if (!NILP (v1))
- {
- BYTE_CODE_QUIT;
- stack.pc += (int) *stack.pc - 128;
- }
- stack.pc++;
+ 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):
@@ -946,15 +852,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;
@@ -1629,7 +1531,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):
@@ -1689,8 +1591,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)
{
diff --git a/src/eval.c b/src/eval.c
index 7b7bdd8..f681ef7 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -222,7 +222,6 @@ static struct handler handlerlist_sentinel;
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
@@ -1135,7 +1134,6 @@ unwind_to_catch (struct handler *catch, Lisp_Object value)
eassert (handlerlist == catch);
- byte_stack_list = catch->byte_stack;
lisp_eval_depth = catch->lisp_eval_depth;
sys_longjmp (catch->jmp, 1);
@@ -1430,7 +1428,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;
}
diff --git a/src/lisp.h b/src/lisp.h
index 8ac9cc1..97c8d9f 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3202,7 +3202,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;
@@ -4231,8 +4230,6 @@ extern int read_bytecode_char (bool);
/* Defined in bytecode.c. */
extern void syms_of_bytecode (void);
-extern struct byte_stack *byte_stack_list;
-extern void relocate_byte_stack (void);
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);
@@ -4530,12 +4527,14 @@ extern void *record_xmalloc (size_t)
ATTRIBUTE_ALLOC_SIZE ((1));
} \
} while (false)
-/* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */
+/* Set BUF to point to an allocated array of NELT Lisp_Objects,
+ immediately followed by EXTRA spare bytes. */
-#define SAFE_ALLOCA_LISP(buf, nelt) \
+#define SAFE_ALLOCA_LISP_EXTRA(buf, nelt, extra) \
do { \
ptrdiff_t alloca_nbytes; \
if (INT_MULTIPLY_WRAPV (nelt, word_size, &alloca_nbytes) \
+ || INT_ADD_WRAPV (alloca_nbytes, extra, &alloca_nbytes) \
|| SIZE_MAX < alloca_nbytes) \
memory_full (SIZE_MAX); \
else if (alloca_nbytes <= sa_avail) \
@@ -4550,6 +4549,10 @@ extern void *record_xmalloc (size_t)
ATTRIBUTE_ALLOC_SIZE ((1));
} \
} while (false)
+/* Set BUF to point to an allocated array of NELT Lisp_Objects. */
+
+#define SAFE_ALLOCA_LISP(buf, nelt) SAFE_ALLOCA_LISP_EXTRA (buf, nelt, 0)
+
/* If USE_STACK_LISP_OBJECTS, define macros that and functions that allocate
block-scoped conses and strings. These objects are not