comparison src/backtrace.h @ 380:8626e4521993 r21-2-5

Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents c5d627a313b1
children aabb7f5b1c81
comparison
equal deleted inserted replaced
379:76b7d63099ad 380:8626e4521993
44 Lisp_Object *args; /* Points to vector of args. */ 44 Lisp_Object *args; /* Points to vector of args. */
45 int nargs; /* Length of vector. 45 int nargs; /* Length of vector.
46 If nargs is UNEVALLED, args points to 46 If nargs is UNEVALLED, args points to
47 slot holding list of unevalled args */ 47 slot holding list of unevalled args */
48 int pdlcount; /* specpdl_depth () when invoked */ 48 int pdlcount; /* specpdl_depth () when invoked */
49 #ifdef EMACS_BTL
50 /* The value of a Lisp integer that specifies the symbol being
51 "invoked" by this node in the backtrace, or 0 if the backtrace
52 doesn't correspond to a such an invocation */
53 int id_number;
54 #endif
55 char evalargs; 49 char evalargs;
56 /* Nonzero means call value of debugger when done with this operation. */ 50 /* Nonzero means call value of debugger when done with this operation. */
57 char debug_on_exit; 51 char debug_on_exit;
58 }; 52 };
59 53
114 Otherwise, undoing this binding stores old_value as symbol's value; this 108 Otherwise, undoing this binding stores old_value as symbol's value; this
115 undoes the bindings made by a let form or function call. */ 109 undoes the bindings made by a let form or function call. */
116 110
117 struct specbinding 111 struct specbinding
118 { 112 {
119 Lisp_Object symbol, old_value; 113 Lisp_Object symbol;
114 Lisp_Object old_value;
120 Lisp_Object (*func) (Lisp_Object); /* for unwind-protect */ 115 Lisp_Object (*func) (Lisp_Object); /* for unwind-protect */
121 }; 116 };
122 117
123 #if 0 /* FSFmacs */ 118 #if 0 /* FSFmacs */
124 /* #### */ 119 /* #### */
130 Lisp_Object var; 125 Lisp_Object var;
131 /* Fsignal stores here the condition-case clause that applies, 126 /* Fsignal stores here the condition-case clause that applies,
132 and Fcondition_case thus knows which clause to run. */ 127 and Fcondition_case thus knows which clause to run. */
133 Lisp_Object chosen_clause; 128 Lisp_Object chosen_clause;
134 129
135 /* Used to effect the longjump out to the handler. */ 130 /* Used to effect the longjmp() out to the handler. */
136 struct catchtag *tag; 131 struct catchtag *tag;
137 132
138 /* The next enclosing handler. */ 133 /* The next enclosing handler. */
139 struct handler *next; 134 struct handler *next;
140 }; 135 };
147 extern struct specbinding *specpdl; 142 extern struct specbinding *specpdl;
148 extern struct specbinding *specpdl_ptr; 143 extern struct specbinding *specpdl_ptr;
149 extern struct catchtag *catchlist; 144 extern struct catchtag *catchlist;
150 extern struct backtrace *backtrace_list; 145 extern struct backtrace *backtrace_list;
151 146
147 /* Most callers should simply use specbind() and unbind_to(), but if
148 speed is REALLY IMPORTANT, you can use the faster macros below */
149 void specbind_magic (Lisp_Object, Lisp_Object);
150 void grow_specpdl (size_t reserved);
151 void unbind_to_hairy (int);
152 extern int specpdl_size;
153
154 /* Inline version of specbind().
155 Use this instead of specbind() if speed is sufficiently important
156 to save the overhead of even a single function call. */
157 #define SPECBIND(symbol_object, value_object) do { \
158 Lisp_Object SB_symbol = (symbol_object); \
159 Lisp_Object SB_newval = (value_object); \
160 Lisp_Object SB_oldval; \
161 struct Lisp_Symbol *SB_sym; \
162 \
163 SPECPDL_RESERVE (1); \
164 \
165 CHECK_SYMBOL (SB_symbol); \
166 SB_sym = XSYMBOL (SB_symbol); \
167 SB_oldval = SB_sym->value; \
168 \
169 if (!SYMBOL_VALUE_MAGIC_P (SB_oldval) || UNBOUNDP (SB_oldval)) \
170 { \
171 /* ### the following test will go away when we have a constant \
172 symbol magic object */ \
173 if (EQ (SB_symbol, Qnil) || \
174 EQ (SB_symbol, Qt) || \
175 SYMBOL_IS_KEYWORD (SB_symbol)) \
176 reject_constant_symbols (SB_symbol, SB_newval, 0, \
177 UNBOUNDP (SB_newval) ? \
178 Qmakunbound : Qset); \
179 \
180 specpdl_ptr->symbol = SB_symbol; \
181 specpdl_ptr->old_value = SB_oldval; \
182 specpdl_ptr->func = 0; \
183 specpdl_ptr++; \
184 specpdl_depth_counter++; \
185 \
186 SB_sym->value = (SB_newval); \
187 } \
188 else \
189 specbind_magic (SB_symbol, SB_newval); \
190 } while (0)
191
192 /* An even faster, but less safe inline version of specbind().
193 Caller guarantees that:
194 - SYMBOL is a non-constant symbol (i.e. not Qnil, Qt, or keyword).
195 - specpdl_depth_counter >= specpdl_size.
196 Else we crash. */
197 #define SPECBIND_FAST_UNSAFE(symbol_object, value_object) do { \
198 Lisp_Object SFU_symbol = (symbol_object); \
199 Lisp_Object SFU_newval = (value_object); \
200 struct Lisp_Symbol *SFU_sym = XSYMBOL (SFU_symbol); \
201 Lisp_Object SFU_oldval = SFU_sym->value; \
202 if (!SYMBOL_VALUE_MAGIC_P (SFU_oldval) || UNBOUNDP (SFU_oldval)) \
203 { \
204 specpdl_ptr->symbol = SFU_symbol; \
205 specpdl_ptr->old_value = SFU_oldval; \
206 specpdl_ptr->func = 0; \
207 specpdl_ptr++; \
208 specpdl_depth_counter++; \
209 \
210 SFU_sym->value = (SFU_newval); \
211 } \
212 else \
213 specbind_magic (SFU_symbol, SFU_newval); \
214 } while (0)
215
216 /* Request enough room for SIZE future entries on special binding stack */
217 #define SPECPDL_RESERVE(size) do { \
218 size_t SR_size = (size); \
219 if (specpdl_depth() + SR_size >= specpdl_size) \
220 grow_specpdl (SR_size); \
221 } while (0)
222
223 /* Inline version of unbind_to().
224 Use this instead of unbind_to() if speed is sufficiently important
225 to save the overhead of even a single function call.
226
227 Most of the time, unbind_to() is called only on ordinary
228 variables, so optimize for that. */
229 #define UNBIND_TO_GCPRO(count, value) do { \
230 int UNBIND_TO_count = (count); \
231 while (specpdl_depth_counter != UNBIND_TO_count) \
232 { \
233 struct Lisp_Symbol *sym; \
234 --specpdl_ptr; \
235 --specpdl_depth_counter; \
236 \
237 if (specpdl_ptr->func != 0 || \
238 ((sym = XSYMBOL (specpdl_ptr->symbol)), \
239 SYMBOL_VALUE_MAGIC_P (sym->value))) \
240 { \
241 struct gcpro gcpro1; \
242 GCPRO1 (value); \
243 unbind_to_hairy (UNBIND_TO_count); \
244 UNGCPRO; \
245 break; \
246 } \
247 \
248 sym->value = specpdl_ptr->old_value; \
249 } \
250 } while (0)
251
252 /* A slightly faster inline version of unbind_to,
253 that doesn't offer GCPROing services. */
254 #define UNBIND_TO(count) do { \
255 int UNBIND_TO_count = (count); \
256 while (specpdl_depth_counter != UNBIND_TO_count) \
257 { \
258 struct Lisp_Symbol *sym; \
259 --specpdl_ptr; \
260 --specpdl_depth_counter; \
261 \
262 if (specpdl_ptr->func != 0 || \
263 ((sym = XSYMBOL (specpdl_ptr->symbol)), \
264 SYMBOL_VALUE_MAGIC_P (sym->value))) \
265 { \
266 unbind_to_hairy (UNBIND_TO_count); \
267 break; \
268 } \
269 \
270 sym->value = specpdl_ptr->old_value; \
271 } \
272 } while (0)
273
274 #ifdef ERROR_CHECK_TYPECHECK
275 #define CHECK_SPECBIND_VARIABLE assert (specpdl_ptr->func == 0)
276 #else
277 #define CHECK_SPECBIND_VARIABLE DO_NOTHING
278 #endif
279
280 /* Another inline version of unbind_to(). VALUE is GC-protected.
281 Caller guarantees that:
282 - all of the elements on the binding stack are variable bindings.
283 Else we crash. */
284 #define UNBIND_TO_GCPRO_VARIABLES_ONLY(count, value) do { \
285 int UNBIND_TO_count = (count); \
286 while (specpdl_depth_counter != UNBIND_TO_count) \
287 { \
288 struct Lisp_Symbol *sym; \
289 --specpdl_ptr; \
290 --specpdl_depth_counter; \
291 \
292 CHECK_SPECBIND_VARIABLE; \
293 sym = XSYMBOL (specpdl_ptr->symbol); \
294 if (!SYMBOL_VALUE_MAGIC_P (sym->value)) \
295 sym->value = specpdl_ptr->old_value; \
296 else \
297 { \
298 struct gcpro gcpro1; \
299 GCPRO1 (value); \
300 unbind_to_hairy (UNBIND_TO_count); \
301 UNGCPRO; \
302 break; \
303 } \
304 } \
305 } while (0)
306
307 /* A faster, but less safe inline version of Fset().
308 Caller guarantees that:
309 - SYMBOL is a non-constant symbol (i.e. not Qnil, Qt, or keyword).
310 Else we crash. */
311 #define FSET_FAST_UNSAFE(sym, newval) do { \
312 Lisp_Object FFU_sym = (sym); \
313 Lisp_Object FFU_newval = (newval); \
314 struct Lisp_Symbol *FFU_symbol = XSYMBOL (FFU_sym); \
315 Lisp_Object FFU_oldval = FFU_symbol->value; \
316 if (!SYMBOL_VALUE_MAGIC_P (FFU_oldval) || UNBOUNDP (FFU_oldval)) \
317 FFU_symbol->value = FFU_newval; \
318 else \
319 Fset (FFU_sym, FFU_newval); \
320 } while (0)
321
152 #endif /* _XEMACS_BACKTRACE_H_ */ 322 #endif /* _XEMACS_BACKTRACE_H_ */