[Emacs-diffs] master a815e5f 1/2: Remove interpreter’s byte stack

[Paul Eggert]

branch: master
commit a815e5f19581344af5e143636039064a7fbe83ed
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.
    * 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 ddec7b4..03efa3b 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 9160ffa..b0c0dfd 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 93ea286..121d704 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 5e0055f..51546ca 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -281,58 +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 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 1313093..ddcccc2 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 79b208a..75a7fd3 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 0bb0b7e..560d2cf 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 33f8ea7..b852401 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 *);