aboutsummaryrefslogtreecommitdiffstats
path: root/src/eval.c
diff options
context:
space:
mode:
authorTom Tromey2013-07-12 18:44:13 -0600
committerTom Tromey2013-07-12 18:44:13 -0600
commitb34a529f177a6ea32da5cb1254f91bf9d71838db (patch)
tree477131abc15d3107b30b635223d87a22550b480b /src/eval.c
parente6f63071a3f7721f55220514b6d9a8ee8c1232d8 (diff)
parent5e301d7651c0691bb2bc7f3fbe711fdbe26ac471 (diff)
downloademacs-b34a529f177a6ea32da5cb1254f91bf9d71838db.tar.gz
emacs-b34a529f177a6ea32da5cb1254f91bf9d71838db.zip
Merge from trunk
Diffstat (limited to 'src/eval.c')
-rw-r--r--src/eval.c71
1 files changed, 42 insertions, 29 deletions
diff --git a/src/eval.c b/src/eval.c
index 451a7b0cc28..97e812dd890 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -114,6 +114,13 @@ Lisp_Object Vsignaling_function;
114 frame is half-initialized. */ 114 frame is half-initialized. */
115Lisp_Object inhibit_lisp_code; 115Lisp_Object inhibit_lisp_code;
116 116
117/* These would ordinarily be static, but they need to be visible to GDB. */
118bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE;
119Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE;
120Lisp_Object backtrace_function (union specbinding *) EXTERNALLY_VISIBLE;
121union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE;
122union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE;
123
117static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); 124static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
118static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); 125static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
119 126
@@ -159,7 +166,7 @@ specpdl_func (union specbinding *pdl)
159 return pdl->unwind.func; 166 return pdl->unwind.func;
160} 167}
161 168
162static Lisp_Object 169Lisp_Object
163backtrace_function (union specbinding *pdl) 170backtrace_function (union specbinding *pdl)
164{ 171{
165 eassert (pdl->kind == SPECPDL_BACKTRACE); 172 eassert (pdl->kind == SPECPDL_BACKTRACE);
@@ -173,7 +180,7 @@ backtrace_nargs (union specbinding *pdl)
173 return pdl->bt.nargs; 180 return pdl->bt.nargs;
174} 181}
175 182
176static Lisp_Object * 183Lisp_Object *
177backtrace_args (union specbinding *pdl) 184backtrace_args (union specbinding *pdl)
178{ 185{
179 eassert (pdl->kind == SPECPDL_BACKTRACE); 186 eassert (pdl->kind == SPECPDL_BACKTRACE);
@@ -212,10 +219,6 @@ set_backtrace_debug_on_exit (union specbinding *pdl, bool doe)
212 219
213/* Helper functions to scan the backtrace. */ 220/* Helper functions to scan the backtrace. */
214 221
215bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE;
216union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE;
217union specbinding *backtrace_next (union specbinding *pdl) EXTERNALLY_VISIBLE;
218
219bool 222bool
220backtrace_p (union specbinding *pdl) 223backtrace_p (union specbinding *pdl)
221{ return pdl >= specpdl; } 224{ return pdl >= specpdl; }
@@ -2013,38 +2016,52 @@ If LEXICAL is t, evaluate using lexical scoping. */)
2013 return unbind_to (count, eval_sub (form)); 2016 return unbind_to (count, eval_sub (form));
2014} 2017}
2015 2018
2019/* Grow the specpdl stack by one entry.
2020 The caller should have already initialized the entry.
2021 Signal an error on stack overflow.
2022
2023 Make sure that there is always one unused entry past the top of the
2024 stack, so that the just-initialized entry is safely unwound if
2025 memory exhausted and an error is signaled here. Also, allocate a
2026 never-used entry just before the bottom of the stack; sometimes its
2027 address is taken. */
2028
2016static void 2029static void
2017grow_specpdl (void) 2030grow_specpdl (void)
2018{ 2031{
2019 ptrdiff_t count = SPECPDL_INDEX (); 2032 specpdl_ptr++;
2020 ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); 2033
2021 union specbinding *pdlvec = specpdl - 1; 2034 if (specpdl_ptr == specpdl + specpdl_size)
2022 ptrdiff_t pdlvecsize = specpdl_size + 1;
2023 if (max_size <= specpdl_size)
2024 { 2035 {
2025 if (max_specpdl_size < 400) 2036 ptrdiff_t count = SPECPDL_INDEX ();
2026 max_size = max_specpdl_size = 400; 2037 ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000);
2038 union specbinding *pdlvec = specpdl - 1;
2039 ptrdiff_t pdlvecsize = specpdl_size + 1;
2027 if (max_size <= specpdl_size) 2040 if (max_size <= specpdl_size)
2028 signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); 2041 {
2042 if (max_specpdl_size < 400)
2043 max_size = max_specpdl_size = 400;
2044 if (max_size <= specpdl_size)
2045 signal_error ("Variable binding depth exceeds max-specpdl-size",
2046 Qnil);
2047 }
2048 pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl);
2049 specpdl = pdlvec + 1;
2050 specpdl_size = pdlvecsize - 1;
2051 specpdl_ptr = specpdl + count;
2029 } 2052 }
2030 pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl);
2031 specpdl = pdlvec + 1;
2032 specpdl_size = pdlvecsize - 1;
2033 specpdl_ptr = specpdl + count;
2034} 2053}
2035 2054
2036void 2055void
2037record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) 2056record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
2038{ 2057{
2039 eassert (nargs >= UNEVALLED); 2058 eassert (nargs >= UNEVALLED);
2040 if (specpdl_ptr == specpdl + specpdl_size)
2041 grow_specpdl ();
2042 specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; 2059 specpdl_ptr->bt.kind = SPECPDL_BACKTRACE;
2043 specpdl_ptr->bt.debug_on_exit = false; 2060 specpdl_ptr->bt.debug_on_exit = false;
2044 specpdl_ptr->bt.function = function; 2061 specpdl_ptr->bt.function = function;
2045 specpdl_ptr->bt.args = args; 2062 specpdl_ptr->bt.args = args;
2046 specpdl_ptr->bt.nargs = nargs; 2063 specpdl_ptr->bt.nargs = nargs;
2047 specpdl_ptr++; 2064 grow_specpdl ();
2048} 2065}
2049 2066
2050/* Eval a sub-expression of the current expression (i.e. in the same 2067/* Eval a sub-expression of the current expression (i.e. in the same
@@ -3176,8 +3193,6 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3176 3193
3177 CHECK_SYMBOL (symbol); 3194 CHECK_SYMBOL (symbol);
3178 sym = XSYMBOL (symbol); 3195 sym = XSYMBOL (symbol);
3179 if (specpdl_ptr == specpdl + specpdl_size)
3180 grow_specpdl ();
3181 3196
3182 start: 3197 start:
3183 switch (sym->redirect) 3198 switch (sym->redirect)
@@ -3191,7 +3206,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3191 specpdl_ptr->let.symbol = symbol; 3206 specpdl_ptr->let.symbol = symbol;
3192 specpdl_ptr->let.old_value = SYMBOL_VAL (sym); 3207 specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
3193 specpdl_ptr->let.saved_value = Qnil; 3208 specpdl_ptr->let.saved_value = Qnil;
3194 ++specpdl_ptr; 3209 grow_specpdl ();
3195 do_specbind (sym, specpdl_ptr - 1, value); 3210 do_specbind (sym, specpdl_ptr - 1, value);
3196 break; 3211 break;
3197 case SYMBOL_LOCALIZED: 3212 case SYMBOL_LOCALIZED:
@@ -3224,7 +3239,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3224 if (NILP (Flocal_variable_p (symbol, Qnil))) 3239 if (NILP (Flocal_variable_p (symbol, Qnil)))
3225 { 3240 {
3226 specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; 3241 specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
3227 ++specpdl_ptr; 3242 grow_specpdl ();
3228 do_specbind (sym, specpdl_ptr - 1, value); 3243 do_specbind (sym, specpdl_ptr - 1, value);
3229 return; 3244 return;
3230 } 3245 }
@@ -3232,7 +3247,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3232 else 3247 else
3233 specpdl_ptr->let.kind = SPECPDL_LET; 3248 specpdl_ptr->let.kind = SPECPDL_LET;
3234 3249
3235 specpdl_ptr++; 3250 grow_specpdl ();
3236 do_specbind (sym, specpdl_ptr - 1, value); 3251 do_specbind (sym, specpdl_ptr - 1, value);
3237 break; 3252 break;
3238 } 3253 }
@@ -3243,12 +3258,10 @@ specbind (Lisp_Object symbol, Lisp_Object value)
3243void 3258void
3244record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) 3259record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
3245{ 3260{
3246 if (specpdl_ptr == specpdl + specpdl_size)
3247 grow_specpdl ();
3248 specpdl_ptr->unwind.kind = SPECPDL_UNWIND; 3261 specpdl_ptr->unwind.kind = SPECPDL_UNWIND;
3249 specpdl_ptr->unwind.func = function; 3262 specpdl_ptr->unwind.func = function;
3250 specpdl_ptr->unwind.arg = arg; 3263 specpdl_ptr->unwind.arg = arg;
3251 specpdl_ptr++; 3264 grow_specpdl ();
3252} 3265}
3253 3266
3254void 3267void