diff options
| author | Tom Tromey | 2013-06-03 12:25:05 -0600 |
|---|---|---|
| committer | Tom Tromey | 2013-06-03 12:25:05 -0600 |
| commit | 68359abba96d7ec4db8aab3d3dd9cf1105c3bab5 (patch) | |
| tree | 862703e7e1a1888170136a8296a5750d6b2ae2eb /src/eval.c | |
| parent | cbcba8ce7f980b01c18c0fd561ef6687b1361507 (diff) | |
| parent | e2d8a6f0a229b4ebe26484b892ec4f14888f58b6 (diff) | |
| download | emacs-68359abba96d7ec4db8aab3d3dd9cf1105c3bab5.tar.gz emacs-68359abba96d7ec4db8aab3d3dd9cf1105c3bab5.zip | |
merge from trunk; clean up some issues
Diffstat (limited to 'src/eval.c')
| -rw-r--r-- | src/eval.c | 494 |
1 files changed, 267 insertions, 227 deletions
diff --git a/src/eval.c b/src/eval.c index a58a1508aaf..be9de93bf1f 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 | /* static 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,26 +115,39 @@ 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; } |
| 124 | { | ||
| 125 | specpdl_ptr->symbol = symbol; | ||
| 126 | } | ||
| 127 | 122 | ||
| 128 | static void | 123 | static void set_backtrace_nargs (struct specbinding *pdl, ptrdiff_t n) |
| 129 | set_specpdl_old_value (Lisp_Object oldval) | 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 | EXTERN_INLINE bool backtrace_p (struct specbinding *pdl) | ||
| 132 | { return pdl >= specpdl; } | ||
| 133 | |||
| 134 | EXTERN_INLINE struct specbinding *backtrace_top (void) | ||
| 130 | { | 135 | { |
| 131 | specpdl_ptr->old_value = oldval; | 136 | struct specbinding *pdl = specpdl_ptr - 1; |
| 137 | while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE) | ||
| 138 | pdl--; | ||
| 139 | return pdl; | ||
| 132 | } | 140 | } |
| 133 | 141 | ||
| 134 | static inline void | 142 | EXTERN_INLINE struct specbinding *backtrace_next (struct specbinding *pdl) |
| 135 | set_specpdl_saved_value (Lisp_Object savedval) | ||
| 136 | { | 143 | { |
| 137 | specpdl_ptr->saved_value = savedval; | 144 | pdl--; |
| 145 | while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE) | ||
| 146 | pdl--; | ||
| 147 | return pdl; | ||
| 138 | } | 148 | } |
| 139 | 149 | ||
| 150 | |||
| 140 | void | 151 | void |
| 141 | init_eval_once (void) | 152 | init_eval_once (void) |
| 142 | { | 153 | { |
| @@ -157,7 +168,6 @@ init_eval (void) | |||
| 157 | specpdl_ptr = specpdl; | 168 | specpdl_ptr = specpdl; |
| 158 | catchlist = 0; | 169 | catchlist = 0; |
| 159 | handlerlist = 0; | 170 | handlerlist = 0; |
| 160 | backtrace_list = 0; | ||
| 161 | Vquit_flag = Qnil; | 171 | Vquit_flag = Qnil; |
| 162 | debug_on_next_call = 0; | 172 | debug_on_next_call = 0; |
| 163 | lisp_eval_depth = 0; | 173 | lisp_eval_depth = 0; |
| @@ -253,7 +263,7 @@ static void | |||
| 253 | do_debug_on_call (Lisp_Object code) | 263 | do_debug_on_call (Lisp_Object code) |
| 254 | { | 264 | { |
| 255 | debug_on_next_call = 0; | 265 | debug_on_next_call = 0; |
| 256 | backtrace_list->debug_on_exit = 1; | 266 | set_backtrace_debug_on_exit (specpdl_ptr - 1, true); |
| 257 | call_debugger (Fcons (code, Qnil)); | 267 | call_debugger (Fcons (code, Qnil)); |
| 258 | } | 268 | } |
| 259 | 269 | ||
| @@ -549,9 +559,8 @@ The return value is BASE-VARIABLE. */) | |||
| 549 | struct specbinding *p; | 559 | struct specbinding *p; |
| 550 | 560 | ||
| 551 | for (p = specpdl_ptr; p > specpdl; ) | 561 | for (p = specpdl_ptr; p > specpdl; ) |
| 552 | if ((--p)->func == NULL | 562 | if ((--p)->kind >= SPECPDL_LET |
| 553 | && (EQ (new_alias, | 563 | && (EQ (new_alias, specpdl_symbol (p)))) |
| 554 | CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol))) | ||
| 555 | error ("Don't know how to make a let-bound variable an alias"); | 564 | error ("Don't know how to make a let-bound variable an alias"); |
| 556 | } | 565 | } |
| 557 | 566 | ||
| @@ -616,8 +625,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) | |||
| 616 | struct specbinding *pdl = specpdl_ptr; | 625 | struct specbinding *pdl = specpdl_ptr; |
| 617 | while (pdl > specpdl) | 626 | while (pdl > specpdl) |
| 618 | { | 627 | { |
| 619 | if (EQ ((--pdl)->symbol, sym) && !pdl->func | 628 | if ((--pdl)->kind >= SPECPDL_LET |
| 620 | && EQ (pdl->old_value, Qunbound)) | 629 | && EQ (specpdl_symbol (pdl), sym) |
| 630 | && EQ (specpdl_old_value (pdl), Qunbound)) | ||
| 621 | { | 631 | { |
| 622 | message_with_string | 632 | message_with_string |
| 623 | ("Warning: defvar ignored because %s is let-bound", | 633 | ("Warning: defvar ignored because %s is let-bound", |
| @@ -956,7 +966,7 @@ usage: (catch TAG BODY...) */) | |||
| 956 | 966 | ||
| 957 | /* Set up a catch, then call C function FUNC on argument ARG. | 967 | /* Set up a catch, then call C function FUNC on argument ARG. |
| 958 | FUNC should return a Lisp_Object. | 968 | FUNC should return a Lisp_Object. |
| 959 | This is how catches are done from within C code. */ | 969 | This is how catches are done from within C code. */ |
| 960 | 970 | ||
| 961 | Lisp_Object | 971 | Lisp_Object |
| 962 | internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) | 972 | internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) |
| @@ -968,7 +978,6 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object | |||
| 968 | c.next = catchlist; | 978 | c.next = catchlist; |
| 969 | c.tag = tag; | 979 | c.tag = tag; |
| 970 | c.val = Qnil; | 980 | c.val = Qnil; |
| 971 | c.backlist = backtrace_list; | ||
| 972 | c.f_handlerlist = handlerlist; | 981 | c.f_handlerlist = handlerlist; |
| 973 | c.f_lisp_eval_depth = lisp_eval_depth; | 982 | c.f_lisp_eval_depth = lisp_eval_depth; |
| 974 | c.pdlcount = SPECPDL_INDEX (); | 983 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1033,7 +1042,6 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value) | |||
| 1033 | #ifdef DEBUG_GCPRO | 1042 | #ifdef DEBUG_GCPRO |
| 1034 | gcpro_level = gcprolist ? gcprolist->level + 1 : 0; | 1043 | gcpro_level = gcprolist ? gcprolist->level + 1 : 0; |
| 1035 | #endif | 1044 | #endif |
| 1036 | backtrace_list = catch->backlist; | ||
| 1037 | lisp_eval_depth = catch->f_lisp_eval_depth; | 1045 | lisp_eval_depth = catch->f_lisp_eval_depth; |
| 1038 | 1046 | ||
| 1039 | sys_longjmp (catch->jmp, 1); | 1047 | sys_longjmp (catch->jmp, 1); |
| @@ -1134,7 +1142,6 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, | |||
| 1134 | 1142 | ||
| 1135 | c.tag = Qnil; | 1143 | c.tag = Qnil; |
| 1136 | c.val = Qnil; | 1144 | c.val = Qnil; |
| 1137 | c.backlist = backtrace_list; | ||
| 1138 | c.f_handlerlist = handlerlist; | 1145 | c.f_handlerlist = handlerlist; |
| 1139 | c.f_lisp_eval_depth = lisp_eval_depth; | 1146 | c.f_lisp_eval_depth = lisp_eval_depth; |
| 1140 | c.pdlcount = SPECPDL_INDEX (); | 1147 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1150,7 +1157,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, | |||
| 1150 | 1157 | ||
| 1151 | /* Note that this just undoes the binding of h.var; whoever | 1158 | /* Note that this just undoes the binding of h.var; whoever |
| 1152 | longjumped to us unwound the stack to c.pdlcount before | 1159 | longjumped to us unwound the stack to c.pdlcount before |
| 1153 | throwing. */ | 1160 | throwing. */ |
| 1154 | unbind_to (c.pdlcount, Qnil); | 1161 | unbind_to (c.pdlcount, Qnil); |
| 1155 | return val; | 1162 | return val; |
| 1156 | } | 1163 | } |
| @@ -1189,7 +1196,6 @@ internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers, | |||
| 1189 | 1196 | ||
| 1190 | c.tag = Qnil; | 1197 | c.tag = Qnil; |
| 1191 | c.val = Qnil; | 1198 | c.val = Qnil; |
| 1192 | c.backlist = backtrace_list; | ||
| 1193 | c.f_handlerlist = handlerlist; | 1199 | c.f_handlerlist = handlerlist; |
| 1194 | c.f_lisp_eval_depth = lisp_eval_depth; | 1200 | c.f_lisp_eval_depth = lisp_eval_depth; |
| 1195 | c.pdlcount = SPECPDL_INDEX (); | 1201 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1227,7 +1233,6 @@ internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg, | |||
| 1227 | 1233 | ||
| 1228 | c.tag = Qnil; | 1234 | c.tag = Qnil; |
| 1229 | c.val = Qnil; | 1235 | c.val = Qnil; |
| 1230 | c.backlist = backtrace_list; | ||
| 1231 | c.f_handlerlist = handlerlist; | 1236 | c.f_handlerlist = handlerlist; |
| 1232 | c.f_lisp_eval_depth = lisp_eval_depth; | 1237 | c.f_lisp_eval_depth = lisp_eval_depth; |
| 1233 | c.pdlcount = SPECPDL_INDEX (); | 1238 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1269,7 +1274,6 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object), | |||
| 1269 | 1274 | ||
| 1270 | c.tag = Qnil; | 1275 | c.tag = Qnil; |
| 1271 | c.val = Qnil; | 1276 | c.val = Qnil; |
| 1272 | c.backlist = backtrace_list; | ||
| 1273 | c.f_handlerlist = handlerlist; | 1277 | c.f_handlerlist = handlerlist; |
| 1274 | c.f_lisp_eval_depth = lisp_eval_depth; | 1278 | c.f_lisp_eval_depth = lisp_eval_depth; |
| 1275 | c.pdlcount = SPECPDL_INDEX (); | 1279 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1313,7 +1317,6 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), | |||
| 1313 | 1317 | ||
| 1314 | c.tag = Qnil; | 1318 | c.tag = Qnil; |
| 1315 | c.val = Qnil; | 1319 | c.val = Qnil; |
| 1316 | c.backlist = backtrace_list; | ||
| 1317 | c.f_handlerlist = handlerlist; | 1320 | c.f_handlerlist = handlerlist; |
| 1318 | c.f_lisp_eval_depth = lisp_eval_depth; | 1321 | c.f_lisp_eval_depth = lisp_eval_depth; |
| 1319 | c.pdlcount = SPECPDL_INDEX (); | 1322 | c.pdlcount = SPECPDL_INDEX (); |
| @@ -1381,7 +1384,6 @@ See also the function `condition-case'. */) | |||
| 1381 | = (NILP (error_symbol) ? Fcar (data) : error_symbol); | 1384 | = (NILP (error_symbol) ? Fcar (data) : error_symbol); |
| 1382 | register Lisp_Object clause = Qnil; | 1385 | register Lisp_Object clause = Qnil; |
| 1383 | struct handler *h; | 1386 | struct handler *h; |
| 1384 | struct backtrace *bp; | ||
| 1385 | 1387 | ||
| 1386 | immediate_quit = 0; | 1388 | immediate_quit = 0; |
| 1387 | abort_on_gc = 0; | 1389 | abort_on_gc = 0; |
| @@ -1417,13 +1419,13 @@ See also the function `condition-case'. */) | |||
| 1417 | too. Don't do this when ERROR_SYMBOL is nil, because that | 1419 | too. Don't do this when ERROR_SYMBOL is nil, because that |
| 1418 | is a memory-full error. */ | 1420 | is a memory-full error. */ |
| 1419 | Vsignaling_function = Qnil; | 1421 | Vsignaling_function = Qnil; |
| 1420 | if (backtrace_list && !NILP (error_symbol)) | 1422 | if (!NILP (error_symbol)) |
| 1421 | { | 1423 | { |
| 1422 | bp = backtrace_list->next; | 1424 | struct specbinding *pdl = backtrace_next (backtrace_top ()); |
| 1423 | if (bp && EQ (bp->function, Qerror)) | 1425 | if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror)) |
| 1424 | bp = bp->next; | 1426 | pdl = backtrace_next (pdl); |
| 1425 | if (bp) | 1427 | if (backtrace_p (pdl)) |
| 1426 | Vsignaling_function = bp->function; | 1428 | Vsignaling_function = backtrace_function (pdl); |
| 1427 | } | 1429 | } |
| 1428 | 1430 | ||
| 1429 | for (h = handlerlist; h; h = h->next) | 1431 | for (h = handlerlist; h; h = h->next) |
| @@ -1920,6 +1922,36 @@ If LEXICAL is t, evaluate using lexical scoping. */) | |||
| 1920 | return unbind_to (count, eval_sub (form)); | 1922 | return unbind_to (count, eval_sub (form)); |
| 1921 | } | 1923 | } |
| 1922 | 1924 | ||
| 1925 | static void | ||
| 1926 | grow_specpdl (void) | ||
| 1927 | { | ||
| 1928 | register ptrdiff_t count = SPECPDL_INDEX (); | ||
| 1929 | ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX); | ||
| 1930 | if (max_size <= specpdl_size) | ||
| 1931 | { | ||
| 1932 | if (max_specpdl_size < 400) | ||
| 1933 | max_size = max_specpdl_size = 400; | ||
| 1934 | if (max_size <= specpdl_size) | ||
| 1935 | signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); | ||
| 1936 | } | ||
| 1937 | specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl); | ||
| 1938 | specpdl_ptr = specpdl + count; | ||
| 1939 | } | ||
| 1940 | |||
| 1941 | LISP_INLINE void | ||
| 1942 | record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) | ||
| 1943 | { | ||
| 1944 | eassert (nargs >= UNEVALLED); | ||
| 1945 | if (specpdl_ptr == specpdl + specpdl_size) | ||
| 1946 | grow_specpdl (); | ||
| 1947 | specpdl_ptr->kind = SPECPDL_BACKTRACE; | ||
| 1948 | specpdl_ptr->v.bt.function = function; | ||
| 1949 | specpdl_ptr->v.bt.args = args; | ||
| 1950 | specpdl_ptr->v.bt.nargs = nargs; | ||
| 1951 | specpdl_ptr->v.bt.debug_on_exit = false; | ||
| 1952 | specpdl_ptr++; | ||
| 1953 | } | ||
| 1954 | |||
| 1923 | /* Eval a sub-expression of the current expression (i.e. in the same | 1955 | /* Eval a sub-expression of the current expression (i.e. in the same |
| 1924 | lexical scope). */ | 1956 | lexical scope). */ |
| 1925 | Lisp_Object | 1957 | Lisp_Object |
| @@ -1927,7 +1959,6 @@ eval_sub (Lisp_Object form) | |||
| 1927 | { | 1959 | { |
| 1928 | Lisp_Object fun, val, original_fun, original_args; | 1960 | Lisp_Object fun, val, original_fun, original_args; |
| 1929 | Lisp_Object funcar; | 1961 | Lisp_Object funcar; |
| 1930 | struct backtrace backtrace; | ||
| 1931 | struct gcpro gcpro1, gcpro2, gcpro3; | 1962 | struct gcpro gcpro1, gcpro2, gcpro3; |
| 1932 | 1963 | ||
| 1933 | if (SYMBOLP (form)) | 1964 | if (SYMBOLP (form)) |
| @@ -1965,12 +1996,8 @@ eval_sub (Lisp_Object form) | |||
| 1965 | original_fun = XCAR (form); | 1996 | original_fun = XCAR (form); |
| 1966 | original_args = XCDR (form); | 1997 | original_args = XCDR (form); |
| 1967 | 1998 | ||
| 1968 | backtrace.next = backtrace_list; | 1999 | /* This also protects them from gc. */ |
| 1969 | backtrace.function = original_fun; /* This also protects them from gc. */ | 2000 | record_in_backtrace (original_fun, &original_args, UNEVALLED); |
| 1970 | backtrace.args = &original_args; | ||
| 1971 | backtrace.nargs = UNEVALLED; | ||
| 1972 | backtrace.debug_on_exit = 0; | ||
| 1973 | backtrace_list = &backtrace; | ||
| 1974 | 2001 | ||
| 1975 | if (debug_on_next_call) | 2002 | if (debug_on_next_call) |
| 1976 | do_debug_on_call (Qt); | 2003 | do_debug_on_call (Qt); |
| @@ -2024,8 +2051,8 @@ eval_sub (Lisp_Object form) | |||
| 2024 | gcpro3.nvars = argnum; | 2051 | gcpro3.nvars = argnum; |
| 2025 | } | 2052 | } |
| 2026 | 2053 | ||
| 2027 | backtrace.args = vals; | 2054 | set_backtrace_args (specpdl_ptr - 1, vals); |
| 2028 | backtrace.nargs = XINT (numargs); | 2055 | set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs)); |
| 2029 | 2056 | ||
| 2030 | val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); | 2057 | val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); |
| 2031 | UNGCPRO; | 2058 | UNGCPRO; |
| @@ -2046,8 +2073,8 @@ eval_sub (Lisp_Object form) | |||
| 2046 | 2073 | ||
| 2047 | UNGCPRO; | 2074 | UNGCPRO; |
| 2048 | 2075 | ||
| 2049 | backtrace.args = argvals; | 2076 | set_backtrace_args (specpdl_ptr - 1, argvals); |
| 2050 | backtrace.nargs = XINT (numargs); | 2077 | set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs)); |
| 2051 | 2078 | ||
| 2052 | switch (i) | 2079 | switch (i) |
| 2053 | { | 2080 | { |
| @@ -2137,9 +2164,9 @@ eval_sub (Lisp_Object form) | |||
| 2137 | check_cons_list (); | 2164 | check_cons_list (); |
| 2138 | 2165 | ||
| 2139 | lisp_eval_depth--; | 2166 | lisp_eval_depth--; |
| 2140 | if (backtrace.debug_on_exit) | 2167 | if (backtrace_debug_on_exit (specpdl_ptr - 1)) |
| 2141 | val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); | 2168 | val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); |
| 2142 | backtrace_list = backtrace.next; | 2169 | specpdl_ptr--; |
| 2143 | 2170 | ||
| 2144 | return val; | 2171 | return val; |
| 2145 | } | 2172 | } |
| @@ -2619,7 +2646,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2619 | ptrdiff_t numargs = nargs - 1; | 2646 | ptrdiff_t numargs = nargs - 1; |
| 2620 | Lisp_Object lisp_numargs; | 2647 | Lisp_Object lisp_numargs; |
| 2621 | Lisp_Object val; | 2648 | Lisp_Object val; |
| 2622 | struct backtrace backtrace; | ||
| 2623 | register Lisp_Object *internal_args; | 2649 | register Lisp_Object *internal_args; |
| 2624 | ptrdiff_t i; | 2650 | ptrdiff_t i; |
| 2625 | 2651 | ||
| @@ -2633,12 +2659,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2633 | error ("Lisp nesting exceeds `max-lisp-eval-depth'"); | 2659 | error ("Lisp nesting exceeds `max-lisp-eval-depth'"); |
| 2634 | } | 2660 | } |
| 2635 | 2661 | ||
| 2636 | backtrace.next = backtrace_list; | 2662 | /* This also GCPROs them. */ |
| 2637 | backtrace.function = args[0]; | 2663 | record_in_backtrace (args[0], &args[1], nargs - 1); |
| 2638 | backtrace.args = &args[1]; /* This also GCPROs them. */ | ||
| 2639 | backtrace.nargs = nargs - 1; | ||
| 2640 | backtrace.debug_on_exit = 0; | ||
| 2641 | backtrace_list = &backtrace; | ||
| 2642 | 2664 | ||
| 2643 | /* Call GC after setting up the backtrace, so the latter GCPROs the args. */ | 2665 | /* Call GC after setting up the backtrace, so the latter GCPROs the args. */ |
| 2644 | maybe_gc (); | 2666 | maybe_gc (); |
| @@ -2763,9 +2785,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2763 | } | 2785 | } |
| 2764 | check_cons_list (); | 2786 | check_cons_list (); |
| 2765 | lisp_eval_depth--; | 2787 | lisp_eval_depth--; |
| 2766 | if (backtrace.debug_on_exit) | 2788 | if (backtrace_debug_on_exit (specpdl_ptr - 1)) |
| 2767 | val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); | 2789 | val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); |
| 2768 | backtrace_list = backtrace.next; | 2790 | specpdl_ptr--; |
| 2769 | return val; | 2791 | return val; |
| 2770 | } | 2792 | } |
| 2771 | 2793 | ||
| @@ -2797,15 +2819,17 @@ apply_lambda (Lisp_Object fun, Lisp_Object args) | |||
| 2797 | 2819 | ||
| 2798 | UNGCPRO; | 2820 | UNGCPRO; |
| 2799 | 2821 | ||
| 2800 | backtrace_list->args = arg_vector; | 2822 | set_backtrace_args (specpdl_ptr - 1, arg_vector); |
| 2801 | backtrace_list->nargs = i; | 2823 | set_backtrace_nargs (specpdl_ptr - 1, i); |
| 2802 | tem = funcall_lambda (fun, numargs, arg_vector); | 2824 | tem = funcall_lambda (fun, numargs, arg_vector); |
| 2803 | 2825 | ||
| 2804 | /* Do the debug-on-exit now, while arg_vector still exists. */ | 2826 | /* Do the debug-on-exit now, while arg_vector still exists. */ |
| 2805 | if (backtrace_list->debug_on_exit) | 2827 | if (backtrace_debug_on_exit (specpdl_ptr - 1)) |
| 2806 | tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil))); | 2828 | { |
| 2807 | /* Don't do it again when we return to eval. */ | 2829 | /* Don't do it again when we return to eval. */ |
| 2808 | backtrace_list->debug_on_exit = 0; | 2830 | set_backtrace_debug_on_exit (specpdl_ptr - 1, false); |
| 2831 | tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil))); | ||
| 2832 | } | ||
| 2809 | SAFE_FREE (); | 2833 | SAFE_FREE (); |
| 2810 | return tem; | 2834 | return tem; |
| 2811 | } | 2835 | } |
| @@ -2955,20 +2979,38 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, | |||
| 2955 | return object; | 2979 | return object; |
| 2956 | } | 2980 | } |
| 2957 | 2981 | ||
| 2958 | static void | 2982 | /* Return true if SYMBOL currently has a let-binding |
| 2959 | grow_specpdl (void) | 2983 | which was made in the buffer that is now current. */ |
| 2984 | |||
| 2985 | bool | ||
| 2986 | let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) | ||
| 2960 | { | 2987 | { |
| 2961 | register ptrdiff_t count = SPECPDL_INDEX (); | 2988 | struct specbinding *p; |
| 2962 | ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX); | 2989 | Lisp_Object buf = Fcurrent_buffer (); |
| 2963 | if (max_size <= specpdl_size) | 2990 | |
| 2964 | { | 2991 | for (p = specpdl_ptr; p > specpdl; ) |
| 2965 | if (max_specpdl_size < 400) | 2992 | if ((--p)->kind > SPECPDL_LET) |
| 2966 | max_size = max_specpdl_size = 400; | 2993 | { |
| 2967 | if (max_size <= specpdl_size) | 2994 | struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p)); |
| 2968 | signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); | 2995 | eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS); |
| 2969 | } | 2996 | if (symbol == let_bound_symbol |
| 2970 | specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl); | 2997 | && EQ (specpdl_where (p), buf)) |
| 2971 | specpdl_ptr = specpdl + count; | 2998 | return 1; |
| 2999 | } | ||
| 3000 | |||
| 3001 | return 0; | ||
| 3002 | } | ||
| 3003 | |||
| 3004 | bool | ||
| 3005 | let_shadows_global_binding_p (Lisp_Object symbol) | ||
| 3006 | { | ||
| 3007 | struct specbinding *p; | ||
| 3008 | |||
| 3009 | for (p = specpdl_ptr; p > specpdl; ) | ||
| 3010 | if ((--p)->kind >= SPECPDL_LET && EQ (specpdl_symbol (p), symbol)) | ||
| 3011 | return 1; | ||
| 3012 | |||
| 3013 | return 0; | ||
| 2972 | } | 3014 | } |
| 2973 | 3015 | ||
| 2974 | static Lisp_Object | 3016 | static Lisp_Object |
| @@ -3050,10 +3092,10 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3050 | case SYMBOL_PLAINVAL: | 3092 | case SYMBOL_PLAINVAL: |
| 3051 | /* The most common case is that of a non-constant symbol with a | 3093 | /* The most common case is that of a non-constant symbol with a |
| 3052 | trivial value. Make that as fast as we can. */ | 3094 | trivial value. Make that as fast as we can. */ |
| 3053 | set_specpdl_symbol (symbol); | 3095 | specpdl_ptr->kind = SPECPDL_LET; |
| 3054 | set_specpdl_old_value (SYMBOL_VAL (sym)); | 3096 | specpdl_ptr->v.let.symbol = symbol; |
| 3055 | specpdl_ptr->func = NULL; | 3097 | specpdl_ptr->v.let.old_value = SYMBOL_VAL (sym); |
| 3056 | specpdl_ptr->saved_value = Qnil; | 3098 | specpdl_ptr->v.let.saved_value = Qnil; |
| 3057 | ++specpdl_ptr; | 3099 | ++specpdl_ptr; |
| 3058 | do_specbind (sym, specpdl_ptr - 1, value); | 3100 | do_specbind (sym, specpdl_ptr - 1, value); |
| 3059 | break; | 3101 | break; |
| @@ -3063,59 +3105,36 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3063 | case SYMBOL_FORWARDED: | 3105 | case SYMBOL_FORWARDED: |
| 3064 | { | 3106 | { |
| 3065 | Lisp_Object ovalue = find_symbol_value (symbol); | 3107 | Lisp_Object ovalue = find_symbol_value (symbol); |
| 3066 | specpdl_ptr->func = 0; | 3108 | specpdl_ptr->kind = SPECPDL_LET_LOCAL; |
| 3067 | set_specpdl_old_value (ovalue); | 3109 | specpdl_ptr->v.let.symbol = symbol; |
| 3110 | specpdl_ptr->v.let.old_value = ovalue; | ||
| 3111 | specpdl_ptr->v.let.where = Fcurrent_buffer (); | ||
| 3068 | 3112 | ||
| 3069 | eassert (sym->redirect != SYMBOL_LOCALIZED | 3113 | eassert (sym->redirect != SYMBOL_LOCALIZED |
| 3070 | || (EQ (SYMBOL_BLV (sym)->where, | 3114 | || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); |
| 3071 | SYMBOL_BLV (sym)->frame_local ? | ||
| 3072 | Fselected_frame () : Fcurrent_buffer ()))); | ||
| 3073 | 3115 | ||
| 3074 | if (sym->redirect == SYMBOL_LOCALIZED | 3116 | if (sym->redirect == SYMBOL_LOCALIZED) |
| 3075 | || BUFFER_OBJFWDP (SYMBOL_FWD (sym))) | 3117 | { |
| 3118 | if (!blv_found (SYMBOL_BLV (sym))) | ||
| 3119 | specpdl_ptr->kind = SPECPDL_LET_DEFAULT; | ||
| 3120 | } | ||
| 3121 | else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym))) | ||
| 3076 | { | 3122 | { |
| 3077 | Lisp_Object where, cur_buf = Fcurrent_buffer (); | ||
| 3078 | |||
| 3079 | /* For a local variable, record both the symbol and which | ||
| 3080 | buffer's or frame's value we are saving. */ | ||
| 3081 | if (!NILP (Flocal_variable_p (symbol, Qnil))) | ||
| 3082 | { | ||
| 3083 | eassert (sym->redirect != SYMBOL_LOCALIZED | ||
| 3084 | || (blv_found (SYMBOL_BLV (sym)) | ||
| 3085 | && EQ (cur_buf, SYMBOL_BLV (sym)->where))); | ||
| 3086 | where = cur_buf; | ||
| 3087 | } | ||
| 3088 | else if (sym->redirect == SYMBOL_LOCALIZED | ||
| 3089 | && blv_found (SYMBOL_BLV (sym))) | ||
| 3090 | where = SYMBOL_BLV (sym)->where; | ||
| 3091 | else | ||
| 3092 | where = Qnil; | ||
| 3093 | |||
| 3094 | /* We're not using the `unused' slot in the specbinding | ||
| 3095 | structure because this would mean we have to do more | ||
| 3096 | work for simple variables. */ | ||
| 3097 | /* FIXME: The third value `current_buffer' is only used in | ||
| 3098 | let_shadows_buffer_binding_p which is itself only used | ||
| 3099 | in set_internal for local_if_set. */ | ||
| 3100 | eassert (NILP (where) || EQ (where, cur_buf)); | ||
| 3101 | set_specpdl_symbol (Fcons (symbol, Fcons (where, cur_buf))); | ||
| 3102 | |||
| 3103 | /* If SYMBOL is a per-buffer variable which doesn't have a | 3123 | /* If SYMBOL is a per-buffer variable which doesn't have a |
| 3104 | buffer-local value here, make the `let' change the global | 3124 | buffer-local value here, make the `let' change the global |
| 3105 | value by changing the value of SYMBOL in all buffers not | 3125 | value by changing the value of SYMBOL in all buffers not |
| 3106 | having their own value. This is consistent with what | 3126 | having their own value. This is consistent with what |
| 3107 | happens with other buffer-local variables. */ | 3127 | happens with other buffer-local variables. */ |
| 3108 | if (NILP (where) | 3128 | if (NILP (Flocal_variable_p (symbol, Qnil))) |
| 3109 | && sym->redirect == SYMBOL_FORWARDED) | ||
| 3110 | { | 3129 | { |
| 3111 | eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym))); | 3130 | specpdl_ptr->kind = SPECPDL_LET_DEFAULT; |
| 3112 | ++specpdl_ptr; | 3131 | ++specpdl_ptr; |
| 3113 | do_specbind (sym, specpdl_ptr - 1, value); | 3132 | do_specbind (sym, specpdl_ptr - 1, value); |
| 3114 | return; | 3133 | return; |
| 3115 | } | 3134 | } |
| 3116 | } | 3135 | } |
| 3117 | else | 3136 | else |
| 3118 | set_specpdl_symbol (symbol); | 3137 | specpdl_ptr->kind = SPECPDL_LET; |
| 3119 | 3138 | ||
| 3120 | specpdl_ptr++; | 3139 | specpdl_ptr++; |
| 3121 | do_specbind (sym, specpdl_ptr - 1, value); | 3140 | do_specbind (sym, specpdl_ptr - 1, value); |
| @@ -3130,10 +3149,9 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) | |||
| 3130 | { | 3149 | { |
| 3131 | if (specpdl_ptr == specpdl + specpdl_size) | 3150 | if (specpdl_ptr == specpdl + specpdl_size) |
| 3132 | grow_specpdl (); | 3151 | grow_specpdl (); |
| 3133 | specpdl_ptr->func = function; | 3152 | specpdl_ptr->kind = SPECPDL_UNWIND; |
| 3134 | set_specpdl_symbol (Qnil); | 3153 | specpdl_ptr->v.unwind.func = function; |
| 3135 | set_specpdl_old_value (arg); | 3154 | specpdl_ptr->v.unwind.arg = arg; |
| 3136 | set_specpdl_saved_value (Qnil); | ||
| 3137 | specpdl_ptr++; | 3155 | specpdl_ptr++; |
| 3138 | } | 3156 | } |
| 3139 | 3157 | ||
| @@ -3144,7 +3162,7 @@ rebind_for_thread_switch (void) | |||
| 3144 | 3162 | ||
| 3145 | for (bind = specpdl; bind != specpdl_ptr; ++bind) | 3163 | for (bind = specpdl; bind != specpdl_ptr; ++bind) |
| 3146 | { | 3164 | { |
| 3147 | if (bind->func == NULL) | 3165 | if (bind->kind >= SPECPDL_LET) |
| 3148 | { | 3166 | { |
| 3149 | Lisp_Object value = bind->saved_value; | 3167 | Lisp_Object value = bind->saved_value; |
| 3150 | 3168 | ||
| @@ -3157,41 +3175,50 @@ rebind_for_thread_switch (void) | |||
| 3157 | static void | 3175 | static void |
| 3158 | do_one_unbind (const struct specbinding *this_binding, int unwinding) | 3176 | do_one_unbind (const struct specbinding *this_binding, int unwinding) |
| 3159 | { | 3177 | { |
| 3160 | if (this_binding->func != 0) | 3178 | switch (this_binding->kind) |
| 3161 | (*this_binding->func) (this_binding->old_value); | 3179 | { |
| 3162 | /* If the symbol is a list, it is really (SYMBOL WHERE | 3180 | case SPECPDL_UNWIND: |
| 3163 | . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a | 3181 | (*specpdl_func (this_binding)) (specpdl_arg (this_binding)); |
| 3164 | frame. If WHERE is a buffer or frame, this indicates we | 3182 | break; |
| 3165 | bound a variable that had a buffer-local or frame-local | 3183 | case SPECPDL_LET: |
| 3166 | binding. WHERE nil means that the variable had the default | 3184 | /* If variable has a trivial value (no forwarding), we can |
| 3167 | value when it was bound. CURRENT-BUFFER is the buffer that | 3185 | just set it. No need to check for constant symbols here, |
| 3168 | was current when the variable was bound. */ | 3186 | since that was already done by specbind. */ |
| 3169 | else if (CONSP (this_binding->symbol)) | 3187 | if (XSYMBOL (specpdl_symbol (this_binding))->redirect |
| 3170 | { | 3188 | == SYMBOL_PLAINVAL) |
| 3171 | Lisp_Object symbol, where; | 3189 | SET_SYMBOL_VAL (XSYMBOL (specpdl_symbol (this_binding)), |
| 3172 | 3190 | specpdl_old_value (this_binding)); | |
| 3173 | symbol = XCAR (this_binding->symbol); | 3191 | else |
| 3174 | where = XCAR (XCDR (this_binding->symbol)); | 3192 | /* NOTE: we only ever come here if make_local_foo was used for |
| 3175 | 3193 | the first time on this var within this let. */ | |
| 3176 | if (NILP (where)) | 3194 | Fset_default (specpdl_symbol (this_binding), |
| 3177 | Fset_default (symbol, this_binding->old_value); | 3195 | specpdl_old_value (this_binding)); |
| 3178 | /* If `where' is non-nil, reset the value in the appropriate | 3196 | break; |
| 3179 | local binding, but only if that binding still exists. */ | 3197 | case SPECPDL_BACKTRACE: |
| 3180 | else if (BUFFERP (where) | 3198 | break; |
| 3181 | ? !NILP (Flocal_variable_p (symbol, where)) | 3199 | case SPECPDL_LET_LOCAL: |
| 3182 | : !NILP (Fassq (symbol, XFRAME (where)->param_alist))) | 3200 | case SPECPDL_LET_DEFAULT: |
| 3183 | set_internal (symbol, this_binding->old_value, where, 1); | 3201 | { /* If the symbol is a list, it is really (SYMBOL WHERE |
| 3184 | } | 3202 | . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a |
| 3185 | /* If variable has a trivial value (no forwarding), we can | 3203 | frame. If WHERE is a buffer or frame, this indicates we |
| 3186 | just set it. No need to check for constant symbols here, | 3204 | bound a variable that had a buffer-local or frame-local |
| 3187 | since that was already done by specbind. */ | 3205 | binding. WHERE nil means that the variable had the default |
| 3188 | else if (XSYMBOL (this_binding->symbol)->redirect == SYMBOL_PLAINVAL) | 3206 | value when it was bound. CURRENT-BUFFER is the buffer that |
| 3189 | SET_SYMBOL_VAL (XSYMBOL (this_binding->symbol), | 3207 | was current when the variable was bound. */ |
| 3190 | this_binding->old_value); | 3208 | Lisp_Object symbol = specpdl_symbol (this_binding); |
| 3191 | else | 3209 | Lisp_Object where = specpdl_where (this_binding); |
| 3192 | /* NOTE: we only ever come here if make_local_foo was used for | 3210 | eassert (BUFFERP (where)); |
| 3193 | the first time on this var within this let. */ | 3211 | |
| 3194 | Fset_default (this_binding->symbol, this_binding->old_value); | 3212 | if (this_binding->kind == SPECPDL_LET_DEFAULT) |
| 3213 | Fset_default (symbol, specpdl_old_value (this_binding)); | ||
| 3214 | /* If this was a local binding, reset the value in the appropriate | ||
| 3215 | buffer, but only if that buffer's binding still exists. */ | ||
| 3216 | else if (!NILP (Flocal_variable_p (symbol, where))) | ||
| 3217 | set_internal (symbol, specpdl_old_value (this_binding), | ||
| 3218 | where, 1); | ||
| 3219 | } | ||
| 3220 | break; | ||
| 3221 | } | ||
| 3195 | } | 3222 | } |
| 3196 | 3223 | ||
| 3197 | Lisp_Object | 3224 | Lisp_Object |
| @@ -3231,7 +3258,7 @@ unbind_for_thread_switch (void) | |||
| 3231 | 3258 | ||
| 3232 | for (bind = specpdl_ptr; bind != specpdl; --bind) | 3259 | for (bind = specpdl_ptr; bind != specpdl; --bind) |
| 3233 | { | 3260 | { |
| 3234 | if (bind->func == NULL) | 3261 | if (bind->kind >= SPECPDL_LET) |
| 3235 | { | 3262 | { |
| 3236 | bind->saved_value = find_symbol_value (binding_symbol (bind)); | 3263 | bind->saved_value = find_symbol_value (binding_symbol (bind)); |
| 3237 | do_one_unbind (bind, 0); | 3264 | do_one_unbind (bind, 0); |
| @@ -3255,18 +3282,16 @@ DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, | |||
| 3255 | The debugger is entered when that frame exits, if the flag is non-nil. */) | 3282 | The debugger is entered when that frame exits, if the flag is non-nil. */) |
| 3256 | (Lisp_Object level, Lisp_Object flag) | 3283 | (Lisp_Object level, Lisp_Object flag) |
| 3257 | { | 3284 | { |
| 3258 | register struct backtrace *backlist = backtrace_list; | 3285 | struct specbinding *pdl = backtrace_top (); |
| 3259 | register EMACS_INT i; | 3286 | register EMACS_INT i; |
| 3260 | 3287 | ||
| 3261 | CHECK_NUMBER (level); | 3288 | CHECK_NUMBER (level); |
| 3262 | 3289 | ||
| 3263 | for (i = 0; backlist && i < XINT (level); i++) | 3290 | for (i = 0; backtrace_p (pdl) && i < XINT (level); i++) |
| 3264 | { | 3291 | pdl = backtrace_next (pdl); |
| 3265 | backlist = backlist->next; | ||
| 3266 | } | ||
| 3267 | 3292 | ||
| 3268 | if (backlist) | 3293 | if (backtrace_p (pdl)) |
| 3269 | backlist->debug_on_exit = !NILP (flag); | 3294 | set_backtrace_debug_on_exit (pdl, !NILP (flag)); |
| 3270 | 3295 | ||
| 3271 | return flag; | 3296 | return flag; |
| 3272 | } | 3297 | } |
| @@ -3276,58 +3301,41 @@ DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "", | |||
| 3276 | Output stream used is value of `standard-output'. */) | 3301 | Output stream used is value of `standard-output'. */) |
| 3277 | (void) | 3302 | (void) |
| 3278 | { | 3303 | { |
| 3279 | register struct backtrace *backlist = backtrace_list; | 3304 | struct specbinding *pdl = backtrace_top (); |
| 3280 | Lisp_Object tail; | ||
| 3281 | Lisp_Object tem; | 3305 | Lisp_Object tem; |
| 3282 | struct gcpro gcpro1; | ||
| 3283 | Lisp_Object old_print_level = Vprint_level; | 3306 | Lisp_Object old_print_level = Vprint_level; |
| 3284 | 3307 | ||
| 3285 | if (NILP (Vprint_level)) | 3308 | if (NILP (Vprint_level)) |
| 3286 | XSETFASTINT (Vprint_level, 8); | 3309 | XSETFASTINT (Vprint_level, 8); |
| 3287 | 3310 | ||
| 3288 | tail = Qnil; | 3311 | while (backtrace_p (pdl)) |
| 3289 | GCPRO1 (tail); | ||
| 3290 | |||
| 3291 | while (backlist) | ||
| 3292 | { | 3312 | { |
| 3293 | write_string (backlist->debug_on_exit ? "* " : " ", 2); | 3313 | write_string (backtrace_debug_on_exit (pdl) ? "* " : " ", 2); |
| 3294 | if (backlist->nargs == UNEVALLED) | 3314 | if (backtrace_nargs (pdl) == UNEVALLED) |
| 3295 | { | 3315 | { |
| 3296 | Fprin1 (Fcons (backlist->function, *backlist->args), Qnil); | 3316 | Fprin1 (Fcons (backtrace_function (pdl), *backtrace_args (pdl)), |
| 3317 | Qnil); | ||
| 3297 | write_string ("\n", -1); | 3318 | write_string ("\n", -1); |
| 3298 | } | 3319 | } |
| 3299 | else | 3320 | else |
| 3300 | { | 3321 | { |
| 3301 | tem = backlist->function; | 3322 | tem = backtrace_function (pdl); |
| 3302 | Fprin1 (tem, Qnil); /* This can QUIT. */ | 3323 | Fprin1 (tem, Qnil); /* This can QUIT. */ |
| 3303 | write_string ("(", -1); | 3324 | write_string ("(", -1); |
| 3304 | if (backlist->nargs == MANY) | 3325 | { |
| 3305 | { /* FIXME: Can this happen? */ | 3326 | ptrdiff_t i; |
| 3306 | bool later_arg = 0; | 3327 | for (i = 0; i < backtrace_nargs (pdl); i++) |
| 3307 | for (tail = *backlist->args; !NILP (tail); tail = Fcdr (tail)) | 3328 | { |
| 3308 | { | 3329 | if (i) write_string (" ", -1); |
| 3309 | if (later_arg) | 3330 | Fprin1 (backtrace_args (pdl)[i], Qnil); |
| 3310 | write_string (" ", -1); | 3331 | } |
| 3311 | Fprin1 (Fcar (tail), Qnil); | 3332 | } |
| 3312 | later_arg = 1; | ||
| 3313 | } | ||
| 3314 | } | ||
| 3315 | else | ||
| 3316 | { | ||
| 3317 | ptrdiff_t i; | ||
| 3318 | for (i = 0; i < backlist->nargs; i++) | ||
| 3319 | { | ||
| 3320 | if (i) write_string (" ", -1); | ||
| 3321 | Fprin1 (backlist->args[i], Qnil); | ||
| 3322 | } | ||
| 3323 | } | ||
| 3324 | write_string (")\n", -1); | 3333 | write_string (")\n", -1); |
| 3325 | } | 3334 | } |
| 3326 | backlist = backlist->next; | 3335 | pdl = backtrace_next (pdl); |
| 3327 | } | 3336 | } |
| 3328 | 3337 | ||
| 3329 | Vprint_level = old_print_level; | 3338 | Vprint_level = old_print_level; |
| 3330 | UNGCPRO; | ||
| 3331 | return Qnil; | 3339 | return Qnil; |
| 3332 | } | 3340 | } |
| 3333 | 3341 | ||
| @@ -3343,53 +3351,85 @@ or a lambda expression for macro calls. | |||
| 3343 | If NFRAMES is more than the number of frames, the value is nil. */) | 3351 | If NFRAMES is more than the number of frames, the value is nil. */) |
| 3344 | (Lisp_Object nframes) | 3352 | (Lisp_Object nframes) |
| 3345 | { | 3353 | { |
| 3346 | register struct backtrace *backlist = backtrace_list; | 3354 | struct specbinding *pdl = backtrace_top (); |
| 3347 | register EMACS_INT i; | 3355 | register EMACS_INT i; |
| 3348 | Lisp_Object tem; | ||
| 3349 | 3356 | ||
| 3350 | CHECK_NATNUM (nframes); | 3357 | CHECK_NATNUM (nframes); |
| 3351 | 3358 | ||
| 3352 | /* Find the frame requested. */ | 3359 | /* Find the frame requested. */ |
| 3353 | for (i = 0; backlist && i < XFASTINT (nframes); i++) | 3360 | for (i = 0; backtrace_p (pdl) && i < XFASTINT (nframes); i++) |
| 3354 | backlist = backlist->next; | 3361 | pdl = backtrace_next (pdl); |
| 3355 | 3362 | ||
| 3356 | if (!backlist) | 3363 | if (!backtrace_p (pdl)) |
| 3357 | return Qnil; | 3364 | return Qnil; |
| 3358 | if (backlist->nargs == UNEVALLED) | 3365 | if (backtrace_nargs (pdl) == UNEVALLED) |
| 3359 | return Fcons (Qnil, Fcons (backlist->function, *backlist->args)); | 3366 | return Fcons (Qnil, |
| 3367 | Fcons (backtrace_function (pdl), *backtrace_args (pdl))); | ||
| 3360 | else | 3368 | else |
| 3361 | { | 3369 | { |
| 3362 | if (backlist->nargs == MANY) /* FIXME: Can this happen? */ | 3370 | Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl)); |
| 3363 | tem = *backlist->args; | ||
| 3364 | else | ||
| 3365 | tem = Flist (backlist->nargs, backlist->args); | ||
| 3366 | 3371 | ||
| 3367 | return Fcons (Qt, Fcons (backlist->function, tem)); | 3372 | return Fcons (Qt, Fcons (backtrace_function (pdl), tem)); |
| 3368 | } | 3373 | } |
| 3369 | } | 3374 | } |
| 3370 | 3375 | ||
| 3371 | 3376 | ||
| 3372 | #if BYTE_MARK_STACK | ||
| 3373 | void | 3377 | void |
| 3374 | mark_backtrace (void) | 3378 | mark_specpdl (struct specbinding *first, struct specbinding *ptr) |
| 3375 | { | 3379 | { |
| 3376 | register struct backtrace *backlist; | 3380 | struct specbinding *pdl; |
| 3377 | ptrdiff_t i; | 3381 | for (pdl = first; pdl != ptr; pdl++) |
| 3378 | |||
| 3379 | for (backlist = backtrace_list; backlist; backlist = backlist->next) | ||
| 3380 | { | 3382 | { |
| 3381 | mark_object (backlist->function); | 3383 | switch (pdl->kind) |
| 3384 | { | ||
| 3385 | case SPECPDL_UNWIND: | ||
| 3386 | mark_object (specpdl_arg (pdl)); | ||
| 3387 | break; | ||
| 3388 | case SPECPDL_BACKTRACE: | ||
| 3389 | { | ||
| 3390 | ptrdiff_t nargs = backtrace_nargs (pdl); | ||
| 3391 | mark_object (backtrace_function (pdl)); | ||
| 3392 | if (nargs == UNEVALLED) | ||
| 3393 | nargs = 1; | ||
| 3394 | while (nargs--) | ||
| 3395 | mark_object (backtrace_args (pdl)[nargs]); | ||
| 3396 | } | ||
| 3397 | break; | ||
| 3398 | case SPECPDL_LET_DEFAULT: | ||
| 3399 | case SPECPDL_LET_LOCAL: | ||
| 3400 | mark_object (specpdl_where (pdl)); | ||
| 3401 | case SPECPDL_LET: | ||
| 3402 | mark_object (specpdl_symbol (pdl)); | ||
| 3403 | mark_object (specpdl_old_value (pdl)); | ||
| 3404 | mark_object (specpdl_saved_value (pdl)); | ||
| 3405 | } | ||
| 3406 | } | ||
| 3407 | } | ||
| 3408 | |||
| 3409 | void | ||
| 3410 | get_backtrace (Lisp_Object array) | ||
| 3411 | { | ||
| 3412 | struct specbinding *pdl = backtrace_next (backtrace_top ()); | ||
| 3413 | ptrdiff_t i = 0, asize = ASIZE (array); | ||
| 3382 | 3414 | ||
| 3383 | if (backlist->nargs == UNEVALLED | 3415 | /* Copy the backtrace contents into working memory. */ |
| 3384 | || backlist->nargs == MANY) /* FIXME: Can this happen? */ | 3416 | for (; i < asize; i++) |
| 3385 | i = 1; | 3417 | { |
| 3418 | if (backtrace_p (pdl)) | ||
| 3419 | { | ||
| 3420 | ASET (array, i, backtrace_function (pdl)); | ||
| 3421 | pdl = backtrace_next (pdl); | ||
| 3422 | } | ||
| 3386 | else | 3423 | else |
| 3387 | i = backlist->nargs; | 3424 | ASET (array, i, Qnil); |
| 3388 | while (i--) | ||
| 3389 | mark_object (backlist->args[i]); | ||
| 3390 | } | 3425 | } |
| 3391 | } | 3426 | } |
| 3392 | #endif | 3427 | |
| 3428 | Lisp_Object backtrace_top_function (void) | ||
| 3429 | { | ||
| 3430 | struct specbinding *pdl = backtrace_top (); | ||
| 3431 | return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil); | ||
| 3432 | } | ||
| 3393 | 3433 | ||
| 3394 | void | 3434 | void |
| 3395 | syms_of_eval (void) | 3435 | syms_of_eval (void) |