diff options
| author | Zach Shaftel | 2020-06-12 17:01:00 -0400 |
|---|---|---|
| committer | Zach Shaftel | 2020-06-12 17:01:00 -0400 |
| commit | f6ec28d7974785b625e395d57cb18d1f2110fe4c (patch) | |
| tree | 9635b02347bf994a52aa98dd5c4445bd5e4fa1a2 | |
| parent | 629d1790ede73d859c503354f2beb1316cf7df8f (diff) | |
| download | emacs-f6ec28d7974785b625e395d57cb18d1f2110fe4c.tar.gz emacs-f6ec28d7974785b625e395d57cb18d1f2110fe4c.zip | |
Store bytecode offset within exec_byte_code
* src/bytecode.c (exec_byte_code): Store offset in the backtrace frame
for the function being executed, before calling Ffuncall.
* src/eval.c (record_in_backtrace): Don't record the offset.
(backtrace_next, backtrace_top): Move declarations to lisp.h.
* src/lisp.h (backtrace_next, backtrace_top): Declare.
| -rw-r--r-- | src/bytecode.c | 11 | ||||
| -rw-r--r-- | src/eval.c | 9 | ||||
| -rw-r--r-- | src/lisp.h | 3 |
3 files changed, 11 insertions, 12 deletions
diff --git a/src/bytecode.c b/src/bytecode.c index 6b7e9cbc7b9..f4900fc588f 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -378,6 +378,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 378 | memcpy (bytestr_data, SDATA (bytestr), bytestr_length); | 378 | memcpy (bytestr_data, SDATA (bytestr), bytestr_length); |
| 379 | unsigned char const *pc = bytestr_data; | 379 | unsigned char const *pc = bytestr_data; |
| 380 | ptrdiff_t count = SPECPDL_INDEX (); | 380 | ptrdiff_t count = SPECPDL_INDEX (); |
| 381 | union specbinding *bt_frame = specpdl_ptr; | ||
| 382 | bt_frame = backtrace_next (bt_frame); | ||
| 381 | 383 | ||
| 382 | if (!NILP (args_template)) | 384 | if (!NILP (args_template)) |
| 383 | { | 385 | { |
| @@ -424,14 +426,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 424 | Threading provides a performance boost. These macros are how | 426 | Threading provides a performance boost. These macros are how |
| 425 | we allow the code to be compiled both ways. */ | 427 | we allow the code to be compiled both ways. */ |
| 426 | #ifdef BYTE_CODE_THREADED | 428 | #ifdef BYTE_CODE_THREADED |
| 427 | #define UPDATE_OFFSET (backtrace_byte_offset = pc - bytestr_data); | 429 | #define UPDATE_OFFSET(to) \ |
| 430 | if (bt_frame->kind == SPECPDL_BACKTRACE) \ | ||
| 431 | bt_frame->bt.bytecode_offset = (to); | ||
| 428 | /* The CASE macro introduces an instruction's body. It is | 432 | /* The CASE macro introduces an instruction's body. It is |
| 429 | either a label or a case label. */ | 433 | either a label or a case label. */ |
| 430 | #define CASE(OP) insn_ ## OP | 434 | #define CASE(OP) insn_ ## OP |
| 431 | /* NEXT is invoked at the end of an instruction to go to the | 435 | /* NEXT is invoked at the end of an instruction to go to the |
| 432 | next instruction. It is either a computed goto, or a | 436 | next instruction. It is either a computed goto, or a |
| 433 | plain break. */ | 437 | plain break. */ |
| 434 | #define NEXT UPDATE_OFFSET goto *(targets[op = FETCH]) | 438 | #define NEXT goto *(targets[op = FETCH]) |
| 435 | /* FIRST is like NEXT, but is only used at the start of the | 439 | /* FIRST is like NEXT, but is only used at the start of the |
| 436 | interpreter body. In the switch-based interpreter it is the | 440 | interpreter body. In the switch-based interpreter it is the |
| 437 | switch, so the threaded definition must include a semicolon. */ | 441 | switch, so the threaded definition must include a semicolon. */ |
| @@ -633,6 +637,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 633 | } | 637 | } |
| 634 | } | 638 | } |
| 635 | #endif | 639 | #endif |
| 640 | UPDATE_OFFSET(pc - bytestr_data); | ||
| 636 | TOP = Ffuncall (op + 1, &TOP); | 641 | TOP = Ffuncall (op + 1, &TOP); |
| 637 | NEXT; | 642 | NEXT; |
| 638 | } | 643 | } |
| @@ -1449,7 +1454,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1449 | unbind_to (count, Qnil); | 1454 | unbind_to (count, Qnil); |
| 1450 | error ("binding stack not balanced (serious byte compiler bug)"); | 1455 | error ("binding stack not balanced (serious byte compiler bug)"); |
| 1451 | } | 1456 | } |
| 1452 | backtrace_byte_offset = -1; | 1457 | UPDATE_OFFSET(-1); |
| 1453 | Lisp_Object result = TOP; | 1458 | Lisp_Object result = TOP; |
| 1454 | SAFE_FREE (); | 1459 | SAFE_FREE (); |
| 1455 | return result; | 1460 | return result; |
diff --git a/src/eval.c b/src/eval.c index 5b43b81a6ca..26e552ea547 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -56,14 +56,10 @@ Lisp_Object Vrun_hooks; | |||
| 56 | /* FIXME: We should probably get rid of this! */ | 56 | /* FIXME: We should probably get rid of this! */ |
| 57 | Lisp_Object Vsignaling_function; | 57 | Lisp_Object Vsignaling_function; |
| 58 | 58 | ||
| 59 | int backtrace_byte_offset = -1; | ||
| 60 | |||
| 61 | /* These would ordinarily be static, but they need to be visible to GDB. */ | 59 | /* These would ordinarily be static, but they need to be visible to GDB. */ |
| 62 | bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; | 60 | bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; |
| 63 | Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE; | 61 | Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE; |
| 64 | Lisp_Object backtrace_function (union specbinding *) EXTERNALLY_VISIBLE; | 62 | Lisp_Object backtrace_function (union specbinding *) EXTERNALLY_VISIBLE; |
| 65 | union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE; | ||
| 66 | union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; | ||
| 67 | 63 | ||
| 68 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); | 64 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); |
| 69 | static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, ptrdiff_t); | 65 | static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, ptrdiff_t); |
| @@ -2156,10 +2152,7 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) | |||
| 2156 | specpdl_ptr->bt.function = function; | 2152 | specpdl_ptr->bt.function = function; |
| 2157 | current_thread->stack_top = specpdl_ptr->bt.args = args; | 2153 | current_thread->stack_top = specpdl_ptr->bt.args = args; |
| 2158 | specpdl_ptr->bt.nargs = nargs; | 2154 | specpdl_ptr->bt.nargs = nargs; |
| 2159 | union specbinding *nxt = specpdl_ptr; | 2155 | specpdl_ptr->bt.bytecode_offset = -1; |
| 2160 | nxt = backtrace_next(nxt); | ||
| 2161 | if (nxt->kind == SPECPDL_BACKTRACE) | ||
| 2162 | nxt->bt.bytecode_offset = backtrace_byte_offset; | ||
| 2163 | grow_specpdl (); | 2156 | grow_specpdl (); |
| 2164 | 2157 | ||
| 2165 | return count; | 2158 | return count; |
diff --git a/src/lisp.h b/src/lisp.h index ef6302a4670..8a7f62df226 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -4113,7 +4113,6 @@ extern Lisp_Object Vautoload_queue; | |||
| 4113 | extern Lisp_Object Vrun_hooks; | 4113 | extern Lisp_Object Vrun_hooks; |
| 4114 | extern Lisp_Object Vsignaling_function; | 4114 | extern Lisp_Object Vsignaling_function; |
| 4115 | extern Lisp_Object inhibit_lisp_code; | 4115 | extern Lisp_Object inhibit_lisp_code; |
| 4116 | extern int backtrace_byte_offset; | ||
| 4117 | 4116 | ||
| 4118 | /* To run a normal hook, use the appropriate function from the list below. | 4117 | /* To run a normal hook, use the appropriate function from the list below. |
| 4119 | The calling convention: | 4118 | The calling convention: |
| @@ -4195,6 +4194,8 @@ extern void prog_ignore (Lisp_Object); | |||
| 4195 | extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t); | 4194 | extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t); |
| 4196 | extern void mark_specpdl (union specbinding *first, union specbinding *ptr); | 4195 | extern void mark_specpdl (union specbinding *first, union specbinding *ptr); |
| 4197 | extern void get_backtrace (Lisp_Object array); | 4196 | extern void get_backtrace (Lisp_Object array); |
| 4197 | extern union specbinding *backtrace_next (union specbinding *pdl) EXTERNALLY_VISIBLE; | ||
| 4198 | extern union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; | ||
| 4198 | Lisp_Object backtrace_top_function (void); | 4199 | Lisp_Object backtrace_top_function (void); |
| 4199 | extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); | 4200 | extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); |
| 4200 | 4201 | ||