Mercurial > hg > xemacs-beta

comparison src/eval.c @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children a86b2b5e0111
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
71 /* If subrs take more than 8 arguments, more cases need to be added 71 /* If subrs take more than 8 arguments, more cases need to be added
72 to this switch. (But wait - don't do it - if you really need 72 to this switch. (But wait - don't do it - if you really need
73 a SUBR with more than 8 arguments, use max_args == MANY. 73 a SUBR with more than 8 arguments, use max_args == MANY.
74 See the DEFUN macro in lisp.h) */ 74 See the DEFUN macro in lisp.h) */
75 #define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \ 75 #define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \
76 void (*PF_fn)() = (void (*)()) (fn); \ 76 void (*PF_fn)(void) = (void (*)(void)) fn; \
77 Lisp_Object *PF_av = (av); \ 77 Lisp_Object *PF_av = (av); \
78 switch (ac) \ 78 switch (ac) \
79 { \ 79 { \
80 default: abort(); \ 80 default:rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break; \
81 case 0: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break; \
82 case 1: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 1); break; \ 81 case 1: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 1); break; \
83 case 2: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 2); break; \ 82 case 2: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 2); break; \
84 case 3: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 3); break; \ 83 case 3: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 3); break; \
85 case 4: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 4); break; \ 84 case 4: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 4); break; \
86 case 5: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 5); break; \ 85 case 5: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 5); break; \
168 167
169 /* Maximum size allowed for specpdl allocation */ 168 /* Maximum size allowed for specpdl allocation */
170 int max_specpdl_size; 169 int max_specpdl_size;
171 170
172 /* Depth in Lisp evaluations and function calls. */ 171 /* Depth in Lisp evaluations and function calls. */
173 int lisp_eval_depth; 172 static int lisp_eval_depth;
174 173
175 /* Maximum allowed depth in Lisp evaluations and function calls. */ 174 /* Maximum allowed depth in Lisp evaluations and function calls. */
176 int max_lisp_eval_depth; 175 int max_lisp_eval_depth;
177 176
178 /* Nonzero means enter debugger before next function call */ 177 /* Nonzero means enter debugger before next function call */
280 279
281 static void 280 static void
282 print_subr (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 281 print_subr (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
283 { 282 {
284 Lisp_Subr *subr = XSUBR (obj); 283 Lisp_Subr *subr = XSUBR (obj);
285 CONST char *header = 284 const char *header =
286 (subr->max_args == UNEVALLED) ? "#<special-form " : "#<subr "; 285 (subr->max_args == UNEVALLED) ? "#<special-form " : "#<subr ";
287 CONST char *name = subr_name (subr); 286 const char *name = subr_name (subr);
288 CONST char *trailer = subr->prompt ? " (interactive)>" : ">"; 287 const char *trailer = subr->prompt ? " (interactive)>" : ">";
289 288
290 if (print_readably) 289 if (print_readably)
291 error ("printing unreadable object %s%s%s", header, name, trailer); 290 error ("printing unreadable object %s%s%s", header, name, trailer);
292 291
293 write_c_string (header, printcharfun); 292 write_c_string (header, printcharfun);
294 write_c_string (name, printcharfun); 293 write_c_string (name, printcharfun);
295 write_c_string (trailer, printcharfun); 294 write_c_string (trailer, printcharfun);
296 } 295 }
297 296
298 DEFINE_LRECORD_IMPLEMENTATION ("subr", subr, 297 static const struct lrecord_description subr_description[] = {
299 this_one_is_unmarkable, print_subr, 0, 0, 0, 298 { XD_DOC_STRING, offsetof (Lisp_Subr, doc) },
300 Lisp_Subr); 299 { XD_END }
300 };
301
302 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("subr", subr,
303 this_one_is_unmarkable, print_subr, 0, 0, 0,
304 subr_description,
305 Lisp_Subr);
301 306
302 /************************************************************************/ 307 /************************************************************************/
303 /* Entering the debugger */ 308 /* Entering the debugger */
304 /************************************************************************/ 309 /************************************************************************/
305 310
1002 /* Defining functions/variables */ 1007 /* Defining functions/variables */
1003 /************************************************************************/ 1008 /************************************************************************/
1004 static Lisp_Object 1009 static Lisp_Object
1005 define_function (Lisp_Object name, Lisp_Object defn) 1010 define_function (Lisp_Object name, Lisp_Object defn)
1006 { 1011 {
1007 if (purify_flag)
1008 defn = Fpurecopy (defn);
1009 Ffset (name, defn); 1012 Ffset (name, defn);
1010 LOADHIST_ATTACH (name); 1013 LOADHIST_ATTACH (name);
1011 return name; 1014 return name;
1012 } 1015 }
1013 1016
1076 } 1079 }
1077 1080
1078 if (!NILP (args = XCDR (args))) 1081 if (!NILP (args = XCDR (args)))
1079 { 1082 {
1080 Lisp_Object doc = XCAR (args); 1083 Lisp_Object doc = XCAR (args);
1081 #if 0 /* FSFmacs */
1082 /* #### We should probably do this but it might be dangerous */
1083 if (purify_flag)
1084 doc = Fpurecopy (doc);
1085 Fput (sym, Qvariable_documentation, doc); 1084 Fput (sym, Qvariable_documentation, doc);
1086 #else
1087 pure_put (sym, Qvariable_documentation, doc);
1088 #endif
1089 if (!NILP (args = XCDR (args))) 1085 if (!NILP (args = XCDR (args)))
1090 error ("too many arguments"); 1086 error ("too many arguments");
1091 } 1087 }
1092 } 1088 }
1093 1089
1094 #ifdef I18N3 1090 #ifdef I18N3
1095 if (!NILP (Vfile_domain)) 1091 if (!NILP (Vfile_domain))
1096 pure_put (sym, Qvariable_domain, Vfile_domain); 1092 Fput (sym, Qvariable_domain, Vfile_domain);
1097 #endif 1093 #endif
1098 1094
1099 LOADHIST_ATTACH (sym); 1095 LOADHIST_ATTACH (sym);
1100 return sym; 1096 return sym;
1101 } 1097 }
1131 UNGCPRO; 1127 UNGCPRO;
1132 1128
1133 if (!NILP (args = XCDR (args))) 1129 if (!NILP (args = XCDR (args)))
1134 { 1130 {
1135 Lisp_Object doc = XCAR (args); 1131 Lisp_Object doc = XCAR (args);
1136 #if 0 /* FSFmacs */
1137 /* #### We should probably do this but it might be dangerous */
1138 if (purify_flag)
1139 doc = Fpurecopy (doc);
1140 Fput (sym, Qvariable_documentation, doc); 1132 Fput (sym, Qvariable_documentation, doc);
1141 #else
1142 pure_put (sym, Qvariable_documentation, doc);
1143 #endif
1144 if (!NILP (args = XCDR (args))) 1133 if (!NILP (args = XCDR (args)))
1145 error ("too many arguments"); 1134 error ("too many arguments");
1146 } 1135 }
1147 1136
1148 #ifdef I18N3 1137 #ifdef I18N3
1149 if (!NILP (Vfile_domain)) 1138 if (!NILP (Vfile_domain))
1150 pure_put (sym, Qvariable_domain, Vfile_domain); 1139 Fput (sym, Qvariable_domain, Vfile_domain);
1151 #endif 1140 #endif
1152 1141
1153 LOADHIST_ATTACH (sym); 1142 LOADHIST_ATTACH (sym);
1154 return sym; 1143 return sym;
1155 } 1144 }
1165 Lisp_Object documentation = Fget (variable, Qvariable_documentation, Qnil); 1154 Lisp_Object documentation = Fget (variable, Qvariable_documentation, Qnil);
1166 1155
1167 return 1156 return
1168 ((INTP (documentation) && XINT (documentation) < 0) || 1157 ((INTP (documentation) && XINT (documentation) < 0) ||
1169 1158
1170 ((STRINGP (documentation)) && 1159 (STRINGP (documentation) &&
1171 (string_byte (XSTRING (documentation), 0) == '*')) || 1160 (string_byte (XSTRING (documentation), 0) == '*')) ||
1172 1161
1173 /* If (STRING . INTEGER), a negative integer means a user variable. */ 1162 /* If (STRING . INTEGER), a negative integer means a user variable. */
1174 (CONSP (documentation) 1163 (CONSP (documentation)
1175 && STRINGP (XCAR (documentation)) 1164 && STRINGP (XCAR (documentation))
1491 /************************************************************************/ 1480 /************************************************************************/
1492 1481
1493 static Lisp_Object 1482 static Lisp_Object
1494 condition_bind_unwind (Lisp_Object loser) 1483 condition_bind_unwind (Lisp_Object loser)
1495 { 1484 {
1496 struct Lisp_Cons *victim; 1485 Lisp_Cons *victim;
1497 /* ((handler-fun . handler-args) ... other handlers) */ 1486 /* ((handler-fun . handler-args) ... other handlers) */
1498 Lisp_Object tem = XCAR (loser); 1487 Lisp_Object tem = XCAR (loser);
1499 1488
1500 while (CONSP (tem)) 1489 while (CONSP (tem))
1501 { 1490 {
1513 } 1502 }
1514 1503
1515 static Lisp_Object 1504 static Lisp_Object
1516 condition_case_unwind (Lisp_Object loser) 1505 condition_case_unwind (Lisp_Object loser)
1517 { 1506 {
1518 struct Lisp_Cons *victim; 1507 Lisp_Cons *victim;
1519 1508
1520 /* ((<unbound> . clauses) ... other handlers */ 1509 /* ((<unbound> . clauses) ... other handlers */
1521 victim = XCONS (XCAR (loser)); 1510 victim = XCONS (XCAR (loser));
1522 free_cons (victim); 1511 free_cons (victim);
1523 1512
2223 is a single string, created using the arguments. */ 2212 is a single string, created using the arguments. */
2224 2213
2225 /* dump an error message; called like printf */ 2214 /* dump an error message; called like printf */
2226 2215
2227 DOESNT_RETURN 2216 DOESNT_RETURN
2228 error (CONST char *fmt, ...) 2217 error (const char *fmt, ...)
2229 { 2218 {
2230 Lisp_Object obj; 2219 Lisp_Object obj;
2231 va_list args; 2220 va_list args;
2232 2221
2233 va_start (args, fmt); 2222 va_start (args, fmt);
2234 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, 2223 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
2235 args); 2224 args);
2236 va_end (args); 2225 va_end (args);
2237 2226
2238 /* Fsignal GC-protects its args */ 2227 /* Fsignal GC-protects its args */
2239 signal_error (Qerror, list1 (obj)); 2228 signal_error (Qerror, list1 (obj));
2240 } 2229 }
2241 2230
2242 void 2231 void
2243 maybe_error (Lisp_Object class, Error_behavior errb, CONST char *fmt, ...) 2232 maybe_error (Lisp_Object class, Error_behavior errb, const char *fmt, ...)
2244 { 2233 {
2245 Lisp_Object obj; 2234 Lisp_Object obj;
2246 va_list args; 2235 va_list args;
2247 2236
2248 /* Optimization: */ 2237 /* Optimization: */
2249 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2238 if (ERRB_EQ (errb, ERROR_ME_NOT))
2250 return; 2239 return;
2251 2240
2252 va_start (args, fmt); 2241 va_start (args, fmt);
2253 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, 2242 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
2254 args); 2243 args);
2255 va_end (args); 2244 va_end (args);
2256 2245
2257 /* Fsignal GC-protects its args */ 2246 /* Fsignal GC-protects its args */
2258 maybe_signal_error (Qerror, list1 (obj), class, errb); 2247 maybe_signal_error (Qerror, list1 (obj), class, errb);
2259 } 2248 }
2260 2249
2261 Lisp_Object 2250 Lisp_Object
2262 continuable_error (CONST char *fmt, ...) 2251 continuable_error (const char *fmt, ...)
2263 { 2252 {
2264 Lisp_Object obj; 2253 Lisp_Object obj;
2265 va_list args; 2254 va_list args;
2266 2255
2267 va_start (args, fmt); 2256 va_start (args, fmt);
2268 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, 2257 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
2269 args); 2258 args);
2270 va_end (args); 2259 va_end (args);
2271 2260
2272 /* Fsignal GC-protects its args */ 2261 /* Fsignal GC-protects its args */
2273 return Fsignal (Qerror, list1 (obj)); 2262 return Fsignal (Qerror, list1 (obj));
2274 } 2263 }
2275 2264
2276 Lisp_Object 2265 Lisp_Object
2277 maybe_continuable_error (Lisp_Object class, Error_behavior errb, 2266 maybe_continuable_error (Lisp_Object class, Error_behavior errb,
2278 CONST char *fmt, ...) 2267 const char *fmt, ...)
2279 { 2268 {
2280 Lisp_Object obj; 2269 Lisp_Object obj;
2281 va_list args; 2270 va_list args;
2282 2271
2283 /* Optimization: */ 2272 /* Optimization: */
2284 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2273 if (ERRB_EQ (errb, ERROR_ME_NOT))
2285 return Qnil; 2274 return Qnil;
2286 2275
2287 va_start (args, fmt); 2276 va_start (args, fmt);
2288 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, 2277 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
2289 args); 2278 args);
2290 va_end (args); 2279 va_end (args);
2291 2280
2292 /* Fsignal GC-protects its args */ 2281 /* Fsignal GC-protects its args */
2293 return maybe_signal_continuable_error (Qerror, list1 (obj), class, errb); 2282 return maybe_signal_continuable_error (Qerror, list1 (obj), class, errb);
2300 These functions signal an error of type Qerror, whose data 2289 These functions signal an error of type Qerror, whose data
2301 is two objects, a string and a related Lisp object (usually the object 2290 is two objects, a string and a related Lisp object (usually the object
2302 where the error is occurring). */ 2291 where the error is occurring). */
2303 2292
2304 DOESNT_RETURN 2293 DOESNT_RETURN
2305 signal_simple_error (CONST char *reason, Lisp_Object frob) 2294 signal_simple_error (const char *reason, Lisp_Object frob)
2306 { 2295 {
2307 signal_error (Qerror, list2 (build_translated_string (reason), frob)); 2296 signal_error (Qerror, list2 (build_translated_string (reason), frob));
2308 } 2297 }
2309 2298
2310 void 2299 void
2311 maybe_signal_simple_error (CONST char *reason, Lisp_Object frob, 2300 maybe_signal_simple_error (const char *reason, Lisp_Object frob,
2312 Lisp_Object class, Error_behavior errb) 2301 Lisp_Object class, Error_behavior errb)
2313 { 2302 {
2314 /* Optimization: */ 2303 /* Optimization: */
2315 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2304 if (ERRB_EQ (errb, ERROR_ME_NOT))
2316 return; 2305 return;
2317 maybe_signal_error (Qerror, list2 (build_translated_string (reason), frob), 2306 maybe_signal_error (Qerror, list2 (build_translated_string (reason), frob),
2318 class, errb); 2307 class, errb);
2319 } 2308 }
2320 2309
2321 Lisp_Object 2310 Lisp_Object
2322 signal_simple_continuable_error (CONST char *reason, Lisp_Object frob) 2311 signal_simple_continuable_error (const char *reason, Lisp_Object frob)
2323 { 2312 {
2324 return Fsignal (Qerror, list2 (build_translated_string (reason), frob)); 2313 return Fsignal (Qerror, list2 (build_translated_string (reason), frob));
2325 } 2314 }
2326 2315
2327 Lisp_Object 2316 Lisp_Object
2328 maybe_signal_simple_continuable_error (CONST char *reason, Lisp_Object frob, 2317 maybe_signal_simple_continuable_error (const char *reason, Lisp_Object frob,
2329 Lisp_Object class, Error_behavior errb) 2318 Lisp_Object class, Error_behavior errb)
2330 { 2319 {
2331 /* Optimization: */ 2320 /* Optimization: */
2332 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2321 if (ERRB_EQ (errb, ERROR_ME_NOT))
2333 return Qnil; 2322 return Qnil;
2344 is a two objects, a string (created using the arguments) and a 2333 is a two objects, a string (created using the arguments) and a
2345 Lisp object. 2334 Lisp object.
2346 */ 2335 */
2347 2336
2348 DOESNT_RETURN 2337 DOESNT_RETURN
2349 error_with_frob (Lisp_Object frob, CONST char *fmt, ...) 2338 error_with_frob (Lisp_Object frob, const char *fmt, ...)
2350 { 2339 {
2351 Lisp_Object obj; 2340 Lisp_Object obj;
2352 va_list args; 2341 va_list args;
2353 2342
2354 va_start (args, fmt); 2343 va_start (args, fmt);
2355 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, 2344 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
2356 args); 2345 args);
2357 va_end (args); 2346 va_end (args);
2358 2347
2359 /* Fsignal GC-protects its args */ 2348 /* Fsignal GC-protects its args */
2360 signal_error (Qerror, list2 (obj, frob)); 2349 signal_error (Qerror, list2 (obj, frob));
2361 } 2350 }
2362 2351
2363 void 2352 void
2364 maybe_error_with_frob (Lisp_Object frob, Lisp_Object class, 2353 maybe_error_with_frob (Lisp_Object frob, Lisp_Object class,
2365 Error_behavior errb, CONST char *fmt, ...) 2354 Error_behavior errb, const char *fmt, ...)
2366 { 2355 {
2367 Lisp_Object obj; 2356 Lisp_Object obj;
2368 va_list args; 2357 va_list args;
2369 2358
2370 /* Optimization: */ 2359 /* Optimization: */
2371 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2360 if (ERRB_EQ (errb, ERROR_ME_NOT))
2372 return; 2361 return;
2373 2362
2374 va_start (args, fmt); 2363 va_start (args, fmt);
2375 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, 2364 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
2376 args); 2365 args);
2377 va_end (args); 2366 va_end (args);
2378 2367
2379 /* Fsignal GC-protects its args */ 2368 /* Fsignal GC-protects its args */
2380 maybe_signal_error (Qerror, list2 (obj, frob), class, errb); 2369 maybe_signal_error (Qerror, list2 (obj, frob), class, errb);
2381 } 2370 }
2382 2371
2383 Lisp_Object 2372 Lisp_Object
2384 continuable_error_with_frob (Lisp_Object frob, CONST char *fmt, ...) 2373 continuable_error_with_frob (Lisp_Object frob, const char *fmt, ...)
2385 { 2374 {
2386 Lisp_Object obj; 2375 Lisp_Object obj;
2387 va_list args; 2376 va_list args;
2388 2377
2389 va_start (args, fmt); 2378 va_start (args, fmt);
2390 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, 2379 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
2391 args); 2380 args);
2392 va_end (args); 2381 va_end (args);
2393 2382
2394 /* Fsignal GC-protects its args */ 2383 /* Fsignal GC-protects its args */
2395 return Fsignal (Qerror, list2 (obj, frob)); 2384 return Fsignal (Qerror, list2 (obj, frob));
2396 } 2385 }
2397 2386
2398 Lisp_Object 2387 Lisp_Object
2399 maybe_continuable_error_with_frob (Lisp_Object frob, Lisp_Object class, 2388 maybe_continuable_error_with_frob (Lisp_Object frob, Lisp_Object class,
2400 Error_behavior errb, CONST char *fmt, ...) 2389 Error_behavior errb, const char *fmt, ...)
2401 { 2390 {
2402 Lisp_Object obj; 2391 Lisp_Object obj;
2403 va_list args; 2392 va_list args;
2404 2393
2405 /* Optimization: */ 2394 /* Optimization: */
2406 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2395 if (ERRB_EQ (errb, ERROR_ME_NOT))
2407 return Qnil; 2396 return Qnil;
2408 2397
2409 va_start (args, fmt); 2398 va_start (args, fmt);
2410 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, 2399 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1,
2411 args); 2400 args);
2412 va_end (args); 2401 va_end (args);
2413 2402
2414 /* Fsignal GC-protects its args */ 2403 /* Fsignal GC-protects its args */
2415 return maybe_signal_continuable_error (Qerror, list2 (obj, frob), 2404 return maybe_signal_continuable_error (Qerror, list2 (obj, frob),
2422 /* Class 5: Signal an error with a string and two associated objects. 2411 /* Class 5: Signal an error with a string and two associated objects.
2423 These functions signal an error of type Qerror, whose data 2412 These functions signal an error of type Qerror, whose data
2424 is three objects, a string and two related Lisp objects. */ 2413 is three objects, a string and two related Lisp objects. */
2425 2414
2426 DOESNT_RETURN 2415 DOESNT_RETURN
2427 signal_simple_error_2 (CONST char *reason, 2416 signal_simple_error_2 (const char *reason,
2428 Lisp_Object frob0, Lisp_Object frob1) 2417 Lisp_Object frob0, Lisp_Object frob1)
2429 { 2418 {
2430 signal_error (Qerror, list3 (build_translated_string (reason), frob0, 2419 signal_error (Qerror, list3 (build_translated_string (reason), frob0,
2431 frob1)); 2420 frob1));
2432 } 2421 }
2433 2422
2434 void 2423 void
2435 maybe_signal_simple_error_2 (CONST char *reason, Lisp_Object frob0, 2424 maybe_signal_simple_error_2 (const char *reason, Lisp_Object frob0,
2436 Lisp_Object frob1, Lisp_Object class, 2425 Lisp_Object frob1, Lisp_Object class,
2437 Error_behavior errb) 2426 Error_behavior errb)
2438 { 2427 {
2439 /* Optimization: */ 2428 /* Optimization: */
2440 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2429 if (ERRB_EQ (errb, ERROR_ME_NOT))
2443 frob1), class, errb); 2432 frob1), class, errb);
2444 } 2433 }
2445 2434
2446 2435
2447 Lisp_Object 2436 Lisp_Object
2448 signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0, 2437 signal_simple_continuable_error_2 (const char *reason, Lisp_Object frob0,
2449 Lisp_Object frob1) 2438 Lisp_Object frob1)
2450 { 2439 {
2451 return Fsignal (Qerror, list3 (build_translated_string (reason), frob0, 2440 return Fsignal (Qerror, list3 (build_translated_string (reason), frob0,
2452 frob1)); 2441 frob1));
2453 } 2442 }
2454 2443
2455 Lisp_Object 2444 Lisp_Object
2456 maybe_signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0, 2445 maybe_signal_simple_continuable_error_2 (const char *reason, Lisp_Object frob0,
2457 Lisp_Object frob1, Lisp_Object class, 2446 Lisp_Object frob1, Lisp_Object class,
2458 Error_behavior errb) 2447 Error_behavior errb)
2459 { 2448 {
2460 /* Optimization: */ 2449 /* Optimization: */
2461 if (ERRB_EQ (errb, ERROR_ME_NOT)) 2450 if (ERRB_EQ (errb, ERROR_ME_NOT))
2479 Fsignal (Qquit, Qnil); 2468 Fsignal (Qquit, Qnil);
2480 } 2469 }
2481 2470
2482 2471
2483 /* Used in core lisp functions for efficiency */ 2472 /* Used in core lisp functions for efficiency */
2484 void 2473 Lisp_Object
2485 signal_void_function_error (Lisp_Object function) 2474 signal_void_function_error (Lisp_Object function)
2486 { 2475 {
2487 Fsignal (Qvoid_function, list1 (function)); 2476 return Fsignal (Qvoid_function, list1 (function));
2488 } 2477 }
2489 2478
2490 static void 2479 Lisp_Object
2491 signal_invalid_function_error (Lisp_Object function) 2480 signal_invalid_function_error (Lisp_Object function)
2492 { 2481 {
2493 Fsignal (Qinvalid_function, list1 (function)); 2482 return Fsignal (Qinvalid_function, list1 (function));
2494 } 2483 }
2495 2484
2496 static void 2485 Lisp_Object
2497 signal_wrong_number_of_arguments_error (Lisp_Object function, int nargs) 2486 signal_wrong_number_of_arguments_error (Lisp_Object function, int nargs)
2498 { 2487 {
2499 Fsignal (Qwrong_number_of_arguments, list2 (function, make_int (nargs))); 2488 return Fsignal (Qwrong_number_of_arguments,
2489 list2 (function, make_int (nargs)));
2500 } 2490 }
2501 2491
2502 /* Used in list traversal macros for efficiency. */ 2492 /* Used in list traversal macros for efficiency. */
2503 void 2493 DOESNT_RETURN
2504 signal_malformed_list_error (Lisp_Object list) 2494 signal_malformed_list_error (Lisp_Object list)
2505 { 2495 {
2506 Fsignal (Qmalformed_list, list1 (list)); 2496 signal_error (Qmalformed_list, list1 (list));
2507 } 2497 }
2508 2498
2509 void 2499 DOESNT_RETURN
2510 signal_malformed_property_list_error (Lisp_Object list) 2500 signal_malformed_property_list_error (Lisp_Object list)
2511 { 2501 {
2512 Fsignal (Qmalformed_property_list, list1 (list)); 2502 signal_error (Qmalformed_property_list, list1 (list));
2513 } 2503 }
2514 2504
2515 void 2505 DOESNT_RETURN
2516 signal_circular_list_error (Lisp_Object list) 2506 signal_circular_list_error (Lisp_Object list)
2517 { 2507 {
2518 Fsignal (Qcircular_list, list1 (list)); 2508 signal_error (Qcircular_list, list1 (list));
2519 } 2509 }
2520 2510
2521 void 2511 DOESNT_RETURN
2522 signal_circular_property_list_error (Lisp_Object list) 2512 signal_circular_property_list_error (Lisp_Object list)
2523 { 2513 {
2524 Fsignal (Qcircular_property_list, list1 (list)); 2514 signal_error (Qcircular_property_list, list1 (list));
2525 } 2515 }
2526 2516
2527 /************************************************************************/ 2517 /************************************************************************/
2528 /* User commands */ 2518 /* User commands */
2529 /************************************************************************/ 2519 /************************************************************************/
2631 } 2621 }
2632 else 2622 else
2633 { 2623 {
2634 Fsignal (Qwrong_type_argument, 2624 Fsignal (Qwrong_type_argument,
2635 Fcons (Qcommandp, 2625 Fcons (Qcommandp,
2636 ((EQ (cmd, final)) 2626 (EQ (cmd, final)
2637 ? list1 (cmd) 2627 ? list1 (cmd)
2638 : list2 (cmd, final)))); 2628 : list2 (cmd, final))));
2639 return Qnil; 2629 return Qnil;
2640 } 2630 }
2641 } 2631 }
2749 { 2739 {
2750 /* Attempt to avoid consing identical (string=) pure strings. */ 2740 /* Attempt to avoid consing identical (string=) pure strings. */
2751 file = Fsymbol_name (Fintern (file, Qnil)); 2741 file = Fsymbol_name (Fintern (file, Qnil));
2752 } 2742 }
2753 2743
2754 return Ffset (function, 2744 return Ffset (function, Fcons (Qautoload, list4 (file,
2755 Fpurecopy (Fcons (Qautoload, list4 (file, 2745 docstring,
2756 docstring, 2746 interactive,
2757 interactive, 2747 type)));
2758 type))));
2759 } 2748 }
2760 2749
2761 Lisp_Object 2750 Lisp_Object
2762 un_autoload (Lisp_Object oldqueue) 2751 un_autoload (Lisp_Object oldqueue)
2763 { 2752 {
2840 /************************************************************************/ 2829 /************************************************************************/
2841 /* eval, funcall, apply */ 2830 /* eval, funcall, apply */
2842 /************************************************************************/ 2831 /************************************************************************/
2843 2832
2844 static Lisp_Object funcall_lambda (Lisp_Object fun, 2833 static Lisp_Object funcall_lambda (Lisp_Object fun,
2845 int nargs, Lisp_Object args[]); 2834 int nargs, Lisp_Object args[]);
2846 static int in_warnings; 2835 static int in_warnings;
2847 2836
2848 static Lisp_Object 2837 static Lisp_Object
2849 in_warnings_restore (Lisp_Object minimus) 2838 in_warnings_restore (Lisp_Object minimus)
2850 { 2839 {
2953 goto wrong_number_of_arguments; 2942 goto wrong_number_of_arguments;
2954 2943
2955 if (max_args == UNEVALLED) /* Optimize for the common case */ 2944 if (max_args == UNEVALLED) /* Optimize for the common case */
2956 { 2945 {
2957 backtrace.evalargs = 0; 2946 backtrace.evalargs = 0;
2958 val = (((Lisp_Object (*) (Lisp_Object)) (subr_function (subr))) 2947 val = (((Lisp_Object (*) (Lisp_Object)) subr_function (subr))
2959 (original_args)); 2948 (original_args));
2960 } 2949 }
2961 else if (nargs <= max_args) 2950 else if (nargs <= max_args)
2962 { 2951 {
2963 struct gcpro gcpro1; 2952 struct gcpro gcpro1;
3007 } 2996 }
3008 2997
3009 backtrace.args = args; 2998 backtrace.args = args;
3010 backtrace.nargs = nargs; 2999 backtrace.nargs = nargs;
3011 3000
3012 val = (((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr))) 3001 val = (((Lisp_Object (*) (int, Lisp_Object *)) subr_function (subr))
3013 (nargs, args)); 3002 (nargs, args));
3014 3003
3015 UNGCPRO; 3004 UNGCPRO;
3016 } 3005 }
3017 else 3006 else
3018 { 3007 {
3019 wrong_number_of_arguments: 3008 wrong_number_of_arguments:
3020 signal_wrong_number_of_arguments_error (fun, nargs); 3009 val = signal_wrong_number_of_arguments_error (original_fun, nargs);
3021 } 3010 }
3022 } 3011 }
3023 else if (COMPILED_FUNCTIONP (fun)) 3012 else if (COMPILED_FUNCTIONP (fun))
3024 { 3013 {
3025 struct gcpro gcpro1; 3014 struct gcpro gcpro1;
3103 } 3092 }
3104 } 3093 }
3105 else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */ 3094 else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */
3106 { 3095 {
3107 invalid_function: 3096 invalid_function:
3108 signal_invalid_function_error (fun); 3097 val = signal_invalid_function_error (fun);
3109 } 3098 }
3110 3099
3111 lisp_eval_depth--; 3100 lisp_eval_depth--;
3112 if (backtrace.debug_on_exit) 3101 if (backtrace.debug_on_exit)
3113 val = do_debug_on_exit (val); 3102 val = do_debug_on_exit (val);
3178 { 3167 {
3179 Lisp_Subr *subr = XSUBR (fun); 3168 Lisp_Subr *subr = XSUBR (fun);
3180 int max_args = subr->max_args; 3169 int max_args = subr->max_args;
3181 Lisp_Object spacious_args[SUBR_MAX_ARGS]; 3170 Lisp_Object spacious_args[SUBR_MAX_ARGS];
3182 3171
3183 if (fun_nargs < subr->min_args)
3184 goto wrong_number_of_arguments;
3185
3186 if (fun_nargs == max_args) /* Optimize for the common case */ 3172 if (fun_nargs == max_args) /* Optimize for the common case */
3187 { 3173 {
3188 funcall_subr: 3174 funcall_subr:
3189 FUNCALL_SUBR (val, subr, fun_args, max_args); 3175 FUNCALL_SUBR (val, subr, fun_args, max_args);
3190 } 3176 }
3177 else if (fun_nargs < subr->min_args)
3178 {
3179 goto wrong_number_of_arguments;
3180 }
3191 else if (fun_nargs < max_args) 3181 else if (fun_nargs < max_args)
3192 { 3182 {
3193 Lisp_Object *p = spacious_args; 3183 Lisp_Object *p = spacious_args;
3194 3184
3195 /* Default optionals to nil */ 3185 /* Default optionals to nil */
3201 fun_args = spacious_args; 3191 fun_args = spacious_args;
3202 goto funcall_subr; 3192 goto funcall_subr;
3203 } 3193 }
3204 else if (max_args == MANY) 3194 else if (max_args == MANY)
3205 { 3195 {
3206 val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr))) 3196 val = SUBR_FUNCTION (subr, MANY) (fun_nargs, fun_args);
3207 (fun_nargs, fun_args);
3208 } 3197 }
3209 else if (max_args == UNEVALLED) /* Can't funcall a special form */ 3198 else if (max_args == UNEVALLED) /* Can't funcall a special form */
3210 { 3199 {
3211 goto invalid_function; 3200 goto invalid_function;
3212 } 3201 }
3213 else 3202 else
3214 { 3203 {
3215 wrong_number_of_arguments: 3204 wrong_number_of_arguments:
3216 signal_wrong_number_of_arguments_error (fun, fun_nargs); 3205 val = signal_wrong_number_of_arguments_error (fun, fun_nargs);
3217 } 3206 }
3218 } 3207 }
3219 else if (COMPILED_FUNCTIONP (fun)) 3208 else if (COMPILED_FUNCTIONP (fun))
3220 { 3209 {
3221 val = funcall_compiled_function (fun, fun_nargs, fun_args); 3210 val = funcall_compiled_function (fun, fun_nargs, fun_args);
3238 goto invalid_function; 3227 goto invalid_function;
3239 } 3228 }
3240 } 3229 }
3241 else if (UNBOUNDP (fun)) 3230 else if (UNBOUNDP (fun))
3242 { 3231 {
3243 signal_void_function_error (args[0]); 3232 val = signal_void_function_error (args[0]);
3244 } 3233 }
3245 else 3234 else
3246 { 3235 {
3247 invalid_function: 3236 invalid_function:
3248 signal_invalid_function_error (fun); 3237 val = signal_invalid_function_error (fun);
3249 } 3238 }
3250 3239
3251 lisp_eval_depth--; 3240 lisp_eval_depth--;
3252 if (backtrace.debug_on_exit) 3241 if (backtrace.debug_on_exit)
3253 val = do_debug_on_exit (val); 3242 val = do_debug_on_exit (val);
3319 } 3308 }
3320 } 3309 }
3321 else 3310 else
3322 { 3311 {
3323 invalid_function: 3312 invalid_function:
3324 return Fsignal (Qinvalid_function, list1 (function)); 3313 return signal_invalid_function_error (function);
3325 } 3314 }
3326 3315
3327 { 3316 {
3328 int argcount = 0; 3317 int argcount = 0;
3329 Lisp_Object arg; 3318 Lisp_Object arg;
3506 goto wrong_number_of_arguments; 3495 goto wrong_number_of_arguments;
3507 3496
3508 return unbind_to (speccount, Fprogn (body)); 3497 return unbind_to (speccount, Fprogn (body));
3509 3498
3510 wrong_number_of_arguments: 3499 wrong_number_of_arguments:
3511 return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); 3500 return signal_wrong_number_of_arguments_error (fun, nargs);
3512 3501
3513 invalid_function: 3502 invalid_function:
3514 return Fsignal (Qinvalid_function, list1 (fun)); 3503 return signal_invalid_function_error (fun);
3515 } 3504 }
3516 3505
3517 3506
3518 /************************************************************************/ 3507 /************************************************************************/
3519 /* Run hook variables in various ways. */ 3508 /* Run hook variables in various ways. */
3625 args[0] = val; 3614 args[0] = val;
3626 return Ffuncall (nargs, args); 3615 return Ffuncall (nargs, args);
3627 } 3616 }
3628 else 3617 else
3629 { 3618 {
3630 struct gcpro gcpro1, gcpro2; 3619 struct gcpro gcpro1, gcpro2, gcpro3;
3631 GCPRO2 (sym, val); 3620 Lisp_Object globals = Qnil;
3621 GCPRO3 (sym, val, globals);
3632 3622
3633 for (; 3623 for (;
3634 CONSP (val) && ((cond == RUN_HOOKS_TO_COMPLETION) 3624 CONSP (val) && ((cond == RUN_HOOKS_TO_COMPLETION)
3635 || (cond == RUN_HOOKS_UNTIL_SUCCESS ? NILP (ret) 3625 || (cond == RUN_HOOKS_UNTIL_SUCCESS ? NILP (ret)
3636 : !NILP (ret))); 3626 : !NILP (ret)));
3638 { 3628 {
3639 if (EQ (XCAR (val), Qt)) 3629 if (EQ (XCAR (val), Qt))
3640 { 3630 {
3641 /* t indicates this hook has a local binding; 3631 /* t indicates this hook has a local binding;
3642 it means to run the global binding too. */ 3632 it means to run the global binding too. */
3643 Lisp_Object globals = Fdefault_value (sym); 3633 globals = Fdefault_value (sym);
3644 3634
3645 if ((! CONSP (globals) || EQ (XCAR (globals), Qlambda)) && 3635 if ((! CONSP (globals) || EQ (XCAR (globals), Qlambda)) &&
3646 ! NILP (globals)) 3636 ! NILP (globals))
3647 { 3637 {
3648 args[0] = globals; 3638 args[0] = globals;
4146 (with-output-to-string (display-error errordata)) 4136 (with-output-to-string (display-error errordata))
4147 but that stuff is all in Lisp currently. */ 4137 but that stuff is all in Lisp currently. */
4148 args[1] = errordata; 4138 args[1] = errordata;
4149 warn_when_safe_lispobj 4139 warn_when_safe_lispobj
4150 (Qerror, Qwarning, 4140 (Qerror, Qwarning,
4151 emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s", 4141 emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s",
4152 Qnil, -1, 2, args)); 4142 Qnil, -1, 2, args));
4153 } 4143 }
4154 return Qunbound; 4144 return Qunbound;
4155 } 4145 }
4156 4146
4189 { 4179 {
4190 return eval_in_buffer (XBUFFER (XCAR (cons)), XCDR (cons)); 4180 return eval_in_buffer (XBUFFER (XCAR (cons)), XCDR (cons));
4191 } 4181 }
4192 4182
4193 Lisp_Object 4183 Lisp_Object
4194 eval_in_buffer_trapping_errors (CONST char *warning_string, 4184 eval_in_buffer_trapping_errors (const char *warning_string,
4195 struct buffer *buf, Lisp_Object form) 4185 struct buffer *buf, Lisp_Object form)
4196 { 4186 {
4197 int speccount = specpdl_depth(); 4187 int speccount = specpdl_depth();
4198 Lisp_Object tem; 4188 Lisp_Object tem;
4199 Lisp_Object buffer; 4189 Lisp_Object buffer;
4205 4195
4206 specbind (Qinhibit_quit, Qt); 4196 specbind (Qinhibit_quit, Qt);
4207 /* gc_currently_forbidden = 1; Currently no reason to do this; */ 4197 /* gc_currently_forbidden = 1; Currently no reason to do this; */
4208 4198
4209 cons = noseeum_cons (buffer, form); 4199 cons = noseeum_cons (buffer, form);
4210 opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); 4200 opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
4211 GCPRO2 (cons, opaque); 4201 GCPRO2 (cons, opaque);
4212 /* Qerror not Qt, so you can get a backtrace */ 4202 /* Qerror not Qt, so you can get a backtrace */
4213 tem = condition_case_1 (Qerror, 4203 tem = condition_case_1 (Qerror,
4214 catch_them_squirmers_eval_in_buffer, cons, 4204 catch_them_squirmers_eval_in_buffer, cons,
4215 caught_a_squirmer, opaque); 4205 caught_a_squirmer, opaque);
4216 free_cons (XCONS (cons)); 4206 free_cons (XCONS (cons));
4217 if (OPAQUEP (opaque)) 4207 if (OPAQUE_PTRP (opaque))
4218 free_opaque_ptr (opaque); 4208 free_opaque_ptr (opaque);
4219 UNGCPRO; 4209 UNGCPRO;
4220 4210
4221 /* gc_currently_forbidden = 0; */ 4211 /* gc_currently_forbidden = 0; */
4222 return unbind_to (speccount, tem); 4212 return unbind_to (speccount, tem);
4229 run_hook (hook_symbol); 4219 run_hook (hook_symbol);
4230 return Qnil; 4220 return Qnil;
4231 } 4221 }
4232 4222
4233 Lisp_Object 4223 Lisp_Object
4234 run_hook_trapping_errors (CONST char *warning_string, Lisp_Object hook_symbol) 4224 run_hook_trapping_errors (const char *warning_string, Lisp_Object hook_symbol)
4235 { 4225 {
4236 int speccount; 4226 int speccount;
4237 Lisp_Object tem; 4227 Lisp_Object tem;
4238 Lisp_Object opaque; 4228 Lisp_Object opaque;
4239 struct gcpro gcpro1; 4229 struct gcpro gcpro1;
4245 return Qnil; 4235 return Qnil;
4246 4236
4247 speccount = specpdl_depth(); 4237 speccount = specpdl_depth();
4248 specbind (Qinhibit_quit, Qt); 4238 specbind (Qinhibit_quit, Qt);
4249 4239
4250 opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); 4240 opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
4251 GCPRO1 (opaque); 4241 GCPRO1 (opaque);
4252 /* Qerror not Qt, so you can get a backtrace */ 4242 /* Qerror not Qt, so you can get a backtrace */
4253 tem = condition_case_1 (Qerror, 4243 tem = condition_case_1 (Qerror,
4254 catch_them_squirmers_run_hook, hook_symbol, 4244 catch_them_squirmers_run_hook, hook_symbol,
4255 caught_a_squirmer, opaque); 4245 caught_a_squirmer, opaque);
4256 if (OPAQUEP (opaque)) 4246 if (OPAQUE_PTRP (opaque))
4257 free_opaque_ptr (opaque); 4247 free_opaque_ptr (opaque);
4258 UNGCPRO; 4248 UNGCPRO;
4259 4249
4260 return unbind_to (speccount, tem); 4250 return unbind_to (speccount, tem);
4261 } 4251 }
4262 4252
4263 /* Same as run_hook_trapping_errors() but also set the hook to nil 4253 /* Same as run_hook_trapping_errors() but also set the hook to nil
4264 if an error occurs. */ 4254 if an error occurs. */
4265 4255
4266 Lisp_Object 4256 Lisp_Object
4267 safe_run_hook_trapping_errors (CONST char *warning_string, 4257 safe_run_hook_trapping_errors (const char *warning_string,
4268 Lisp_Object hook_symbol, 4258 Lisp_Object hook_symbol,
4269 int allow_quit) 4259 int allow_quit)
4270 { 4260 {
4271 int speccount = specpdl_depth(); 4261 int speccount = specpdl_depth();
4272 Lisp_Object tem; 4262 Lisp_Object tem;
4281 4271
4282 if (!allow_quit) 4272 if (!allow_quit)
4283 specbind (Qinhibit_quit, Qt); 4273 specbind (Qinhibit_quit, Qt);
4284 4274
4285 cons = noseeum_cons (hook_symbol, 4275 cons = noseeum_cons (hook_symbol,
4286 warning_string ? make_opaque_ptr (warning_string) 4276 warning_string ? make_opaque_ptr ((void *)warning_string)
4287 : Qnil); 4277 : Qnil);
4288 GCPRO1 (cons); 4278 GCPRO1 (cons);
4289 /* Qerror not Qt, so you can get a backtrace */ 4279 /* Qerror not Qt, so you can get a backtrace */
4290 tem = condition_case_1 (Qerror, 4280 tem = condition_case_1 (Qerror,
4291 catch_them_squirmers_run_hook, 4281 catch_them_squirmers_run_hook,
4292 hook_symbol, 4282 hook_symbol,
4293 allow_quit ? 4283 allow_quit ?
4294 allow_quit_safe_run_hook_caught_a_squirmer : 4284 allow_quit_safe_run_hook_caught_a_squirmer :
4295 safe_run_hook_caught_a_squirmer, 4285 safe_run_hook_caught_a_squirmer,
4296 cons); 4286 cons);
4297 if (OPAQUEP (XCDR (cons))) 4287 if (OPAQUE_PTRP (XCDR (cons)))
4298 free_opaque_ptr (XCDR (cons)); 4288 free_opaque_ptr (XCDR (cons));
4299 free_cons (XCONS (cons)); 4289 free_cons (XCONS (cons));
4300 UNGCPRO; 4290 UNGCPRO;
4301 4291
4302 return unbind_to (speccount, tem); 4292 return unbind_to (speccount, tem);
4308 /* This function can GC */ 4298 /* This function can GC */
4309 return call0 (function); 4299 return call0 (function);
4310 } 4300 }
4311 4301
4312 Lisp_Object 4302 Lisp_Object
4313 call0_trapping_errors (CONST char *warning_string, Lisp_Object function) 4303 call0_trapping_errors (const char *warning_string, Lisp_Object function)
4314 { 4304 {
4315 int speccount; 4305 int speccount;
4316 Lisp_Object tem; 4306 Lisp_Object tem;
4317 Lisp_Object opaque = Qnil; 4307 Lisp_Object opaque = Qnil;
4318 struct gcpro gcpro1, gcpro2; 4308 struct gcpro gcpro1, gcpro2;
4327 GCPRO2 (opaque, function); 4317 GCPRO2 (opaque, function);
4328 speccount = specpdl_depth(); 4318 speccount = specpdl_depth();
4329 specbind (Qinhibit_quit, Qt); 4319 specbind (Qinhibit_quit, Qt);
4330 /* gc_currently_forbidden = 1; Currently no reason to do this; */ 4320 /* gc_currently_forbidden = 1; Currently no reason to do this; */
4331 4321
4332 opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); 4322 opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
4333 /* Qerror not Qt, so you can get a backtrace */ 4323 /* Qerror not Qt, so you can get a backtrace */
4334 tem = condition_case_1 (Qerror, 4324 tem = condition_case_1 (Qerror,
4335 catch_them_squirmers_call0, function, 4325 catch_them_squirmers_call0, function,
4336 caught_a_squirmer, opaque); 4326 caught_a_squirmer, opaque);
4337 if (OPAQUEP (opaque)) 4327 if (OPAQUE_PTRP (opaque))
4338 free_opaque_ptr (opaque); 4328 free_opaque_ptr (opaque);
4339 UNGCPRO; 4329 UNGCPRO;
4340 4330
4341 /* gc_currently_forbidden = 0; */ 4331 /* gc_currently_forbidden = 0; */
4342 return unbind_to (speccount, tem); 4332 return unbind_to (speccount, tem);
4355 /* This function can GC */ 4345 /* This function can GC */
4356 return call2 (XCAR (cons), XCAR (XCDR (cons)), XCAR (XCDR (XCDR (cons)))); 4346 return call2 (XCAR (cons), XCAR (XCDR (cons)), XCAR (XCDR (XCDR (cons))));
4357 } 4347 }
4358 4348
4359 Lisp_Object 4349 Lisp_Object
4360 call1_trapping_errors (CONST char *warning_string, Lisp_Object function, 4350 call1_trapping_errors (const char *warning_string, Lisp_Object function,
4361 Lisp_Object object) 4351 Lisp_Object object)
4362 { 4352 {
4363 int speccount = specpdl_depth(); 4353 int speccount = specpdl_depth();
4364 Lisp_Object tem; 4354 Lisp_Object tem;
4365 Lisp_Object cons = Qnil; 4355 Lisp_Object cons = Qnil;
4377 4367
4378 specbind (Qinhibit_quit, Qt); 4368 specbind (Qinhibit_quit, Qt);
4379 /* gc_currently_forbidden = 1; Currently no reason to do this; */ 4369 /* gc_currently_forbidden = 1; Currently no reason to do this; */
4380 4370
4381 cons = noseeum_cons (function, object); 4371 cons = noseeum_cons (function, object);
4382 opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); 4372 opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
4383 /* Qerror not Qt, so you can get a backtrace */ 4373 /* Qerror not Qt, so you can get a backtrace */
4384 tem = condition_case_1 (Qerror, 4374 tem = condition_case_1 (Qerror,
4385 catch_them_squirmers_call1, cons, 4375 catch_them_squirmers_call1, cons,
4386 caught_a_squirmer, opaque); 4376 caught_a_squirmer, opaque);
4387 if (OPAQUEP (opaque)) 4377 if (OPAQUE_PTRP (opaque))
4388 free_opaque_ptr (opaque); 4378 free_opaque_ptr (opaque);
4389 free_cons (XCONS (cons)); 4379 free_cons (XCONS (cons));
4390 UNGCPRO; 4380 UNGCPRO;
4391 4381
4392 /* gc_currently_forbidden = 0; */ 4382 /* gc_currently_forbidden = 0; */
4393 return unbind_to (speccount, tem); 4383 return unbind_to (speccount, tem);
4394 } 4384 }
4395 4385
4396 Lisp_Object 4386 Lisp_Object
4397 call2_trapping_errors (CONST char *warning_string, Lisp_Object function, 4387 call2_trapping_errors (const char *warning_string, Lisp_Object function,
4398 Lisp_Object object1, Lisp_Object object2) 4388 Lisp_Object object1, Lisp_Object object2)
4399 { 4389 {
4400 int speccount = specpdl_depth(); 4390 int speccount = specpdl_depth();
4401 Lisp_Object tem; 4391 Lisp_Object tem;
4402 Lisp_Object cons = Qnil; 4392 Lisp_Object cons = Qnil;
4413 GCPRO5 (cons, opaque, function, object1, object2); 4403 GCPRO5 (cons, opaque, function, object1, object2);
4414 specbind (Qinhibit_quit, Qt); 4404 specbind (Qinhibit_quit, Qt);
4415 /* gc_currently_forbidden = 1; Currently no reason to do this; */ 4405 /* gc_currently_forbidden = 1; Currently no reason to do this; */
4416 4406
4417 cons = list3 (function, object1, object2); 4407 cons = list3 (function, object1, object2);
4418 opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); 4408 opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil);
4419 /* Qerror not Qt, so you can get a backtrace */ 4409 /* Qerror not Qt, so you can get a backtrace */
4420 tem = condition_case_1 (Qerror, 4410 tem = condition_case_1 (Qerror,
4421 catch_them_squirmers_call2, cons, 4411 catch_them_squirmers_call2, cons,
4422 caught_a_squirmer, opaque); 4412 caught_a_squirmer, opaque);
4423 if (OPAQUEP (opaque)) 4413 if (OPAQUE_PTRP (opaque))
4424 free_opaque_ptr (opaque); 4414 free_opaque_ptr (opaque);
4425 free_list (cons); 4415 free_list (cons);
4426 UNGCPRO; 4416 UNGCPRO;
4427 4417
4428 /* gc_currently_forbidden = 0; */ 4418 /* gc_currently_forbidden = 0; */
4471 static Lisp_Object 4461 static Lisp_Object
4472 specbind_unwind_local (Lisp_Object ovalue) 4462 specbind_unwind_local (Lisp_Object ovalue)
4473 { 4463 {
4474 Lisp_Object current = Fcurrent_buffer (); 4464 Lisp_Object current = Fcurrent_buffer ();
4475 Lisp_Object symbol = specpdl_ptr->symbol; 4465 Lisp_Object symbol = specpdl_ptr->symbol;
4476 struct Lisp_Cons *victim = XCONS (ovalue); 4466 Lisp_Cons *victim = XCONS (ovalue);
4477 Lisp_Object buf = get_buffer (victim->car, 0); 4467 Lisp_Object buf = get_buffer (victim->car, 0);
4478 ovalue = victim->cdr; 4468 ovalue = victim->cdr;
4479 4469
4480 free_cons (victim); 4470 free_cons (victim);
4481 4471
4625 (*specpdl_ptr->func) (specpdl_ptr->old_value); 4615 (*specpdl_ptr->func) (specpdl_ptr->old_value);
4626 else 4616 else
4627 { 4617 {
4628 /* We checked symbol for validity when we specbound it, 4618 /* We checked symbol for validity when we specbound it,
4629 so only need to call Fset if symbol has magic value. */ 4619 so only need to call Fset if symbol has magic value. */
4630 struct Lisp_Symbol *sym = XSYMBOL (specpdl_ptr->symbol); 4620 Lisp_Symbol *sym = XSYMBOL (specpdl_ptr->symbol);
4631 if (!SYMBOL_VALUE_MAGIC_P (sym->value)) 4621 if (!SYMBOL_VALUE_MAGIC_P (sym->value))
4632 sym->value = specpdl_ptr->old_value; 4622 sym->value = specpdl_ptr->old_value;
4633 else 4623 else
4634 Fset (specpdl_ptr->symbol, specpdl_ptr->old_value); 4624 Fset (specpdl_ptr->symbol, specpdl_ptr->old_value);
4635 } 4625 }
4751 if (printing_bindings) write_c_string (")\n", stream); 4741 if (printing_bindings) write_c_string (")\n", stream);
4752 } 4742 }
4753 4743
4754 DEFUN ("backtrace", Fbacktrace, 0, 2, "", /* 4744 DEFUN ("backtrace", Fbacktrace, 0, 2, "", /*
4755 Print a trace of Lisp function calls currently active. 4745 Print a trace of Lisp function calls currently active.
4756 Option arg STREAM specifies the output stream to send the backtrace to, 4746 Optional arg STREAM specifies the output stream to send the backtrace to,
4757 and defaults to the value of `standard-output'. Optional second arg 4747 and defaults to the value of `standard-output'. Optional second arg
4758 DETAILED means show places where currently active variable bindings, 4748 DETAILED means show places where currently active variable bindings,
4759 catches, condition-cases, and unwind-protects were made as well as 4749 catches, condition-cases, and unwind-protects were made as well as
4760 function calls. 4750 function calls.
4761 */ 4751 */
4794 for (;;) 4784 for (;;)
4795 { 4785 {
4796 if (!NILP (detailed) && catches && catches->backlist == backlist) 4786 if (!NILP (detailed) && catches && catches->backlist == backlist)
4797 { 4787 {
4798 int catchpdl = catches->pdlcount; 4788 int catchpdl = catches->pdlcount;
4799 if (specpdl[catchpdl].func == condition_case_unwind 4789 if (speccount > catchpdl
4800 && speccount > catchpdl) 4790 && specpdl[catchpdl].func == condition_case_unwind)
4801 /* This is a condition-case catchpoint */ 4791 /* This is a condition-case catchpoint */
4802 catchpdl = catchpdl + 1; 4792 catchpdl = catchpdl + 1;
4803 4793
4804 backtrace_specials (speccount, catchpdl, stream); 4794 backtrace_specials (speccount, catchpdl, stream);
4805 4795
4945 An alternative approach is to just pass some non-string type of 4935 An alternative approach is to just pass some non-string type of
4946 Lisp_Object to warn_when_safe_lispobj(); `prin1-to-string' will 4936 Lisp_Object to warn_when_safe_lispobj(); `prin1-to-string' will
4947 automatically be called when it is safe to do so. */ 4937 automatically be called when it is safe to do so. */
4948 4938
4949 void 4939 void
4950 warn_when_safe (Lisp_Object class, Lisp_Object level, CONST char *fmt, ...) 4940 warn_when_safe (Lisp_Object class, Lisp_Object level, const char *fmt, ...)
4951 { 4941 {
4952 Lisp_Object obj; 4942 Lisp_Object obj;
4953 va_list args; 4943 va_list args;
4954 4944
4955 va_start (args, fmt); 4945 va_start (args, fmt);
4956 obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), 4946 obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt),
4957 Qnil, -1, args); 4947 Qnil, -1, args);
4958 va_end (args); 4948 va_end (args);
4959 4949
4960 warn_when_safe_lispobj (class, level, obj); 4950 warn_when_safe_lispobj (class, level, obj);
4961 } 4951 }
5051 lisp_eval_depth = 0; 5041 lisp_eval_depth = 0;
5052 entering_debugger = 0; 5042 entering_debugger = 0;
5053 } 5043 }
5054 5044
5055 void 5045 void
5046 reinit_vars_of_eval (void)
5047 {
5048 preparing_for_armageddon = 0;
5049 in_warnings = 0;
5050 Qunbound_suspended_errors_tag = make_opaque_ptr (&Qunbound_suspended_errors_tag);
5051 staticpro_nodump (&Qunbound_suspended_errors_tag);
5052
5053 specpdl_size = 50;
5054 specpdl = xnew_array (struct specbinding, specpdl_size);
5055 /* XEmacs change: increase these values. */
5056 max_specpdl_size = 3000;
5057 max_lisp_eval_depth = 500;
5058 #if 0 /* no longer used */
5059 throw_level = 0;
5060 #endif
5061 }
5062
5063 void
5056 vars_of_eval (void) 5064 vars_of_eval (void)
5057 { 5065 {
5066 reinit_vars_of_eval ();
5067
5058 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size /* 5068 DEFVAR_INT ("max-specpdl-size", &max_specpdl_size /*
5059 Limit on number of Lisp variable bindings & unwind-protects before error. 5069 Limit on number of Lisp variable bindings & unwind-protects before error.
5060 */ ); 5070 */ );
5061 5071
5062 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth /* 5072 DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth /*
5154 If due to `apply' or `funcall' entry, one arg, `lambda'. 5164 If due to `apply' or `funcall' entry, one arg, `lambda'.
5155 If due to `eval' entry, one arg, t. 5165 If due to `eval' entry, one arg, t.
5156 */ ); 5166 */ );
5157 Vdebugger = Qnil; 5167 Vdebugger = Qnil;
5158 5168
5159 preparing_for_armageddon = 0;
5160
5161 staticpro (&Vpending_warnings); 5169 staticpro (&Vpending_warnings);
5162 Vpending_warnings = Qnil; 5170 Vpending_warnings = Qnil;
5163 Vpending_warnings_tail = Qnil; /* no need to protect this */ 5171 pdump_wire (&Vpending_warnings_tail);
5164 5172 Vpending_warnings_tail = Qnil;
5165 in_warnings = 0;
5166 5173
5167 staticpro (&Vautoload_queue); 5174 staticpro (&Vautoload_queue);
5168 Vautoload_queue = Qnil; 5175 Vautoload_queue = Qnil;
5169 5176
5170 staticpro (&Vcondition_handlers); 5177 staticpro (&Vcondition_handlers);
5173 Vcurrent_warning_class = Qnil; 5180 Vcurrent_warning_class = Qnil;
5174 5181
5175 staticpro (&Vcurrent_error_state); 5182 staticpro (&Vcurrent_error_state);
5176 Vcurrent_error_state = Qnil; /* errors as normal */ 5183 Vcurrent_error_state = Qnil; /* errors as normal */
5177 5184
5178 Qunbound_suspended_errors_tag = make_opaque_long (0);
5179 staticpro (&Qunbound_suspended_errors_tag);
5180
5181 specpdl_size = 50;
5182 specpdl_depth_counter = 0;
5183 specpdl = xnew_array (struct specbinding, specpdl_size);
5184 /* XEmacs change: increase these values. */
5185 max_specpdl_size = 3000;
5186 max_lisp_eval_depth = 500;
5187 #if 0 /* no longer used */
5188 throw_level = 0;
5189 #endif
5190
5191 reinit_eval (); 5185 reinit_eval ();
5192 } 5186 }