Fix -Wimplicit warnings.
[bpt/emacs.git] / src / eval.c
index 069608b..1f4f852 100644 (file)
@@ -20,6 +20,11 @@ Boston, MA 02111-1307, USA.  */
 
 
 #include <config.h>
+
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
+
 #include "lisp.h"
 #include "blockinput.h"
 
@@ -145,9 +150,9 @@ Lisp_Object Vsignal_hook_function;
    is handled by the command loop's error handler. */
 int debug_on_quit;
 
-/* The value of num_nonmacro_input_chars as of the last time we
+/* The value of num_nonmacro_input_events as of the last time we
    started to enter the debugger.  If we decide to enter the debugger
-   again when this is still equal to num_nonmacro_input_chars, then we
+   again when this is still equal to num_nonmacro_input_events, then we
    know that the debugger itself has an error, and we should just
    signal the error instead of entering an infinite loop of debugger
    invocations.  */
@@ -162,17 +167,19 @@ Lisp_Object run_hook_with_args ();
 Lisp_Object funcall_lambda ();
 extern Lisp_Object ml_apply (); /* Apply a mocklisp function to unevaluated argument list */
 
+void
 init_eval_once ()
 {
   specpdl_size = 50;
   specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
   specpdl_ptr = specpdl;
   max_specpdl_size = 600;
-  max_lisp_eval_depth = 200;
+  max_lisp_eval_depth = 300;
 
   Vrun_hooks = Qnil;
 }
 
+void
 init_eval ()
 {
   specpdl_ptr = specpdl;
@@ -182,7 +189,7 @@ init_eval ()
   Vquit_flag = Qnil;
   debug_on_next_call = 0;
   lisp_eval_depth = 0;
-  /* This is less than the initial value of num_nonmacro_input_chars.  */
+  /* This is less than the initial value of num_nonmacro_input_events.  */
   when_entered_debugger = -1;
 }
 
@@ -195,10 +202,11 @@ call_debugger (arg)
   if (specpdl_size + 40 > max_specpdl_size)
     max_specpdl_size = specpdl_size + 40;
   debug_on_next_call = 0;
-  when_entered_debugger = num_nonmacro_input_chars;
+  when_entered_debugger = num_nonmacro_input_events;
   return apply1 (Vdebugger, arg);
 }
 
+void
 do_debug_on_call (code)
      Lisp_Object code;
 {
@@ -658,6 +666,9 @@ for the variable is `*'.")
 {
   Lisp_Object documentation;
   
+  if (!SYMBOLP (variable))
+      return Qnil;
+
   documentation = Fget (variable, Qvariable_documentation);
   if (INTEGERP (documentation) && XINT (documentation) < 0)
     return Qt;
@@ -1207,6 +1218,9 @@ See also the function `condition-case'.")
   extern int gc_in_progress;
   extern int waiting_for_input;
   Lisp_Object debugger_value;
+  Lisp_Object string;
+  Lisp_Object real_error_symbol;
+  Lisp_Object combined_data;
 
   quit_error_check ();
   immediate_quit = 0;
@@ -1217,11 +1231,16 @@ See also the function `condition-case'.")
   TOTALLY_UNBLOCK_INPUT;
 #endif
 
+  if (NILP (error_symbol))
+    real_error_symbol = Fcar (data);
+  else
+    real_error_symbol = error_symbol;
+
   /* This hook is used by edebug.  */
   if (! NILP (Vsignal_hook_function))
-    Ffuncall (Vsignal_hook_function, error_symbol, data);
+    call2 (Vsignal_hook_function, error_symbol, data);
 
-  conditions = Fget (error_symbol, Qerror_conditions);
+  conditions = Fget (real_error_symbol, Qerror_conditions);
 
   for (; handlerlist; handlerlist = handlerlist->next)
     {
@@ -1240,7 +1259,7 @@ See also the function `condition-case'.")
        {
          /* We can't return values to code which signaled an error, but we
             can continue code which has signaled a quit.  */
-         if (EQ (error_symbol, Qquit))
+         if (EQ (real_error_symbol, Qquit))
            return Qnil;
          else
            error ("Cannot return from the debugger in an error");
@@ -1253,8 +1272,9 @@ See also the function `condition-case'.")
          struct handler *h = handlerlist;
 
          handlerlist = allhandlers;
-         if (EQ (data, memory_signal_data))
-           unwind_data = memory_signal_data;
+
+         if (NILP (error_symbol))
+           unwind_data = data;
          else
            unwind_data = Fcons (error_symbol, data);
          h->chosen_clause = clause;
@@ -1266,7 +1286,14 @@ See also the function `condition-case'.")
   /* If no handler is present now, try to run the debugger,
      and if that fails, throw to top level.  */
   find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value);
-  Fthrow (Qtop_level, Qt);
+  if (catchlist != 0)
+    Fthrow (Qtop_level, Qt);
+
+  if (! NILP (error_symbol))
+    data = Fcons (error_symbol, data);
+
+  string = Ferror_message_string (data);
+  fatal (XSTRING (string)->data, 0, 0);
 }
 
 /* Return nonzero iff LIST is a non-nil atom or
@@ -1333,6 +1360,10 @@ skip_debugger (conditions, data)
 }
 
 /* Value of Qlambda means we have called debugger and user has continued.
+   There are two ways to pass SIG and DATA:
+    - SIG is the error symbol, and DATA is the rest of the data.
+    = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
+
    Store value returned from debugger into *DEBUGGER_VALUE_PTR.  */
 
 static Lisp_Object
@@ -1353,20 +1384,31 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
     {
       int count = specpdl_ptr - specpdl;
       int debugger_called = 0;
+      Lisp_Object sig_symbol, combined_data;
+
+      if (NILP (sig))
+       {
+         combined_data = data;
+         sig_symbol = Fcar (data);
+       }
+      else
+       {
+         combined_data = Fcons (sig, data);
+         sig_symbol = sig;
+       }
 
       if (wants_debugger (Vstack_trace_on_error, conditions))
        internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil);
-      if ((EQ (sig, Qquit)
+      if ((EQ (sig_symbol, Qquit)
           ? debug_on_quit
           : wants_debugger (Vdebug_on_error, conditions))
-         && ! skip_debugger (conditions, Fcons (sig, data))
-         && when_entered_debugger < num_nonmacro_input_chars)
+         && ! skip_debugger (conditions, combined_data)
+         && when_entered_debugger < num_nonmacro_input_events)
        {
          specbind (Qdebug_on_error, Qnil);
          *debugger_value_ptr
            = call_debugger (Fcons (Qerror,
-                                   Fcons (Fcons (sig, data),
-                                          Qnil)));
+                                   Fcons (combined_data, Qnil)));
          debugger_called = 1;
        }
       /* If there is no handler, return saying whether we ran the debugger.  */
@@ -1584,6 +1626,7 @@ un_autoload (oldqueue)
    FUNNAME is the symbol which is the function's name.
    FUNDEF is the autoload definition (a list).  */
 
+void
 do_autoload (fundef, funname)
      Lisp_Object fundef, funname;
 {
@@ -1598,7 +1641,7 @@ do_autoload (fundef, funname)
   /* Value saved here is to be restored into Vautoload_queue */
   record_unwind_protect (un_autoload, Vautoload_queue);
   Vautoload_queue = Qt;
-  Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil);
+  Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil, Qt);
 
   /* Save the old autoloads, in case we ever do an unload. */
   queue = Vautoload_queue;
@@ -1691,7 +1734,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
   if (SUBRP (fun))
     {
       Lisp_Object numargs;
-      Lisp_Object argvals[7];
+      Lisp_Object argvals[8];
       Lisp_Object args_left;
       register int i, maxargs;
 
@@ -1785,6 +1828,12 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
                                          argvals[6]);
          goto done;
 
+       case 8:
+         val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
+                                         argvals[3], argvals[4], argvals[5],
+                                         argvals[6], argvals[7]);
+         goto done;
+
        default:
          /* Someone has created a subr that takes more arguments than
             is supported by this code.  We need to either rewrite the
@@ -1942,8 +1991,8 @@ not `make-local-variable'.")
   return Qnil;
 }
       
-DEFUN ("run-hook-with-args",
-  Frun_hook_with_args, Srun_hook_with_args, 1, MANY, 0,
+DEFUN ("run-hook-with-args", Frun_hook_with_args,
+  Srun_hook_with_args, 1, MANY, 0,
   "Run HOOK with the specified arguments ARGS.\n\
 HOOK should be a symbol, a hook variable.  If HOOK has a non-nil\n\
 value, that value may be a function or a list of functions to be\n\
@@ -1963,9 +2012,8 @@ not `make-local-variable'.")
   return run_hook_with_args (nargs, args, to_completion);
 }
 
-DEFUN ("run-hook-with-args-until-success",
-  Frun_hook_with_args_until_success, Srun_hook_with_args_until_success,
-  1, MANY, 0,
+DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
+  Srun_hook_with_args_until_success, 1, MANY, 0,
   "Run HOOK with the specified arguments ARGS.\n\
 HOOK should be a symbol, a hook variable.  Its value should\n\
 be a list of functions.  We call those functions, one by one,\n\
@@ -1982,9 +2030,8 @@ not `make-local-variable'.")
   return run_hook_with_args (nargs, args, until_success);
 }
 
-DEFUN ("run-hook-with-args-until-failure",
-  Frun_hook_with_args_until_failure, Srun_hook_with_args_until_failure,
-  1, MANY, 0,
+DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
+  Srun_hook_with_args_until_failure, 1, MANY, 0,
   "Run HOOK with the specified arguments ARGS.\n\
 HOOK should be a symbol, a hook variable.  Its value should\n\
 be a list of functions.  We call those functions, one by one,\n\
@@ -2426,9 +2473,16 @@ Thus, (funcall 'cons 'x 'y) returns (x . y).")
                                          internal_args[6]);
          goto done;
 
+       case 8:
+         val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
+                                         internal_args[2], internal_args[3],
+                                         internal_args[4], internal_args[5],
+                                         internal_args[6], internal_args[7]);
+         goto done;
+
        default:
 
-         /* If a subr takes more than 6 arguments without using MANY
+         /* If a subr takes more than 8 arguments without using MANY
             or UNEVALLED, we need to extend this function to support it. 
             Until this is done, there is no way to call the function.  */
          abort ();
@@ -2642,12 +2696,12 @@ specbind (symbol, value)
   if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
     store_symval_forwarding (symbol, ovalue, value);
   else
-    Fset (symbol, value);
+    set_internal (symbol, value, 1);
 }
 
 void
 record_unwind_protect (function, arg)
-     Lisp_Object (*function)();
+     Lisp_Object (*function) P_ ((Lisp_Object));
      Lisp_Object arg;
 {
   if (specpdl_ptr == specpdl + specpdl_size)
@@ -2680,7 +2734,7 @@ unbind_to (count, value)
       else if (NILP (specpdl_ptr->symbol))
        Fprogn (specpdl_ptr->old_value);
       else
-        Fset (specpdl_ptr->symbol, specpdl_ptr->old_value);
+        set_internal (specpdl_ptr->symbol, specpdl_ptr->old_value, 1);
     }
   if (NILP (Vquit_flag) && quitf) Vquit_flag = Qt;
 
@@ -2847,13 +2901,16 @@ If NFRAMES is more than the number of frames, the value is nil.")
     }
 }
 \f
+void
 syms_of_eval ()
 {
   DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
-    "Limit on number of Lisp variable bindings & unwind-protects before error.");
+    "*Limit on number of Lisp variable bindings & unwind-protects.\n\
+If Lisp code tries to make more than this many at once,\n\
+an error is signaled.");
 
   DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth,
-    "Limit on depth in `eval', `apply' and `funcall' before error.\n\
+    "*Limit on depth in `eval', `apply' and `funcall' before error.\n\
 This limit is to catch infinite recursions for you before they cause\n\
 actual stack overflow in C, which would be fatal for Emacs.\n\
 You can safely make it considerably larger than its default value,\n\