Mercurial > hg > xemacs-beta

comparison src/eval.c @ 195:a2f645c6b9f8 r20-3b24

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b24
author cvs
date Mon, 13 Aug 2007 09:59:05 +0200
parents b405438285a2
children 850242ba4a81
comparison
equal deleted inserted replaced
194:2947057885e5 195:a2f645c6b9f8
769 /* This function can GC */ 769 /* This function can GC */
770 REGISTER Lisp_Object val; 770 REGISTER Lisp_Object val;
771 Lisp_Object args_left; 771 Lisp_Object args_left;
772 struct gcpro gcpro1; 772 struct gcpro gcpro1;
773 773
774 if (NILP (args)) 774 if (! CONSP (args))
775 return Qnil; 775 return Qnil;
776 776
777 args_left = args; 777 args_left = args;
778 GCPRO1 (args_left); 778 GCPRO1 (args_left);
779 779
780 do 780 do
781 { 781 {
782 val = Feval (Fcar (args_left)); 782 val = Feval (XCAR (args_left));
783 args_left = Fcdr (args_left); 783 args_left = XCDR (args_left);
784 } 784 }
785 while (!NILP (args_left)); 785 while (CONSP (args_left));
786 786
787 UNGCPRO; 787 UNGCPRO;
788 return val; 788 return val;
789 } 789 }
790 790
995 struct gcpro gcpro1; 995 struct gcpro gcpro1;
996 996
997 if (NILP (args)) 997 if (NILP (args))
998 return Qnil; 998 return Qnil;
999 999
1000 val = Flength (args); 1000 {
1001 if (XINT (val) & 1) /* Odd number of arguments? */ 1001 REGISTER int i;
1002 Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, val)); 1002 for (i = 0, val = args ; CONSP (val); val = XCDR (val))
1003 {
1004 i++;
1005 /*
1006 * uncomment the QUIT if there is some way a circular
1007 * arglist can get in here. I think Feval or Fapply would
1008 * spin first and the list would never get here.
1009 */
1010 /* QUIT; */
1011 }
1012 if (i & 1) /* Odd number of arguments? */
1013 Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, make_int(i)));
1014 }
1003 1015
1004 args_left = args; 1016 args_left = args;
1005 GCPRO1 (args); 1017 GCPRO1 (args);
1006 1018
1007 do 1019 do
1008 { 1020 {
1009 val = Feval (Fcar (Fcdr (args_left))); 1021 val = Feval (XCAR (XCDR (args_left)));
1010 sym = Fcar (args_left); 1022 sym = XCAR (args_left);
1011 Fset (sym, val); 1023 Fset (sym, val);
1012 args_left = Fcdr (Fcdr (args_left)); 1024 args_left = XCDR (XCDR (args_left));
1013 } 1025 }
1014 while (!NILP (args_left)); 1026 while (CONSP (args_left));
1015 1027
1016 UNGCPRO; 1028 UNGCPRO;
1017 return val; 1029 return val;
1018 } 1030 }
1019 1031
2851 { 2863 {
2852 in_warnings = 0; 2864 in_warnings = 0;
2853 return Qnil; 2865 return Qnil;
2854 } 2866 }
2855 2867
2868 #define inline_funcall_subr(rv, subr, av) \
2869 do { \
2870 switch (subr->max_args) { \
2871 case 0: rv = (subr_function(subr))(); \
2872 break; \
2873 case 1: rv = (subr_function(subr))(av[0]); \
2874 break; \
2875 case 2: rv = (subr_function(subr))(av[0], av[1]); \
2876 break; \
2877 case 3: rv = (subr_function(subr))(av[0], av[1], av[2]); \
2878 break; \
2879 case 4: rv = (subr_function(subr))(av[0], av[1], av[2], av[3]); \
2880 break; \
2881 case 5: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4]); \
2882 break; \
2883 case 6: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
2884 av[5]); \
2885 break; \
2886 case 7: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
2887 av[5], av[6]); \
2888 break; \
2889 case 8: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
2890 av[5], av[6], av[7]); \
2891 break; \
2892 case 9: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
2893 av[5], av[6], av[7], av[8]); \
2894 break; \
2895 case 10: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
2896 av[5], av[6], av[7], av[8], av[9]); \
2897 break; \
2898 case 11: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
2899 av[5], av[6], av[7], av[8], av[9], \
2900 av[10]); \
2901 break; \
2902 case 12: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
2903 av[5], av[6], av[7], av[8], av[9], \
2904 av[10], av[11]); \
2905 break; \
2906 } \
2907 } while (0)
2856 2908
2857 DEFUN ("eval", Feval, 1, 1, 0, /* 2909 DEFUN ("eval", Feval, 1, 1, 0, /*
2858 Evaluate FORM and return its value. 2910 Evaluate FORM and return its value.
2859 */ 2911 */
2860 (form)) 2912 (form))
2921 max_lisp_eval_depth = 100; 2973 max_lisp_eval_depth = 100;
2922 if (lisp_eval_depth > max_lisp_eval_depth) 2974 if (lisp_eval_depth > max_lisp_eval_depth)
2923 error ("Lisp nesting exceeds `max-lisp-eval-depth'"); 2975 error ("Lisp nesting exceeds `max-lisp-eval-depth'");
2924 } 2976 }
2925 2977
2926 original_fun = Fcar (form); 2978 /*
2927 original_args = Fcdr (form); 2979 * At this point we know that `form' is a Lisp_Cons so we can safely
2928 nargs = XINT (Flength (original_args)); 2980 * use XCAR and XCDR.
2981 */
2982 original_fun = XCAR (form);
2983 original_args = XCDR (form);
2984
2985 /*
2986 * Formerly we used a call to Flength here, but that is slow and
2987 * wasteful due to type checking, stack push/pop and initialization.
2988 * We know we're dealing with a cons, so open code it for speed.
2989 *
2990 * We call QUIT in the loop so that a circular arg list won't lock
2991 * up the editor.
2992 */
2993 for (nargs = 0, val = original_args ; CONSP (val) ; val = XCDR (val))
2994 {
2995 nargs++;
2996 QUIT;
2997 }
2998 if (! NILP (val))
2999 signal_simple_error ("Argument list must be nil-terminated",
3000 original_args);
2929 3001
2930 #ifdef EMACS_BTL 3002 #ifdef EMACS_BTL
2931 backtrace.id_number = 0; 3003 backtrace.id_number = 0;
2932 #endif 3004 #endif
2933 backtrace.pdlcount = specpdl_depth_counter; 3005 backtrace.pdlcount = specpdl_depth_counter;
2980 3052
2981 GCPRO3 (args_left, fun, vals[0]); 3053 GCPRO3 (args_left, fun, vals[0]);
2982 gcpro3.nvars = 0; 3054 gcpro3.nvars = 0;
2983 3055
2984 argnum = 0; 3056 argnum = 0;
2985 while (!NILP (args_left)) 3057 while (CONSP (args_left))
2986 { 3058 {
2987 vals[argnum++] = Feval (Fcar (args_left)); 3059 vals[argnum++] = Feval (XCAR (args_left));
2988 args_left = Fcdr (args_left); 3060 args_left = XCDR (args_left);
2989 gcpro3.nvars = argnum; 3061 gcpro3.nvars = argnum;
2990 } 3062 }
2991 3063
2992 backtrace.args = vals; 3064 backtrace.args = vals;
2993 backtrace.nargs = nargs; 3065 backtrace.nargs = nargs;
3014 3086
3015 GCPRO3 (args_left, fun, fun); 3087 GCPRO3 (args_left, fun, fun);
3016 gcpro3.var = argvals; 3088 gcpro3.var = argvals;
3017 gcpro3.nvars = 0; 3089 gcpro3.nvars = 0;
3018 3090
3019 for (i = 0; i < nargs; args_left = Fcdr (args_left)) 3091 for (i = 0; i < nargs; args_left = XCDR (args_left))
3020 { 3092 {
3021 argvals[i] = Feval (Fcar (args_left)); 3093 argvals[i] = Feval (XCAR (args_left));
3022 gcpro3.nvars = ++i; 3094 gcpro3.nvars = ++i;
3023 } 3095 }
3024 3096
3025 UNGCPRO; 3097 UNGCPRO;
3026 3098
3027 for (i = nargs; i < max_args; i++) 3099 /* i == nargs at this point */
3100 for (; i < max_args; i++)
3028 argvals[i] = Qnil; 3101 argvals[i] = Qnil;
3029 3102
3030 backtrace.args = argvals; 3103 backtrace.args = argvals;
3031 backtrace.nargs = nargs; 3104 backtrace.nargs = nargs;
3032 3105
3033 val = funcall_subr (subr, argvals); 3106 /* val = funcall_subr (subr, argvals); */
3107 inline_funcall_subr(val, subr, argvals);
3034 } 3108 }
3035 } 3109 }
3036 else if (COMPILED_FUNCTIONP (fun)) 3110 else if (COMPILED_FUNCTIONP (fun))
3037 val = apply_lambda (fun, nargs, original_args); 3111 val = apply_lambda (fun, nargs, original_args);
3038 else 3112 else
3039 { 3113 {
3040 Lisp_Object funcar; 3114 Lisp_Object funcar;
3041 3115
3042 if (!CONSP (fun)) 3116 if (!CONSP (fun))
3043 goto invalid_function; 3117 goto invalid_function;
3044 funcar = Fcar (fun); 3118 funcar = XCAR (fun);
3045 if (!SYMBOLP (funcar)) 3119 if (!SYMBOLP (funcar))
3046 goto invalid_function; 3120 goto invalid_function;
3047 if (EQ (funcar, Qautoload)) 3121 if (EQ (funcar, Qautoload))
3048 { 3122 {
3049 do_autoload (fun, original_fun); 3123 do_autoload (fun, original_fun);
3050 goto retry; 3124 goto retry;
3051 } 3125 }
3052 if (EQ (funcar, Qmacro)) 3126 if (EQ (funcar, Qmacro))
3053 val = Feval (apply1 (Fcdr (fun), original_args)); 3127 val = Feval (apply1 (XCDR (fun), original_args));
3054 else if (EQ (funcar, Qlambda)) 3128 else if (EQ (funcar, Qlambda))
3055 val = apply_lambda (fun, nargs, original_args); 3129 val = apply_lambda (fun, nargs, original_args);
3056 else 3130 else
3057 { 3131 {
3058 invalid_function: 3132 invalid_function:
3153 for (i = 0; i < nargs; i++) 3227 for (i = 0; i < nargs; i++)
3154 argvals[i] = args[i + 1]; 3228 argvals[i] = args[i + 1];
3155 for (i = nargs; i < max_args; i++) 3229 for (i = nargs; i < max_args; i++)
3156 argvals[i] = Qnil; 3230 argvals[i] = Qnil;
3157 3231
3158 val = funcall_subr (subr, argvals); 3232 /* val = funcall_subr (subr, argvals); */
3233 inline_funcall_subr(val, subr, argvals);
3159 } 3234 }
3160 else 3235 else
3161 val = funcall_subr (subr, args + 1); 3236 /* val = funcall_subr (subr, args + 1); */
3237 inline_funcall_subr(val, subr, (&args[1]));
3162 } 3238 }
3163 else if (COMPILED_FUNCTIONP (fun)) 3239 else if (COMPILED_FUNCTIONP (fun))
3164 val = funcall_lambda (fun, nargs, args + 1); 3240 val = funcall_lambda (fun, nargs, args + 1);
3165 else if (!CONSP (fun)) 3241 else if (!CONSP (fun))
3166 { 3242 {
3167 invalid_function: 3243 invalid_function:
3168 return Fsignal (Qinvalid_function, list1 (fun)); 3244 return Fsignal (Qinvalid_function, list1 (fun));
3169 } 3245 }
3170 else 3246 else
3171 { 3247 {
3172 Lisp_Object funcar = Fcar (fun); 3248 /* `fun' is a Lisp_Cons so XCAR is safe */
3249 Lisp_Object funcar = XCAR (fun);
3173 3250
3174 if (!SYMBOLP (funcar)) 3251 if (!SYMBOLP (funcar))
3175 goto invalid_function; 3252 goto invalid_function;
3176 if (EQ (funcar, Qlambda)) 3253 if (EQ (funcar, Qlambda))
3177 val = funcall_lambda (fun, nargs, args + 1); 3254 val = funcall_lambda (fun, nargs, args + 1);
3337 */ 3414 */
3338 (int nargs, Lisp_Object *args)) 3415 (int nargs, Lisp_Object *args))
3339 { 3416 {
3340 /* This function can GC */ 3417 /* This function can GC */
3341 Lisp_Object fun = args[0]; 3418 Lisp_Object fun = args[0];
3342 Lisp_Object spread_arg = args [nargs - 1]; 3419 Lisp_Object spread_arg = args [nargs - 1], p;
3343 int numargs; 3420 int numargs;
3344 int funcall_nargs; 3421 int funcall_nargs;
3345 3422
3346 CHECK_LIST (spread_arg); 3423 CHECK_LIST (spread_arg);
3347 3424
3348 numargs = XINT (Flength (spread_arg)); 3425 /*
3426 * Formerly we used a call to Flength here, but that is slow and
3427 * wasteful due to type checking, stack push/pop and initialization.
3428 * We know we're dealing with a cons, so open code it for speed.
3429 *
3430 * We call QUIT in the loop so that a circular arg list won't lock
3431 * up the editor.
3432 */
3433 for (numargs = 0, p = spread_arg ; CONSP (p) ; p = XCDR (p))
3434 {
3435 numargs++;
3436 QUIT;
3437 }
3438 if (! NILP (p))
3439 signal_simple_error ("Argument list must be nil-terminated", spread_arg);
3349 3440
3350 if (numargs == 0) 3441 if (numargs == 0)
3351 /* (apply foo 0 1 '()) */ 3442 /* (apply foo 0 1 '()) */
3352 return Ffuncall (nargs - 1, args); 3443 return Ffuncall (nargs - 1, args);
3353 else if (numargs == 1) 3444 else if (numargs == 1)
3480 GCPRO3 (*arg_vector, unevalled_args, fun); 3571 GCPRO3 (*arg_vector, unevalled_args, fun);
3481 gcpro1.nvars = 0; 3572 gcpro1.nvars = 0;
3482 3573
3483 for (i = 0; i < numargs;) 3574 for (i = 0; i < numargs;)
3484 { 3575 {
3485 tem = Fcar (unevalled_args), unevalled_args = Fcdr (unevalled_args); 3576 /*
3577 * unevalled_args is always a normal list, or Feval would have
3578 * rejected it, so use XCAR and XCDR.
3579 */
3580 tem = XCAR (unevalled_args), unevalled_args = XCDR (unevalled_args);
3486 tem = Feval (tem); 3581 tem = Feval (tem);
3487 arg_vector[i++] = tem; 3582 arg_vector[i++] = tem;
3488 gcpro1.nvars = i; 3583 gcpro1.nvars = i;
3489 } 3584 }
3490 3585
3517 int speccount = specpdl_depth_counter; 3612 int speccount = specpdl_depth_counter;
3518 REGISTER int i; 3613 REGISTER int i;
3519 int optional = 0, rest = 0; 3614 int optional = 0, rest = 0;
3520 3615
3521 if (CONSP (fun)) 3616 if (CONSP (fun))
3522 syms_left = Fcar (Fcdr (fun)); 3617 syms_left = Fcar (XCDR (fun));
3523 else if (COMPILED_FUNCTIONP (fun)) 3618 else if (COMPILED_FUNCTIONP (fun))
3524 syms_left = XCOMPILED_FUNCTION (fun)->arglist; 3619 syms_left = XCOMPILED_FUNCTION (fun)->arglist;
3525 else abort (); 3620 else abort ();
3526 3621
3527 i = 0; 3622 i = 0;
3528 for (; !NILP (syms_left); syms_left = Fcdr (syms_left)) 3623 for (; CONSP (syms_left); syms_left = XCDR (syms_left))
3529 { 3624 {
3530 QUIT; 3625 QUIT;
3531 next = Fcar (syms_left); 3626 next = XCAR (syms_left);
3532 if (!SYMBOLP (next)) 3627 if (!SYMBOLP (next))
3533 signal_error (Qinvalid_function, list1 (fun)); 3628 signal_error (Qinvalid_function, list1 (fun));
3534 if (EQ (next, Qand_rest)) 3629 if (EQ (next, Qand_rest))
3535 rest = 1; 3630 rest = 1;
3536 else if (EQ (next, Qand_optional)) 3631 else if (EQ (next, Qand_optional))
3555 if (i < nargs) 3650 if (i < nargs)
3556 return Fsignal (Qwrong_number_of_arguments, 3651 return Fsignal (Qwrong_number_of_arguments,
3557 list2 (fun, make_int (nargs))); 3652 list2 (fun, make_int (nargs)));
3558 3653
3559 if (CONSP (fun)) 3654 if (CONSP (fun))
3560 val = Fprogn (Fcdr (Fcdr (fun))); 3655 val = Fprogn (Fcdr (XCDR (fun)));
3561 else 3656 else
3562 { 3657 {
3563 struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (fun); 3658 struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (fun);
3564 /* If we have not actually read the bytecode string 3659 /* If we have not actually read the bytecode string
3565 and constants vector yet, fetch them from the file. */ 3660 and constants vector yet, fetch them from the file. */