From 5e301d7651c0691bb2bc7f3fbe711fdbe26ac471 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 12 Jul 2013 17:24:38 -0700 Subject: [PATCH] Don't lose top specpdl entry when memory is exhausted. * eval.c (grow_specpdl): Increment specpdl top by 1 and check for specpdl overflow here, to simplify callers; all callers changed. Always reserve an unused entry at the stack top; this avoids losing the top entry's information when memory is exhausted. --- src/ChangeLog | 8 ++++++++ src/eval.c | 56 ++++++++++++++++++++++++++++++--------------------- 2 files changed, 41 insertions(+), 23 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 6e3a82c7c13..60e7e376729 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2013-07-13 Paul Eggert + + Don't lose top specpdl entry when memory is exhausted. + * eval.c (grow_specpdl): Increment specpdl top by 1 and check for + specpdl overflow here, to simplify callers; all callers changed. + Always reserve an unused entry at the stack top; this avoids + losing the top entry's information when memory is exhausted. + 2013-07-12 Paul Eggert Clean up errno reporting and fix some errno-reporting bugs. diff --git a/src/eval.c b/src/eval.c index 31a774b9d27..0e231bdb285 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1996,38 +1996,52 @@ If LEXICAL is t, evaluate using lexical scoping. */) return unbind_to (count, eval_sub (form)); } +/* Grow the specpdl stack by one entry. + The caller should have already initialized the entry. + Signal an error on stack overflow. + + Make sure that there is always one unused entry past the top of the + stack, so that the just-initialized entry is safely unwound if + memory exhausted and an error is signaled here. Also, allocate a + never-used entry just before the bottom of the stack; sometimes its + address is taken. */ + static void grow_specpdl (void) { - ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); - union specbinding *pdlvec = specpdl - 1; - ptrdiff_t pdlvecsize = specpdl_size + 1; - if (max_size <= specpdl_size) + specpdl_ptr++; + + if (specpdl_ptr == specpdl + specpdl_size) { - if (max_specpdl_size < 400) - max_size = max_specpdl_size = 400; + ptrdiff_t count = SPECPDL_INDEX (); + ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); + union specbinding *pdlvec = specpdl - 1; + ptrdiff_t pdlvecsize = specpdl_size + 1; if (max_size <= specpdl_size) - signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); + { + if (max_specpdl_size < 400) + max_size = max_specpdl_size = 400; + if (max_size <= specpdl_size) + signal_error ("Variable binding depth exceeds max-specpdl-size", + Qnil); + } + pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); + specpdl = pdlvec + 1; + specpdl_size = pdlvecsize - 1; + specpdl_ptr = specpdl + count; } - pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); - specpdl = pdlvec + 1; - specpdl_size = pdlvecsize - 1; - specpdl_ptr = specpdl + count; } void record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) { eassert (nargs >= UNEVALLED); - if (specpdl_ptr == specpdl + specpdl_size) - grow_specpdl (); specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; specpdl_ptr->bt.debug_on_exit = false; specpdl_ptr->bt.function = function; specpdl_ptr->bt.args = args; specpdl_ptr->bt.nargs = nargs; - specpdl_ptr++; + grow_specpdl (); } /* Eval a sub-expression of the current expression (i.e. in the same @@ -3113,8 +3127,6 @@ specbind (Lisp_Object symbol, Lisp_Object value) CHECK_SYMBOL (symbol); sym = XSYMBOL (symbol); - if (specpdl_ptr == specpdl + specpdl_size) - grow_specpdl (); start: switch (sym->redirect) @@ -3127,7 +3139,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.kind = SPECPDL_LET; specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = SYMBOL_VAL (sym); - ++specpdl_ptr; + grow_specpdl (); if (!sym->constant) SET_SYMBOL_VAL (sym, value); else @@ -3162,7 +3174,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) if (NILP (Flocal_variable_p (symbol, Qnil))) { specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; - ++specpdl_ptr; + grow_specpdl (); Fset_default (symbol, value); return; } @@ -3170,7 +3182,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) else specpdl_ptr->let.kind = SPECPDL_LET; - specpdl_ptr++; + grow_specpdl (); set_internal (symbol, value, Qnil, 1); break; } @@ -3181,12 +3193,10 @@ specbind (Lisp_Object symbol, Lisp_Object value) void record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) { - if (specpdl_ptr == specpdl + specpdl_size) - grow_specpdl (); specpdl_ptr->unwind.kind = SPECPDL_UNWIND; specpdl_ptr->unwind.func = function; specpdl_ptr->unwind.arg = arg; - specpdl_ptr++; + grow_specpdl (); } Lisp_Object -- 2.39.2