Mercurial > hg > xemacs-beta

comparison src/eval.c @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents ac2d302a0011
children 859a2309aef8
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
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 */
2082 2082
2083 static Lisp_Object 2083 static Lisp_Object
2084 call_with_suspended_errors_1 (Lisp_Object opaque_arg) 2084 call_with_suspended_errors_1 (Lisp_Object opaque_arg)
2085 { 2085 {
2086 Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg); 2086 Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg);
2087 return (primitive_funcall 2087 return (primitive_funcall ((lisp_fn_t) get_opaque_ptr (kludgy_args[0]),
2088 ((Lisp_Object (*)()) get_opaque_ptr (kludgy_args[0]), 2088 XINT (kludgy_args[1]), kludgy_args + 2));
2089 XINT (kludgy_args[1]), kludgy_args + 2));
2090 } 2089 }
2091 2090
2092 static Lisp_Object 2091 static Lisp_Object
2093 restore_current_warning_class (Lisp_Object warning_class) 2092 restore_current_warning_class (Lisp_Object warning_class)
2094 { 2093 {
2117 Wrap this around any function in which you might want errors 2116 Wrap this around any function in which you might want errors
2118 to not be errors. 2117 to not be errors.
2119 */ 2118 */
2120 2119
2121 Lisp_Object 2120 Lisp_Object
2122 call_with_suspended_errors (Lisp_Object (*fun)(), Lisp_Object retval, 2121 call_with_suspended_errors (lisp_fn_t fun, Lisp_Object retval,
2123 Lisp_Object class, Error_behavior errb, 2122 Lisp_Object class, Error_behavior errb,
2124 int nargs, ...) 2123 int nargs, ...)
2125 { 2124 {
2126 va_list vargs; 2125 va_list vargs;
2127 int speccount; 2126 int speccount;
3013 } 3012 }
3014 3013
3015 backtrace.args = vals; 3014 backtrace.args = vals;
3016 backtrace.nargs = nargs; 3015 backtrace.nargs = nargs;
3017 3016
3018 val = ((subr_function (subr)) (nargs, vals)); 3017 val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
3018 (nargs, vals);
3019 3019
3020 /* Have to duplicate this code because if the 3020 /* Have to duplicate this code because if the
3021 * debugger is called it must be in a scope in 3021 * debugger is called it must be in a scope in
3022 * which the `alloca'-ed data in vals is still valid. 3022 * which the `alloca'-ed data in vals is still valid.
3023 * (And GC-protected.) 3023 * (And GC-protected.)
3186 list2 (fun, make_int (nargs))); 3186 list2 (fun, make_int (nargs)));
3187 } 3187 }
3188 3188
3189 if (max_args == MANY) 3189 if (max_args == MANY)
3190 { 3190 {
3191 val = ((subr_function (subr)) (nargs, args + 1)); 3191 val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
3192 (nargs, args + 1);
3192 } 3193 }
3193 3194
3194 else if (max_args > nargs) 3195 else if (max_args > nargs)
3195 { 3196 {
3196 Lisp_Object argvals[SUBR_MAX_ARGS]; 3197 Lisp_Object argvals[SUBR_MAX_ARGS];
3471 RETURN_UNGCPRO (Ffuncall (funcall_nargs, funcall_args)); 3472 RETURN_UNGCPRO (Ffuncall (funcall_nargs, funcall_args));
3472 } 3473 }
3473 } 3474 }
3474 3475
3475 3476
3477 /* Define proper types and argument lists simultaneously */
3478 #define PRIMITIVE_FUNCALL(n) ((Lisp_Object (*) (PRIMITIVE_FUNCALL_##n)
3479 #define PRIMITIVE_FUNCALL_0 void)) (fn)) (
3480 #define PRIMITIVE_FUNCALL_1 Lisp_Object)) (fn)) (args[0]
3481 #define PRIMITIVE_FUNCALL_2 Lisp_Object, PRIMITIVE_FUNCALL_1, args[1]
3482 #define PRIMITIVE_FUNCALL_3 Lisp_Object, PRIMITIVE_FUNCALL_2, args[2]
3483 #define PRIMITIVE_FUNCALL_4 Lisp_Object, PRIMITIVE_FUNCALL_3, args[3]
3484 #define PRIMITIVE_FUNCALL_5 Lisp_Object, PRIMITIVE_FUNCALL_4, args[4]
3485 #define PRIMITIVE_FUNCALL_6 Lisp_Object, PRIMITIVE_FUNCALL_5, args[5]
3486 #define PRIMITIVE_FUNCALL_7 Lisp_Object, PRIMITIVE_FUNCALL_6, args[6]
3487 #define PRIMITIVE_FUNCALL_8 Lisp_Object, PRIMITIVE_FUNCALL_7, args[7]
3488 #define PRIMITIVE_FUNCALL_9 Lisp_Object, PRIMITIVE_FUNCALL_8, args[8]
3489 #define PRIMITIVE_FUNCALL_10 Lisp_Object, PRIMITIVE_FUNCALL_9, args[9]
3490 #define PRIMITIVE_FUNCALL_11 Lisp_Object, PRIMITIVE_FUNCALL_10, args[10]
3491 #define PRIMITIVE_FUNCALL_12 Lisp_Object, PRIMITIVE_FUNCALL_11, args[11]
3492
3476 static Lisp_Object 3493 static Lisp_Object
3477 primitive_funcall (Lisp_Object (*fn) (), int nargs, Lisp_Object args[]) 3494 primitive_funcall (lisp_fn_t fn, int nargs, Lisp_Object args[])
3478 { 3495 {
3479 switch (nargs) 3496 switch (nargs)
3480 { 3497 {
3481 case 0: 3498 case 0: return PRIMITIVE_FUNCALL(0);
3482 return ((*fn) ()); 3499 case 1: return PRIMITIVE_FUNCALL(1);
3483 case 1: 3500 case 2: return PRIMITIVE_FUNCALL(2);
3484 return ((*fn) (args[0])); 3501 case 3: return PRIMITIVE_FUNCALL(3);
3485 case 2: 3502 case 4: return PRIMITIVE_FUNCALL(4);
3486 return ((*fn) (args[0], args[1])); 3503 case 5: return PRIMITIVE_FUNCALL(5);
3487 case 3: 3504 case 6: return PRIMITIVE_FUNCALL(6);
3488 return ((*fn) (args[0], args[1], args[2])); 3505 case 7: return PRIMITIVE_FUNCALL(7);
3489 case 4: 3506 case 8: return PRIMITIVE_FUNCALL(8);
3490 return ((*fn) (args[0], args[1], args[2], args[3])); 3507 case 9: return PRIMITIVE_FUNCALL(9);
3491 case 5: 3508 case 10: return PRIMITIVE_FUNCALL(10);
3492 return ((*fn) (args[0], args[1], args[2], args[3], args[4])); 3509 case 11: return PRIMITIVE_FUNCALL(11);
3493 case 6: 3510 case 12: return PRIMITIVE_FUNCALL(12);
3494 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5])); 3511 }
3495 case 7: 3512
3496 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5], 3513 /* Someone has created a subr that takes more arguments than is
3497 args[6])); 3514 supported by this code. We need to either rewrite the subr to
3498 case 8: 3515 use a different argument protocol, or add more cases to this
3499 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5], 3516 switch. */
3500 args[6], args[7])); 3517 abort ();
3501 case 9:
3502 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
3503 args[6], args[7], args[8]));
3504 case 10:
3505 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
3506 args[6], args[7], args[8], args[9]));
3507 case 11:
3508 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
3509 args[6], args[7], args[8], args[9], args[10]));
3510 case 12:
3511 return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
3512 args[6], args[7], args[8], args[9], args[10], args[11]));
3513 default:
3514 /* Someone has created a subr that takes more arguments than
3515 is supported by this code. We need to either rewrite the
3516 subr to use a different argument protocol, or add more
3517 cases to this switch. */
3518 abort ();
3519 }
3520 return Qnil; /* suppress compiler warning */ 3518 return Qnil; /* suppress compiler warning */
3521 } 3519 }
3522 3520
3523 static Lisp_Object 3521 static Lisp_Object
3524 funcall_subr (struct Lisp_Subr *subr, Lisp_Object args[]) 3522 funcall_subr (struct Lisp_Subr *subr, Lisp_Object args[])