Mercurial > hg > xemacs-beta

comparison src/eval.c @ 74:54cc21c15cbb r20-0b32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b32
author cvs
date Mon, 13 Aug 2007 09:04:33 +0200
parents 131b0175ea99
children 1040fe1366ac
comparison
equal deleted inserted replaced
73:e2d7a37b7c8d 74:54cc21c15cbb
216 static Lisp_Object Vcondition_handlers; 216 static Lisp_Object Vcondition_handlers;
217 217
218 /* Used for error catching purposes by throw_or_bomb_out */ 218 /* Used for error catching purposes by throw_or_bomb_out */
219 static int throw_level; 219 static int throw_level;
220 220
221 static Lisp_Object primitive_funcall (Lisp_Object (*fn) (), int nargs, 221 static Lisp_Object primitive_funcall (lisp_fn_t fn, int nargs,
222 Lisp_Object args[]); 222 Lisp_Object args[]);
223 223
224 224
225 /**********************************************************************/ 225 /**********************************************************************/
226 /* The subr and compiled-function types */ 226 /* The subr and compiled-function types */
2052 2052
2053 static Lisp_Object 2053 static Lisp_Object
2054 call_with_suspended_errors_1 (Lisp_Object opaque_arg) 2054 call_with_suspended_errors_1 (Lisp_Object opaque_arg)
2055 { 2055 {
2056 Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg); 2056 Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg);
2057 return (primitive_funcall 2057 return (primitive_funcall ((lisp_fn_t) get_opaque_ptr (kludgy_args[0]),
2058 ((Lisp_Object (*)()) get_opaque_ptr (kludgy_args[0]), 2058 XINT (kludgy_args[1]), kludgy_args + 2));
2059 XINT (kludgy_args[1]), kludgy_args + 2));
2060 } 2059 }
2061 2060
2062 static Lisp_Object 2061 static Lisp_Object
2063 restore_current_warning_class (Lisp_Object warning_class) 2062 restore_current_warning_class (Lisp_Object warning_class)
2064 { 2063 {
2087 Wrap this around any function in which you might want errors 2086 Wrap this around any function in which you might want errors
2088 to not be errors. 2087 to not be errors.
2089 */ 2088 */
2090 2089
2091 Lisp_Object 2090 Lisp_Object
2092 call_with_suspended_errors (Lisp_Object (*fun)(), Lisp_Object retval, 2091 call_with_suspended_errors (lisp_fn_t fun, Lisp_Object retval,
2093 Lisp_Object class, Error_behavior errb, 2092 Lisp_Object class, Error_behavior errb,
2094 int nargs, ...) 2093 int nargs, ...)
2095 { 2094 {
2096 va_list vargs; 2095 va_list vargs;
2097 int speccount; 2096 int speccount;
2979 } 2978 }
2980 2979
2981 backtrace.args = vals; 2980 backtrace.args = vals;
2982 backtrace.nargs = nargs; 2981 backtrace.nargs = nargs;
2983 2982
2984 val = ((subr_function (subr)) (nargs, vals)); 2983 val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
2984 (nargs, vals);
2985 2985
2986 /* Have to duplicate this code because if the 2986 /* Have to duplicate this code because if the
2987 * debugger is called it must be in a scope in 2987 * debugger is called it must be in a scope in
2988 * which the `alloca'-ed data in vals is still valid. 2988 * which the `alloca'-ed data in vals is still valid.
2989 * (And GC-protected.) 2989 * (And GC-protected.)
3152 list2 (fun, make_int (nargs))); 3152 list2 (fun, make_int (nargs)));
3153 } 3153 }
3154 3154
3155 if (max_args == MANY) 3155 if (max_args == MANY)
3156 { 3156 {
3157 val = ((subr_function (subr)) (nargs, args + 1)); 3157 val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
3158 (nargs, args + 1);
3158 } 3159 }
3159 3160
3160 else if (max_args > nargs) 3161 else if (max_args > nargs)
3161 { 3162 {
3162 Lisp_Object argvals[SUBR_MAX_ARGS]; 3163 Lisp_Object argvals[SUBR_MAX_ARGS];
3429 RETURN_UNGCPRO (Ffuncall (funcall_nargs, funcall_args)); 3430 RETURN_UNGCPRO (Ffuncall (funcall_nargs, funcall_args));
3430 } 3431 }
3431 } 3432 }
3432 3433
3433 3434
3435 /* Define proper types and argument lists simultaneously */
3436 #define PRIMITIVE_FUNCALL(n) ((Lisp_Object (*) (PRIMITIVE_FUNCALL_##n)
3437 #define PRIMITIVE_FUNCALL_0 void)) (fn)) (
3438 #define PRIMITIVE_FUNCALL_1 Lisp_Object)) (fn)) (args[0]
3439 #define PRIMITIVE_FUNCALL_2 Lisp_Object, PRIMITIVE_FUNCALL_1, args[1]
3440 #define PRIMITIVE_FUNCALL_3 Lisp_Object, PRIMITIVE_FUNCALL_2, args[2]
3441 #define PRIMITIVE_FUNCALL_4 Lisp_Object, PRIMITIVE_FUNCALL_3, args[3]
3442 #define PRIMITIVE_FUNCALL_5 Lisp_Object, PRIMITIVE_FUNCALL_4, args[4]
3443 #define PRIMITIVE_FUNCALL_6 Lisp_Object, PRIMITIVE_FUNCALL_5, args[5]
3444 #define PRIMITIVE_FUNCALL_7 Lisp_Object, PRIMITIVE_FUNCALL_6, args[6]
3445 #define PRIMITIVE_FUNCALL_8 Lisp_Object, PRIMITIVE_FUNCALL_7, args[7]
3446 #define PRIMITIVE_FUNCALL_9 Lisp_Object, PRIMITIVE_FUNCALL_8, args[8]
3447 #define PRIMITIVE_FUNCALL_10 Lisp_Object, PRIMITIVE_FUNCALL_9, args[9]
3448 #define PRIMITIVE_FUNCALL_11 Lisp_Object, PRIMITIVE_FUNCALL_10, args[10]
3449 #define PRIMITIVE_FUNCALL_12 Lisp_Object, PRIMITIVE_FUNCALL_11, args[11]
3450
3434 static Lisp_Object 3451 static Lisp_Object
3435 primitive_funcall (Lisp_Object (*fn) (), int nargs, Lisp_Object args[]) 3452 primitive_funcall (lisp_fn_t fn, int nargs, Lisp_Object args[])
3436 { 3453 {
3437 switch (nargs) 3454 switch (nargs)
3438 { 3455 {
3439 case 0: 3456 case 0: return PRIMITIVE_FUNCALL(0);
3440 return ((*fn) ()); 3457 case 1: return PRIMITIVE_FUNCALL(1);
3441 case 1: 3458 case 2: return PRIMITIVE_FUNCALL(2);
3442 return ((*fn) (args[0])); 3459 case 3: return PRIMITIVE_FUNCALL(3);
3443 case 2: 3460 case 4: return PRIMITIVE_FUNCALL(4);
3444 return ((*fn) (args[0], args[1])); 3461 case 5: return PRIMITIVE_FUNCALL(5);
3445 case 3: 3462 case 6: return PRIMITIVE_FUNCALL(6);
3446 return ((*fn) (args[0], args[1], args[2])); 3463 case 7: return PRIMITIVE_FUNCALL(7);
3447 case 4: 3464 case 8: return PRIMITIVE_FUNCALL(8);
3448 return ((*fn) (args[0], args[1], args[2], args[3])); 3465 case 9: return PRIMITIVE_FUNCALL(9);
3449 case 5: 3466 case 10: return PRIMITIVE_FUNCALL(10);
3450 return ((*fn) (args[0], args[1], args[2], args[3], args[4])); 3467 case 11: return PRIMITIVE_FUNCALL(11);
3451 case 6: 3468 case 12: return PRIMITIVE_FUNCALL(12);
3452 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5])); 3469 }
3453 case 7: 3470
3454 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5], 3471 /* Someone has created a subr that takes more arguments than is
3455 args[6])); 3472 supported by this code. We need to either rewrite the subr to
3456 case 8: 3473 use a different argument protocol, or add more cases to this
3457 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5], 3474 switch. */
3458 args[6], args[7])); 3475 abort ();
3459 case 9:
3460 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
3461 args[6], args[7], args[8]));
3462 case 10:
3463 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
3464 args[6], args[7], args[8], args[9]));
3465 case 11:
3466 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
3467 args[6], args[7], args[8], args[9], args[10]));
3468 case 12:
3469 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
3470 args[6], args[7], args[8], args[9], args[10], args[11]));
3471 default:
3472 /* Someone has created a subr that takes more arguments than
3473 is supported by this code. We need to either rewrite the
3474 subr to use a different argument protocol, or add more
3475 cases to this switch. */
3476 abort ();
3477 }
3478 return Qnil; /* suppress compiler warning */ 3476 return Qnil; /* suppress compiler warning */
3479 } 3477 }
3480 3478
3481 static Lisp_Object 3479 static Lisp_Object
3482 funcall_subr (struct Lisp_Subr *subr, Lisp_Object args[]) 3480 funcall_subr (struct Lisp_Subr *subr, Lisp_Object args[])