/[emacs]/emacs/src/eval.c
ViewVC logotype

Diff of /emacs/src/eval.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.178 by monnier, Thu Dec 6 16:21:23 2001 UTC revision 1.179 by pj, Sat Dec 22 14:01:01 2001 UTC
# Line 89  int gcpro_level; Line 89  int gcpro_level;
89    
90  Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;  Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
91  Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;  Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
 Lisp_Object Qmocklisp_arguments, Vmocklisp_arguments, Qmocklisp;  
92  Lisp_Object Qand_rest, Qand_optional;  Lisp_Object Qand_rest, Qand_optional;
93  Lisp_Object Qdebug_on_error;  Lisp_Object Qdebug_on_error;
94    
# Line 191  Lisp_Object Vsignaling_function; Line 190  Lisp_Object Vsignaling_function;
190  int handling_signal;  int handling_signal;
191    
192  static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*));  static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*));
 /* Apply a mocklisp function to unevaluated argument list.  */  
 extern Lisp_Object ml_apply P_ ((Lisp_Object, Lisp_Object));  
193    
194  void  void
195  init_eval_once ()  init_eval_once ()
# Line 406  usage: (progn BODY ...)  */) Line 403  usage: (progn BODY ...)  */)
403       (args)       (args)
404       Lisp_Object args;       Lisp_Object args;
405  {  {
406    register Lisp_Object val, tem;    register Lisp_Object val;
407    Lisp_Object args_left;    Lisp_Object args_left;
408    struct gcpro gcpro1;    struct gcpro gcpro1;
409    
   /* In Mocklisp code, symbols at the front of the progn arglist  
    are to be bound to zero. */  
   if (!EQ (Vmocklisp_arguments, Qt))  
     {  
       val = make_number (0);  
       while (!NILP (args) && (tem = Fcar (args), SYMBOLP (tem)))  
         {  
           QUIT;  
           specbind (tem, val), args = Fcdr (args);  
         }  
     }  
   
410    if (NILP(args))    if (NILP(args))
411      return Qnil;      return Qnil;
412    
# Line 925  usage: (while TEST BODY...)  */) Line 910  usage: (while TEST BODY...)  */)
910       (args)       (args)
911       Lisp_Object args;       Lisp_Object args;
912  {  {
913    Lisp_Object test, body, tem;    Lisp_Object test, body;
914    struct gcpro gcpro1, gcpro2;    struct gcpro gcpro1, gcpro2;
915    
916    GCPRO2 (test, body);    GCPRO2 (test, body);
917    
918    test = Fcar (args);    test = Fcar (args);
919    body = Fcdr (args);    body = Fcdr (args);
920    while (tem = Feval (test),    while (!NILP (Feval (test)))
          (!EQ (Vmocklisp_arguments, Qt) ? XINT (tem) : !NILP (tem)))  
921      {      {
922        QUIT;        QUIT;
923        Fprogn (body);        Fprogn (body);
# Line 1795  Also, a symbol satisfies `commandp' if i Line 1779  Also, a symbol satisfies `commandp' if i
1779      return Fsignal (Qinvalid_function, Fcons (fun, Qnil));      return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
1780    if (EQ (funcar, Qlambda))    if (EQ (funcar, Qlambda))
1781      return Fassq (Qinteractive, Fcdr (Fcdr (fun)));      return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
   if (EQ (funcar, Qmocklisp))  
     return Qt;  /* All mocklisp functions can be called interactively */  
1782    if (EQ (funcar, Qautoload))    if (EQ (funcar, Qautoload))
1783      return Fcar (Fcdr (Fcdr (Fcdr (fun))));      return Fcar (Fcdr (Fcdr (Fcdr (fun))));
1784    else    else
# Line 1942  DEFUN ("eval", Feval, Seval, 1, 1, 0, Line 1924  DEFUN ("eval", Feval, Seval, 1, 1, 0,
1924      abort ();      abort ();
1925        
1926    if (SYMBOLP (form))    if (SYMBOLP (form))
1927      {      return Fsymbol_value (form);
       if (EQ (Vmocklisp_arguments, Qt))  
         return Fsymbol_value (form);  
       val = Fsymbol_value (form);  
       if (NILP (val))  
         XSETFASTINT (val, 0);  
       else if (EQ (val, Qt))  
         XSETFASTINT (val, 1);  
       return val;  
     }  
1928    if (!CONSP (form))    if (!CONSP (form))
1929      return form;      return form;
1930    
# Line 2119  DEFUN ("eval", Feval, Seval, 1, 1, 0, Line 2092  DEFUN ("eval", Feval, Seval, 1, 1, 0,
2092          val = Feval (apply1 (Fcdr (fun), original_args));          val = Feval (apply1 (Fcdr (fun), original_args));
2093        else if (EQ (funcar, Qlambda))        else if (EQ (funcar, Qlambda))
2094          val = apply_lambda (fun, original_args, 1);          val = apply_lambda (fun, original_args, 1);
       else if (EQ (funcar, Qmocklisp))  
         val = ml_apply (fun, original_args);  
2095        else        else
2096          return Fsignal (Qinvalid_function, Fcons (fun, Qnil));          return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
2097      }      }
2098   done:   done:
   if (!EQ (Vmocklisp_arguments, Qt))  
     {  
       if (NILP (val))  
         XSETFASTINT (val, 0);  
       else if (EQ (val, Qt))  
         XSETFASTINT (val, 1);  
     }  
2099    lisp_eval_depth--;    lisp_eval_depth--;
2100    if (backtrace.debug_on_exit)    if (backtrace.debug_on_exit)
2101      val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));      val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
# Line 2768  usage: (funcall FUNCTION &rest ARGUMENTS Line 2732  usage: (funcall FUNCTION &rest ARGUMENTS
2732          return Fsignal (Qinvalid_function, Fcons (fun, Qnil));          return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
2733        if (EQ (funcar, Qlambda))        if (EQ (funcar, Qlambda))
2734          val = funcall_lambda (fun, numargs, args + 1);          val = funcall_lambda (fun, numargs, args + 1);
       else if (EQ (funcar, Qmocklisp))  
         val = ml_apply (fun, Flist (numargs, args + 1));  
2735        else if (EQ (funcar, Qautoload))        else if (EQ (funcar, Qautoload))
2736          {          {
2737            do_autoload (fun, args[0]);            do_autoload (fun, args[0]);
# Line 2845  funcall_lambda (fun, nargs, arg_vector) Line 2807  funcall_lambda (fun, nargs, arg_vector)
2807    int count = specpdl_ptr - specpdl;    int count = specpdl_ptr - specpdl;
2808    int i, optional, rest;    int i, optional, rest;
2809    
   if (NILP (Vmocklisp_arguments))  
     specbind (Qmocklisp_arguments, Qt);   /* t means NOT mocklisp! */  
   
2810    if (CONSP (fun))    if (CONSP (fun))
2811      {      {
2812        syms_left = XCDR (fun);        syms_left = XCDR (fun);
# Line 3350  It receives the same arguments that `sig Line 3309  It receives the same arguments that `sig
3309  The Edebug package uses this to regain control.  */);  The Edebug package uses this to regain control.  */);
3310    Vsignal_hook_function = Qnil;    Vsignal_hook_function = Qnil;
3311    
   Qmocklisp_arguments = intern ("mocklisp-arguments");  
   staticpro (&Qmocklisp_arguments);  
   DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments,  
                doc: /* While in a mocklisp function, the list of its unevaluated args.  */);  
   Vmocklisp_arguments = Qt;  
   
3312    DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal,    DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal,
3313                 doc: /* *Non-nil means call the debugger regardless of condition handlers.                 doc: /* *Non-nil means call the debugger regardless of condition handlers.
3314  Note that `debug-on-error', `debug-on-quit' and friends  Note that `debug-on-error', `debug-on-quit' and friends

Legend:
Removed from v.1.178  
changed lines
  Added in v.1.179

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26