diff options
Diffstat (limited to 'src/bytecode.c')
| -rw-r--r-- | src/bytecode.c | 200 |
1 files changed, 55 insertions, 145 deletions
diff --git a/src/bytecode.c b/src/bytecode.c index 5e0055f4ee4..51546ca474d 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) { |
