diff options
| author | Joakim Verona | 2013-07-14 11:04:49 +0200 |
|---|---|---|
| committer | Joakim Verona | 2013-07-14 11:04:49 +0200 |
| commit | 0bb9bb0841d89fff09820a57369df4cb01b16b43 (patch) | |
| tree | 832bf9fa8415eef0ce464d22b3ee1300cfa90bb1 /src/eval.c | |
| parent | 3718127221fbbc31f8ebd027ab7c95403dbe9118 (diff) | |
| parent | 3af1c8684ed6e48fbc21481d129e9aa164752c6e (diff) | |
| download | emacs-0bb9bb0841d89fff09820a57369df4cb01b16b43.tar.gz emacs-0bb9bb0841d89fff09820a57369df4cb01b16b43.zip | |
Merge branch 'trunk' into xwidget
Conflicts:
src/xdisp.c
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 d3545add21d..0e231bdb285 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 | ||
| @@ -152,7 +159,7 @@ specpdl_func (union specbinding *pdl) | |||
| 152 | return pdl->unwind.func; | 159 | return pdl->unwind.func; |
| 153 | } | 160 | } |
| 154 | 161 | ||
| 155 | static Lisp_Object | 162 | Lisp_Object |
| 156 | backtrace_function (union specbinding *pdl) | 163 | backtrace_function (union specbinding *pdl) |
| 157 | { | 164 | { |
| 158 | eassert (pdl->kind == SPECPDL_BACKTRACE); | 165 | eassert (pdl->kind == SPECPDL_BACKTRACE); |
| @@ -166,7 +173,7 @@ backtrace_nargs (union specbinding *pdl) | |||
| 166 | return pdl->bt.nargs; | 173 | return pdl->bt.nargs; |
| 167 | } | 174 | } |
| 168 | 175 | ||
| 169 | static Lisp_Object * | 176 | Lisp_Object * |
| 170 | backtrace_args (union specbinding *pdl) | 177 | backtrace_args (union specbinding *pdl) |
| 171 | { | 178 | { |
| 172 | eassert (pdl->kind == SPECPDL_BACKTRACE); | 179 | eassert (pdl->kind == SPECPDL_BACKTRACE); |
| @@ -205,10 +212,6 @@ set_backtrace_debug_on_exit (union specbinding *pdl, bool doe) | |||
| 205 | 212 | ||
| 206 | /* Helper functions to scan the backtrace. */ | 213 | /* Helper functions to scan the backtrace. */ |
| 207 | 214 | ||
| 208 | bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; | ||
| 209 | union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; | ||
| 210 | union specbinding *backtrace_next (union specbinding *pdl) EXTERNALLY_VISIBLE; | ||
| 211 | |||
| 212 | bool | 215 | bool |
| 213 | backtrace_p (union specbinding *pdl) | 216 | backtrace_p (union specbinding *pdl) |
| 214 | { return pdl >= specpdl; } | 217 | { return pdl >= specpdl; } |
| @@ -1993,38 +1996,52 @@ If LEXICAL is t, evaluate using lexical scoping. */) | |||
| 1993 | return unbind_to (count, eval_sub (form)); | 1996 | return unbind_to (count, eval_sub (form)); |
| 1994 | } | 1997 | } |
| 1995 | 1998 | ||
| 1999 | /* Grow the specpdl stack by one entry. | ||
| 2000 | The caller should have already initialized the entry. | ||
| 2001 | Signal an error on stack overflow. | ||
| 2002 | |||
| 2003 | Make sure that there is always one unused entry past the top of the | ||
| 2004 | stack, so that the just-initialized entry is safely unwound if | ||
| 2005 | memory exhausted and an error is signaled here. Also, allocate a | ||
| 2006 | never-used entry just before the bottom of the stack; sometimes its | ||
| 2007 | address is taken. */ | ||
| 2008 | |||
| 1996 | static void | 2009 | static void |
| 1997 | grow_specpdl (void) | 2010 | grow_specpdl (void) |
| 1998 | { | 2011 | { |
| 1999 | ptrdiff_t count = SPECPDL_INDEX (); | 2012 | specpdl_ptr++; |
| 2000 | ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); | 2013 | |
| 2001 | union specbinding *pdlvec = specpdl - 1; | 2014 | if (specpdl_ptr == specpdl + specpdl_size) |
| 2002 | ptrdiff_t pdlvecsize = specpdl_size + 1; | ||
| 2003 | if (max_size <= specpdl_size) | ||
| 2004 | { | 2015 | { |
| 2005 | if (max_specpdl_size < 400) | 2016 | ptrdiff_t count = SPECPDL_INDEX (); |
| 2006 | max_size = max_specpdl_size = 400; | 2017 | ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); |
| 2018 | union specbinding *pdlvec = specpdl - 1; | ||
| 2019 | ptrdiff_t pdlvecsize = specpdl_size + 1; | ||
| 2007 | if (max_size <= specpdl_size) | 2020 | if (max_size <= specpdl_size) |
| 2008 | signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); | 2021 | { |
| 2022 | if (max_specpdl_size < 400) | ||
| 2023 | max_size = max_specpdl_size = 400; | ||
| 2024 | if (max_size <= specpdl_size) | ||
| 2025 | signal_error ("Variable binding depth exceeds max-specpdl-size", | ||
| 2026 | Qnil); | ||
| 2027 | } | ||
| 2028 | pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); | ||
| 2029 | specpdl = pdlvec + 1; | ||
| 2030 | specpdl_size = pdlvecsize - 1; | ||
| 2031 | specpdl_ptr = specpdl + count; | ||
| 2009 | } | 2032 | } |
| 2010 | pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); | ||
| 2011 | specpdl = pdlvec + 1; | ||
| 2012 | specpdl_size = pdlvecsize - 1; | ||
| 2013 | specpdl_ptr = specpdl + count; | ||
| 2014 | } | 2033 | } |
| 2015 | 2034 | ||
| 2016 | void | 2035 | void |
| 2017 | record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) | 2036 | record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) |
| 2018 | { | 2037 | { |
| 2019 | eassert (nargs >= UNEVALLED); | 2038 | eassert (nargs >= UNEVALLED); |
| 2020 | if (specpdl_ptr == specpdl + specpdl_size) | ||
| 2021 | grow_specpdl (); | ||
| 2022 | specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; | 2039 | specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; |
| 2023 | specpdl_ptr->bt.debug_on_exit = false; | 2040 | specpdl_ptr->bt.debug_on_exit = false; |
| 2024 | specpdl_ptr->bt.function = function; | 2041 | specpdl_ptr->bt.function = function; |
| 2025 | specpdl_ptr->bt.args = args; | 2042 | specpdl_ptr->bt.args = args; |
| 2026 | specpdl_ptr->bt.nargs = nargs; | 2043 | specpdl_ptr->bt.nargs = nargs; |
| 2027 | specpdl_ptr++; | 2044 | grow_specpdl (); |
| 2028 | } | 2045 | } |
| 2029 | 2046 | ||
| 2030 | /* Eval a sub-expression of the current expression (i.e. in the same | 2047 | /* Eval a sub-expression of the current expression (i.e. in the same |
| @@ -3110,8 +3127,6 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3110 | 3127 | ||
| 3111 | CHECK_SYMBOL (symbol); | 3128 | CHECK_SYMBOL (symbol); |
| 3112 | sym = XSYMBOL (symbol); | 3129 | sym = XSYMBOL (symbol); |
| 3113 | if (specpdl_ptr == specpdl + specpdl_size) | ||
| 3114 | grow_specpdl (); | ||
| 3115 | 3130 | ||
| 3116 | start: | 3131 | start: |
| 3117 | switch (sym->redirect) | 3132 | switch (sym->redirect) |
| @@ -3124,7 +3139,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3124 | specpdl_ptr->let.kind = SPECPDL_LET; | 3139 | specpdl_ptr->let.kind = SPECPDL_LET; |
| 3125 | specpdl_ptr->let.symbol = symbol; | 3140 | specpdl_ptr->let.symbol = symbol; |
| 3126 | specpdl_ptr->let.old_value = SYMBOL_VAL (sym); | 3141 | specpdl_ptr->let.old_value = SYMBOL_VAL (sym); |
| 3127 | ++specpdl_ptr; | 3142 | grow_specpdl (); |
| 3128 | if (!sym->constant) | 3143 | if (!sym->constant) |
| 3129 | SET_SYMBOL_VAL (sym, value); | 3144 | SET_SYMBOL_VAL (sym, value); |
| 3130 | else | 3145 | else |
| @@ -3159,7 +3174,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3159 | if (NILP (Flocal_variable_p (symbol, Qnil))) | 3174 | if (NILP (Flocal_variable_p (symbol, Qnil))) |
| 3160 | { | 3175 | { |
| 3161 | specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; | 3176 | specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; |
| 3162 | ++specpdl_ptr; | 3177 | grow_specpdl (); |
| 3163 | Fset_default (symbol, value); | 3178 | Fset_default (symbol, value); |
| 3164 | return; | 3179 | return; |
| 3165 | } | 3180 | } |
| @@ -3167,7 +3182,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3167 | else | 3182 | else |
| 3168 | specpdl_ptr->let.kind = SPECPDL_LET; | 3183 | specpdl_ptr->let.kind = SPECPDL_LET; |
| 3169 | 3184 | ||
| 3170 | specpdl_ptr++; | 3185 | grow_specpdl (); |
| 3171 | set_internal (symbol, value, Qnil, 1); | 3186 | set_internal (symbol, value, Qnil, 1); |
| 3172 | break; | 3187 | break; |
| 3173 | } | 3188 | } |
| @@ -3178,12 +3193,10 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3178 | void | 3193 | void |
| 3179 | record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) | 3194 | record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) |
| 3180 | { | 3195 | { |
| 3181 | if (specpdl_ptr == specpdl + specpdl_size) | ||
| 3182 | grow_specpdl (); | ||
| 3183 | specpdl_ptr->unwind.kind = SPECPDL_UNWIND; | 3196 | specpdl_ptr->unwind.kind = SPECPDL_UNWIND; |
| 3184 | specpdl_ptr->unwind.func = function; | 3197 | specpdl_ptr->unwind.func = function; |
| 3185 | specpdl_ptr->unwind.arg = arg; | 3198 | specpdl_ptr->unwind.arg = arg; |
| 3186 | specpdl_ptr++; | 3199 | grow_specpdl (); |
| 3187 | } | 3200 | } |
| 3188 | 3201 | ||
| 3189 | Lisp_Object | 3202 | Lisp_Object |