diff options
| author | Tom Tromey | 2013-07-12 18:44:13 -0600 |
|---|---|---|
| committer | Tom Tromey | 2013-07-12 18:44:13 -0600 |
| commit | b34a529f177a6ea32da5cb1254f91bf9d71838db (patch) | |
| tree | 477131abc15d3107b30b635223d87a22550b480b /src/eval.c | |
| parent | e6f63071a3f7721f55220514b6d9a8ee8c1232d8 (diff) | |
| parent | 5e301d7651c0691bb2bc7f3fbe711fdbe26ac471 (diff) | |
| download | emacs-b34a529f177a6ea32da5cb1254f91bf9d71838db.tar.gz emacs-b34a529f177a6ea32da5cb1254f91bf9d71838db.zip | |
Merge from trunk
Diffstat (limited to 'src/eval.c')
| -rw-r--r-- | src/eval.c | 71 |
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. */ |
| 115 | Lisp_Object inhibit_lisp_code; | 115 | Lisp_Object inhibit_lisp_code; |
| 116 | 116 | ||
| 117 | /* These would ordinarily be static, but they need to be visible to GDB. */ | ||
| 118 | bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; | ||
| 119 | Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE; | ||
| 120 | Lisp_Object backtrace_function (union specbinding *) EXTERNALLY_VISIBLE; | ||
| 121 | union specbinding *backtrace_next (union specbinding *) EXTERNALLY_VISIBLE; | ||
| 122 | union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; | ||
| 123 | |||
| 117 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); | 124 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); |
| 118 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); | 125 | static 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 | ||
| 162 | static Lisp_Object | 169 | Lisp_Object |
| 163 | backtrace_function (union specbinding *pdl) | 170 | backtrace_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 | ||
| 176 | static Lisp_Object * | 183 | Lisp_Object * |
| 177 | backtrace_args (union specbinding *pdl) | 184 | backtrace_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 | ||
| 215 | bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; | ||
| 216 | union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; | ||
| 217 | union specbinding *backtrace_next (union specbinding *pdl) EXTERNALLY_VISIBLE; | ||
| 218 | |||
| 219 | bool | 222 | bool |
| 220 | backtrace_p (union specbinding *pdl) | 223 | backtrace_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 | |||
| 2016 | static void | 2029 | static void |
| 2017 | grow_specpdl (void) | 2030 | grow_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 | ||
| 2036 | void | 2055 | void |
| 2037 | record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) | 2056 | record_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) | |||
| 3243 | void | 3258 | void |
| 3244 | record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) | 3259 | record_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 | ||
| 3254 | void | 3267 | void |