comparison src/eval.c @ 153:25f70ba0133c r20-3b3

Import from CVS: tag r20-3b3
author cvs
date Mon, 13 Aug 2007 09:38:25 +0200
parents 538048ae2ab8
children 0132846995bd
comparison
equal deleted inserted replaced
152:4c132ee2d62b 153:25f70ba0133c
722 /* This function can GC */ 722 /* This function can GC */
723 REGISTER Lisp_Object val; 723 REGISTER Lisp_Object val;
724 Lisp_Object args_left; 724 Lisp_Object args_left;
725 struct gcpro gcpro1; 725 struct gcpro gcpro1;
726 726
727 #ifdef MOCKLISP_SUPPORT
728 /* In Mucklisp code, symbols at the front of the progn arglist
729 are to be bound to zero. */
730 if (!EQ (Vmocklisp_arguments, Qt))
731 {
732 Lisp_Object tem;
733 val = Qzero;
734 while (!NILP (args) && (tem = Fcar (args), SYMBOLP (tem)))
735 {
736 QUIT;
737 specbind (tem, val), args = Fcdr (args);
738 }
739 }
740 #endif
741
742 if (NILP (args)) 727 if (NILP (args))
743 return Qnil; 728 return Qnil;
744 729
745 args_left = args; 730 args_left = args;
746 GCPRO1 (args_left); 731 GCPRO1 (args_left);
934 919
935 GCPRO2 (test, body); 920 GCPRO2 (test, body);
936 921
937 test = Fcar (args); 922 test = Fcar (args);
938 body = Fcdr (args); 923 body = Fcdr (args);
939 #ifdef MOCKLISP_SUPPORT
940 while (tem = Feval (test),
941 (!EQ (Vmocklisp_arguments, Qt) ? XINT (tem) : !NILP (tem)))
942 #else
943 while (tem = Feval (test), !NILP (tem)) 924 while (tem = Feval (test), !NILP (tem))
944 #endif
945 { 925 {
946 QUIT; 926 QUIT;
947 Fprogn (body); 927 Fprogn (body);
948 } 928 }
949 929
2548 funcar = Fcar (fun); 2528 funcar = Fcar (fun);
2549 if (!SYMBOLP (funcar)) 2529 if (!SYMBOLP (funcar))
2550 return Fsignal (Qinvalid_function, list1 (fun)); 2530 return Fsignal (Qinvalid_function, list1 (fun));
2551 if (EQ (funcar, Qlambda)) 2531 if (EQ (funcar, Qlambda))
2552 return Fassq (Qinteractive, Fcdr (Fcdr (fun))); 2532 return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
2553 #ifdef MOCKLISP_SUPPORT
2554 if (EQ (funcar, Qmocklisp))
2555 return Qt; /* All mocklisp functions can be called interactively */
2556 #endif
2557 if (EQ (funcar, Qautoload)) 2533 if (EQ (funcar, Qautoload))
2558 return Fcar (Fcdr (Fcdr (Fcdr (fun)))); 2534 return Fcar (Fcdr (Fcdr (Fcdr (fun))));
2559 else 2535 else
2560 return Qnil; 2536 return Qnil;
2561 } 2537 }
2892 if (!SYMBOLP (form)) 2868 if (!SYMBOLP (form))
2893 return form; 2869 return form;
2894 2870
2895 val = Fsymbol_value (form); 2871 val = Fsymbol_value (form);
2896 2872
2897 #ifdef MOCKLISP_SUPPORT
2898 if (!EQ (Vmocklisp_arguments, Qt))
2899 {
2900 if (NILP (val))
2901 val = Qzero;
2902 else if (EQ (val, Qt))
2903 val = make_int (1);
2904 }
2905 #endif
2906 return val; 2873 return val;
2907 } 2874 }
2908 2875
2909 QUIT; 2876 QUIT;
2910 if ((consing_since_gc > gc_cons_threshold) || always_gc) 2877 if ((consing_since_gc > gc_cons_threshold) || always_gc)
2999 * debugger is called it must be in a scope in 2966 * debugger is called it must be in a scope in
3000 * which the `alloca'-ed data in vals is still valid. 2967 * which the `alloca'-ed data in vals is still valid.
3001 * (And GC-protected.) 2968 * (And GC-protected.)
3002 */ 2969 */
3003 lisp_eval_depth--; 2970 lisp_eval_depth--;
3004 #ifdef MOCKLISP_SUPPORT
3005 if (!EQ (Vmocklisp_arguments, Qt))
3006 {
3007 if (NILP (val))
3008 val = Qzero;
3009 else if (EQ (val, Qt))
3010 val = make_int (1);
3011 }
3012 #endif
3013 if (backtrace.debug_on_exit) 2971 if (backtrace.debug_on_exit)
3014 val = do_debug_on_exit (val); 2972 val = do_debug_on_exit (val);
3015 POP_BACKTRACE (backtrace); 2973 POP_BACKTRACE (backtrace);
3016 UNGCPRO; 2974 UNGCPRO;
3017 return (val); 2975 return (val);
3060 } 3018 }
3061 if (EQ (funcar, Qmacro)) 3019 if (EQ (funcar, Qmacro))
3062 val = Feval (apply1 (Fcdr (fun), original_args)); 3020 val = Feval (apply1 (Fcdr (fun), original_args));
3063 else if (EQ (funcar, Qlambda)) 3021 else if (EQ (funcar, Qlambda))
3064 val = apply_lambda (fun, nargs, original_args); 3022 val = apply_lambda (fun, nargs, original_args);
3065 #ifdef MOCKLISP_SUPPORT
3066 else if (EQ (funcar, Qmocklisp))
3067 val = ml_apply (fun, original_args);
3068 #endif
3069 else 3023 else
3070 { 3024 {
3071 invalid_function: 3025 invalid_function:
3072 return Fsignal (Qinvalid_function, list1 (fun)); 3026 return Fsignal (Qinvalid_function, list1 (fun));
3073 } 3027 }
3074 } 3028 }
3075 3029
3076 lisp_eval_depth--; 3030 lisp_eval_depth--;
3077 #ifdef MOCKLISP_SUPPORT
3078 if (!EQ (Vmocklisp_arguments, Qt))
3079 {
3080 if (NILP (val))
3081 val = Qzero;
3082 else if (EQ (val, Qt))
3083 val = make_int (1);
3084 }
3085 #endif
3086 if (backtrace.debug_on_exit) 3031 if (backtrace.debug_on_exit)
3087 val = do_debug_on_exit (val); 3032 val = do_debug_on_exit (val);
3088 POP_BACKTRACE (backtrace); 3033 POP_BACKTRACE (backtrace);
3089 return (val); 3034 return (val);
3090 } 3035 }
3195 3140
3196 if (!SYMBOLP (funcar)) 3141 if (!SYMBOLP (funcar))
3197 goto invalid_function; 3142 goto invalid_function;
3198 if (EQ (funcar, Qlambda)) 3143 if (EQ (funcar, Qlambda))
3199 val = funcall_lambda (fun, nargs, args + 1); 3144 val = funcall_lambda (fun, nargs, args + 1);
3200 #ifdef MOCKLISP_SUPPORT
3201 else if (EQ (funcar, Qmocklisp))
3202 val = ml_apply (fun, Flist (nargs, args + 1));
3203 #endif
3204 else if (EQ (funcar, Qautoload)) 3145 else if (EQ (funcar, Qautoload))
3205 { 3146 {
3206 do_autoload (fun, args[0]); 3147 do_autoload (fun, args[0]);
3207 goto retry; 3148 goto retry;
3208 } 3149 }
3543 REGISTER Lisp_Object syms_left; 3484 REGISTER Lisp_Object syms_left;
3544 REGISTER Lisp_Object next; 3485 REGISTER Lisp_Object next;
3545 int speccount = specpdl_depth_counter; 3486 int speccount = specpdl_depth_counter;
3546 REGISTER int i; 3487 REGISTER int i;
3547 int optional = 0, rest = 0; 3488 int optional = 0, rest = 0;
3548
3549 #ifdef MOCKLISP_SUPPORT
3550 if (!EQ (Vmocklisp_arguments, Qt))
3551 specbind (Qmocklisp_arguments, Qt); /* t means NOT mocklisp! */
3552 #endif
3553 3489
3554 if (CONSP (fun)) 3490 if (CONSP (fun))
3555 syms_left = Fcar (Fcdr (fun)); 3491 syms_left = Fcar (Fcdr (fun));
3556 else if (COMPILED_FUNCTIONP (fun)) 3492 else if (COMPILED_FUNCTIONP (fun))
3557 syms_left = XCOMPILED_FUNCTION (fun)->arglist; 3493 syms_left = XCOMPILED_FUNCTION (fun)->arglist;