From a815e5f19581344af5e143636039064a7fbe83ed Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 23 Dec 2016 21:13:58 -0800 Subject: [PATCH] =?utf8?q?Remove=20interpreter=E2=80=99s=20byte=20stack?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 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. --- etc/DEBUG | 2 +- src/.gdbinit | 15 ---- src/alloc.c | 2 - src/bytecode.c | 200 ++++++++++++++----------------------------------- src/eval.c | 3 - src/lisp.h | 2 - src/thread.c | 16 +--- src/thread.h | 10 +-- 8 files changed, 60 insertions(+), 190 deletions(-) diff --git a/etc/DEBUG b/etc/DEBUG index ddec7b4414d..03efa3b10dd 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -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 diff --git a/src/.gdbinit b/src/.gdbinit index 9160ffa439e..b0c0dfd7e90 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 93ea286cfb8..121d7042353 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -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); diff --git a/src/bytecode.c b/src/bytecode.c index 5e0055f4ee4..51546ca474d 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -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) { diff --git a/src/eval.c b/src/eval.c index 1313093a533..ddcccc285d3 100644 --- a/src/eval.c +++ b/src/eval.c @@ -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; } diff --git a/src/lisp.h b/src/lisp.h index 79b208a333b..75a7fd3d53d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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); diff --git a/src/thread.c b/src/thread.c index 0bb0b7e006a..560d2cfa74f 100644 --- a/src/thread.c +++ b/src/thread.c @@ -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; diff --git a/src/thread.h b/src/thread.h index 33f8ea70636..b8524014ea4 100644 --- a/src/thread.h +++ b/src/thread.h @@ -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 *); -- 2.39.2