diff options
| author | Stefan Monnier | 2013-06-03 05:01:53 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2013-06-03 05:01:53 -0400 |
| commit | 2f592f95d2344d4a28eb946848330dca49e0f5ee (patch) | |
| tree | a920b413f4367d49b7f7feeb3fdf63c5e9018dcb | |
| parent | e5e4a94293d5a9a157557e53b4fea4e5d280673e (diff) | |
| download | emacs-2f592f95d2344d4a28eb946848330dca49e0f5ee.tar.gz emacs-2f592f95d2344d4a28eb946848330dca49e0f5ee.zip | |
Merge the specpdl and backtrace stacks. Make the structure of the
specpdl entries more obvious via a tagged union of structs.
* src/lisp.h (BITS_PER_PTRDIFF_T): New constant.
(enum specbind_tag): New enum.
(struct specbinding): Make it a tagged union of structs.
Add a case for backtrace records.
(specpdl_symbol, specpdl_old_value, specpdl_where, specpdl_arg)
(specpdl_func, backtrace_function, backtrace_nargs, backtrace_args)
(backtrace_debug_on_exit): New accessors.
(struct backtrace): Remove.
(struct catchtag): Remove backlist field.
* src/data.c (let_shadows_buffer_binding_p, let_shadows_global_binding_p):
Move to eval.c.
(Flocal_variable_p): Speed up the common case where the binding is
already loaded.
* src/eval.c (backtrace_list): Remove.
(set_specpdl_symbol, set_specpdl_old_value): Remove.
(set_backtrace_args, set_backtrace_nargs)
(set_backtrace_debug_on_exit, backtrace_p, backtrace_top)
(backtrace_next): New functions.
(Fdefvaralias, Fdefvar): Adjust to new specpdl format.
(unwind_to_catch, internal_lisp_condition_case)
(internal_condition_case, internal_condition_case_1)
(internal_condition_case_2, internal_condition_case_n): Don't bother
with backtrace_list any more.
(Fsignal): Adjust to new backtrace format.
(grow_specpdl): Move up.
(record_in_backtrace): New function.
(eval_sub, Ffuncall): Use it.
(apply_lambda): Adjust to new backtrace format.
(let_shadows_buffer_binding_p, let_shadows_global_binding_p): Move from
data.c.
(specbind): Adjust to new specpdl format. Simplify.
(record_unwind_protect, unbind_to): Adjust to new specpdl format.
(Fbacktrace_debug, Fbacktrace, Fbacktrace_frame): Adjust to new
backtrace format.
(mark_backtrace): Remove.
(mark_specpdl, get_backtrace, backtrace_top_function): New functions.
* src/xdisp.c (redisplay_internal): Use record_in_backtrace.
* src/alloc.c (Fgarbage_collect): Use record_in_backtrace.
Use mark_specpdl.
* src/profiler.c (record_backtrace): Use get_backtrace.
(handle_profiler_signal): Use backtrace_top_function.
* src/.gdbinit (xbacktrace, hookpost-backtrace): Use new backtrace
accessor functions.
| -rw-r--r-- | src/.gdbinit | 21 | ||||
| -rw-r--r-- | src/ChangeLog | 48 | ||||
| -rw-r--r-- | src/alloc.c | 17 | ||||
| -rw-r--r-- | src/data.c | 57 | ||||
| -rw-r--r-- | src/eval.c | 478 | ||||
| -rw-r--r-- | src/lisp.h | 105 | ||||
| -rw-r--r-- | src/profiler.c | 17 | ||||
| -rw-r--r-- | src/xdisp.c | 9 |
8 files changed, 421 insertions, 331 deletions
diff --git a/src/.gdbinit b/src/.gdbinit index c4604e6e2b0..1bfc293c466 100644 --- a/src/.gdbinit +++ b/src/.gdbinit | |||
| @@ -1150,17 +1150,18 @@ Print $ assuming it is a list font (font-spec, font-entity, or font-object). | |||
| 1150 | end | 1150 | end |
| 1151 | 1151 | ||
| 1152 | define xbacktrace | 1152 | define xbacktrace |
| 1153 | set $bt = backtrace_list | 1153 | set $bt = backtrace_top () |
| 1154 | while $bt | 1154 | while backtrace_p ($bt) |
| 1155 | xgettype ($bt->function) | 1155 | set $fun = backtrace_function ($bt) |
| 1156 | xgettype $fun | ||
| 1156 | if $type == Lisp_Symbol | 1157 | if $type == Lisp_Symbol |
| 1157 | xprintsym ($bt->function) | 1158 | xprintsym $fun |
| 1158 | printf " (0x%x)\n", $bt->args | 1159 | printf " (0x%x)\n", backtrace_args ($bt) |
| 1159 | else | 1160 | else |
| 1160 | xgetptr $bt->function | 1161 | xgetptr $fun |
| 1161 | printf "0x%x ", $ptr | 1162 | printf "0x%x ", $ptr |
| 1162 | if $type == Lisp_Vectorlike | 1163 | if $type == Lisp_Vectorlike |
| 1163 | xgetptr ($bt->function) | 1164 | xgetptr $fun |
| 1164 | set $size = ((struct Lisp_Vector *) $ptr)->header.size | 1165 | set $size = ((struct Lisp_Vector *) $ptr)->header.size |
| 1165 | if ($size & PSEUDOVECTOR_FLAG) | 1166 | if ($size & PSEUDOVECTOR_FLAG) |
| 1166 | output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS) | 1167 | output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS) |
| @@ -1172,7 +1173,7 @@ define xbacktrace | |||
| 1172 | end | 1173 | end |
| 1173 | echo \n | 1174 | echo \n |
| 1174 | end | 1175 | end |
| 1175 | set $bt = $bt->next | 1176 | set $bt = backtrace_next ($bt) |
| 1176 | end | 1177 | end |
| 1177 | end | 1178 | end |
| 1178 | document xbacktrace | 1179 | document xbacktrace |
| @@ -1220,8 +1221,8 @@ end | |||
| 1220 | 1221 | ||
| 1221 | # Show Lisp backtrace after normal backtrace. | 1222 | # Show Lisp backtrace after normal backtrace. |
| 1222 | define hookpost-backtrace | 1223 | define hookpost-backtrace |
| 1223 | set $bt = backtrace_list | 1224 | set $bt = backtrace_top () |
| 1224 | if $bt | 1225 | if backtrace_p ($bt) |
| 1225 | echo \n | 1226 | echo \n |
| 1226 | echo Lisp Backtrace:\n | 1227 | echo Lisp Backtrace:\n |
| 1227 | xbacktrace | 1228 | xbacktrace |
diff --git a/src/ChangeLog b/src/ChangeLog index a7791444e09..41687e07593 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,51 @@ | |||
| 1 | 2013-06-03 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | Merge the specpdl and backtrace stacks. Make the structure of the | ||
| 4 | specpdl entries more obvious via a tagged union of structs. | ||
| 5 | * lisp.h (BITS_PER_PTRDIFF_T): New constant. | ||
| 6 | (enum specbind_tag): New enum. | ||
| 7 | (struct specbinding): Make it a tagged union of structs. | ||
| 8 | Add a case for backtrace records. | ||
| 9 | (specpdl_symbol, specpdl_old_value, specpdl_where, specpdl_arg) | ||
| 10 | (specpdl_func, backtrace_function, backtrace_nargs, backtrace_args) | ||
| 11 | (backtrace_debug_on_exit): New accessors. | ||
| 12 | (struct backtrace): Remove. | ||
| 13 | (struct catchtag): Remove backlist field. | ||
| 14 | * data.c (let_shadows_buffer_binding_p, let_shadows_global_binding_p): | ||
| 15 | Move to eval.c. | ||
| 16 | (Flocal_variable_p): Speed up the common case where the binding is | ||
| 17 | already loaded. | ||
| 18 | * eval.c (backtrace_list): Remove. | ||
| 19 | (set_specpdl_symbol, set_specpdl_old_value): Remove. | ||
| 20 | (set_backtrace_args, set_backtrace_nargs) | ||
| 21 | (set_backtrace_debug_on_exit, backtrace_p, backtrace_top) | ||
| 22 | (backtrace_next): New functions. | ||
| 23 | (Fdefvaralias, Fdefvar): Adjust to new specpdl format. | ||
| 24 | (unwind_to_catch, internal_lisp_condition_case) | ||
| 25 | (internal_condition_case, internal_condition_case_1) | ||
| 26 | (internal_condition_case_2, internal_condition_case_n): Don't bother | ||
| 27 | with backtrace_list any more. | ||
| 28 | (Fsignal): Adjust to new backtrace format. | ||
| 29 | (grow_specpdl): Move up. | ||
| 30 | (record_in_backtrace): New function. | ||
| 31 | (eval_sub, Ffuncall): Use it. | ||
| 32 | (apply_lambda): Adjust to new backtrace format. | ||
| 33 | (let_shadows_buffer_binding_p, let_shadows_global_binding_p): Move from | ||
| 34 | data.c. | ||
| 35 | (specbind): Adjust to new specpdl format. Simplify. | ||
| 36 | (record_unwind_protect, unbind_to): Adjust to new specpdl format. | ||
| 37 | (Fbacktrace_debug, Fbacktrace, Fbacktrace_frame): Adjust to new | ||
| 38 | backtrace format. | ||
| 39 | (mark_backtrace): Remove. | ||
| 40 | (mark_specpdl, get_backtrace, backtrace_top_function): New functions. | ||
| 41 | * xdisp.c (redisplay_internal): Use record_in_backtrace. | ||
| 42 | * alloc.c (Fgarbage_collect): Use record_in_backtrace. | ||
| 43 | Use mark_specpdl. | ||
| 44 | * profiler.c (record_backtrace): Use get_backtrace. | ||
| 45 | (handle_profiler_signal): Use backtrace_top_function. | ||
| 46 | * .gdbinit (xbacktrace, hookpost-backtrace): Use new backtrace | ||
| 47 | accessor functions. | ||
| 48 | |||
| 1 | 2013-06-02 Jan Djärv <jan.h.d@swipnet.se> | 49 | 2013-06-02 Jan Djärv <jan.h.d@swipnet.se> |
| 2 | 50 | ||
| 3 | * process.h (catch_child_signal): Declare. | 51 | * process.h (catch_child_signal): Declare. |
diff --git a/src/alloc.c b/src/alloc.c index 7a56c78e2ba..cce0fff4fd4 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -5165,7 +5165,6 @@ returns nil, because real GC can't be done. | |||
| 5165 | See Info node `(elisp)Garbage Collection'. */) | 5165 | See Info node `(elisp)Garbage Collection'. */) |
| 5166 | (void) | 5166 | (void) |
| 5167 | { | 5167 | { |
| 5168 | struct specbinding *bind; | ||
| 5169 | struct buffer *nextb; | 5168 | struct buffer *nextb; |
| 5170 | char stack_top_variable; | 5169 | char stack_top_variable; |
| 5171 | ptrdiff_t i; | 5170 | ptrdiff_t i; |
| @@ -5174,7 +5173,6 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5174 | EMACS_TIME start; | 5173 | EMACS_TIME start; |
| 5175 | Lisp_Object retval = Qnil; | 5174 | Lisp_Object retval = Qnil; |
| 5176 | size_t tot_before = 0; | 5175 | size_t tot_before = 0; |
| 5177 | struct backtrace backtrace; | ||
| 5178 | 5176 | ||
| 5179 | if (abort_on_gc) | 5177 | if (abort_on_gc) |
| 5180 | emacs_abort (); | 5178 | emacs_abort (); |
| @@ -5185,12 +5183,7 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5185 | return Qnil; | 5183 | return Qnil; |
| 5186 | 5184 | ||
| 5187 | /* Record this function, so it appears on the profiler's backtraces. */ | 5185 | /* Record this function, so it appears on the profiler's backtraces. */ |
| 5188 | backtrace.next = backtrace_list; | 5186 | record_in_backtrace (Qautomatic_gc, &Qnil, 0); |
| 5189 | backtrace.function = Qautomatic_gc; | ||
| 5190 | backtrace.args = &Qnil; | ||
| 5191 | backtrace.nargs = 0; | ||
| 5192 | backtrace.debug_on_exit = 0; | ||
| 5193 | backtrace_list = &backtrace; | ||
| 5194 | 5187 | ||
| 5195 | check_cons_list (); | 5188 | check_cons_list (); |
| 5196 | 5189 | ||
| @@ -5257,11 +5250,7 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5257 | for (i = 0; i < staticidx; i++) | 5250 | for (i = 0; i < staticidx; i++) |
| 5258 | mark_object (*staticvec[i]); | 5251 | mark_object (*staticvec[i]); |
| 5259 | 5252 | ||
| 5260 | for (bind = specpdl; bind != specpdl_ptr; bind++) | 5253 | mark_specpdl (); |
| 5261 | { | ||
| 5262 | mark_object (bind->symbol); | ||
| 5263 | mark_object (bind->old_value); | ||
| 5264 | } | ||
| 5265 | mark_terminals (); | 5254 | mark_terminals (); |
| 5266 | mark_kboards (); | 5255 | mark_kboards (); |
| 5267 | 5256 | ||
| @@ -5295,7 +5284,6 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5295 | mark_object (handler->var); | 5284 | mark_object (handler->var); |
| 5296 | } | 5285 | } |
| 5297 | } | 5286 | } |
| 5298 | mark_backtrace (); | ||
| 5299 | #endif | 5287 | #endif |
| 5300 | 5288 | ||
| 5301 | #ifdef HAVE_WINDOW_SYSTEM | 5289 | #ifdef HAVE_WINDOW_SYSTEM |
| @@ -5486,7 +5474,6 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5486 | malloc_probe (swept); | 5474 | malloc_probe (swept); |
| 5487 | } | 5475 | } |
| 5488 | 5476 | ||
| 5489 | backtrace_list = backtrace.next; | ||
| 5490 | return retval; | 5477 | return retval; |
| 5491 | } | 5478 | } |
| 5492 | 5479 | ||
diff --git a/src/data.c b/src/data.c index 6622088b648..b33d9656d57 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -1069,40 +1069,6 @@ DEFUN ("set", Fset, Sset, 2, 2, 0, | |||
| 1069 | return newval; | 1069 | return newval; |
| 1070 | } | 1070 | } |
| 1071 | 1071 | ||
| 1072 | /* Return true if SYMBOL currently has a let-binding | ||
| 1073 | which was made in the buffer that is now current. */ | ||
| 1074 | |||
| 1075 | static bool | ||
| 1076 | let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) | ||
| 1077 | { | ||
| 1078 | struct specbinding *p; | ||
| 1079 | |||
| 1080 | for (p = specpdl_ptr; p > specpdl; ) | ||
| 1081 | if ((--p)->func == NULL | ||
| 1082 | && CONSP (p->symbol)) | ||
| 1083 | { | ||
| 1084 | struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol)); | ||
| 1085 | eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS); | ||
| 1086 | if (symbol == let_bound_symbol | ||
| 1087 | && XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer) | ||
| 1088 | return 1; | ||
| 1089 | } | ||
| 1090 | |||
| 1091 | return 0; | ||
| 1092 | } | ||
| 1093 | |||
| 1094 | static bool | ||
| 1095 | let_shadows_global_binding_p (Lisp_Object symbol) | ||
| 1096 | { | ||
| 1097 | struct specbinding *p; | ||
| 1098 | |||
| 1099 | for (p = specpdl_ptr; p > specpdl; ) | ||
| 1100 | if ((--p)->func == NULL && EQ (p->symbol, symbol)) | ||
| 1101 | return 1; | ||
| 1102 | |||
| 1103 | return 0; | ||
| 1104 | } | ||
| 1105 | |||
| 1106 | /* Store the value NEWVAL into SYMBOL. | 1072 | /* Store the value NEWVAL into SYMBOL. |
| 1107 | If buffer/frame-locality is an issue, WHERE specifies which context to use. | 1073 | If buffer/frame-locality is an issue, WHERE specifies which context to use. |
| 1108 | (nil stands for the current buffer/frame). | 1074 | (nil stands for the current buffer/frame). |
| @@ -1841,17 +1807,18 @@ BUFFER defaults to the current buffer. */) | |||
| 1841 | XSETBUFFER (tmp, buf); | 1807 | XSETBUFFER (tmp, buf); |
| 1842 | XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ | 1808 | XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ |
| 1843 | 1809 | ||
| 1844 | for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) | 1810 | if (EQ (blv->where, tmp)) /* The binding is already loaded. */ |
| 1845 | { | 1811 | return blv_found (blv) ? Qt : Qnil; |
| 1846 | elt = XCAR (tail); | 1812 | else |
| 1847 | if (EQ (variable, XCAR (elt))) | 1813 | for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) |
| 1848 | { | 1814 | { |
| 1849 | eassert (!blv->frame_local); | 1815 | elt = XCAR (tail); |
| 1850 | eassert (blv_found (blv) || !EQ (blv->where, tmp)); | 1816 | if (EQ (variable, XCAR (elt))) |
| 1851 | return Qt; | 1817 | { |
| 1852 | } | 1818 | eassert (!blv->frame_local); |
| 1853 | } | 1819 | return Qt; |
| 1854 | eassert (!blv_found (blv) || !EQ (blv->where, tmp)); | 1820 | } |
| 1821 | } | ||
| 1855 | return Qnil; | 1822 | return Qnil; |
| 1856 | } | 1823 | } |
| 1857 | case SYMBOL_FORWARDED: | 1824 | case SYMBOL_FORWARDED: |
diff --git a/src/eval.c b/src/eval.c index 69483a9b205..fac71e34a22 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -32,8 +32,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 32 | #include "xterm.h" | 32 | #include "xterm.h" |
| 33 | #endif | 33 | #endif |
| 34 | 34 | ||
| 35 | struct backtrace *backtrace_list; | ||
| 36 | |||
| 37 | #if !BYTE_MARK_STACK | 35 | #if !BYTE_MARK_STACK |
| 38 | static | 36 | static |
| 39 | #endif | 37 | #endif |
| @@ -105,7 +103,7 @@ static EMACS_INT when_entered_debugger; | |||
| 105 | 103 | ||
| 106 | /* The function from which the last `signal' was called. Set in | 104 | /* The function from which the last `signal' was called. Set in |
| 107 | Fsignal. */ | 105 | Fsignal. */ |
| 108 | 106 | /* FIXME: We should probably get rid of this! */ | |
| 109 | Lisp_Object Vsignaling_function; | 107 | Lisp_Object Vsignaling_function; |
| 110 | 108 | ||
| 111 | /* If non-nil, Lisp code must not be run since some part of Emacs is | 109 | /* If non-nil, Lisp code must not be run since some part of Emacs is |
| @@ -117,20 +115,37 @@ Lisp_Object inhibit_lisp_code; | |||
| 117 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); | 115 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); |
| 118 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); | 116 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); |
| 119 | 117 | ||
| 120 | /* Functions to set Lisp_Object slots of struct specbinding. */ | 118 | /* Functions to modify slots of backtrace records. */ |
| 121 | 119 | ||
| 122 | static void | 120 | static void set_backtrace_args (struct specbinding *pdl, Lisp_Object *args) |
| 123 | set_specpdl_symbol (Lisp_Object symbol) | 121 | { eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.args = args; } |
| 122 | |||
| 123 | static void set_backtrace_nargs (struct specbinding *pdl, ptrdiff_t n) | ||
| 124 | { eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.nargs = n; } | ||
| 125 | |||
| 126 | void set_backtrace_debug_on_exit (struct specbinding *pdl, bool doe) | ||
| 127 | { eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.debug_on_exit = doe; } | ||
| 128 | |||
| 129 | /* Helper functions to scan the backtrace. */ | ||
| 130 | |||
| 131 | LISP_INLINE bool backtrace_p (struct specbinding *pdl) | ||
| 132 | { return pdl >= specpdl; } | ||
| 133 | LISP_INLINE struct specbinding *backtrace_top (void) | ||
| 124 | { | 134 | { |
| 125 | specpdl_ptr->symbol = symbol; | 135 | struct specbinding *pdl = specpdl_ptr - 1; |
| 136 | while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE) \ | ||
| 137 | pdl--; | ||
| 138 | return pdl; | ||
| 126 | } | 139 | } |
| 127 | 140 | LISP_INLINE struct specbinding *backtrace_next (struct specbinding *pdl) | |
| 128 | static void | ||
| 129 | set_specpdl_old_value (Lisp_Object oldval) | ||
| 130 | { | 141 | { |
| 131 | specpdl_ptr->old_value = oldval; | 142 | pdl--; |
| 143 | while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE) | ||
| 144 | pdl--; | ||
| 145 | return pdl; | ||
| 132 | } | 146 | } |
| 133 | 147 | ||
| 148 | |||
| 134 | void | 149 | void |
| 135 | init_eval_once (void) | 150 | init_eval_once (void) |
| 136 | { | 151 | { |
| @@ -151,7 +166,6 @@ init_eval (void) | |||
| 151 | specpdl_ptr = specpdl; | 166 | specpdl_ptr = specpdl; |
| 152 | catchlist = 0; | 167 | catchlist = 0; |
| 153 | handlerlist = 0; | 168 | handlerlist = 0; |
| 154 | backtrace_list = 0; | ||
| 155 | Vquit_flag = Qnil; | 169 | Vquit_flag = Qnil; |
| 156 | debug_on_next_call = 0; | 170 | debug_on_next_call = 0; |
| 157 | lisp_eval_depth = 0; | 171 | lisp_eval_depth = 0; |
| @@ -234,7 +248,7 @@ static void | |||
| 234 | do_debug_on_call (Lisp_Object code) | 248 | do_debug_on_call (Lisp_Object code) |
| 235 | { | 249 | { |
| 236 | debug_on_next_call = 0; | 250 | debug_on_next_call = 0; |
| 237 | backtrace_list->debug_on_exit = 1; | 251 | set_backtrace_debug_on_exit (specpdl_ptr - 1, true); |
| 238 | call_debugger (Fcons (code, Qnil)); | 252 | call_debugger (Fcons (code, Qnil)); |
| 239 | } | 253 | } |
| 240 | 254 | ||
| @@ -530,9 +544,8 @@ The return value is BASE-VARIABLE. */) | |||
| 530 | struct specbinding *p; | 544 | struct specbinding *p; |
| 531 | 545 | ||
| 532 | for (p = specpdl_ptr; p > specpdl; ) | 546 | for (p = specpdl_ptr; p > specpdl; ) |
| 533 | if ((--p)->func == NULL | 547 | if ((--p)->kind >= SPECPDL_LET |
| 534 | && (EQ (new_alias, | 548 | && (EQ (new_alias, specpdl_symbol (p)))) |
| 535 | CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol))) | ||
| 536 | error ("Don't know how to make a let-bound variable an alias"); | 549 | error ("Don't know how to make a let-bound variable an alias"); |
| 537 | } | 550 | } |
| 538 | 551 | ||
| @@ -597,8 +610,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) | |||
| 597 | struct specbinding *pdl = specpdl_ptr; | 610 | struct specbinding *pdl = specpdl_ptr; |
| 598 | while (pdl > specpdl) | 611 | while (pdl > specpdl) |
| 599 | { | 612 | { |
| 600 | if (EQ ((--pdl)->symbol, sym) && !pdl->func | 613 | if ((--pdl)->kind >= SPECPDL_LET |
| 601 | && EQ (pdl->old_value, Qunbound)) | 614 | && EQ (specpdl_symbol (pdl), sym) |
| 615 | && EQ (specpdl_old_value (pdl), Qunbound)) | ||
| 602 | { | 616 | { |
| 603 | message_with_string | 617 | message_with_string |
| 604 | ("Warning: defvar ignored because %s is let-bound", | 618 | ("Warning: defvar ignored because %s is let-bound", |
| @@ -937,7 +951,7 @@ usage: (catch TAG BODY...) */) | |||
| 937 | 951 | ||
| 938 | /* Set up a catch, then call C function FUNC on argument ARG. | 952 | /* Set up a catch, then call C function FUNC on argument ARG. |
| 939 | FUNC should return a Lisp_Object. | 953 | FUNC should return a Lisp_Object. |
| 940 | This is how catches are done from within C code. */ | 954 | This is how catches are done from within C code. */ |
| 941 | 955 | ||
| 942 | Lisp_Object | 956 | Lisp_Object |
| 943 | internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) | 957 | internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) |
| @@ -949,7 +963,6 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object | |||
| 949 | c.next = catchlist; | 963 | c.next = catchlist; |
| 950 | c.tag = tag; | 964 | c.tag = tag; |
| 951 | c.val = Qnil; | 965 | c.val = Qnil; |
| 952 | c.backlist = backtrace_list; | ||
| 953 | c.handlerlist = handlerlist; | 966 | c.handlerlist = handlerlist; |
| 954 | c.lisp_eval_depth = lisp_eval_depth; | 967 | c.lisp_eval_depth = lisp_eval_depth; |
| 955 | c.pdlcount = SPECPDL_INDEX (); | 968 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1014,7 +1027,6 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value) | |||
| 1014 | #ifdef DEBUG_GCPRO | 1027 | #ifdef DEBUG_GCPRO |
| 1015 | gcpro_level = gcprolist ? gcprolist->level + 1 : 0; | 1028 | gcpro_level = gcprolist ? gcprolist->level + 1 : 0; |
| 1016 | #endif | 1029 | #endif |
| 1017 | backtrace_list = catch->backlist; | ||
| 1018 | lisp_eval_depth = catch->lisp_eval_depth; | 1030 | lisp_eval_depth = catch->lisp_eval_depth; |
| 1019 | 1031 | ||
| 1020 | sys_longjmp (catch->jmp, 1); | 1032 | sys_longjmp (catch->jmp, 1); |
| @@ -1115,7 +1127,6 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, | |||
| 1115 | 1127 | ||
| 1116 | c.tag = Qnil; | 1128 | c.tag = Qnil; |
| 1117 | c.val = Qnil; | 1129 | c.val = Qnil; |
| 1118 | c.backlist = backtrace_list; | ||
| 1119 | c.handlerlist = handlerlist; | 1130 | c.handlerlist = handlerlist; |
| 1120 | c.lisp_eval_depth = lisp_eval_depth; | 1131 | c.lisp_eval_depth = lisp_eval_depth; |
| 1121 | c.pdlcount = SPECPDL_INDEX (); | 1132 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1131,7 +1142,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, | |||
| 1131 | 1142 | ||
| 1132 | /* Note that this just undoes the binding of h.var; whoever | 1143 | /* Note that this just undoes the binding of h.var; whoever |
| 1133 | longjumped to us unwound the stack to c.pdlcount before | 1144 | longjumped to us unwound the stack to c.pdlcount before |
| 1134 | throwing. */ | 1145 | throwing. */ |
| 1135 | unbind_to (c.pdlcount, Qnil); | 1146 | unbind_to (c.pdlcount, Qnil); |
| 1136 | return val; | 1147 | return val; |
| 1137 | } | 1148 | } |
| @@ -1170,7 +1181,6 @@ internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers, | |||
| 1170 | 1181 | ||
| 1171 | c.tag = Qnil; | 1182 | c.tag = Qnil; |
| 1172 | c.val = Qnil; | 1183 | c.val = Qnil; |
| 1173 | c.backlist = backtrace_list; | ||
| 1174 | c.handlerlist = handlerlist; | 1184 | c.handlerlist = handlerlist; |
| 1175 | c.lisp_eval_depth = lisp_eval_depth; | 1185 | c.lisp_eval_depth = lisp_eval_depth; |
| 1176 | c.pdlcount = SPECPDL_INDEX (); | 1186 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1208,7 +1218,6 @@ internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg, | |||
| 1208 | 1218 | ||
| 1209 | c.tag = Qnil; | 1219 | c.tag = Qnil; |
| 1210 | c.val = Qnil; | 1220 | c.val = Qnil; |
| 1211 | c.backlist = backtrace_list; | ||
| 1212 | c.handlerlist = handlerlist; | 1221 | c.handlerlist = handlerlist; |
| 1213 | c.lisp_eval_depth = lisp_eval_depth; | 1222 | c.lisp_eval_depth = lisp_eval_depth; |
| 1214 | c.pdlcount = SPECPDL_INDEX (); | 1223 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1250,7 +1259,6 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object), | |||
| 1250 | 1259 | ||
| 1251 | c.tag = Qnil; | 1260 | c.tag = Qnil; |
| 1252 | c.val = Qnil; | 1261 | c.val = Qnil; |
| 1253 | c.backlist = backtrace_list; | ||
| 1254 | c.handlerlist = handlerlist; | 1262 | c.handlerlist = handlerlist; |
| 1255 | c.lisp_eval_depth = lisp_eval_depth; | 1263 | c.lisp_eval_depth = lisp_eval_depth; |
| 1256 | c.pdlcount = SPECPDL_INDEX (); | 1264 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1294,7 +1302,6 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), | |||
| 1294 | 1302 | ||
| 1295 | c.tag = Qnil; | 1303 | c.tag = Qnil; |
| 1296 | c.val = Qnil; | 1304 | c.val = Qnil; |
| 1297 | c.backlist = backtrace_list; | ||
| 1298 | c.handlerlist = handlerlist; | 1305 | c.handlerlist = handlerlist; |
| 1299 | c.lisp_eval_depth = lisp_eval_depth; | 1306 | c.lisp_eval_depth = lisp_eval_depth; |
| 1300 | c.pdlcount = SPECPDL_INDEX (); | 1307 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1362,7 +1369,6 @@ See also the function `condition-case'. */) | |||
| 1362 | = (NILP (error_symbol) ? Fcar (data) : error_symbol); | 1369 | = (NILP (error_symbol) ? Fcar (data) : error_symbol); |
| 1363 | register Lisp_Object clause = Qnil; | 1370 | register Lisp_Object clause = Qnil; |
| 1364 | struct handler *h; | 1371 | struct handler *h; |
| 1365 | struct backtrace *bp; | ||
| 1366 | 1372 | ||
| 1367 | immediate_quit = 0; | 1373 | immediate_quit = 0; |
| 1368 | abort_on_gc = 0; | 1374 | abort_on_gc = 0; |
| @@ -1398,13 +1404,13 @@ See also the function `condition-case'. */) | |||
| 1398 | too. Don't do this when ERROR_SYMBOL is nil, because that | 1404 | too. Don't do this when ERROR_SYMBOL is nil, because that |
| 1399 | is a memory-full error. */ | 1405 | is a memory-full error. */ |
| 1400 | Vsignaling_function = Qnil; | 1406 | Vsignaling_function = Qnil; |
| 1401 | if (backtrace_list && !NILP (error_symbol)) | 1407 | if (!NILP (error_symbol)) |
| 1402 | { | 1408 | { |
| 1403 | bp = backtrace_list->next; | 1409 | struct specbinding *pdl = backtrace_next (backtrace_top ()); |
| 1404 | if (bp && EQ (bp->function, Qerror)) | 1410 | if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror)) |
| 1405 | bp = bp->next; | 1411 | pdl = backtrace_next (pdl); |
| 1406 | if (bp) | 1412 | if (backtrace_p (pdl)) |
| 1407 | Vsignaling_function = bp->function; | 1413 | Vsignaling_function = backtrace_function (pdl); |
| 1408 | } | 1414 | } |
| 1409 | 1415 | ||
| 1410 | for (h = handlerlist; h; h = h->next) | 1416 | for (h = handlerlist; h; h = h->next) |
| @@ -1901,6 +1907,36 @@ If LEXICAL is t, evaluate using lexical scoping. */) | |||
| 1901 | return unbind_to (count, eval_sub (form)); | 1907 | return unbind_to (count, eval_sub (form)); |
| 1902 | } | 1908 | } |
| 1903 | 1909 | ||
| 1910 | static void | ||
| 1911 | grow_specpdl (void) | ||
| 1912 | { | ||
| 1913 | register ptrdiff_t count = SPECPDL_INDEX (); | ||
| 1914 | ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX); | ||
| 1915 | if (max_size <= specpdl_size) | ||
| 1916 | { | ||
| 1917 | if (max_specpdl_size < 400) | ||
| 1918 | max_size = max_specpdl_size = 400; | ||
| 1919 | if (max_size <= specpdl_size) | ||
| 1920 | signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); | ||
| 1921 | } | ||
| 1922 | specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl); | ||
| 1923 | specpdl_ptr = specpdl + count; | ||
| 1924 | } | ||
| 1925 | |||
| 1926 | LISP_INLINE void | ||
| 1927 | record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) | ||
| 1928 | { | ||
| 1929 | eassert (nargs >= UNEVALLED); | ||
| 1930 | if (specpdl_ptr == specpdl + specpdl_size) | ||
| 1931 | grow_specpdl (); | ||
| 1932 | specpdl_ptr->kind = SPECPDL_BACKTRACE; | ||
| 1933 | specpdl_ptr->v.bt.function = function; | ||
| 1934 | specpdl_ptr->v.bt.args = args; | ||
| 1935 | specpdl_ptr->v.bt.nargs = nargs; | ||
| 1936 | specpdl_ptr->v.bt.debug_on_exit = false; | ||
| 1937 | specpdl_ptr++; | ||
| 1938 | } | ||
| 1939 | |||
| 1904 | /* Eval a sub-expression of the current expression (i.e. in the same | 1940 | /* Eval a sub-expression of the current expression (i.e. in the same |
| 1905 | lexical scope). */ | 1941 | lexical scope). */ |
| 1906 | Lisp_Object | 1942 | Lisp_Object |
| @@ -1908,7 +1944,6 @@ eval_sub (Lisp_Object form) | |||
| 1908 | { | 1944 | { |
| 1909 | Lisp_Object fun, val, original_fun, original_args; | 1945 | Lisp_Object fun, val, original_fun, original_args; |
| 1910 | Lisp_Object funcar; | 1946 | Lisp_Object funcar; |
| 1911 | struct backtrace backtrace; | ||
| 1912 | struct gcpro gcpro1, gcpro2, gcpro3; | 1947 | struct gcpro gcpro1, gcpro2, gcpro3; |
| 1913 | 1948 | ||
| 1914 | if (SYMBOLP (form)) | 1949 | if (SYMBOLP (form)) |
| @@ -1946,12 +1981,8 @@ eval_sub (Lisp_Object form) | |||
| 1946 | original_fun = XCAR (form); | 1981 | original_fun = XCAR (form); |
| 1947 | original_args = XCDR (form); | 1982 | original_args = XCDR (form); |
| 1948 | 1983 | ||
| 1949 | backtrace.next = backtrace_list; | 1984 | /* This also protects them from gc. */ |
| 1950 | backtrace.function = original_fun; /* This also protects them from gc. */ | 1985 | record_in_backtrace (original_fun, &original_args, UNEVALLED); |
| 1951 | backtrace.args = &original_args; | ||
| 1952 | backtrace.nargs = UNEVALLED; | ||
| 1953 | backtrace.debug_on_exit = 0; | ||
| 1954 | backtrace_list = &backtrace; | ||
| 1955 | 1986 | ||
| 1956 | if (debug_on_next_call) | 1987 | if (debug_on_next_call) |
| 1957 | do_debug_on_call (Qt); | 1988 | do_debug_on_call (Qt); |
| @@ -2005,8 +2036,8 @@ eval_sub (Lisp_Object form) | |||
| 2005 | gcpro3.nvars = argnum; | 2036 | gcpro3.nvars = argnum; |
| 2006 | } | 2037 | } |
| 2007 | 2038 | ||
| 2008 | backtrace.args = vals; | 2039 | set_backtrace_args (specpdl_ptr - 1, vals); |
| 2009 | backtrace.nargs = XINT (numargs); | 2040 | set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs)); |
| 2010 | 2041 | ||
| 2011 | val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); | 2042 | val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); |
| 2012 | UNGCPRO; | 2043 | UNGCPRO; |
| @@ -2027,8 +2058,8 @@ eval_sub (Lisp_Object form) | |||
| 2027 | 2058 | ||
| 2028 | UNGCPRO; | 2059 | UNGCPRO; |
| 2029 | 2060 | ||
| 2030 | backtrace.args = argvals; | 2061 | set_backtrace_args (specpdl_ptr - 1, argvals); |
| 2031 | backtrace.nargs = XINT (numargs); | 2062 | set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs)); |
| 2032 | 2063 | ||
| 2033 | switch (i) | 2064 | switch (i) |
| 2034 | { | 2065 | { |
| @@ -2118,9 +2149,9 @@ eval_sub (Lisp_Object form) | |||
| 2118 | check_cons_list (); | 2149 | check_cons_list (); |
| 2119 | 2150 | ||
| 2120 | lisp_eval_depth--; | 2151 | lisp_eval_depth--; |
| 2121 | if (backtrace.debug_on_exit) | 2152 | if (backtrace_debug_on_exit (specpdl_ptr - 1)) |
| 2122 | val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); | 2153 | val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); |
| 2123 | backtrace_list = backtrace.next; | 2154 | specpdl_ptr--; |
| 2124 | 2155 | ||
| 2125 | return val; | 2156 | return val; |
| 2126 | } | 2157 | } |
| @@ -2600,7 +2631,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2600 | ptrdiff_t numargs = nargs - 1; | 2631 | ptrdiff_t numargs = nargs - 1; |
| 2601 | Lisp_Object lisp_numargs; | 2632 | Lisp_Object lisp_numargs; |
| 2602 | Lisp_Object val; | 2633 | Lisp_Object val; |
| 2603 | struct backtrace backtrace; | ||
| 2604 | register Lisp_Object *internal_args; | 2634 | register Lisp_Object *internal_args; |
| 2605 | ptrdiff_t i; | 2635 | ptrdiff_t i; |
| 2606 | 2636 | ||
| @@ -2614,12 +2644,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2614 | error ("Lisp nesting exceeds `max-lisp-eval-depth'"); | 2644 | error ("Lisp nesting exceeds `max-lisp-eval-depth'"); |
| 2615 | } | 2645 | } |
| 2616 | 2646 | ||
| 2617 | backtrace.next = backtrace_list; | 2647 | /* This also GCPROs them. */ |
| 2618 | backtrace.function = args[0]; | 2648 | record_in_backtrace (args[0], &args[1], nargs - 1); |
| 2619 | backtrace.args = &args[1]; /* This also GCPROs them. */ | ||
| 2620 | backtrace.nargs = nargs - 1; | ||
| 2621 | backtrace.debug_on_exit = 0; | ||
| 2622 | backtrace_list = &backtrace; | ||
| 2623 | 2649 | ||
| 2624 | /* Call GC after setting up the backtrace, so the latter GCPROs the args. */ | 2650 | /* Call GC after setting up the backtrace, so the latter GCPROs the args. */ |
| 2625 | maybe_gc (); | 2651 | maybe_gc (); |
| @@ -2744,9 +2770,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2744 | } | 2770 | } |
| 2745 | check_cons_list (); | 2771 | check_cons_list (); |
| 2746 | lisp_eval_depth--; | 2772 | lisp_eval_depth--; |
| 2747 | if (backtrace.debug_on_exit) | 2773 | if (backtrace_debug_on_exit (specpdl_ptr - 1)) |
| 2748 | val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); | 2774 | val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); |
| 2749 | backtrace_list = backtrace.next; | 2775 | specpdl_ptr--; |
| 2750 | return val; | 2776 | return val; |
| 2751 | } | 2777 | } |
| 2752 | 2778 | ||
| @@ -2778,15 +2804,17 @@ apply_lambda (Lisp_Object fun, Lisp_Object args) | |||
| 2778 | 2804 | ||
| 2779 | UNGCPRO; | 2805 | UNGCPRO; |
| 2780 | 2806 | ||
| 2781 | backtrace_list->args = arg_vector; | 2807 | set_backtrace_args (specpdl_ptr - 1, arg_vector); |
| 2782 | backtrace_list->nargs = i; | 2808 | set_backtrace_nargs (specpdl_ptr - 1, i); |
| 2783 | tem = funcall_lambda (fun, numargs, arg_vector); | 2809 | tem = funcall_lambda (fun, numargs, arg_vector); |
| 2784 | 2810 | ||
| 2785 | /* Do the debug-on-exit now, while arg_vector still exists. */ | 2811 | /* Do the debug-on-exit now, while arg_vector still exists. */ |
| 2786 | if (backtrace_list->debug_on_exit) | 2812 | if (backtrace_debug_on_exit (specpdl_ptr - 1)) |
| 2787 | tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil))); | 2813 | { |
| 2788 | /* Don't do it again when we return to eval. */ | 2814 | /* Don't do it again when we return to eval. */ |
| 2789 | backtrace_list->debug_on_exit = 0; | 2815 | set_backtrace_debug_on_exit (specpdl_ptr - 1, false); |
| 2816 | tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil))); | ||
| 2817 | } | ||
| 2790 | SAFE_FREE (); | 2818 | SAFE_FREE (); |
| 2791 | return tem; | 2819 | return tem; |
| 2792 | } | 2820 | } |
| @@ -2936,20 +2964,38 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, | |||
| 2936 | return object; | 2964 | return object; |
| 2937 | } | 2965 | } |
| 2938 | 2966 | ||
| 2939 | static void | 2967 | /* Return true if SYMBOL currently has a let-binding |
| 2940 | grow_specpdl (void) | 2968 | which was made in the buffer that is now current. */ |
| 2969 | |||
| 2970 | bool | ||
| 2971 | let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) | ||
| 2941 | { | 2972 | { |
| 2942 | register ptrdiff_t count = SPECPDL_INDEX (); | 2973 | struct specbinding *p; |
| 2943 | ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX); | 2974 | Lisp_Object buf = Fcurrent_buffer (); |
| 2944 | if (max_size <= specpdl_size) | 2975 | |
| 2945 | { | 2976 | for (p = specpdl_ptr; p > specpdl; ) |
| 2946 | if (max_specpdl_size < 400) | 2977 | if ((--p)->kind > SPECPDL_LET) |
| 2947 | max_size = max_specpdl_size = 400; | 2978 | { |
| 2948 | if (max_size <= specpdl_size) | 2979 | struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p)); |
| 2949 | signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); | 2980 | eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS); |
| 2950 | } | 2981 | if (symbol == let_bound_symbol |
| 2951 | specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl); | 2982 | && EQ (specpdl_where (p), buf)) |
| 2952 | specpdl_ptr = specpdl + count; | 2983 | return 1; |
| 2984 | } | ||
| 2985 | |||
| 2986 | return 0; | ||
| 2987 | } | ||
| 2988 | |||
| 2989 | bool | ||
| 2990 | let_shadows_global_binding_p (Lisp_Object symbol) | ||
| 2991 | { | ||
| 2992 | struct specbinding *p; | ||
| 2993 | |||
| 2994 | for (p = specpdl_ptr; p > specpdl; ) | ||
| 2995 | if ((--p)->kind >= SPECPDL_LET && EQ (specpdl_symbol (p), symbol)) | ||
| 2996 | return 1; | ||
| 2997 | |||
| 2998 | return 0; | ||
| 2953 | } | 2999 | } |
| 2954 | 3000 | ||
| 2955 | /* `specpdl_ptr->symbol' is a field which describes which variable is | 3001 | /* `specpdl_ptr->symbol' is a field which describes which variable is |
| @@ -2985,9 +3031,9 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 2985 | case SYMBOL_PLAINVAL: | 3031 | case SYMBOL_PLAINVAL: |
| 2986 | /* The most common case is that of a non-constant symbol with a | 3032 | /* The most common case is that of a non-constant symbol with a |
| 2987 | trivial value. Make that as fast as we can. */ | 3033 | trivial value. Make that as fast as we can. */ |
| 2988 | set_specpdl_symbol (symbol); | 3034 | specpdl_ptr->kind = SPECPDL_LET; |
| 2989 | set_specpdl_old_value (SYMBOL_VAL (sym)); | 3035 | specpdl_ptr->v.let.symbol = symbol; |
| 2990 | specpdl_ptr->func = NULL; | 3036 | specpdl_ptr->v.let.old_value = SYMBOL_VAL (sym); |
| 2991 | ++specpdl_ptr; | 3037 | ++specpdl_ptr; |
| 2992 | if (!sym->constant) | 3038 | if (!sym->constant) |
| 2993 | SET_SYMBOL_VAL (sym, value); | 3039 | SET_SYMBOL_VAL (sym, value); |
| @@ -3000,59 +3046,36 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3000 | case SYMBOL_FORWARDED: | 3046 | case SYMBOL_FORWARDED: |
| 3001 | { | 3047 | { |
| 3002 | Lisp_Object ovalue = find_symbol_value (symbol); | 3048 | Lisp_Object ovalue = find_symbol_value (symbol); |
| 3003 | specpdl_ptr->func = 0; | 3049 | specpdl_ptr->kind = SPECPDL_LET_LOCAL; |
| 3004 | set_specpdl_old_value (ovalue); | 3050 | specpdl_ptr->v.let.symbol = symbol; |
| 3051 | specpdl_ptr->v.let.old_value = ovalue; | ||
| 3052 | specpdl_ptr->v.let.where = Fcurrent_buffer (); | ||
| 3005 | 3053 | ||
| 3006 | eassert (sym->redirect != SYMBOL_LOCALIZED | 3054 | eassert (sym->redirect != SYMBOL_LOCALIZED |
| 3007 | || (EQ (SYMBOL_BLV (sym)->where, | 3055 | || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); |
| 3008 | SYMBOL_BLV (sym)->frame_local ? | ||
| 3009 | Fselected_frame () : Fcurrent_buffer ()))); | ||
| 3010 | 3056 | ||
| 3011 | if (sym->redirect == SYMBOL_LOCALIZED | 3057 | if (sym->redirect == SYMBOL_LOCALIZED) |
| 3012 | || BUFFER_OBJFWDP (SYMBOL_FWD (sym))) | 3058 | { |
| 3059 | if (!blv_found (SYMBOL_BLV (sym))) | ||
| 3060 | specpdl_ptr->kind = SPECPDL_LET_DEFAULT; | ||
| 3061 | } | ||
| 3062 | else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym))) | ||
| 3013 | { | 3063 | { |
| 3014 | Lisp_Object where, cur_buf = Fcurrent_buffer (); | ||
| 3015 | |||
| 3016 | /* For a local variable, record both the symbol and which | ||
| 3017 | buffer's or frame's value we are saving. */ | ||
| 3018 | if (!NILP (Flocal_variable_p (symbol, Qnil))) | ||
| 3019 | { | ||
| 3020 | eassert (sym->redirect != SYMBOL_LOCALIZED | ||
| 3021 | || (blv_found (SYMBOL_BLV (sym)) | ||
| 3022 | && EQ (cur_buf, SYMBOL_BLV (sym)->where))); | ||
| 3023 | where = cur_buf; | ||
| 3024 | } | ||
| 3025 | else if (sym->redirect == SYMBOL_LOCALIZED | ||
| 3026 | && blv_found (SYMBOL_BLV (sym))) | ||
| 3027 | where = SYMBOL_BLV (sym)->where; | ||
| 3028 | else | ||
| 3029 | where = Qnil; | ||
| 3030 | |||
| 3031 | /* We're not using the `unused' slot in the specbinding | ||
| 3032 | structure because this would mean we have to do more | ||
| 3033 | work for simple variables. */ | ||
| 3034 | /* FIXME: The third value `current_buffer' is only used in | ||
| 3035 | let_shadows_buffer_binding_p which is itself only used | ||
| 3036 | in set_internal for local_if_set. */ | ||
| 3037 | eassert (NILP (where) || EQ (where, cur_buf)); | ||
| 3038 | set_specpdl_symbol (Fcons (symbol, Fcons (where, cur_buf))); | ||
| 3039 | |||
| 3040 | /* If SYMBOL is a per-buffer variable which doesn't have a | 3064 | /* If SYMBOL is a per-buffer variable which doesn't have a |
| 3041 | buffer-local value here, make the `let' change the global | 3065 | buffer-local value here, make the `let' change the global |
| 3042 | value by changing the value of SYMBOL in all buffers not | 3066 | value by changing the value of SYMBOL in all buffers not |
| 3043 | having their own value. This is consistent with what | 3067 | having their own value. This is consistent with what |
| 3044 | happens with other buffer-local variables. */ | 3068 | happens with other buffer-local variables. */ |
| 3045 | if (NILP (where) | 3069 | if (NILP (Flocal_variable_p (symbol, Qnil))) |
| 3046 | && sym->redirect == SYMBOL_FORWARDED) | ||
| 3047 | { | 3070 | { |
| 3048 | eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym))); | 3071 | specpdl_ptr->kind = SPECPDL_LET_DEFAULT; |
| 3049 | ++specpdl_ptr; | 3072 | ++specpdl_ptr; |
| 3050 | Fset_default (symbol, value); | 3073 | Fset_default (symbol, value); |
| 3051 | return; | 3074 | return; |
| 3052 | } | 3075 | } |
| 3053 | } | 3076 | } |
| 3054 | else | 3077 | else |
| 3055 | set_specpdl_symbol (symbol); | 3078 | specpdl_ptr->kind = SPECPDL_LET; |
| 3056 | 3079 | ||
| 3057 | specpdl_ptr++; | 3080 | specpdl_ptr++; |
| 3058 | set_internal (symbol, value, Qnil, 1); | 3081 | set_internal (symbol, value, Qnil, 1); |
| @@ -3067,9 +3090,9 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) | |||
| 3067 | { | 3090 | { |
| 3068 | if (specpdl_ptr == specpdl + specpdl_size) | 3091 | if (specpdl_ptr == specpdl + specpdl_size) |
| 3069 | grow_specpdl (); | 3092 | grow_specpdl (); |
| 3070 | specpdl_ptr->func = function; | 3093 | specpdl_ptr->kind = SPECPDL_UNWIND; |
| 3071 | set_specpdl_symbol (Qnil); | 3094 | specpdl_ptr->v.unwind.func = function; |
| 3072 | set_specpdl_old_value (arg); | 3095 | specpdl_ptr->v.unwind.arg = arg; |
| 3073 | specpdl_ptr++; | 3096 | specpdl_ptr++; |
| 3074 | } | 3097 | } |
| 3075 | 3098 | ||
| @@ -3093,41 +3116,50 @@ unbind_to (ptrdiff_t count, Lisp_Object value) | |||
| 3093 | struct specbinding this_binding; | 3116 | struct specbinding this_binding; |
| 3094 | this_binding = *--specpdl_ptr; | 3117 | this_binding = *--specpdl_ptr; |
| 3095 | 3118 | ||
| 3096 | if (this_binding.func != 0) | 3119 | switch (this_binding.kind) |
| 3097 | (*this_binding.func) (this_binding.old_value); | ||
| 3098 | /* If the symbol is a list, it is really (SYMBOL WHERE | ||
| 3099 | . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a | ||
| 3100 | frame. If WHERE is a buffer or frame, this indicates we | ||
| 3101 | bound a variable that had a buffer-local or frame-local | ||
| 3102 | binding. WHERE nil means that the variable had the default | ||
| 3103 | value when it was bound. CURRENT-BUFFER is the buffer that | ||
| 3104 | was current when the variable was bound. */ | ||
| 3105 | else if (CONSP (this_binding.symbol)) | ||
| 3106 | { | 3120 | { |
| 3107 | Lisp_Object symbol, where; | 3121 | case SPECPDL_UNWIND: |
| 3108 | 3122 | (*specpdl_func (&this_binding)) (specpdl_arg (&this_binding)); | |
| 3109 | symbol = XCAR (this_binding.symbol); | 3123 | break; |
| 3110 | where = XCAR (XCDR (this_binding.symbol)); | 3124 | case SPECPDL_LET: |
| 3111 | 3125 | /* If variable has a trivial value (no forwarding), we can | |
| 3112 | if (NILP (where)) | 3126 | just set it. No need to check for constant symbols here, |
| 3113 | Fset_default (symbol, this_binding.old_value); | 3127 | since that was already done by specbind. */ |
| 3114 | /* If `where' is non-nil, reset the value in the appropriate | 3128 | if (XSYMBOL (specpdl_symbol (&this_binding))->redirect |
| 3115 | local binding, but only if that binding still exists. */ | 3129 | == SYMBOL_PLAINVAL) |
| 3116 | else if (BUFFERP (where) | 3130 | SET_SYMBOL_VAL (XSYMBOL (specpdl_symbol (&this_binding)), |
| 3117 | ? !NILP (Flocal_variable_p (symbol, where)) | 3131 | specpdl_old_value (&this_binding)); |
| 3118 | : !NILP (Fassq (symbol, XFRAME (where)->param_alist))) | 3132 | else |
| 3119 | set_internal (symbol, this_binding.old_value, where, 1); | 3133 | /* NOTE: we only ever come here if make_local_foo was used for |
| 3134 | the first time on this var within this let. */ | ||
| 3135 | Fset_default (specpdl_symbol (&this_binding), | ||
| 3136 | specpdl_old_value (&this_binding)); | ||
| 3137 | break; | ||
| 3138 | case SPECPDL_BACKTRACE: | ||
| 3139 | break; | ||
| 3140 | case SPECPDL_LET_LOCAL: | ||
| 3141 | case SPECPDL_LET_DEFAULT: | ||
| 3142 | { /* If the symbol is a list, it is really (SYMBOL WHERE | ||
| 3143 | . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a | ||
| 3144 | frame. If WHERE is a buffer or frame, this indicates we | ||
| 3145 | bound a variable that had a buffer-local or frame-local | ||
| 3146 | binding. WHERE nil means that the variable had the default | ||
| 3147 | value when it was bound. CURRENT-BUFFER is the buffer that | ||
| 3148 | was current when the variable was bound. */ | ||
| 3149 | Lisp_Object symbol = specpdl_symbol (&this_binding); | ||
| 3150 | Lisp_Object where = specpdl_where (&this_binding); | ||
| 3151 | eassert (BUFFERP (where)); | ||
| 3152 | |||
| 3153 | if (this_binding.kind == SPECPDL_LET_DEFAULT) | ||
| 3154 | Fset_default (symbol, specpdl_old_value (&this_binding)); | ||
| 3155 | /* If this was a local binding, reset the value in the appropriate | ||
| 3156 | buffer, but only if that buffer's binding still exists. */ | ||
| 3157 | else if (!NILP (Flocal_variable_p (symbol, where))) | ||
| 3158 | set_internal (symbol, specpdl_old_value (&this_binding), | ||
| 3159 | where, 1); | ||
| 3160 | } | ||
| 3161 | break; | ||
| 3120 | } | 3162 | } |
| 3121 | /* If variable has a trivial value (no forwarding), we can | ||
| 3122 | just set it. No need to check for constant symbols here, | ||
| 3123 | since that was already done by specbind. */ | ||
| 3124 | else if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL) | ||
| 3125 | SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol), | ||
| 3126 | this_binding.old_value); | ||
| 3127 | else | ||
| 3128 | /* NOTE: we only ever come here if make_local_foo was used for | ||
| 3129 | the first time on this var within this let. */ | ||
| 3130 | Fset_default (this_binding.symbol, this_binding.old_value); | ||
| 3131 | } | 3163 | } |
| 3132 | 3164 | ||
| 3133 | if (NILP (Vquit_flag) && !NILP (quitf)) | 3165 | if (NILP (Vquit_flag) && !NILP (quitf)) |
| @@ -3153,18 +3185,16 @@ DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, | |||
| 3153 | The debugger is entered when that frame exits, if the flag is non-nil. */) | 3185 | The debugger is entered when that frame exits, if the flag is non-nil. */) |
| 3154 | (Lisp_Object level, Lisp_Object flag) | 3186 | (Lisp_Object level, Lisp_Object flag) |
| 3155 | { | 3187 | { |
| 3156 | register struct backtrace *backlist = backtrace_list; | 3188 | struct specbinding *pdl = backtrace_top (); |
| 3157 | register EMACS_INT i; | 3189 | register EMACS_INT i; |
| 3158 | 3190 | ||
| 3159 | CHECK_NUMBER (level); | 3191 | CHECK_NUMBER (level); |
| 3160 | 3192 | ||
| 3161 | for (i = 0; backlist && i < XINT (level); i++) | 3193 | for (i = 0; backtrace_p (pdl) && i < XINT (level); i++) |
| 3162 | { | 3194 | pdl = backtrace_next (pdl); |
| 3163 | backlist = backlist->next; | ||
| 3164 | } | ||
| 3165 | 3195 | ||
| 3166 | if (backlist) | 3196 | if (backtrace_p (pdl)) |
| 3167 | backlist->debug_on_exit = !NILP (flag); | 3197 | set_backtrace_debug_on_exit (pdl, !NILP (flag)); |
| 3168 | 3198 | ||
| 3169 | return flag; | 3199 | return flag; |
| 3170 | } | 3200 | } |
| @@ -3174,58 +3204,41 @@ DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "", | |||
| 3174 | Output stream used is value of `standard-output'. */) | 3204 | Output stream used is value of `standard-output'. */) |
| 3175 | (void) | 3205 | (void) |
| 3176 | { | 3206 | { |
| 3177 | register struct backtrace *backlist = backtrace_list; | 3207 | struct specbinding *pdl = backtrace_top (); |
| 3178 | Lisp_Object tail; | ||
| 3179 | Lisp_Object tem; | 3208 | Lisp_Object tem; |
| 3180 | struct gcpro gcpro1; | ||
| 3181 | Lisp_Object old_print_level = Vprint_level; | 3209 | Lisp_Object old_print_level = Vprint_level; |
| 3182 | 3210 | ||
| 3183 | if (NILP (Vprint_level)) | 3211 | if (NILP (Vprint_level)) |
| 3184 | XSETFASTINT (Vprint_level, 8); | 3212 | XSETFASTINT (Vprint_level, 8); |
| 3185 | 3213 | ||
| 3186 | tail = Qnil; | 3214 | while (backtrace_p (pdl)) |
| 3187 | GCPRO1 (tail); | ||
| 3188 | |||
| 3189 | while (backlist) | ||
| 3190 | { | 3215 | { |
| 3191 | write_string (backlist->debug_on_exit ? "* " : " ", 2); | 3216 | write_string (backtrace_debug_on_exit (pdl) ? "* " : " ", 2); |
| 3192 | if (backlist->nargs == UNEVALLED) | 3217 | if (backtrace_nargs (pdl) == UNEVALLED) |
| 3193 | { | 3218 | { |
| 3194 | Fprin1 (Fcons (backlist->function, *backlist->args), Qnil); | 3219 | Fprin1 (Fcons (backtrace_function (pdl), *backtrace_args (pdl)), |
| 3220 | Qnil); | ||
| 3195 | write_string ("\n", -1); | 3221 | write_string ("\n", -1); |
| 3196 | } | 3222 | } |
| 3197 | else | 3223 | else |
| 3198 | { | 3224 | { |
| 3199 | tem = backlist->function; | 3225 | tem = backtrace_function (pdl); |
| 3200 | Fprin1 (tem, Qnil); /* This can QUIT. */ | 3226 | Fprin1 (tem, Qnil); /* This can QUIT. */ |
| 3201 | write_string ("(", -1); | 3227 | write_string ("(", -1); |
| 3202 | if (backlist->nargs == MANY) | 3228 | { |
| 3203 | { /* FIXME: Can this happen? */ | 3229 | ptrdiff_t i; |
| 3204 | bool later_arg = 0; | 3230 | for (i = 0; i < backtrace_nargs (pdl); i++) |
| 3205 | for (tail = *backlist->args; !NILP (tail); tail = Fcdr (tail)) | 3231 | { |
| 3206 | { | 3232 | if (i) write_string (" ", -1); |
| 3207 | if (later_arg) | 3233 | Fprin1 (backtrace_args (pdl)[i], Qnil); |
| 3208 | write_string (" ", -1); | 3234 | } |
| 3209 | Fprin1 (Fcar (tail), Qnil); | 3235 | } |
| 3210 | later_arg = 1; | ||
| 3211 | } | ||
| 3212 | } | ||
| 3213 | else | ||
| 3214 | { | ||
| 3215 | ptrdiff_t i; | ||
| 3216 | for (i = 0; i < backlist->nargs; i++) | ||
| 3217 | { | ||
| 3218 | if (i) write_string (" ", -1); | ||
| 3219 | Fprin1 (backlist->args[i], Qnil); | ||
| 3220 | } | ||
| 3221 | } | ||
| 3222 | write_string (")\n", -1); | 3236 | write_string (")\n", -1); |
| 3223 | } | 3237 | } |
| 3224 | backlist = backlist->next; | 3238 | pdl = backtrace_next (pdl); |
| 3225 | } | 3239 | } |
| 3226 | 3240 | ||
| 3227 | Vprint_level = old_print_level; | 3241 | Vprint_level = old_print_level; |
| 3228 | UNGCPRO; | ||
| 3229 | return Qnil; | 3242 | return Qnil; |
| 3230 | } | 3243 | } |
| 3231 | 3244 | ||
| @@ -3241,53 +3254,84 @@ or a lambda expression for macro calls. | |||
| 3241 | If NFRAMES is more than the number of frames, the value is nil. */) | 3254 | If NFRAMES is more than the number of frames, the value is nil. */) |
| 3242 | (Lisp_Object nframes) | 3255 | (Lisp_Object nframes) |
| 3243 | { | 3256 | { |
| 3244 | register struct backtrace *backlist = backtrace_list; | 3257 | struct specbinding *pdl = backtrace_top (); |
| 3245 | register EMACS_INT i; | 3258 | register EMACS_INT i; |
| 3246 | Lisp_Object tem; | ||
| 3247 | 3259 | ||
| 3248 | CHECK_NATNUM (nframes); | 3260 | CHECK_NATNUM (nframes); |
| 3249 | 3261 | ||
| 3250 | /* Find the frame requested. */ | 3262 | /* Find the frame requested. */ |
| 3251 | for (i = 0; backlist && i < XFASTINT (nframes); i++) | 3263 | for (i = 0; backtrace_p (pdl) && i < XFASTINT (nframes); i++) |
| 3252 | backlist = backlist->next; | 3264 | pdl = backtrace_next (pdl); |
| 3253 | 3265 | ||
| 3254 | if (!backlist) | 3266 | if (!backtrace_p (pdl)) |
| 3255 | return Qnil; | 3267 | return Qnil; |
| 3256 | if (backlist->nargs == UNEVALLED) | 3268 | if (backtrace_nargs (pdl) == UNEVALLED) |
| 3257 | return Fcons (Qnil, Fcons (backlist->function, *backlist->args)); | 3269 | return Fcons (Qnil, |
| 3270 | Fcons (backtrace_function (pdl), *backtrace_args (pdl))); | ||
| 3258 | else | 3271 | else |
| 3259 | { | 3272 | { |
| 3260 | if (backlist->nargs == MANY) /* FIXME: Can this happen? */ | 3273 | Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl)); |
| 3261 | tem = *backlist->args; | ||
| 3262 | else | ||
| 3263 | tem = Flist (backlist->nargs, backlist->args); | ||
| 3264 | 3274 | ||
| 3265 | return Fcons (Qt, Fcons (backlist->function, tem)); | 3275 | return Fcons (Qt, Fcons (backtrace_function (pdl), tem)); |
| 3266 | } | 3276 | } |
| 3267 | } | 3277 | } |
| 3268 | 3278 | ||
| 3269 | 3279 | ||
| 3270 | #if BYTE_MARK_STACK | ||
| 3271 | void | 3280 | void |
| 3272 | mark_backtrace (void) | 3281 | mark_specpdl (void) |
| 3273 | { | 3282 | { |
| 3274 | register struct backtrace *backlist; | 3283 | struct specbinding *pdl; |
| 3275 | ptrdiff_t i; | 3284 | for (pdl = specpdl; pdl != specpdl_ptr; pdl++) |
| 3276 | |||
| 3277 | for (backlist = backtrace_list; backlist; backlist = backlist->next) | ||
| 3278 | { | 3285 | { |
| 3279 | mark_object (backlist->function); | 3286 | switch (pdl->kind) |
| 3287 | { | ||
| 3288 | case SPECPDL_UNWIND: | ||
| 3289 | mark_object (specpdl_arg (pdl)); | ||
| 3290 | break; | ||
| 3291 | case SPECPDL_BACKTRACE: | ||
| 3292 | { | ||
| 3293 | ptrdiff_t nargs = backtrace_nargs (pdl); | ||
| 3294 | mark_object (backtrace_function (pdl)); | ||
| 3295 | if (nargs == UNEVALLED) | ||
| 3296 | nargs = 1; | ||
| 3297 | while (nargs--) | ||
| 3298 | mark_object (backtrace_args (pdl)[nargs]); | ||
| 3299 | } | ||
| 3300 | break; | ||
| 3301 | case SPECPDL_LET_DEFAULT: | ||
| 3302 | case SPECPDL_LET_LOCAL: | ||
| 3303 | mark_object (specpdl_where (pdl)); | ||
| 3304 | case SPECPDL_LET: | ||
| 3305 | mark_object (specpdl_symbol (pdl)); | ||
| 3306 | mark_object (specpdl_old_value (pdl)); | ||
| 3307 | } | ||
| 3308 | } | ||
| 3309 | } | ||
| 3310 | |||
| 3311 | void | ||
| 3312 | get_backtrace (Lisp_Object array) | ||
| 3313 | { | ||
| 3314 | struct specbinding *pdl = backtrace_next (backtrace_top ()); | ||
| 3315 | ptrdiff_t i = 0, asize = ASIZE (array); | ||
| 3280 | 3316 | ||
| 3281 | if (backlist->nargs == UNEVALLED | 3317 | /* Copy the backtrace contents into working memory. */ |
| 3282 | || backlist->nargs == MANY) /* FIXME: Can this happen? */ | 3318 | for (; i < asize; i++) |
| 3283 | i = 1; | 3319 | { |
| 3320 | if (backtrace_p (pdl)) | ||
| 3321 | { | ||
| 3322 | ASET (array, i, backtrace_function (pdl)); | ||
| 3323 | pdl = backtrace_next (pdl); | ||
| 3324 | } | ||
| 3284 | else | 3325 | else |
| 3285 | i = backlist->nargs; | 3326 | ASET (array, i, Qnil); |
| 3286 | while (i--) | ||
| 3287 | mark_object (backlist->args[i]); | ||
| 3288 | } | 3327 | } |
| 3289 | } | 3328 | } |
| 3290 | #endif | 3329 | |
| 3330 | Lisp_Object backtrace_top_function (void) | ||
| 3331 | { | ||
| 3332 | struct specbinding *pdl = backtrace_top (); | ||
| 3333 | return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil); | ||
| 3334 | } | ||
| 3291 | 3335 | ||
| 3292 | void | 3336 | void |
| 3293 | syms_of_eval (void) | 3337 | syms_of_eval (void) |
diff --git a/src/lisp.h b/src/lisp.h index 79d32c90f73..bd2f55f7cf4 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -73,6 +73,7 @@ enum | |||
| 73 | BITS_PER_SHORT = CHAR_BIT * sizeof (short), | 73 | BITS_PER_SHORT = CHAR_BIT * sizeof (short), |
| 74 | BITS_PER_INT = CHAR_BIT * sizeof (int), | 74 | BITS_PER_INT = CHAR_BIT * sizeof (int), |
| 75 | BITS_PER_LONG = CHAR_BIT * sizeof (long int), | 75 | BITS_PER_LONG = CHAR_BIT * sizeof (long int), |
| 76 | BITS_PER_PTRDIFF_T = CHAR_BIT * sizeof (ptrdiff_t), | ||
| 76 | BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT) | 77 | BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT) |
| 77 | }; | 78 | }; |
| 78 | 79 | ||
| @@ -2176,12 +2177,24 @@ typedef jmp_buf sys_jmp_buf; | |||
| 2176 | #endif | 2177 | #endif |
| 2177 | 2178 | ||
| 2178 | 2179 | ||
| 2180 | /* Elisp uses several stacks: | ||
| 2181 | - the C stack. | ||
| 2182 | - the bytecode stack: used internally by the bytecode interpreter. | ||
| 2183 | Allocated from the C stack. | ||
| 2184 | - The specpdl stack: keeps track of active unwind-protect and | ||
| 2185 | dynamic-let-bindings. Allocated from the `specpdl' array, a manually | ||
| 2186 | managed stack. | ||
| 2187 | - The catch stack: keeps track of active catch tags. | ||
| 2188 | Allocated on the C stack. This is where the setmp data is kept. | ||
| 2189 | - The handler stack: keeps track of active condition-case handlers. | ||
| 2190 | Allocated on the C stack. Every entry there also uses an entry in | ||
| 2191 | the catch stack. */ | ||
| 2192 | |||
| 2179 | /* Structure for recording Lisp call stack for backtrace purposes. */ | 2193 | /* Structure for recording Lisp call stack for backtrace purposes. */ |
| 2180 | 2194 | ||
| 2181 | /* The special binding stack holds the outer values of variables while | 2195 | /* The special binding stack holds the outer values of variables while |
| 2182 | they are bound by a function application or a let form, stores the | 2196 | they are bound by a function application or a let form, stores the |
| 2183 | code to be executed for Lisp unwind-protect forms, and stores the C | 2197 | code to be executed for unwind-protect forms. |
| 2184 | functions to be called for record_unwind_protect. | ||
| 2185 | 2198 | ||
| 2186 | If func is non-zero, undoing this binding applies func to old_value; | 2199 | If func is non-zero, undoing this binding applies func to old_value; |
| 2187 | This implements record_unwind_protect. | 2200 | This implements record_unwind_protect. |
| @@ -2194,35 +2207,77 @@ typedef jmp_buf sys_jmp_buf; | |||
| 2194 | which means having bound a local value while CURRENT-BUFFER was active. | 2207 | which means having bound a local value while CURRENT-BUFFER was active. |
| 2195 | If WHERE is nil this means we saw the default value when binding SYMBOL. | 2208 | If WHERE is nil this means we saw the default value when binding SYMBOL. |
| 2196 | WHERE being a buffer or frame means we saw a buffer-local or frame-local | 2209 | WHERE being a buffer or frame means we saw a buffer-local or frame-local |
| 2197 | value. Other values of WHERE mean an internal error. */ | 2210 | value. Other values of WHERE mean an internal error. |
| 2211 | |||
| 2212 | NOTE: The specbinding struct is defined here, because SPECPDL_INDEX is | ||
| 2213 | used all over the place, needs to be fast, and needs to know the size of | ||
| 2214 | struct specbinding. But only eval.c should access it. */ | ||
| 2198 | 2215 | ||
| 2199 | typedef Lisp_Object (*specbinding_func) (Lisp_Object); | 2216 | typedef Lisp_Object (*specbinding_func) (Lisp_Object); |
| 2200 | 2217 | ||
| 2218 | enum specbind_tag { | ||
| 2219 | SPECPDL_UNWIND, /* An unwind_protect function. */ | ||
| 2220 | SPECPDL_BACKTRACE, /* An element of the backtrace. */ | ||
| 2221 | SPECPDL_LET, /* A plain and simple dynamic let-binding. */ | ||
| 2222 | /* Tags greater than SPECPDL_LET must be "subkinds" of LET. */ | ||
| 2223 | SPECPDL_LET_LOCAL, /* A buffer-local let-binding. */ | ||
| 2224 | SPECPDL_LET_DEFAULT /* A global binding for a localized var. */ | ||
| 2225 | }; | ||
| 2226 | |||
| 2201 | struct specbinding | 2227 | struct specbinding |
| 2202 | { | 2228 | { |
| 2203 | Lisp_Object symbol, old_value; | 2229 | enum specbind_tag kind; |
| 2204 | specbinding_func func; | 2230 | union { |
| 2205 | Lisp_Object unused; /* Dividing by 16 is faster than by 12. */ | 2231 | struct { |
| 2232 | Lisp_Object arg; | ||
| 2233 | specbinding_func func; | ||
| 2234 | } unwind; | ||
| 2235 | struct { | ||
| 2236 | /* `where' is not used in the case of SPECPDL_LET. */ | ||
| 2237 | Lisp_Object symbol, old_value, where; | ||
| 2238 | } let; | ||
| 2239 | struct { | ||
| 2240 | Lisp_Object function; | ||
| 2241 | Lisp_Object *args; | ||
| 2242 | ptrdiff_t nargs : BITS_PER_PTRDIFF_T - 1; | ||
| 2243 | bool debug_on_exit : 1; | ||
| 2244 | } bt; | ||
| 2245 | } v; | ||
| 2206 | }; | 2246 | }; |
| 2207 | 2247 | ||
| 2248 | LISP_INLINE Lisp_Object specpdl_symbol (struct specbinding *pdl) | ||
| 2249 | { eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.symbol; } | ||
| 2250 | |||
| 2251 | LISP_INLINE Lisp_Object specpdl_old_value (struct specbinding *pdl) | ||
| 2252 | { eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.old_value; } | ||
| 2253 | |||
| 2254 | LISP_INLINE Lisp_Object specpdl_where (struct specbinding *pdl) | ||
| 2255 | { eassert (pdl->kind > SPECPDL_LET); return pdl->v.let.where; } | ||
| 2256 | |||
| 2257 | LISP_INLINE Lisp_Object specpdl_arg (struct specbinding *pdl) | ||
| 2258 | { eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.arg; } | ||
| 2259 | |||
| 2260 | LISP_INLINE specbinding_func specpdl_func (struct specbinding *pdl) | ||
| 2261 | { eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.func; } | ||
| 2262 | |||
| 2263 | LISP_INLINE Lisp_Object backtrace_function (struct specbinding *pdl) | ||
| 2264 | { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.function; } | ||
| 2265 | |||
| 2266 | LISP_INLINE ptrdiff_t backtrace_nargs (struct specbinding *pdl) | ||
| 2267 | { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.nargs; } | ||
| 2268 | |||
| 2269 | LISP_INLINE Lisp_Object *backtrace_args (struct specbinding *pdl) | ||
| 2270 | { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.args; } | ||
| 2271 | |||
| 2272 | LISP_INLINE bool backtrace_debug_on_exit (struct specbinding *pdl) | ||
| 2273 | { eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.debug_on_exit; } | ||
| 2274 | |||
| 2208 | extern struct specbinding *specpdl; | 2275 | extern struct specbinding *specpdl; |
| 2209 | extern struct specbinding *specpdl_ptr; | 2276 | extern struct specbinding *specpdl_ptr; |
| 2210 | extern ptrdiff_t specpdl_size; | 2277 | extern ptrdiff_t specpdl_size; |
| 2211 | 2278 | ||
| 2212 | #define SPECPDL_INDEX() (specpdl_ptr - specpdl) | 2279 | #define SPECPDL_INDEX() (specpdl_ptr - specpdl) |
| 2213 | 2280 | ||
| 2214 | struct backtrace | ||
| 2215 | { | ||
| 2216 | struct backtrace *next; | ||
| 2217 | Lisp_Object function; | ||
| 2218 | Lisp_Object *args; /* Points to vector of args. */ | ||
| 2219 | ptrdiff_t nargs; /* Length of vector. */ | ||
| 2220 | /* Nonzero means call value of debugger when done with this operation. */ | ||
| 2221 | unsigned int debug_on_exit : 1; | ||
| 2222 | }; | ||
| 2223 | |||
| 2224 | extern struct backtrace *backtrace_list; | ||
| 2225 | |||
| 2226 | /* Everything needed to describe an active condition case. | 2281 | /* Everything needed to describe an active condition case. |
| 2227 | 2282 | ||
| 2228 | Members are volatile if their values need to survive _longjmp when | 2283 | Members are volatile if their values need to survive _longjmp when |
| @@ -2277,9 +2332,10 @@ struct catchtag | |||
| 2277 | Lisp_Object tag; | 2332 | Lisp_Object tag; |
| 2278 | Lisp_Object volatile val; | 2333 | Lisp_Object volatile val; |
| 2279 | struct catchtag *volatile next; | 2334 | struct catchtag *volatile next; |
| 2335 | #if 1 /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but they're defined later. */ | ||
| 2280 | struct gcpro *gcpro; | 2336 | struct gcpro *gcpro; |
| 2337 | #endif | ||
| 2281 | sys_jmp_buf jmp; | 2338 | sys_jmp_buf jmp; |
| 2282 | struct backtrace *backlist; | ||
| 2283 | struct handler *handlerlist; | 2339 | struct handler *handlerlist; |
| 2284 | EMACS_INT lisp_eval_depth; | 2340 | EMACS_INT lisp_eval_depth; |
| 2285 | ptrdiff_t volatile pdlcount; | 2341 | ptrdiff_t volatile pdlcount; |
| @@ -3337,10 +3393,15 @@ extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); | |||
| 3337 | extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object); | 3393 | extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object); |
| 3338 | extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); | 3394 | extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); |
| 3339 | extern void init_eval (void); | 3395 | extern void init_eval (void); |
| 3340 | #if BYTE_MARK_STACK | ||
| 3341 | extern void mark_backtrace (void); | ||
| 3342 | #endif | ||
| 3343 | extern void syms_of_eval (void); | 3396 | extern void syms_of_eval (void); |
| 3397 | extern void record_in_backtrace (Lisp_Object function, | ||
| 3398 | Lisp_Object *args, ptrdiff_t nargs); | ||
| 3399 | extern void mark_specpdl (void); | ||
| 3400 | extern void get_backtrace (Lisp_Object array); | ||
| 3401 | Lisp_Object backtrace_top_function (void); | ||
| 3402 | extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol); | ||
| 3403 | extern bool let_shadows_global_binding_p (Lisp_Object symbol); | ||
| 3404 | |||
| 3344 | 3405 | ||
| 3345 | /* Defined in editfns.c. */ | 3406 | /* Defined in editfns.c. */ |
| 3346 | extern Lisp_Object Qfield; | 3407 | extern Lisp_Object Qfield; |
diff --git a/src/profiler.c b/src/profiler.c index 0a0a4d0bc57..aba81344c68 100644 --- a/src/profiler.c +++ b/src/profiler.c | |||
| @@ -138,10 +138,8 @@ static void evict_lower_half (log_t *log) | |||
| 138 | static void | 138 | static void |
| 139 | record_backtrace (log_t *log, EMACS_INT count) | 139 | record_backtrace (log_t *log, EMACS_INT count) |
| 140 | { | 140 | { |
| 141 | struct backtrace *backlist = backtrace_list; | ||
| 142 | Lisp_Object backtrace; | 141 | Lisp_Object backtrace; |
| 143 | ptrdiff_t index, i = 0; | 142 | ptrdiff_t index; |
| 144 | ptrdiff_t asize; | ||
| 145 | 143 | ||
| 146 | if (!INTEGERP (log->next_free)) | 144 | if (!INTEGERP (log->next_free)) |
| 147 | /* FIXME: transfer the evicted counts to a special entry rather | 145 | /* FIXME: transfer the evicted counts to a special entry rather |
| @@ -151,16 +149,7 @@ record_backtrace (log_t *log, EMACS_INT count) | |||
| 151 | 149 | ||
| 152 | /* Get a "working memory" vector. */ | 150 | /* Get a "working memory" vector. */ |
| 153 | backtrace = HASH_KEY (log, index); | 151 | backtrace = HASH_KEY (log, index); |
| 154 | asize = ASIZE (backtrace); | 152 | get_backtrace (backtrace); |
| 155 | |||
| 156 | /* Copy the backtrace contents into working memory. */ | ||
| 157 | for (; i < asize && backlist; i++, backlist = backlist->next) | ||
| 158 | /* FIXME: For closures we should ignore the environment. */ | ||
| 159 | ASET (backtrace, i, backlist->function); | ||
| 160 | |||
| 161 | /* Make sure that unused space of working memory is filled with nil. */ | ||
| 162 | for (; i < asize; i++) | ||
| 163 | ASET (backtrace, i, Qnil); | ||
| 164 | 153 | ||
| 165 | { /* We basically do a `gethash+puthash' here, except that we have to be | 154 | { /* We basically do a `gethash+puthash' here, except that we have to be |
| 166 | careful to avoid memory allocation since we're in a signal | 155 | careful to avoid memory allocation since we're in a signal |
| @@ -232,7 +221,7 @@ static EMACS_INT current_sampling_interval; | |||
| 232 | static void | 221 | static void |
| 233 | handle_profiler_signal (int signal) | 222 | handle_profiler_signal (int signal) |
| 234 | { | 223 | { |
| 235 | if (backtrace_list && EQ (backtrace_list->function, Qautomatic_gc)) | 224 | if (EQ (backtrace_top_function (), Qautomatic_gc)) |
| 236 | /* Special case the time-count inside GC because the hash-table | 225 | /* Special case the time-count inside GC because the hash-table |
| 237 | code is not prepared to be used while the GC is running. | 226 | code is not prepared to be used while the GC is running. |
| 238 | More specifically it uses ASIZE at many places where it does | 227 | More specifically it uses ASIZE at many places where it does |
diff --git a/src/xdisp.c b/src/xdisp.c index 9f3be44ecfd..5ae15cbd0b3 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -12846,7 +12846,6 @@ redisplay_internal (void) | |||
| 12846 | struct frame *sf; | 12846 | struct frame *sf; |
| 12847 | int polling_stopped_here = 0; | 12847 | int polling_stopped_here = 0; |
| 12848 | Lisp_Object tail, frame; | 12848 | Lisp_Object tail, frame; |
| 12849 | struct backtrace backtrace; | ||
| 12850 | 12849 | ||
| 12851 | /* Non-zero means redisplay has to consider all windows on all | 12850 | /* Non-zero means redisplay has to consider all windows on all |
| 12852 | frames. Zero means, only selected_window is considered. */ | 12851 | frames. Zero means, only selected_window is considered. */ |
| @@ -12890,12 +12889,7 @@ redisplay_internal (void) | |||
| 12890 | specbind (Qinhibit_free_realized_faces, Qnil); | 12889 | specbind (Qinhibit_free_realized_faces, Qnil); |
| 12891 | 12890 | ||
| 12892 | /* Record this function, so it appears on the profiler's backtraces. */ | 12891 | /* Record this function, so it appears on the profiler's backtraces. */ |
| 12893 | backtrace.next = backtrace_list; | 12892 | record_in_backtrace (Qredisplay_internal, &Qnil, 0); |
| 12894 | backtrace.function = Qredisplay_internal; | ||
| 12895 | backtrace.args = &Qnil; | ||
| 12896 | backtrace.nargs = 0; | ||
| 12897 | backtrace.debug_on_exit = 0; | ||
| 12898 | backtrace_list = &backtrace; | ||
| 12899 | 12893 | ||
| 12900 | FOR_EACH_FRAME (tail, frame) | 12894 | FOR_EACH_FRAME (tail, frame) |
| 12901 | XFRAME (frame)->already_hscrolled_p = 0; | 12895 | XFRAME (frame)->already_hscrolled_p = 0; |
| @@ -13532,7 +13526,6 @@ redisplay_internal (void) | |||
| 13532 | #endif /* HAVE_WINDOW_SYSTEM */ | 13526 | #endif /* HAVE_WINDOW_SYSTEM */ |
| 13533 | 13527 | ||
| 13534 | end_of_redisplay: | 13528 | end_of_redisplay: |
| 13535 | backtrace_list = backtrace.next; | ||
| 13536 | unbind_to (count, Qnil); | 13529 | unbind_to (count, Qnil); |
| 13537 | RESUME_POLLING; | 13530 | RESUME_POLLING; |
| 13538 | } | 13531 | } |