diff options
Diffstat (limited to 'src/bytecode.c')
| -rw-r--r-- | src/bytecode.c | 200 |
1 files changed, 153 insertions, 47 deletions
diff --git a/src/bytecode.c b/src/bytecode.c index 868c0148d30..3ac94055f33 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -280,10 +280,68 @@ enum byte_code_op Bset_mark = 0163, /* this loser is no longer generated as of v18 */ #endif }; + +/* Whether to maintain a `top' and `bottom' field in the stack frame. */ +#define BYTE_MAINTAIN_TOP BYTE_CODE_SAFE -/* Fetch the next byte from the bytecode stream. */ +/* 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; + + /* Top and bottom of stack. The bottom points to an area of memory + allocated with alloca in Fbyte_code. */ +#if BYTE_MAINTAIN_TOP + Lisp_Object *top, *bottom; +#endif + + /* 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; + } + } +} -#define FETCH (*pc++) + +/* Fetch the next byte from the bytecode stream. */ +#ifdef BYTE_CODE_SAFE +#define FETCH (eassert (stack.byte_string_start == SDATA (stack.byte_string)), *stack.pc++) +#else +#define FETCH *stack.pc++ +#endif /* Fetch two bytes from the bytecode stream and make a 16-bit number out of them. */ @@ -308,6 +366,29 @@ enum byte_code_op #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; @@ -357,18 +438,19 @@ 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; - unsigned char quitcounter = 1; + stack.byte_string = bytestr; + stack.pc = stack.byte_string_start = SDATA (bytestr); + unsigned char quitcounter = 0; EMACS_INT stack_items = XFASTINT (maxdepth) + 1; USE_SAFE_ALLOCA; Lisp_Object *stack_base; - SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length); + SAFE_ALLOCA_LISP (stack_base, stack_items); Lisp_Object *stack_lim = stack_base + stack_items; Lisp_Object *top = stack_base; - 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; + stack.next = byte_stack_list; + byte_stack_list = &stack; ptrdiff_t count = SPECPDL_INDEX (); if (!NILP (args_template)) @@ -508,10 +590,15 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bgotoifnil): { - Lisp_Object v1 = POP; + Lisp_Object v1; op = FETCH2; + v1 = POP; if (NILP (v1)) - goto op_branch; + { + BYTE_CODE_QUIT; + CHECK_RANGE (op); + stack.pc = stack.byte_string_start + op; + } NEXT; } @@ -666,72 +753,85 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Bgoto): - 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; + BYTE_CODE_QUIT; + op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */ + CHECK_RANGE (op); + stack.pc = stack.byte_string_start + op; NEXT; CASE (Bgotoifnonnil): op = FETCH2; - if (!NILP (POP)) - goto op_branch; + Lisp_Object v1 = POP; + if (!NILP (v1)) + { + BYTE_CODE_QUIT; + CHECK_RANGE (op); + stack.pc = stack.byte_string_start + op; + } NEXT; CASE (Bgotoifnilelsepop): op = FETCH2; if (NILP (TOP)) - goto op_branch; - DISCARD (1); + { + BYTE_CODE_QUIT; + CHECK_RANGE (op); + stack.pc = stack.byte_string_start + op; + } NEXT; CASE (Bgotoifnonnilelsepop): op = FETCH2; if (!NILP (TOP)) - goto op_branch; - DISCARD (1); + { + BYTE_CODE_QUIT; + CHECK_RANGE (op); + stack.pc = stack.byte_string_start + op; + } + else DISCARD (1); NEXT; CASE (BRgoto): - op = FETCH - 128; - goto op_relative_branch; + BYTE_CODE_QUIT; + stack.pc += (int) *stack.pc - 127; + NEXT; CASE (BRgotoifnil): - op = FETCH - 128; if (NILP (POP)) - goto op_relative_branch; + { + BYTE_CODE_QUIT; + stack.pc += (int) *stack.pc - 128; + } + stack.pc++; NEXT; CASE (BRgotoifnonnil): - op = FETCH - 128; if (!NILP (POP)) - goto op_relative_branch; + { + BYTE_CODE_QUIT; + stack.pc += (int) *stack.pc - 128; + } + stack.pc++; NEXT; CASE (BRgotoifnilelsepop): - op = FETCH - 128; + op = *stack.pc++; if (NILP (TOP)) - goto op_relative_branch; - DISCARD (1); + { + BYTE_CODE_QUIT; + stack.pc += op - 128; + } + else DISCARD (1); NEXT; CASE (BRgotoifnonnilelsepop): - op = FETCH - 128; + op = *stack.pc++; if (!NILP (TOP)) - goto op_relative_branch; - DISCARD (1); + { + BYTE_CODE_QUIT; + stack.pc += op - 128; + } + else DISCARD (1); NEXT; CASE (Breturn): @@ -791,11 +891,15 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, if (sys_setjmp (c->jmp)) { struct handler *c = handlerlist; + int desc; top = c->bytecode_top; - op = c->bytecode_dest; + dest = c->bytecode_dest; handlerlist = c->next; PUSH (c->val); - goto op_branch; + 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; } NEXT; @@ -1364,7 +1468,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 (pc - 1 - bytestr_data)); + make_number (stack.pc - 1 - stack.byte_string_start)); /* Handy byte-codes for lexical binding. */ CASE (Bstack_ref1): @@ -1424,6 +1528,8 @@ 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) { |