Mercurial > hg > xemacs-beta

comparison src/eval.c @ 436:080151679be2 r21-2-26

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-26
author cvs
date Mon, 13 Aug 2007 11:31:24 +0200
parents 3ecd8885ac67
children 84b14dcb0985
comparison
equal deleted inserted replaced
435:53cf74a9db44 436:080151679be2
75 #define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \ 75 #define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \
76 void (*PF_fn)(void) = (void (*)(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; \
2469 Fsignal (Qquit, Qnil); 2468 Fsignal (Qquit, Qnil);
2470 } 2469 }
2471 2470
2472 2471
2473 /* Used in core lisp functions for efficiency */ 2472 /* Used in core lisp functions for efficiency */
2474 void 2473 Lisp_Object
2475 signal_void_function_error (Lisp_Object function) 2474 signal_void_function_error (Lisp_Object function)
2476 { 2475 {
2477 Fsignal (Qvoid_function, list1 (function)); 2476 return Fsignal (Qvoid_function, list1 (function));
2478 } 2477 }
2479 2478
2480 static void 2479 Lisp_Object
2481 signal_invalid_function_error (Lisp_Object function) 2480 signal_invalid_function_error (Lisp_Object function)
2482 { 2481 {
2483 Fsignal (Qinvalid_function, list1 (function)); 2482 return Fsignal (Qinvalid_function, list1 (function));
2484 } 2483 }
2485 2484
2486 static void 2485 Lisp_Object
2487 signal_wrong_number_of_arguments_error (Lisp_Object function, int nargs) 2486 signal_wrong_number_of_arguments_error (Lisp_Object function, int nargs)
2488 { 2487 {
2489 Fsignal (Qwrong_number_of_arguments, list2 (function, make_int (nargs))); 2488 return Fsignal (Qwrong_number_of_arguments,
2489 list2 (function, make_int (nargs)));
2490 } 2490 }
2491 2491
2492 /* Used in list traversal macros for efficiency. */ 2492 /* Used in list traversal macros for efficiency. */
2493 void 2493 DOESNT_RETURN
2494 signal_malformed_list_error (Lisp_Object list) 2494 signal_malformed_list_error (Lisp_Object list)
2495 { 2495 {
2496 Fsignal (Qmalformed_list, list1 (list)); 2496 signal_error (Qmalformed_list, list1 (list));
2497 } 2497 }
2498 2498
2499 void 2499 DOESNT_RETURN
2500 signal_malformed_property_list_error (Lisp_Object list) 2500 signal_malformed_property_list_error (Lisp_Object list)
2501 { 2501 {
2502 Fsignal (Qmalformed_property_list, list1 (list)); 2502 signal_error (Qmalformed_property_list, list1 (list));
2503 } 2503 }
2504 2504
2505 void 2505 DOESNT_RETURN
2506 signal_circular_list_error (Lisp_Object list) 2506 signal_circular_list_error (Lisp_Object list)
2507 { 2507 {
2508 Fsignal (Qcircular_list, list1 (list)); 2508 signal_error (Qcircular_list, list1 (list));
2509 } 2509 }
2510 2510
2511 void 2511 DOESNT_RETURN
2512 signal_circular_property_list_error (Lisp_Object list) 2512 signal_circular_property_list_error (Lisp_Object list)
2513 { 2513 {
2514 Fsignal (Qcircular_property_list, list1 (list)); 2514 signal_error (Qcircular_property_list, list1 (list));
2515 } 2515 }
2516 2516
2517 /************************************************************************/ 2517 /************************************************************************/
2518 /* User commands */ 2518 /* User commands */
2519 /************************************************************************/ 2519 /************************************************************************/
3004 UNGCPRO; 3004 UNGCPRO;
3005 } 3005 }
3006 else 3006 else
3007 { 3007 {
3008 wrong_number_of_arguments: 3008 wrong_number_of_arguments:
3009 signal_wrong_number_of_arguments_error (fun, nargs); 3009 val = signal_wrong_number_of_arguments_error (fun, nargs);
3010 } 3010 }
3011 } 3011 }
3012 else if (COMPILED_FUNCTIONP (fun)) 3012 else if (COMPILED_FUNCTIONP (fun))
3013 { 3013 {
3014 struct gcpro gcpro1; 3014 struct gcpro gcpro1;
3092 } 3092 }
3093 } 3093 }
3094 else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */ 3094 else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */
3095 { 3095 {
3096 invalid_function: 3096 invalid_function:
3097 signal_invalid_function_error (fun); 3097 val = signal_invalid_function_error (fun);
3098 } 3098 }
3099 3099
3100 lisp_eval_depth--; 3100 lisp_eval_depth--;
3101 if (backtrace.debug_on_exit) 3101 if (backtrace.debug_on_exit)
3102 val = do_debug_on_exit (val); 3102 val = do_debug_on_exit (val);
3167 { 3167 {
3168 Lisp_Subr *subr = XSUBR (fun); 3168 Lisp_Subr *subr = XSUBR (fun);
3169 int max_args = subr->max_args; 3169 int max_args = subr->max_args;
3170 Lisp_Object spacious_args[SUBR_MAX_ARGS]; 3170 Lisp_Object spacious_args[SUBR_MAX_ARGS];
3171 3171
3172 if (fun_nargs < subr->min_args)
3173 goto wrong_number_of_arguments;
3174
3175 if (fun_nargs == max_args) /* Optimize for the common case */ 3172 if (fun_nargs == max_args) /* Optimize for the common case */
3176 { 3173 {
3177 funcall_subr: 3174 funcall_subr:
3178 FUNCALL_SUBR (val, subr, fun_args, max_args); 3175 FUNCALL_SUBR (val, subr, fun_args, max_args);
3179 } 3176 }
3177 else if (fun_nargs < subr->min_args)
3178 {
3179 goto wrong_number_of_arguments;
3180 }
3180 else if (fun_nargs < max_args) 3181 else if (fun_nargs < max_args)
3181 { 3182 {
3182 Lisp_Object *p = spacious_args; 3183 Lisp_Object *p = spacious_args;
3183 3184
3184 /* Default optionals to nil */ 3185 /* Default optionals to nil */
3190 fun_args = spacious_args; 3191 fun_args = spacious_args;
3191 goto funcall_subr; 3192 goto funcall_subr;
3192 } 3193 }
3193 else if (max_args == MANY) 3194 else if (max_args == MANY)
3194 { 3195 {
3195 val = ((Lisp_Object (*) (int, Lisp_Object *)) subr_function (subr)) 3196 val = SUBR_FUNCTION (subr, MANY) (fun_nargs, fun_args);
3196 (fun_nargs, fun_args);
3197 } 3197 }
3198 else if (max_args == UNEVALLED) /* Can't funcall a special form */ 3198 else if (max_args == UNEVALLED) /* Can't funcall a special form */
3199 { 3199 {
3200 goto invalid_function; 3200 goto invalid_function;
3201 } 3201 }
3202 else 3202 else
3203 { 3203 {
3204 wrong_number_of_arguments: 3204 wrong_number_of_arguments:
3205 signal_wrong_number_of_arguments_error (fun, fun_nargs); 3205 val = signal_wrong_number_of_arguments_error (fun, fun_nargs);
3206 } 3206 }
3207 } 3207 }
3208 else if (COMPILED_FUNCTIONP (fun)) 3208 else if (COMPILED_FUNCTIONP (fun))
3209 { 3209 {
3210 val = funcall_compiled_function (fun, fun_nargs, fun_args); 3210 val = funcall_compiled_function (fun, fun_nargs, fun_args);
3227 goto invalid_function; 3227 goto invalid_function;
3228 } 3228 }
3229 } 3229 }
3230 else if (UNBOUNDP (fun)) 3230 else if (UNBOUNDP (fun))
3231 { 3231 {
3232 signal_void_function_error (args[0]); 3232 val = signal_void_function_error (args[0]);
3233 } 3233 }
3234 else 3234 else
3235 { 3235 {
3236 invalid_function: 3236 invalid_function:
3237 signal_invalid_function_error (fun); 3237 val = signal_invalid_function_error (fun);
3238 } 3238 }
3239 3239
3240 lisp_eval_depth--; 3240 lisp_eval_depth--;
3241 if (backtrace.debug_on_exit) 3241 if (backtrace.debug_on_exit)
3242 val = do_debug_on_exit (val); 3242 val = do_debug_on_exit (val);
3308 } 3308 }
3309 } 3309 }
3310 else 3310 else
3311 { 3311 {
3312 invalid_function: 3312 invalid_function:
3313 return Fsignal (Qinvalid_function, list1 (function)); 3313 return signal_invalid_function_error (function);
3314 } 3314 }
3315 3315
3316 { 3316 {
3317 int argcount = 0; 3317 int argcount = 0;
3318 Lisp_Object arg; 3318 Lisp_Object arg;
3495 goto wrong_number_of_arguments; 3495 goto wrong_number_of_arguments;
3496 3496
3497 return unbind_to (speccount, Fprogn (body)); 3497 return unbind_to (speccount, Fprogn (body));
3498 3498
3499 wrong_number_of_arguments: 3499 wrong_number_of_arguments:
3500 return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); 3500 return signal_wrong_number_of_arguments_error (fun, nargs);
3501 3501
3502 invalid_function: 3502 invalid_function:
3503 return Fsignal (Qinvalid_function, list1 (fun)); 3503 return signal_invalid_function_error (fun);
3504 } 3504 }
3505 3505
3506 3506
3507 /************************************************************************/ 3507 /************************************************************************/
3508 /* Run hook variables in various ways. */ 3508 /* Run hook variables in various ways. */