diff options
| author | Paul Eggert | 2013-06-18 00:42:37 -0700 |
|---|---|---|
| committer | Paul Eggert | 2013-06-18 00:42:37 -0700 |
| commit | 9349e5f76716b44f92391fa722f5feba58898f27 (patch) | |
| tree | b92794231ade365c43949c92850d1af491953e4a /src | |
| parent | e0df2d1420f322f0879c59471d9e579cf74a8ea5 (diff) | |
| download | emacs-9349e5f76716b44f92391fa722f5feba58898f27.tar.gz emacs-9349e5f76716b44f92391fa722f5feba58898f27.zip | |
Porting fixes for merged specpdl and backtrace stacks.
In particular this ports to 32-bit sparc Sun cc.
* eval.c (init_eval_once, grow_specpdl): Allocate a specbinding
array with a dummy element at specpdl[-1], so that its address can
be taken portably.
(unbind_to): Do not copy the binding; not needed, now that we
copy old_value in the one place where the copy is needed.
* fileio.c (Fwrite_region): Use ptrdiff_t, not int, for specpdl count.
* lisp.h (BITS_PER_PTRDIFF_T): Remove; no longer needed.
(union specbinding): Rename from struct specbinding. Redo layout
to avoid the need for 'ptrdiff_t nargs : BITS_PER_PTRDIFF_T - 1;',
which is not portable. With Sun C 5.12 32-bit sparc, the
declaration causes nargs to be an unsigned bitfield, a behavior
that the C standard allows; but Emacs wants nargs to be signed.
The overall type is now a union of structures rather than a
structure of union of structures, and the 'kind' member is now a
bitfield, so that the overall type doesn't grow. All uses changed.
* process.c (Fmake_serial_process): Remove unnecessary initialization.
Fixes: debbugs:14643
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 21 | ||||
| -rw-r--r-- | src/eval.c | 198 | ||||
| -rw-r--r-- | src/fileio.c | 2 | ||||
| -rw-r--r-- | src/lisp.h | 46 | ||||
| -rw-r--r-- | src/process.c | 2 |
5 files changed, 154 insertions, 115 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 9a23c144e82..e1609356403 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,24 @@ | |||
| 1 | 2013-06-18 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | Porting fixes for merged specpdl and backtrace stacks (Bug#14643). | ||
| 4 | In particular this ports to 32-bit sparc Sun cc. | ||
| 5 | * eval.c (init_eval_once, grow_specpdl): Allocate a specbinding | ||
| 6 | array with a dummy element at specpdl[-1], so that its address can | ||
| 7 | be taken portably. | ||
| 8 | (unbind_to): Do not copy the binding; not needed, now that we | ||
| 9 | copy old_value in the one place where the copy is needed. | ||
| 10 | * fileio.c (Fwrite_region): Use ptrdiff_t, not int, for specpdl count. | ||
| 11 | * lisp.h (BITS_PER_PTRDIFF_T): Remove; no longer needed. | ||
| 12 | (union specbinding): Rename from struct specbinding. Redo layout | ||
| 13 | to avoid the need for 'ptrdiff_t nargs : BITS_PER_PTRDIFF_T - 1;', | ||
| 14 | which is not portable. With Sun C 5.12 32-bit sparc, the | ||
| 15 | declaration causes nargs to be an unsigned bitfield, a behavior | ||
| 16 | that the C standard allows; but Emacs wants nargs to be signed. | ||
| 17 | The overall type is now a union of structures rather than a | ||
| 18 | structure of union of structures, and the 'kind' member is now a | ||
| 19 | bitfield, so that the overall type doesn't grow. All uses changed. | ||
| 20 | * process.c (Fmake_serial_process): Remove unnecessary initialization. | ||
| 21 | |||
| 1 | 2013-06-17 Paul Eggert <eggert@cs.ucla.edu> | 22 | 2013-06-17 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 23 | ||
| 3 | * frame.c (x_report_frame_params): Cast parent_desc to uintptr_t. | 24 | * frame.c (x_report_frame_params): Cast parent_desc to uintptr_t. |
diff --git a/src/eval.c b/src/eval.c index 1b2f3bdc048..d3545add21d 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -76,17 +76,19 @@ Lisp_Object Vrun_hooks; | |||
| 76 | 76 | ||
| 77 | Lisp_Object Vautoload_queue; | 77 | Lisp_Object Vautoload_queue; |
| 78 | 78 | ||
| 79 | /* Current number of specbindings allocated in specpdl. */ | 79 | /* Current number of specbindings allocated in specpdl, not counting |
| 80 | the dummy entry specpdl[-1]. */ | ||
| 80 | 81 | ||
| 81 | ptrdiff_t specpdl_size; | 82 | ptrdiff_t specpdl_size; |
| 82 | 83 | ||
| 83 | /* Pointer to beginning of specpdl. */ | 84 | /* Pointer to beginning of specpdl. A dummy entry specpdl[-1] exists |
| 85 | only so that its address can be taken. */ | ||
| 84 | 86 | ||
| 85 | struct specbinding *specpdl; | 87 | union specbinding *specpdl; |
| 86 | 88 | ||
| 87 | /* Pointer to first unused element in specpdl. */ | 89 | /* Pointer to first unused element in specpdl. */ |
| 88 | 90 | ||
| 89 | struct specbinding *specpdl_ptr; | 91 | union specbinding *specpdl_ptr; |
| 90 | 92 | ||
| 91 | /* Depth in Lisp evaluations and function calls. */ | 93 | /* Depth in Lisp evaluations and function calls. */ |
| 92 | 94 | ||
| @@ -116,102 +118,112 @@ static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); | |||
| 116 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); | 118 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); |
| 117 | 119 | ||
| 118 | static Lisp_Object | 120 | static Lisp_Object |
| 119 | specpdl_symbol (struct specbinding *pdl) | 121 | specpdl_symbol (union specbinding *pdl) |
| 120 | { | 122 | { |
| 121 | eassert (pdl->kind >= SPECPDL_LET); | 123 | eassert (pdl->kind >= SPECPDL_LET); |
| 122 | return pdl->v.let.symbol; | 124 | return pdl->let.symbol; |
| 123 | } | 125 | } |
| 124 | 126 | ||
| 125 | static Lisp_Object | 127 | static Lisp_Object |
| 126 | specpdl_old_value (struct specbinding *pdl) | 128 | specpdl_old_value (union specbinding *pdl) |
| 127 | { | 129 | { |
| 128 | eassert (pdl->kind >= SPECPDL_LET); | 130 | eassert (pdl->kind >= SPECPDL_LET); |
| 129 | return pdl->v.let.old_value; | 131 | return pdl->let.old_value; |
| 130 | } | 132 | } |
| 131 | 133 | ||
| 132 | static Lisp_Object | 134 | static Lisp_Object |
| 133 | specpdl_where (struct specbinding *pdl) | 135 | specpdl_where (union specbinding *pdl) |
| 134 | { | 136 | { |
| 135 | eassert (pdl->kind > SPECPDL_LET); | 137 | eassert (pdl->kind > SPECPDL_LET); |
| 136 | return pdl->v.let.where; | 138 | return pdl->let.where; |
| 137 | } | 139 | } |
| 138 | 140 | ||
| 139 | static Lisp_Object | 141 | static Lisp_Object |
| 140 | specpdl_arg (struct specbinding *pdl) | 142 | specpdl_arg (union specbinding *pdl) |
| 141 | { | 143 | { |
| 142 | eassert (pdl->kind == SPECPDL_UNWIND); | 144 | eassert (pdl->kind == SPECPDL_UNWIND); |
| 143 | return pdl->v.unwind.arg; | 145 | return pdl->unwind.arg; |
| 144 | } | 146 | } |
| 145 | 147 | ||
| 146 | static specbinding_func | 148 | static specbinding_func |
| 147 | specpdl_func (struct specbinding *pdl) | 149 | specpdl_func (union specbinding *pdl) |
| 148 | { | 150 | { |
| 149 | eassert (pdl->kind == SPECPDL_UNWIND); | 151 | eassert (pdl->kind == SPECPDL_UNWIND); |
| 150 | return pdl->v.unwind.func; | 152 | return pdl->unwind.func; |
| 151 | } | 153 | } |
| 152 | 154 | ||
| 153 | static Lisp_Object | 155 | static Lisp_Object |
| 154 | backtrace_function (struct specbinding *pdl) | 156 | backtrace_function (union specbinding *pdl) |
| 155 | { | 157 | { |
| 156 | eassert (pdl->kind == SPECPDL_BACKTRACE); | 158 | eassert (pdl->kind == SPECPDL_BACKTRACE); |
| 157 | return pdl->v.bt.function; | 159 | return pdl->bt.function; |
| 158 | } | 160 | } |
| 159 | 161 | ||
| 160 | static ptrdiff_t | 162 | static ptrdiff_t |
| 161 | backtrace_nargs (struct specbinding *pdl) | 163 | backtrace_nargs (union specbinding *pdl) |
| 162 | { | 164 | { |
| 163 | eassert (pdl->kind == SPECPDL_BACKTRACE); | 165 | eassert (pdl->kind == SPECPDL_BACKTRACE); |
| 164 | return pdl->v.bt.nargs; | 166 | return pdl->bt.nargs; |
| 165 | } | 167 | } |
| 166 | 168 | ||
| 167 | static Lisp_Object * | 169 | static Lisp_Object * |
| 168 | backtrace_args (struct specbinding *pdl) | 170 | backtrace_args (union specbinding *pdl) |
| 169 | { | 171 | { |
| 170 | eassert (pdl->kind == SPECPDL_BACKTRACE); | 172 | eassert (pdl->kind == SPECPDL_BACKTRACE); |
| 171 | return pdl->v.bt.args; | 173 | return pdl->bt.args; |
| 172 | } | 174 | } |
| 173 | 175 | ||
| 174 | static bool | 176 | static bool |
| 175 | backtrace_debug_on_exit (struct specbinding *pdl) | 177 | backtrace_debug_on_exit (union specbinding *pdl) |
| 176 | { | 178 | { |
| 177 | eassert (pdl->kind == SPECPDL_BACKTRACE); | 179 | eassert (pdl->kind == SPECPDL_BACKTRACE); |
| 178 | return pdl->v.bt.debug_on_exit; | 180 | return pdl->bt.debug_on_exit; |
| 179 | } | 181 | } |
| 180 | 182 | ||
| 181 | /* Functions to modify slots of backtrace records. */ | 183 | /* Functions to modify slots of backtrace records. */ |
| 182 | 184 | ||
| 183 | static void | 185 | static void |
| 184 | set_backtrace_args (struct specbinding *pdl, Lisp_Object *args) | 186 | set_backtrace_args (union specbinding *pdl, Lisp_Object *args) |
| 185 | { eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.args = args; } | 187 | { |
| 188 | eassert (pdl->kind == SPECPDL_BACKTRACE); | ||
| 189 | pdl->bt.args = args; | ||
| 190 | } | ||
| 186 | 191 | ||
| 187 | static void | 192 | static void |
| 188 | set_backtrace_nargs (struct specbinding *pdl, ptrdiff_t n) | 193 | set_backtrace_nargs (union specbinding *pdl, ptrdiff_t n) |
| 189 | { eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.nargs = n; } | 194 | { |
| 195 | eassert (pdl->kind == SPECPDL_BACKTRACE); | ||
| 196 | pdl->bt.nargs = n; | ||
| 197 | } | ||
| 190 | 198 | ||
| 191 | static void | 199 | static void |
| 192 | set_backtrace_debug_on_exit (struct specbinding *pdl, bool doe) | 200 | set_backtrace_debug_on_exit (union specbinding *pdl, bool doe) |
| 193 | { eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.debug_on_exit = doe; } | 201 | { |
| 202 | eassert (pdl->kind == SPECPDL_BACKTRACE); | ||
| 203 | pdl->bt.debug_on_exit = doe; | ||
| 204 | } | ||
| 194 | 205 | ||
| 195 | /* Helper functions to scan the backtrace. */ | 206 | /* Helper functions to scan the backtrace. */ |
| 196 | 207 | ||
| 197 | bool backtrace_p (struct specbinding *) EXTERNALLY_VISIBLE; | 208 | bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; |
| 198 | struct specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; | 209 | union specbinding *backtrace_top (void) EXTERNALLY_VISIBLE; |
| 199 | struct specbinding *backtrace_next (struct specbinding *pdl) EXTERNALLY_VISIBLE; | 210 | union specbinding *backtrace_next (union specbinding *pdl) EXTERNALLY_VISIBLE; |
| 200 | 211 | ||
| 201 | bool backtrace_p (struct specbinding *pdl) | 212 | bool |
| 213 | backtrace_p (union specbinding *pdl) | ||
| 202 | { return pdl >= specpdl; } | 214 | { return pdl >= specpdl; } |
| 203 | 215 | ||
| 204 | struct specbinding * | 216 | union specbinding * |
| 205 | backtrace_top (void) | 217 | backtrace_top (void) |
| 206 | { | 218 | { |
| 207 | struct specbinding *pdl = specpdl_ptr - 1; | 219 | union specbinding *pdl = specpdl_ptr - 1; |
| 208 | while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE) | 220 | while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE) |
| 209 | pdl--; | 221 | pdl--; |
| 210 | return pdl; | 222 | return pdl; |
| 211 | } | 223 | } |
| 212 | 224 | ||
| 213 | struct specbinding * | 225 | union specbinding * |
| 214 | backtrace_next (struct specbinding *pdl) | 226 | backtrace_next (union specbinding *pdl) |
| 215 | { | 227 | { |
| 216 | pdl--; | 228 | pdl--; |
| 217 | while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE) | 229 | while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE) |
| @@ -224,9 +236,9 @@ void | |||
| 224 | init_eval_once (void) | 236 | init_eval_once (void) |
| 225 | { | 237 | { |
| 226 | enum { size = 50 }; | 238 | enum { size = 50 }; |
| 227 | specpdl = xmalloc (size * sizeof *specpdl); | 239 | union specbinding *pdlvec = xmalloc ((size + 1) * sizeof *specpdl); |
| 228 | specpdl_size = size; | 240 | specpdl_size = size; |
| 229 | specpdl_ptr = specpdl; | 241 | specpdl = specpdl_ptr = pdlvec + 1; |
| 230 | /* Don't forget to update docs (lispref node "Local Variables"). */ | 242 | /* Don't forget to update docs (lispref node "Local Variables"). */ |
| 231 | max_specpdl_size = 1300; /* 1000 is not enough for CEDET's c-by.el. */ | 243 | max_specpdl_size = 1300; /* 1000 is not enough for CEDET's c-by.el. */ |
| 232 | max_lisp_eval_depth = 600; | 244 | max_lisp_eval_depth = 600; |
| @@ -615,7 +627,7 @@ The return value is BASE-VARIABLE. */) | |||
| 615 | set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1); | 627 | set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1); |
| 616 | 628 | ||
| 617 | { | 629 | { |
| 618 | struct specbinding *p; | 630 | union specbinding *p; |
| 619 | 631 | ||
| 620 | for (p = specpdl_ptr; p > specpdl; ) | 632 | for (p = specpdl_ptr; p > specpdl; ) |
| 621 | if ((--p)->kind >= SPECPDL_LET | 633 | if ((--p)->kind >= SPECPDL_LET |
| @@ -681,7 +693,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) | |||
| 681 | else | 693 | else |
| 682 | { /* Check if there is really a global binding rather than just a let | 694 | { /* Check if there is really a global binding rather than just a let |
| 683 | binding that shadows the global unboundness of the var. */ | 695 | binding that shadows the global unboundness of the var. */ |
| 684 | struct specbinding *pdl = specpdl_ptr; | 696 | union specbinding *pdl = specpdl_ptr; |
| 685 | while (pdl > specpdl) | 697 | while (pdl > specpdl) |
| 686 | { | 698 | { |
| 687 | if ((--pdl)->kind >= SPECPDL_LET | 699 | if ((--pdl)->kind >= SPECPDL_LET |
| @@ -1480,7 +1492,7 @@ See also the function `condition-case'. */) | |||
| 1480 | Vsignaling_function = Qnil; | 1492 | Vsignaling_function = Qnil; |
| 1481 | if (!NILP (error_symbol)) | 1493 | if (!NILP (error_symbol)) |
| 1482 | { | 1494 | { |
| 1483 | struct specbinding *pdl = backtrace_next (backtrace_top ()); | 1495 | union specbinding *pdl = backtrace_next (backtrace_top ()); |
| 1484 | if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror)) | 1496 | if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror)) |
| 1485 | pdl = backtrace_next (pdl); | 1497 | pdl = backtrace_next (pdl); |
| 1486 | if (backtrace_p (pdl)) | 1498 | if (backtrace_p (pdl)) |
| @@ -1984,8 +1996,10 @@ If LEXICAL is t, evaluate using lexical scoping. */) | |||
| 1984 | static void | 1996 | static void |
| 1985 | grow_specpdl (void) | 1997 | grow_specpdl (void) |
| 1986 | { | 1998 | { |
| 1987 | register ptrdiff_t count = SPECPDL_INDEX (); | 1999 | ptrdiff_t count = SPECPDL_INDEX (); |
| 1988 | ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX); | 2000 | ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); |
| 2001 | union specbinding *pdlvec = specpdl - 1; | ||
| 2002 | ptrdiff_t pdlvecsize = specpdl_size + 1; | ||
| 1989 | if (max_size <= specpdl_size) | 2003 | if (max_size <= specpdl_size) |
| 1990 | { | 2004 | { |
| 1991 | if (max_specpdl_size < 400) | 2005 | if (max_specpdl_size < 400) |
| @@ -1993,7 +2007,9 @@ grow_specpdl (void) | |||
| 1993 | if (max_size <= specpdl_size) | 2007 | if (max_size <= specpdl_size) |
| 1994 | signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); | 2008 | signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); |
| 1995 | } | 2009 | } |
| 1996 | specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl); | 2010 | pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); |
| 2011 | specpdl = pdlvec + 1; | ||
| 2012 | specpdl_size = pdlvecsize - 1; | ||
| 1997 | specpdl_ptr = specpdl + count; | 2013 | specpdl_ptr = specpdl + count; |
| 1998 | } | 2014 | } |
| 1999 | 2015 | ||
| @@ -2003,11 +2019,11 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) | |||
| 2003 | eassert (nargs >= UNEVALLED); | 2019 | eassert (nargs >= UNEVALLED); |
| 2004 | if (specpdl_ptr == specpdl + specpdl_size) | 2020 | if (specpdl_ptr == specpdl + specpdl_size) |
| 2005 | grow_specpdl (); | 2021 | grow_specpdl (); |
| 2006 | specpdl_ptr->kind = SPECPDL_BACKTRACE; | 2022 | specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; |
| 2007 | specpdl_ptr->v.bt.function = function; | 2023 | specpdl_ptr->bt.debug_on_exit = false; |
| 2008 | specpdl_ptr->v.bt.args = args; | 2024 | specpdl_ptr->bt.function = function; |
| 2009 | specpdl_ptr->v.bt.nargs = nargs; | 2025 | specpdl_ptr->bt.args = args; |
| 2010 | specpdl_ptr->v.bt.debug_on_exit = false; | 2026 | specpdl_ptr->bt.nargs = nargs; |
| 2011 | specpdl_ptr++; | 2027 | specpdl_ptr++; |
| 2012 | } | 2028 | } |
| 2013 | 2029 | ||
| @@ -3044,7 +3060,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, | |||
| 3044 | bool | 3060 | bool |
| 3045 | let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) | 3061 | let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) |
| 3046 | { | 3062 | { |
| 3047 | struct specbinding *p; | 3063 | union specbinding *p; |
| 3048 | Lisp_Object buf = Fcurrent_buffer (); | 3064 | Lisp_Object buf = Fcurrent_buffer (); |
| 3049 | 3065 | ||
| 3050 | for (p = specpdl_ptr; p > specpdl; ) | 3066 | for (p = specpdl_ptr; p > specpdl; ) |
| @@ -3063,7 +3079,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) | |||
| 3063 | bool | 3079 | bool |
| 3064 | let_shadows_global_binding_p (Lisp_Object symbol) | 3080 | let_shadows_global_binding_p (Lisp_Object symbol) |
| 3065 | { | 3081 | { |
| 3066 | struct specbinding *p; | 3082 | union specbinding *p; |
| 3067 | 3083 | ||
| 3068 | for (p = specpdl_ptr; p > specpdl; ) | 3084 | for (p = specpdl_ptr; p > specpdl; ) |
| 3069 | if ((--p)->kind >= SPECPDL_LET && EQ (specpdl_symbol (p), symbol)) | 3085 | if ((--p)->kind >= SPECPDL_LET && EQ (specpdl_symbol (p), symbol)) |
| @@ -3105,9 +3121,9 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3105 | case SYMBOL_PLAINVAL: | 3121 | case SYMBOL_PLAINVAL: |
| 3106 | /* The most common case is that of a non-constant symbol with a | 3122 | /* The most common case is that of a non-constant symbol with a |
| 3107 | trivial value. Make that as fast as we can. */ | 3123 | trivial value. Make that as fast as we can. */ |
| 3108 | specpdl_ptr->kind = SPECPDL_LET; | 3124 | specpdl_ptr->let.kind = SPECPDL_LET; |
| 3109 | specpdl_ptr->v.let.symbol = symbol; | 3125 | specpdl_ptr->let.symbol = symbol; |
| 3110 | specpdl_ptr->v.let.old_value = SYMBOL_VAL (sym); | 3126 | specpdl_ptr->let.old_value = SYMBOL_VAL (sym); |
| 3111 | ++specpdl_ptr; | 3127 | ++specpdl_ptr; |
| 3112 | if (!sym->constant) | 3128 | if (!sym->constant) |
| 3113 | SET_SYMBOL_VAL (sym, value); | 3129 | SET_SYMBOL_VAL (sym, value); |
| @@ -3120,10 +3136,10 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3120 | case SYMBOL_FORWARDED: | 3136 | case SYMBOL_FORWARDED: |
| 3121 | { | 3137 | { |
| 3122 | Lisp_Object ovalue = find_symbol_value (symbol); | 3138 | Lisp_Object ovalue = find_symbol_value (symbol); |
| 3123 | specpdl_ptr->kind = SPECPDL_LET_LOCAL; | 3139 | specpdl_ptr->let.kind = SPECPDL_LET_LOCAL; |
| 3124 | specpdl_ptr->v.let.symbol = symbol; | 3140 | specpdl_ptr->let.symbol = symbol; |
| 3125 | specpdl_ptr->v.let.old_value = ovalue; | 3141 | specpdl_ptr->let.old_value = ovalue; |
| 3126 | specpdl_ptr->v.let.where = Fcurrent_buffer (); | 3142 | specpdl_ptr->let.where = Fcurrent_buffer (); |
| 3127 | 3143 | ||
| 3128 | eassert (sym->redirect != SYMBOL_LOCALIZED | 3144 | eassert (sym->redirect != SYMBOL_LOCALIZED |
| 3129 | || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); | 3145 | || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); |
| @@ -3131,7 +3147,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3131 | if (sym->redirect == SYMBOL_LOCALIZED) | 3147 | if (sym->redirect == SYMBOL_LOCALIZED) |
| 3132 | { | 3148 | { |
| 3133 | if (!blv_found (SYMBOL_BLV (sym))) | 3149 | if (!blv_found (SYMBOL_BLV (sym))) |
| 3134 | specpdl_ptr->kind = SPECPDL_LET_DEFAULT; | 3150 | specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; |
| 3135 | } | 3151 | } |
| 3136 | else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym))) | 3152 | else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym))) |
| 3137 | { | 3153 | { |
| @@ -3142,14 +3158,14 @@ specbind (Lisp_Object symbol, Lisp_Object value) | |||
| 3142 | happens with other buffer-local variables. */ | 3158 | happens with other buffer-local variables. */ |
| 3143 | if (NILP (Flocal_variable_p (symbol, Qnil))) | 3159 | if (NILP (Flocal_variable_p (symbol, Qnil))) |
| 3144 | { | 3160 | { |
| 3145 | specpdl_ptr->kind = SPECPDL_LET_DEFAULT; | 3161 | specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; |
| 3146 | ++specpdl_ptr; | 3162 | ++specpdl_ptr; |
| 3147 | Fset_default (symbol, value); | 3163 | Fset_default (symbol, value); |
| 3148 | return; | 3164 | return; |
| 3149 | } | 3165 | } |
| 3150 | } | 3166 | } |
| 3151 | else | 3167 | else |
| 3152 | specpdl_ptr->kind = SPECPDL_LET; | 3168 | specpdl_ptr->let.kind = SPECPDL_LET; |
| 3153 | 3169 | ||
| 3154 | specpdl_ptr++; | 3170 | specpdl_ptr++; |
| 3155 | set_internal (symbol, value, Qnil, 1); | 3171 | set_internal (symbol, value, Qnil, 1); |
| @@ -3164,9 +3180,9 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) | |||
| 3164 | { | 3180 | { |
| 3165 | if (specpdl_ptr == specpdl + specpdl_size) | 3181 | if (specpdl_ptr == specpdl + specpdl_size) |
| 3166 | grow_specpdl (); | 3182 | grow_specpdl (); |
| 3167 | specpdl_ptr->kind = SPECPDL_UNWIND; | 3183 | specpdl_ptr->unwind.kind = SPECPDL_UNWIND; |
| 3168 | specpdl_ptr->v.unwind.func = function; | 3184 | specpdl_ptr->unwind.func = function; |
| 3169 | specpdl_ptr->v.unwind.arg = arg; | 3185 | specpdl_ptr->unwind.arg = arg; |
| 3170 | specpdl_ptr++; | 3186 | specpdl_ptr++; |
| 3171 | } | 3187 | } |
| 3172 | 3188 | ||
| @@ -3181,33 +3197,31 @@ unbind_to (ptrdiff_t count, Lisp_Object value) | |||
| 3181 | 3197 | ||
| 3182 | while (specpdl_ptr != specpdl + count) | 3198 | while (specpdl_ptr != specpdl + count) |
| 3183 | { | 3199 | { |
| 3184 | /* Copy the binding, and decrement specpdl_ptr, before we do | 3200 | /* Decrement specpdl_ptr before we do the work to unbind it, so |
| 3185 | the work to unbind it. We decrement first | 3201 | that an error in unbinding won't try to unbind the same entry |
| 3186 | so that an error in unbinding won't try to unbind | 3202 | again. Take care to copy any parts of the binding needed |
| 3187 | the same entry again, and we copy the binding first | 3203 | before invoking any code that can make more bindings. */ |
| 3188 | in case more bindings are made during some of the code we run. */ | ||
| 3189 | 3204 | ||
| 3190 | struct specbinding this_binding; | 3205 | specpdl_ptr--; |
| 3191 | this_binding = *--specpdl_ptr; | ||
| 3192 | 3206 | ||
| 3193 | switch (this_binding.kind) | 3207 | switch (specpdl_ptr->kind) |
| 3194 | { | 3208 | { |
| 3195 | case SPECPDL_UNWIND: | 3209 | case SPECPDL_UNWIND: |
| 3196 | (*specpdl_func (&this_binding)) (specpdl_arg (&this_binding)); | 3210 | specpdl_func (specpdl_ptr) (specpdl_arg (specpdl_ptr)); |
| 3197 | break; | 3211 | break; |
| 3198 | case SPECPDL_LET: | 3212 | case SPECPDL_LET: |
| 3199 | /* If variable has a trivial value (no forwarding), we can | 3213 | /* If variable has a trivial value (no forwarding), we can |
| 3200 | just set it. No need to check for constant symbols here, | 3214 | just set it. No need to check for constant symbols here, |
| 3201 | since that was already done by specbind. */ | 3215 | since that was already done by specbind. */ |
| 3202 | if (XSYMBOL (specpdl_symbol (&this_binding))->redirect | 3216 | if (XSYMBOL (specpdl_symbol (specpdl_ptr))->redirect |
| 3203 | == SYMBOL_PLAINVAL) | 3217 | == SYMBOL_PLAINVAL) |
| 3204 | SET_SYMBOL_VAL (XSYMBOL (specpdl_symbol (&this_binding)), | 3218 | SET_SYMBOL_VAL (XSYMBOL (specpdl_symbol (specpdl_ptr)), |
| 3205 | specpdl_old_value (&this_binding)); | 3219 | specpdl_old_value (specpdl_ptr)); |
| 3206 | else | 3220 | else |
| 3207 | /* NOTE: we only ever come here if make_local_foo was used for | 3221 | /* NOTE: we only ever come here if make_local_foo was used for |
| 3208 | the first time on this var within this let. */ | 3222 | the first time on this var within this let. */ |
| 3209 | Fset_default (specpdl_symbol (&this_binding), | 3223 | Fset_default (specpdl_symbol (specpdl_ptr), |
| 3210 | specpdl_old_value (&this_binding)); | 3224 | specpdl_old_value (specpdl_ptr)); |
| 3211 | break; | 3225 | break; |
| 3212 | case SPECPDL_BACKTRACE: | 3226 | case SPECPDL_BACKTRACE: |
| 3213 | break; | 3227 | break; |
| @@ -3220,17 +3234,17 @@ unbind_to (ptrdiff_t count, Lisp_Object value) | |||
| 3220 | binding. WHERE nil means that the variable had the default | 3234 | binding. WHERE nil means that the variable had the default |
| 3221 | value when it was bound. CURRENT-BUFFER is the buffer that | 3235 | value when it was bound. CURRENT-BUFFER is the buffer that |
| 3222 | was current when the variable was bound. */ | 3236 | was current when the variable was bound. */ |
| 3223 | Lisp_Object symbol = specpdl_symbol (&this_binding); | 3237 | Lisp_Object symbol = specpdl_symbol (specpdl_ptr); |
| 3224 | Lisp_Object where = specpdl_where (&this_binding); | 3238 | Lisp_Object where = specpdl_where (specpdl_ptr); |
| 3239 | Lisp_Object old_value = specpdl_old_value (specpdl_ptr); | ||
| 3225 | eassert (BUFFERP (where)); | 3240 | eassert (BUFFERP (where)); |
| 3226 | 3241 | ||
| 3227 | if (this_binding.kind == SPECPDL_LET_DEFAULT) | 3242 | if (specpdl_ptr->kind == SPECPDL_LET_DEFAULT) |
| 3228 | Fset_default (symbol, specpdl_old_value (&this_binding)); | 3243 | Fset_default (symbol, old_value); |
| 3229 | /* If this was a local binding, reset the value in the appropriate | 3244 | /* If this was a local binding, reset the value in the appropriate |
| 3230 | buffer, but only if that buffer's binding still exists. */ | 3245 | buffer, but only if that buffer's binding still exists. */ |
| 3231 | else if (!NILP (Flocal_variable_p (symbol, where))) | 3246 | else if (!NILP (Flocal_variable_p (symbol, where))) |
| 3232 | set_internal (symbol, specpdl_old_value (&this_binding), | 3247 | set_internal (symbol, old_value, where, 1); |
| 3233 | where, 1); | ||
| 3234 | } | 3248 | } |
| 3235 | break; | 3249 | break; |
| 3236 | } | 3250 | } |
| @@ -3259,7 +3273,7 @@ DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, | |||
| 3259 | The debugger is entered when that frame exits, if the flag is non-nil. */) | 3273 | The debugger is entered when that frame exits, if the flag is non-nil. */) |
| 3260 | (Lisp_Object level, Lisp_Object flag) | 3274 | (Lisp_Object level, Lisp_Object flag) |
| 3261 | { | 3275 | { |
| 3262 | struct specbinding *pdl = backtrace_top (); | 3276 | union specbinding *pdl = backtrace_top (); |
| 3263 | register EMACS_INT i; | 3277 | register EMACS_INT i; |
| 3264 | 3278 | ||
| 3265 | CHECK_NUMBER (level); | 3279 | CHECK_NUMBER (level); |
| @@ -3278,7 +3292,7 @@ DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "", | |||
| 3278 | Output stream used is value of `standard-output'. */) | 3292 | Output stream used is value of `standard-output'. */) |
| 3279 | (void) | 3293 | (void) |
| 3280 | { | 3294 | { |
| 3281 | struct specbinding *pdl = backtrace_top (); | 3295 | union specbinding *pdl = backtrace_top (); |
| 3282 | Lisp_Object tem; | 3296 | Lisp_Object tem; |
| 3283 | Lisp_Object old_print_level = Vprint_level; | 3297 | Lisp_Object old_print_level = Vprint_level; |
| 3284 | 3298 | ||
| @@ -3328,7 +3342,7 @@ or a lambda expression for macro calls. | |||
| 3328 | If NFRAMES is more than the number of frames, the value is nil. */) | 3342 | If NFRAMES is more than the number of frames, the value is nil. */) |
| 3329 | (Lisp_Object nframes) | 3343 | (Lisp_Object nframes) |
| 3330 | { | 3344 | { |
| 3331 | struct specbinding *pdl = backtrace_top (); | 3345 | union specbinding *pdl = backtrace_top (); |
| 3332 | register EMACS_INT i; | 3346 | register EMACS_INT i; |
| 3333 | 3347 | ||
| 3334 | CHECK_NATNUM (nframes); | 3348 | CHECK_NATNUM (nframes); |
| @@ -3354,7 +3368,7 @@ If NFRAMES is more than the number of frames, the value is nil. */) | |||
| 3354 | void | 3368 | void |
| 3355 | mark_specpdl (void) | 3369 | mark_specpdl (void) |
| 3356 | { | 3370 | { |
| 3357 | struct specbinding *pdl; | 3371 | union specbinding *pdl; |
| 3358 | for (pdl = specpdl; pdl != specpdl_ptr; pdl++) | 3372 | for (pdl = specpdl; pdl != specpdl_ptr; pdl++) |
| 3359 | { | 3373 | { |
| 3360 | switch (pdl->kind) | 3374 | switch (pdl->kind) |
| @@ -3362,6 +3376,7 @@ mark_specpdl (void) | |||
| 3362 | case SPECPDL_UNWIND: | 3376 | case SPECPDL_UNWIND: |
| 3363 | mark_object (specpdl_arg (pdl)); | 3377 | mark_object (specpdl_arg (pdl)); |
| 3364 | break; | 3378 | break; |
| 3379 | |||
| 3365 | case SPECPDL_BACKTRACE: | 3380 | case SPECPDL_BACKTRACE: |
| 3366 | { | 3381 | { |
| 3367 | ptrdiff_t nargs = backtrace_nargs (pdl); | 3382 | ptrdiff_t nargs = backtrace_nargs (pdl); |
| @@ -3372,12 +3387,15 @@ mark_specpdl (void) | |||
| 3372 | mark_object (backtrace_args (pdl)[nargs]); | 3387 | mark_object (backtrace_args (pdl)[nargs]); |
| 3373 | } | 3388 | } |
| 3374 | break; | 3389 | break; |
| 3390 | |||
| 3375 | case SPECPDL_LET_DEFAULT: | 3391 | case SPECPDL_LET_DEFAULT: |
| 3376 | case SPECPDL_LET_LOCAL: | 3392 | case SPECPDL_LET_LOCAL: |
| 3377 | mark_object (specpdl_where (pdl)); | 3393 | mark_object (specpdl_where (pdl)); |
| 3394 | /* Fall through. */ | ||
| 3378 | case SPECPDL_LET: | 3395 | case SPECPDL_LET: |
| 3379 | mark_object (specpdl_symbol (pdl)); | 3396 | mark_object (specpdl_symbol (pdl)); |
| 3380 | mark_object (specpdl_old_value (pdl)); | 3397 | mark_object (specpdl_old_value (pdl)); |
| 3398 | break; | ||
| 3381 | } | 3399 | } |
| 3382 | } | 3400 | } |
| 3383 | } | 3401 | } |
| @@ -3385,7 +3403,7 @@ mark_specpdl (void) | |||
| 3385 | void | 3403 | void |
| 3386 | get_backtrace (Lisp_Object array) | 3404 | get_backtrace (Lisp_Object array) |
| 3387 | { | 3405 | { |
| 3388 | struct specbinding *pdl = backtrace_next (backtrace_top ()); | 3406 | union specbinding *pdl = backtrace_next (backtrace_top ()); |
| 3389 | ptrdiff_t i = 0, asize = ASIZE (array); | 3407 | ptrdiff_t i = 0, asize = ASIZE (array); |
| 3390 | 3408 | ||
| 3391 | /* Copy the backtrace contents into working memory. */ | 3409 | /* Copy the backtrace contents into working memory. */ |
| @@ -3403,7 +3421,7 @@ get_backtrace (Lisp_Object array) | |||
| 3403 | 3421 | ||
| 3404 | Lisp_Object backtrace_top_function (void) | 3422 | Lisp_Object backtrace_top_function (void) |
| 3405 | { | 3423 | { |
| 3406 | struct specbinding *pdl = backtrace_top (); | 3424 | union specbinding *pdl = backtrace_top (); |
| 3407 | return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil); | 3425 | return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil); |
| 3408 | } | 3426 | } |
| 3409 | 3427 | ||
diff --git a/src/fileio.c b/src/fileio.c index 6a60186a84f..4a14f5a5911 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -4764,7 +4764,7 @@ This calls `write-region-annotate-functions' at the start, and | |||
| 4764 | struct stat st; | 4764 | struct stat st; |
| 4765 | EMACS_TIME modtime; | 4765 | EMACS_TIME modtime; |
| 4766 | ptrdiff_t count = SPECPDL_INDEX (); | 4766 | ptrdiff_t count = SPECPDL_INDEX (); |
| 4767 | int count1; | 4767 | ptrdiff_t count1; |
| 4768 | Lisp_Object handler; | 4768 | Lisp_Object handler; |
| 4769 | Lisp_Object visit_file; | 4769 | Lisp_Object visit_file; |
| 4770 | Lisp_Object annotations; | 4770 | Lisp_Object annotations; |
diff --git a/src/lisp.h b/src/lisp.h index f76bbfb9ead..e4033a2f45b 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -73,7 +73,6 @@ enum | |||
| 73 | BITS_PER_SHORT = CHAR_BIT * sizeof (short), | 73 | BITS_PER_SHORT = CHAR_BIT * sizeof (short), |
| 74 | BITS_PER_INT = CHAR_BIT * sizeof (int), | 74 | BITS_PER_INT = CHAR_BIT * sizeof (int), |
| 75 | BITS_PER_LONG = CHAR_BIT * sizeof (long int), | 75 | BITS_PER_LONG = CHAR_BIT * sizeof (long int), |
| 76 | BITS_PER_PTRDIFF_T = CHAR_BIT * sizeof (ptrdiff_t), | ||
| 77 | BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT) | 76 | BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT) |
| 78 | }; | 77 | }; |
| 79 | 78 | ||
| @@ -2679,9 +2678,9 @@ typedef jmp_buf sys_jmp_buf; | |||
| 2679 | WHERE being a buffer or frame means we saw a buffer-local or frame-local | 2678 | WHERE being a buffer or frame means we saw a buffer-local or frame-local |
| 2680 | value. Other values of WHERE mean an internal error. | 2679 | value. Other values of WHERE mean an internal error. |
| 2681 | 2680 | ||
| 2682 | NOTE: The specbinding struct is defined here, because SPECPDL_INDEX is | 2681 | NOTE: The specbinding union is defined here, because SPECPDL_INDEX is |
| 2683 | used all over the place, needs to be fast, and needs to know the size of | 2682 | used all over the place, needs to be fast, and needs to know the size of |
| 2684 | struct specbinding. But only eval.c should access it. */ | 2683 | union specbinding. But only eval.c should access it. */ |
| 2685 | 2684 | ||
| 2686 | typedef Lisp_Object (*specbinding_func) (Lisp_Object); | 2685 | typedef Lisp_Object (*specbinding_func) (Lisp_Object); |
| 2687 | 2686 | ||
| @@ -2694,29 +2693,30 @@ enum specbind_tag { | |||
| 2694 | SPECPDL_LET_DEFAULT /* A global binding for a localized var. */ | 2693 | SPECPDL_LET_DEFAULT /* A global binding for a localized var. */ |
| 2695 | }; | 2694 | }; |
| 2696 | 2695 | ||
| 2697 | struct specbinding | 2696 | union specbinding |
| 2698 | { | 2697 | { |
| 2699 | enum specbind_tag kind; | 2698 | ENUM_BF (specbind_tag) kind : CHAR_BIT; |
| 2700 | union { | 2699 | struct { |
| 2701 | struct { | 2700 | ENUM_BF (specbind_tag) kind : CHAR_BIT; |
| 2702 | Lisp_Object arg; | 2701 | Lisp_Object arg; |
| 2703 | specbinding_func func; | 2702 | specbinding_func func; |
| 2704 | } unwind; | 2703 | } unwind; |
| 2705 | struct { | 2704 | struct { |
| 2706 | /* `where' is not used in the case of SPECPDL_LET. */ | 2705 | ENUM_BF (specbind_tag) kind : CHAR_BIT; |
| 2707 | Lisp_Object symbol, old_value, where; | 2706 | /* `where' is not used in the case of SPECPDL_LET. */ |
| 2708 | } let; | 2707 | Lisp_Object symbol, old_value, where; |
| 2709 | struct { | 2708 | } let; |
| 2710 | Lisp_Object function; | 2709 | struct { |
| 2711 | Lisp_Object *args; | 2710 | ENUM_BF (specbind_tag) kind : CHAR_BIT; |
| 2712 | ptrdiff_t nargs : BITS_PER_PTRDIFF_T - 1; | 2711 | bool debug_on_exit : 1; |
| 2713 | bool debug_on_exit : 1; | 2712 | Lisp_Object function; |
| 2714 | } bt; | 2713 | Lisp_Object *args; |
| 2715 | } v; | 2714 | ptrdiff_t nargs; |
| 2715 | } bt; | ||
| 2716 | }; | 2716 | }; |
| 2717 | 2717 | ||
| 2718 | extern struct specbinding *specpdl; | 2718 | extern union specbinding *specpdl; |
| 2719 | extern struct specbinding *specpdl_ptr; | 2719 | extern union specbinding *specpdl_ptr; |
| 2720 | extern ptrdiff_t specpdl_size; | 2720 | extern ptrdiff_t specpdl_size; |
| 2721 | 2721 | ||
| 2722 | LISP_INLINE ptrdiff_t | 2722 | LISP_INLINE ptrdiff_t |
diff --git a/src/process.c b/src/process.c index a873dd0cdb2..0afd8b5d2ac 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -2524,7 +2524,7 @@ usage: (make-serial-process &rest ARGS) */) | |||
| 2524 | struct gcpro gcpro1; | 2524 | struct gcpro gcpro1; |
| 2525 | Lisp_Object name, buffer; | 2525 | Lisp_Object name, buffer; |
| 2526 | Lisp_Object tem, val; | 2526 | Lisp_Object tem, val; |
| 2527 | ptrdiff_t specpdl_count = -1; | 2527 | ptrdiff_t specpdl_count; |
| 2528 | 2528 | ||
| 2529 | if (nargs == 0) | 2529 | if (nargs == 0) |
| 2530 | return Qnil; | 2530 | return Qnil; |