diff options
| author | Dmitry Antipov | 2014-09-16 08:04:56 +0400 |
|---|---|---|
| committer | Dmitry Antipov | 2014-09-16 08:04:56 +0400 |
| commit | ccb767d639543d70ac689c93eb64849eea376583 (patch) | |
| tree | 5a82efcfd17922512919d56a29363e5708eedbb8 /src | |
| parent | 2d83441cc06cca6706dc9b102598d1bf6fe7612b (diff) | |
| download | emacs-ccb767d639543d70ac689c93eb64849eea376583.tar.gz emacs-ccb767d639543d70ac689c93eb64849eea376583.zip | |
Always use matched specpdl entry to record call arguments (Bug#18473).
* lisp.h (record_in_backtrace): Adjust prototype.
* eval.c (record_in_backtrace): Return current specpdl level.
(set_backtrace_args, set_backtrace_nargs): Merge. Adjust all users.
(eval_sub, Ffuncall): Record call arguments in matched specpdl
entry and use that entry in call to backtrace_debug_on_exit.
(apply_lambda): Likewise. Get current specpdl level as 3rd arg.
(do_debug_on_call): Get current specpdl level as 2nd arg.
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 11 | ||||
| -rw-r--r-- | src/eval.c | 60 | ||||
| -rw-r--r-- | src/lisp.h | 3 |
3 files changed, 40 insertions, 34 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 09b606d1dd5..fe771fd8f74 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,14 @@ | |||
| 1 | 2014-09-16 Dmitry Antipov <dmantipov@yandex.ru> | ||
| 2 | |||
| 3 | Always use matched specpdl entry to record call arguments (Bug#18473). | ||
| 4 | * lisp.h (record_in_backtrace): Adjust prototype. | ||
| 5 | * eval.c (record_in_backtrace): Return current specpdl level. | ||
| 6 | (set_backtrace_args, set_backtrace_nargs): Merge. Adjust all users. | ||
| 7 | (eval_sub, Ffuncall): Record call arguments in matched specpdl | ||
| 8 | entry and use that entry in call to backtrace_debug_on_exit. | ||
| 9 | (apply_lambda): Likewise. Get current specpdl level as 3rd arg. | ||
| 10 | (do_debug_on_call): Get current specpdl level as 2nd arg. | ||
| 11 | |||
| 1 | 2014-09-15 Eli Zaretskii <eliz@gnu.org> | 12 | 2014-09-15 Eli Zaretskii <eliz@gnu.org> |
| 2 | 13 | ||
| 3 | Fix display of R2L lines in partial-width windows. | 14 | Fix display of R2L lines in partial-width windows. |
diff --git a/src/eval.c b/src/eval.c index 5e986c7ecc2..929b98e9f71 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -111,7 +111,7 @@ union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE; | |||
| 111 | union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; | 111 | union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; |
| 112 | 112 | ||
| 113 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); | 113 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); |
| 114 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); | 114 | static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, ptrdiff_t); |
| 115 | 115 | ||
| 116 | static Lisp_Object | 116 | static Lisp_Object |
| 117 | specpdl_symbol (union specbinding *pdl) | 117 | specpdl_symbol (union specbinding *pdl) |
| @@ -179,17 +179,11 @@ backtrace_debug_on_exit (union specbinding *pdl) | |||
| 179 | /* Functions to modify slots of backtrace records. */ | 179 | /* Functions to modify slots of backtrace records. */ |
| 180 | 180 | ||
| 181 | static void | 181 | static void |
| 182 | set_backtrace_args (union specbinding *pdl, Lisp_Object *args) | 182 | set_backtrace_args (union specbinding *pdl, Lisp_Object *args, ptrdiff_t nargs) |
| 183 | { | 183 | { |
| 184 | eassert (pdl->kind == SPECPDL_BACKTRACE); | 184 | eassert (pdl->kind == SPECPDL_BACKTRACE); |
| 185 | pdl->bt.args = args; | 185 | pdl->bt.args = args; |
| 186 | } | 186 | pdl->bt.nargs = nargs; |
| 187 | |||
| 188 | static void | ||
| 189 | set_backtrace_nargs (union specbinding *pdl, ptrdiff_t n) | ||
| 190 | { | ||
| 191 | eassert (pdl->kind == SPECPDL_BACKTRACE); | ||
| 192 | pdl->bt.nargs = n; | ||
| 193 | } | 187 | } |
| 194 | 188 | ||
| 195 | static void | 189 | static void |
| @@ -341,10 +335,10 @@ call_debugger (Lisp_Object arg) | |||
| 341 | } | 335 | } |
| 342 | 336 | ||
| 343 | static void | 337 | static void |
| 344 | do_debug_on_call (Lisp_Object code) | 338 | do_debug_on_call (Lisp_Object code, ptrdiff_t count) |
| 345 | { | 339 | { |
| 346 | debug_on_next_call = 0; | 340 | debug_on_next_call = 0; |
| 347 | set_backtrace_debug_on_exit (specpdl_ptr - 1, true); | 341 | set_backtrace_debug_on_exit (specpdl + count, true); |
| 348 | call_debugger (list1 (code)); | 342 | call_debugger (list1 (code)); |
| 349 | } | 343 | } |
| 350 | 344 | ||
| @@ -2039,9 +2033,11 @@ grow_specpdl (void) | |||
| 2039 | } | 2033 | } |
| 2040 | } | 2034 | } |
| 2041 | 2035 | ||
| 2042 | void | 2036 | ptrdiff_t |
| 2043 | record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) | 2037 | record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) |
| 2044 | { | 2038 | { |
| 2039 | ptrdiff_t count = SPECPDL_INDEX (); | ||
| 2040 | |||
| 2045 | eassert (nargs >= UNEVALLED); | 2041 | eassert (nargs >= UNEVALLED); |
| 2046 | specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; | 2042 | specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; |
| 2047 | specpdl_ptr->bt.debug_on_exit = false; | 2043 | specpdl_ptr->bt.debug_on_exit = false; |
| @@ -2049,6 +2045,8 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) | |||
| 2049 | specpdl_ptr->bt.args = args; | 2045 | specpdl_ptr->bt.args = args; |
| 2050 | specpdl_ptr->bt.nargs = nargs; | 2046 | specpdl_ptr->bt.nargs = nargs; |
| 2051 | grow_specpdl (); | 2047 | grow_specpdl (); |
| 2048 | |||
| 2049 | return count; | ||
| 2052 | } | 2050 | } |
| 2053 | 2051 | ||
| 2054 | /* Eval a sub-expression of the current expression (i.e. in the same | 2052 | /* Eval a sub-expression of the current expression (i.e. in the same |
| @@ -2059,6 +2057,7 @@ eval_sub (Lisp_Object form) | |||
| 2059 | Lisp_Object fun, val, original_fun, original_args; | 2057 | Lisp_Object fun, val, original_fun, original_args; |
| 2060 | Lisp_Object funcar; | 2058 | Lisp_Object funcar; |
| 2061 | struct gcpro gcpro1, gcpro2, gcpro3; | 2059 | struct gcpro gcpro1, gcpro2, gcpro3; |
| 2060 | ptrdiff_t count; | ||
| 2062 | 2061 | ||
| 2063 | if (SYMBOLP (form)) | 2062 | if (SYMBOLP (form)) |
| 2064 | { | 2063 | { |
| @@ -2096,10 +2095,10 @@ eval_sub (Lisp_Object form) | |||
| 2096 | original_args = XCDR (form); | 2095 | original_args = XCDR (form); |
| 2097 | 2096 | ||
| 2098 | /* This also protects them from gc. */ | 2097 | /* This also protects them from gc. */ |
| 2099 | record_in_backtrace (original_fun, &original_args, UNEVALLED); | 2098 | count = record_in_backtrace (original_fun, &original_args, UNEVALLED); |
| 2100 | 2099 | ||
| 2101 | if (debug_on_next_call) | 2100 | if (debug_on_next_call) |
| 2102 | do_debug_on_call (Qt); | 2101 | do_debug_on_call (Qt, count); |
| 2103 | 2102 | ||
| 2104 | /* At this point, only original_fun and original_args | 2103 | /* At this point, only original_fun and original_args |
| 2105 | have values that will be used below. */ | 2104 | have values that will be used below. */ |
| @@ -2151,8 +2150,7 @@ eval_sub (Lisp_Object form) | |||
| 2151 | gcpro3.nvars = argnum; | 2150 | gcpro3.nvars = argnum; |
| 2152 | } | 2151 | } |
| 2153 | 2152 | ||
| 2154 | set_backtrace_args (specpdl_ptr - 1, vals); | 2153 | set_backtrace_args (specpdl + count, vals, XINT (numargs)); |
| 2155 | set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs)); | ||
| 2156 | 2154 | ||
| 2157 | val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); | 2155 | val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); |
| 2158 | UNGCPRO; | 2156 | UNGCPRO; |
| @@ -2173,8 +2171,7 @@ eval_sub (Lisp_Object form) | |||
| 2173 | 2171 | ||
| 2174 | UNGCPRO; | 2172 | UNGCPRO; |
| 2175 | 2173 | ||
| 2176 | set_backtrace_args (specpdl_ptr - 1, argvals); | 2174 | set_backtrace_args (specpdl + count, argvals, XINT (numargs)); |
| 2177 | set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs)); | ||
| 2178 | 2175 | ||
| 2179 | switch (i) | 2176 | switch (i) |
| 2180 | { | 2177 | { |
| @@ -2227,7 +2224,7 @@ eval_sub (Lisp_Object form) | |||
| 2227 | } | 2224 | } |
| 2228 | } | 2225 | } |
| 2229 | else if (COMPILEDP (fun)) | 2226 | else if (COMPILEDP (fun)) |
| 2230 | val = apply_lambda (fun, original_args); | 2227 | val = apply_lambda (fun, original_args, count); |
| 2231 | else | 2228 | else |
| 2232 | { | 2229 | { |
| 2233 | if (NILP (fun)) | 2230 | if (NILP (fun)) |
| @@ -2244,7 +2241,7 @@ eval_sub (Lisp_Object form) | |||
| 2244 | } | 2241 | } |
| 2245 | if (EQ (funcar, Qmacro)) | 2242 | if (EQ (funcar, Qmacro)) |
| 2246 | { | 2243 | { |
| 2247 | ptrdiff_t count = SPECPDL_INDEX (); | 2244 | ptrdiff_t count1 = SPECPDL_INDEX (); |
| 2248 | Lisp_Object exp; | 2245 | Lisp_Object exp; |
| 2249 | /* Bind lexical-binding during expansion of the macro, so the | 2246 | /* Bind lexical-binding during expansion of the macro, so the |
| 2250 | macro can know reliably if the code it outputs will be | 2247 | macro can know reliably if the code it outputs will be |
| @@ -2252,19 +2249,19 @@ eval_sub (Lisp_Object form) | |||
| 2252 | specbind (Qlexical_binding, | 2249 | specbind (Qlexical_binding, |
| 2253 | NILP (Vinternal_interpreter_environment) ? Qnil : Qt); | 2250 | NILP (Vinternal_interpreter_environment) ? Qnil : Qt); |
| 2254 | exp = apply1 (Fcdr (fun), original_args); | 2251 | exp = apply1 (Fcdr (fun), original_args); |
| 2255 | unbind_to (count, Qnil); | 2252 | unbind_to (count1, Qnil); |
| 2256 | val = eval_sub (exp); | 2253 | val = eval_sub (exp); |
| 2257 | } | 2254 | } |
| 2258 | else if (EQ (funcar, Qlambda) | 2255 | else if (EQ (funcar, Qlambda) |
| 2259 | || EQ (funcar, Qclosure)) | 2256 | || EQ (funcar, Qclosure)) |
| 2260 | val = apply_lambda (fun, original_args); | 2257 | val = apply_lambda (fun, original_args, count); |
| 2261 | else | 2258 | else |
| 2262 | xsignal1 (Qinvalid_function, original_fun); | 2259 | xsignal1 (Qinvalid_function, original_fun); |
| 2263 | } | 2260 | } |
| 2264 | check_cons_list (); | 2261 | check_cons_list (); |
| 2265 | 2262 | ||
| 2266 | lisp_eval_depth--; | 2263 | lisp_eval_depth--; |
| 2267 | if (backtrace_debug_on_exit (specpdl_ptr - 1)) | 2264 | if (backtrace_debug_on_exit (specpdl + count)) |
| 2268 | val = call_debugger (list2 (Qexit, val)); | 2265 | val = call_debugger (list2 (Qexit, val)); |
| 2269 | specpdl_ptr--; | 2266 | specpdl_ptr--; |
| 2270 | 2267 | ||
| @@ -2747,7 +2744,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2747 | Lisp_Object lisp_numargs; | 2744 | Lisp_Object lisp_numargs; |
| 2748 | Lisp_Object val; | 2745 | Lisp_Object val; |
| 2749 | register Lisp_Object *internal_args; | 2746 | register Lisp_Object *internal_args; |
| 2750 | ptrdiff_t i; | 2747 | ptrdiff_t i, count; |
| 2751 | 2748 | ||
| 2752 | QUIT; | 2749 | QUIT; |
| 2753 | 2750 | ||
| @@ -2760,13 +2757,13 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2760 | } | 2757 | } |
| 2761 | 2758 | ||
| 2762 | /* This also GCPROs them. */ | 2759 | /* This also GCPROs them. */ |
| 2763 | record_in_backtrace (args[0], &args[1], nargs - 1); | 2760 | count = record_in_backtrace (args[0], &args[1], nargs - 1); |
| 2764 | 2761 | ||
| 2765 | /* Call GC after setting up the backtrace, so the latter GCPROs the args. */ | 2762 | /* Call GC after setting up the backtrace, so the latter GCPROs the args. */ |
| 2766 | maybe_gc (); | 2763 | maybe_gc (); |
| 2767 | 2764 | ||
| 2768 | if (debug_on_next_call) | 2765 | if (debug_on_next_call) |
| 2769 | do_debug_on_call (Qlambda); | 2766 | do_debug_on_call (Qlambda, count); |
| 2770 | 2767 | ||
| 2771 | check_cons_list (); | 2768 | check_cons_list (); |
| 2772 | 2769 | ||
| @@ -2885,14 +2882,14 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2885 | } | 2882 | } |
| 2886 | check_cons_list (); | 2883 | check_cons_list (); |
| 2887 | lisp_eval_depth--; | 2884 | lisp_eval_depth--; |
| 2888 | if (backtrace_debug_on_exit (specpdl_ptr - 1)) | 2885 | if (backtrace_debug_on_exit (specpdl + count)) |
| 2889 | val = call_debugger (list2 (Qexit, val)); | 2886 | val = call_debugger (list2 (Qexit, val)); |
| 2890 | specpdl_ptr--; | 2887 | specpdl_ptr--; |
| 2891 | return val; | 2888 | return val; |
| 2892 | } | 2889 | } |
| 2893 | 2890 | ||
| 2894 | static Lisp_Object | 2891 | static Lisp_Object |
| 2895 | apply_lambda (Lisp_Object fun, Lisp_Object args) | 2892 | apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count) |
| 2896 | { | 2893 | { |
| 2897 | Lisp_Object args_left; | 2894 | Lisp_Object args_left; |
| 2898 | ptrdiff_t i; | 2895 | ptrdiff_t i; |
| @@ -2919,15 +2916,14 @@ apply_lambda (Lisp_Object fun, Lisp_Object args) | |||
| 2919 | 2916 | ||
| 2920 | UNGCPRO; | 2917 | UNGCPRO; |
| 2921 | 2918 | ||
| 2922 | set_backtrace_args (specpdl_ptr - 1, arg_vector); | 2919 | set_backtrace_args (specpdl + count, arg_vector, i); |
| 2923 | set_backtrace_nargs (specpdl_ptr - 1, i); | ||
| 2924 | tem = funcall_lambda (fun, numargs, arg_vector); | 2920 | tem = funcall_lambda (fun, numargs, arg_vector); |
| 2925 | 2921 | ||
| 2926 | /* Do the debug-on-exit now, while arg_vector still exists. */ | 2922 | /* Do the debug-on-exit now, while arg_vector still exists. */ |
| 2927 | if (backtrace_debug_on_exit (specpdl_ptr - 1)) | 2923 | if (backtrace_debug_on_exit (specpdl + count)) |
| 2928 | { | 2924 | { |
| 2929 | /* Don't do it again when we return to eval. */ | 2925 | /* Don't do it again when we return to eval. */ |
| 2930 | set_backtrace_debug_on_exit (specpdl_ptr - 1, false); | 2926 | set_backtrace_debug_on_exit (specpdl + count, false); |
| 2931 | tem = call_debugger (list2 (Qexit, tem)); | 2927 | tem = call_debugger (list2 (Qexit, tem)); |
| 2932 | } | 2928 | } |
| 2933 | SAFE_FREE (); | 2929 | SAFE_FREE (); |
diff --git a/src/lisp.h b/src/lisp.h index 2b632ad19f1..0bcc0ec0e3f 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -3955,8 +3955,7 @@ extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); | |||
| 3955 | extern void init_eval (void); | 3955 | extern void init_eval (void); |
| 3956 | extern void syms_of_eval (void); | 3956 | extern void syms_of_eval (void); |
| 3957 | extern void unwind_body (Lisp_Object); | 3957 | extern void unwind_body (Lisp_Object); |
| 3958 | extern void record_in_backtrace (Lisp_Object function, | 3958 | extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t); |
| 3959 | Lisp_Object *args, ptrdiff_t nargs); | ||
| 3960 | extern void mark_specpdl (void); | 3959 | extern void mark_specpdl (void); |
| 3961 | extern void get_backtrace (Lisp_Object array); | 3960 | extern void get_backtrace (Lisp_Object array); |
| 3962 | Lisp_Object backtrace_top_function (void); | 3961 | Lisp_Object backtrace_top_function (void); |