xemacs-beta: src/eval.c comparison

comparison src/eval.c @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14

author	cvs
date	Mon, 13 Aug 2007 08:45:50 +0200
parents
children	ac2d302a0011

comparison

equal deleted inserted replaced

--1:000000000000
+:376386a54a3c
+/* Evaluator for XEmacs Lisp interpreter.
+Copyright (C) 1985-1987, 1992-1994 Free Software Foundation, Inc.
+Copyright (C) 1995 Sun Microsystems, Inc.
+This file is part of XEmacs.
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+/* Synched up with: FSF 19.30 (except for Fsignal), Mule 2.0. */
+/* Debugging hack */
+int always_gc;
+#include <config.h>
+#include "lisp.h"
+#ifndef standalone
+#include "commands.h"
+#endif
+#include "symeval.h"
+#include "backtrace.h"
+#include "bytecode.h"
+#include "buffer.h"
+#include "console.h"
+#include "opaque.h"
+struct backtrace *backtrace_list;
+/* This is the list of current catches (and also condition-cases).
+This is a stack: the most recent catch is at the head of the
+list.  Catches are created by declaring a 'struct catchtag'
+locally, filling the .TAG field in with the tag, and doing
+a setjmp() on .JMP.  Fthrow() will store the value passed
+to it in .VAL and longjmp() back to .JMP, back to the function
+that established the catch.  This will always be either
+internal_catch() (catches established internally or through
+`catch') or condition_case_1 (condition-cases established
+internally or through `condition-case').
+The catchtag also records the current position in the
+call stack (stored in BACKTRACE_LIST), the current position
+in the specpdl stack (used for variable bindings and
+unwind-protects), the value of LISP_EVAL_DEPTH, and the
+current position in the GCPRO stack.  All of these are
+restored by Fthrow().
+*/
+struct catchtag *catchlist;
+Lisp_Object Qautoload, Qmacro, Qexit;
+Lisp_Object Qinteractive, Qcommandp, Qdefun, Qprogn, Qvalues;
+Lisp_Object Vquit_flag, Vinhibit_quit;
+Lisp_Object Qand_rest, Qand_optional;
+Lisp_Object Qdebug_on_error;
+Lisp_Object Qstack_trace_on_error;
+Lisp_Object Qdebug_on_signal;
+Lisp_Object Qstack_trace_on_signal;
+Lisp_Object Qdebugger;
+Lisp_Object Qinhibit_quit;
+Lisp_Object Qrun_hooks;
+Lisp_Object Qsetq;
+Lisp_Object Qdisplay_warning;
+Lisp_Object Vpending_warnings, Vpending_warnings_tail;
+/* Records whether we want errors to occur.  This will be a boolean,
+nil (errors OK) or t (no errors).  If t, an error will cause a
+throw to Qunbound_suspended_errors_tag.
+See call_with_suspended_errors(). */
+Lisp_Object Vcurrent_error_state;
+/* Current warning class when warnings occur, or nil for no warnings.
+Only meaningful when Vcurrent_error_state is non-nil.
+See call_with_suspended_errors(). */
+Lisp_Object Vcurrent_warning_class;
+/* Special catch tag used in call_with_suspended_errors(). */
+Lisp_Object Qunbound_suspended_errors_tag;
+/* Non-nil means we're going down, so we better not run any hooks
+or do other non-essential stuff. */
+int preparing_for_armageddon;
+/* Non-nil means record all fset's and provide's, to be undone
+if the file being autoloaded is not fully loaded.
+They are recorded by being consed onto the front of Vautoload_queue:
+(FUN . ODEF) for a defun, (OFEATURES . nil) for a provide.  */
+Lisp_Object Vautoload_queue;
+/* Current number of specbindings allocated in specpdl.  */
+static int specpdl_size;
+/* Pointer to beginning of specpdl.  */
+struct specbinding *specpdl;
+/* Pointer to first unused element in specpdl.  */
+struct specbinding *specpdl_ptr;
+/* specpdl_ptr - specpdl.  Callers outside this this file should use
+*  specpdl_depth () function-call */
+static int specpdl_depth_counter;
+/* Maximum size allowed for specpdl allocation */
+int max_specpdl_size;
+/* Depth in Lisp evaluations and function calls.  */
+int lisp_eval_depth;
+/* Maximum allowed depth in Lisp evaluations and function calls.  */
+int max_lisp_eval_depth;
+/* Nonzero means enter debugger before next function call */
+static int debug_on_next_call;
+/* List of conditions (non-nil atom means all) which cause a backtrace
+if an error is handled by the command loop's error handler.  */
+Lisp_Object Vstack_trace_on_error;
+/* List of conditions (non-nil atom means all) which enter the debugger
+if an error is handled by the command loop's error handler.  */
+Lisp_Object Vdebug_on_error;
+/* List of conditions (non-nil atom means all) which cause a backtrace
+if any error is signalled.  */
+Lisp_Object Vstack_trace_on_signal;
+/* List of conditions (non-nil atom means all) which enter the debugger
+if any error is signalled.  */
+Lisp_Object Vdebug_on_signal;
+/* Nonzero means enter debugger if a quit signal
+is handled by the command loop's error handler.
+From lisp, this is a boolean variable and may have the values 0 and 1.
+But, eval.c temporarily uses the second bit of this variable to indicate
+that a critical_quit is in progress.  The second bit is reset immediately
+after it is processed in signal_call_debugger().  */
+int debug_on_quit;
+#if 0 /* FSFmacs */
+/* entering_debugger is basically equivalent */
+/* The value of num_nonmacro_input_chars 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
+know that the debugger itself has an error, and we should just
+signal the error instead of entering an infinite loop of debugger
+invocations.  */
+int when_entered_debugger;
+#endif
+/* Nonzero means we are trying to enter the debugger.
+This is to prevent recursive attempts.
+Cleared by the debugger calling Fbacktrace */
+static int entering_debugger;
+/* Function to call to invoke the debugger */
+Lisp_Object Vdebugger;
+/* Chain of condition handlers currently in effect.
+The elements of this chain are contained in the stack frames
+of Fcondition_case and internal_condition_case.
+When an error is signaled (by calling Fsignal, below),
+this chain is searched for an element that applies.
+Each element of this list is one of the following:
+A list of a handler function and possibly args to pass to
+the function.  This is a handler established with
+`call-with-condition-handler' (q.v.).
+A list whose car is Qunbound and whose cdr is Qt.
+This is a special condition-case handler established
+by C code with condition_case_1().  All errors are
+trapped; the debugger is not invoked even if
+`debug-on-error' was set.
+A list whose car is Qunbound and whose cdr is Qerror.
+This is a special condition-case handler established
+by C code with condition_case_1().  It is like Qt
+except that the debugger is invoked normally if it is
+called for.
+A list whose car is Qunbound and whose cdr is a list
+of lists (CONDITION-NAME BODY ...) exactly as in
+`condition-case'.  This is a normal `condition-case'
+handler.
+Note that in all cases *except* the first, there is a
+corresponding catch, whose TAG is the value of
+Vcondition_handlers just after the handler data just
+described is pushed onto it.  The reason is that
+`condition-case' handlers need to throw back to the
+place where the handler was installed before invoking
+it, while `call-with-condition-handler' handlers are
+invoked in the environment that `signal' was invoked
+in.
+*/
+static Lisp_Object Vcondition_handlers;
+/* Used for error catching purposes by throw_or_bomb_out */
+static int throw_level;
+static Lisp_Object primitive_funcall (Lisp_Object (*fn) (), int nargs,
+				      Lisp_Object args[]);
+/**********************************************************************/
+/*                 The subr and compiled-function types               */
+/**********************************************************************/
+static void print_subr (Lisp_Object, Lisp_Object, int);
+DEFINE_LRECORD_IMPLEMENTATION ("subr", subr,
+this_one_is_unmarkable, print_subr, 0, 0, 0,
+			       struct Lisp_Subr);
+static void
+print_subr (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+struct Lisp_Subr *subr = XSUBR (obj);
+if (print_readably)
+error ("printing unreadable object #<subr %s>",
+	   subr_name (subr));
+write_c_string (((subr->max_args == UNEVALLED)
+? "#<special-form "
+: "#<subr "),
+printcharfun);
+write_c_string (subr_name (subr), printcharfun);
+write_c_string (((subr->prompt) ? " (interactive)>" : ">"),
+printcharfun);
+}
+static Lisp_Object mark_compiled_function (Lisp_Object,
+					   void (*) (Lisp_Object));
+extern void print_compiled_function (Lisp_Object, Lisp_Object, int);
+static int compiled_function_equal (Lisp_Object, Lisp_Object, int);
+static unsigned long compiled_function_hash (Lisp_Object obj, int depth);
+DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function,
+				     mark_compiled_function,
+				     print_compiled_function, 0,
+				     compiled_function_equal,
+				     compiled_function_hash,
+				     struct Lisp_Compiled_Function);
+static Lisp_Object
+mark_compiled_function (Lisp_Object obj, void (*markobj) (Lisp_Object))
+{
+struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (obj);
+((markobj) (b->bytecodes));
+((markobj) (b->arglist));
+((markobj) (b->doc_and_interactive));
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+((markobj) (b->annotated));
+#endif
+/* tail-recurse on constants */
+return (b->constants);
+}
+static int
+compiled_function_equal (Lisp_Object o1, Lisp_Object o2, int depth)
+{
+struct Lisp_Compiled_Function *b1 = XCOMPILED_FUNCTION (o1);
+struct Lisp_Compiled_Function *b2 = XCOMPILED_FUNCTION (o2);
+return (b1->flags.documentationp == b2->flags.documentationp
+	  && b1->flags.interactivep == b2->flags.interactivep
+	  && b1->flags.domainp == b2->flags.domainp /* I18N3 */
+	  && internal_equal (b1->bytecodes, b2->bytecodes, depth + 1)
+	  && internal_equal (b1->constants, b2->constants, depth + 1)
+	  && internal_equal (b1->arglist, b2->arglist, depth + 1)
+	  && internal_equal (b1->doc_and_interactive,
+			     b2->doc_and_interactive, depth + 1));
+}
+static unsigned long
+compiled_function_hash (Lisp_Object obj, int depth)
+{
+struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (obj);
+return HASH3 ((b->flags.documentationp << 2) +
+		(b->flags.interactivep << 1) +
+		b->flags.domainp,
+		internal_hash (b->bytecodes, depth + 1),
+		internal_hash (b->constants, depth + 1));
+}
+/**********************************************************************/
+/*                       Entering the debugger                        */
+/**********************************************************************/
+/* unwind-protect used by call_debugger() to restore the value of
+enterring_debugger. (We cannot use specbind() because the
+variable is not Lisp-accessible.) */
+static Lisp_Object
+restore_entering_debugger (Lisp_Object arg)
+{
+entering_debugger = ((NILP (arg)) ? 0 : 1);
+return arg;
+}
+/* Actually call the debugger.  ARG is a list of args that will be
+passed to the debugger function, as follows;
+If due to frame exit, args are `exit' and the value being returned;
+this function's value will be returned instead of that.
+If due to error, args are `error' and a list of the args to `signal'.
+If due to `apply' or `funcall' entry, one arg, `lambda'.
+If due to `eval' entry, one arg, t.
+*/
+static Lisp_Object
+call_debugger_259 (Lisp_Object arg)
+{
+return apply1 (Vdebugger, arg);
+}
+/* Call the debugger, doing some encapsulation.  We make sure we have
+some room on the eval and specpdl stacks, and bind enterring_debugger
+to 1 during this call.  This is used to trap errors that may occur
+when enterring the debugger (e.g. the value of `debugger' is invalid),
+so that the debugger will not be recursively entered if debug-on-error
+is set. (Otherwise, XEmacs would infinitely recurse, attempting to
+enter the debugger.) enterring_debugger gets reset to 0 as soon
+as a backtrace is displayed, so that further errors can indeed be
+handled normally.
+We also establish a catch for 'debugger.  If the debugger function
+throws to this instead of returning a value, it means that the user
+pressed 'c' (pretend like the debugger was never entered).  The
+function then returns Qunbound. (If the user pressed 'r', for
+return a value, then the debugger function returns normally with
+this value.)
+The difference between 'c' and 'r' is as follows:
+debug-on-call:
+No difference.  The call proceeds as normal.
+debug-on-exit:
+With 'r', the specified value is returned as the function's
+return value.  With 'c', the value that would normally be
+returned is returned.
+signal:
+With 'r', the specified value is returned as the return
+value of `signal'. (This is the only time that `signal'
+can return, instead of making a non-local exit.) With `c',
+`signal' will continue looking for handlers as if the
+debugger was never entered, and will probably end up
+throwing to a handler or to top-level.
+*/
+static Lisp_Object
+call_debugger (Lisp_Object arg)
+{
+int threw;
+Lisp_Object val;
+int speccount;
+if (lisp_eval_depth + 20 > max_lisp_eval_depth)
+max_lisp_eval_depth = lisp_eval_depth + 20;
+if (specpdl_size + 40 > max_specpdl_size)
+max_specpdl_size = specpdl_size + 40;
+debug_on_next_call = 0;
+speccount = specpdl_depth_counter;
+record_unwind_protect (restore_entering_debugger,
+(entering_debugger ? Qt : Qnil));
+entering_debugger = 1;
+val = internal_catch (Qdebugger, call_debugger_259, arg, &threw);
+return (unbind_to (speccount, ((threw)
+? Qunbound /* Not returning a value */
+: val)));
+}
+/* Called when debug-on-exit behavior is called for.  Enter the debugger
+with the appropriate args for this.  VAL is the exit value that is
+about to be returned. */
+static Lisp_Object
+do_debug_on_exit (Lisp_Object val)
+{
+/* This is falsified by call_debugger */
+int old_debug_on_next_call = debug_on_next_call;
+Lisp_Object v = call_debugger (list2 (Qexit, val));
+debug_on_next_call = old_debug_on_next_call;
+return ((!UNBOUNDP (v)) ? v : val);
+}
+/* Called when debug-on-call behavior is called for.  Enter the debugger
+with the appropriate args for this.  VAL is either t for a call
+through `eval' or 'lambda for a call through `funcall'.
+#### The differentiation here between EVAL and FUNCALL is bogus.
+FUNCALL can be defined as
+(defmacro func (fun &rest args)
+(cons (eval fun) args))
+and should be treated as such.
+*/
+static void
+do_debug_on_call (Lisp_Object code)
+{
+debug_on_next_call = 0;
+backtrace_list->debug_on_exit = 1;
+call_debugger (list1 (code));
+}
+/* LIST is the value of one of the variables `debug-on-error',
+`debug-on-signal', `stack-trace-on-error', or `stack-trace-on-signal',
+and CONDITIONS is the list of error conditions associated with
+the error being signalled.  This returns non-nil if LIST
+matches CONDITIONS. (A nil value for LIST does not match
+CONDITIONS.  A non-list value for LIST does match CONDITIONS.
+A list matches CONDITIONS when one of the symbols in LIST is the
+same as one of the symbols in CONDITIONS.) */
+static int
+wants_debugger (Lisp_Object list, Lisp_Object conditions)
+{
+if (NILP (list))
+return 0;
+if (! CONSP (list))
+return 1;
+while (CONSP (conditions))
+{
+Lisp_Object this, tail;
+this = XCAR (conditions);
+for (tail = list; CONSP (tail); tail = XCDR (tail))
+	if (EQ (XCAR (tail), this))
+	  return 1;
+conditions = XCDR (conditions);
+}
+return 0;
+}
+/* Actually generate a backtrace on STREAM. */
+static Lisp_Object
+backtrace_259 (Lisp_Object stream)
+{
+return (Fbacktrace (stream, Qt));
+}
+/* An error was signalled.  Maybe call the debugger, if the `debug-on-error'
+etc. variables call for this.  CONDITIONS is the list of conditions
+associated with the error being signalled.  SIG is the actual error
+being signalled, and DATA is the associated data (these are exactly
+the same as the arguments to `signal').  ACTIVE_HANDLERS is the
+list of error handlers that are to be put in place while the debugger
+is called.  This is generally the remaining handlers that are
+outside of the innermost handler trapping this error.  This way,
+if the same error occurs inside of the debugger, you usually don't get
+the debugger entered recursively.
+This function returns Qunbound if it didn't call the debugger or if
+the user asked (through 'c') that XEmacs should pretend like the
+debugger was never entered.  Otherwise, it returns the value
+that the user specified with `r'. (Note that much of the time,
+the user will abort with C-], and we will never have a chance to
+return anything at all.)
+SIGNAL_VARS_ONLY means we should only look at debug-on-signal
+and stack-trace-on-signal to control whether we do anything.
+This is so that debug-on-error doesn't make handled errors
+cause the debugger to get invoked.
+STACK_TRACE_DISPLAYED and DEBUGGER_ENTERED are used so that
+those functions aren't done more than once in a single `signal'
+session. */
+static Lisp_Object
+signal_call_debugger (Lisp_Object conditions,
+Lisp_Object sig, Lisp_Object data,
+Lisp_Object active_handlers,
+		      int signal_vars_only,
+		      int *stack_trace_displayed,
+		      int *debugger_entered)
+{
+/* This function can GC */
+Lisp_Object val = Qunbound;
+Lisp_Object all_handlers = Vcondition_handlers;
+int speccount = specpdl_depth_counter;
+struct gcpro gcpro1;
+GCPRO1 (all_handlers);
+Vcondition_handlers = active_handlers;
+if (!entering_debugger && !*stack_trace_displayed && !signal_vars_only
+&& wants_debugger (Vstack_trace_on_error, conditions))
+{
+specbind (Qdebug_on_error, Qnil);
+specbind (Qstack_trace_on_error, Qnil);
+specbind (Qdebug_on_signal, Qnil);
+specbind (Qstack_trace_on_signal, Qnil);
+internal_with_output_to_temp_buffer ("*Backtrace*",
+					   backtrace_259,
+					   Qnil,
+					   Qnil);
+unbind_to (speccount, Qnil);
+*stack_trace_displayed = 1;
+}
+if (!entering_debugger && !*debugger_entered && !signal_vars_only
+&& (EQ (sig, Qquit)
+	  ? debug_on_quit
+	  : wants_debugger (Vdebug_on_error, conditions)))
+{
+debug_on_quit &= ~2;	/* reset critical bit */
+specbind (Qdebug_on_error, Qnil);
+specbind (Qstack_trace_on_error, Qnil);
+specbind (Qdebug_on_signal, Qnil);
+specbind (Qstack_trace_on_signal, Qnil);
+val = call_debugger (list2 (Qerror, (Fcons (sig, data))));
+*debugger_entered = 1;
+}
+if (!entering_debugger && !*stack_trace_displayed
+&& wants_debugger (Vstack_trace_on_signal, conditions))
+{
+specbind (Qdebug_on_error, Qnil);
+specbind (Qstack_trace_on_error, Qnil);
+specbind (Qdebug_on_signal, Qnil);
+specbind (Qstack_trace_on_signal, Qnil);
+internal_with_output_to_temp_buffer ("*Backtrace*",
+					   backtrace_259,
+					   Qnil,
+					   Qnil);
+unbind_to (speccount, Qnil);
+*stack_trace_displayed = 1;
+}
+if (!entering_debugger && !*debugger_entered
+&& (EQ (sig, Qquit)
+	  ? debug_on_quit
+	  : wants_debugger (Vdebug_on_signal, conditions)))
+{
+debug_on_quit &= ~2;	/* reset critical bit */
+specbind (Qdebug_on_error, Qnil);
+specbind (Qstack_trace_on_error, Qnil);
+specbind (Qdebug_on_signal, Qnil);
+specbind (Qstack_trace_on_signal, Qnil);
+val = call_debugger (list2 (Qerror, (Fcons (sig, data))));
+*debugger_entered = 1;
+}
+UNGCPRO;
+Vcondition_handlers = all_handlers;
+return (unbind_to (speccount, val));
+}
+/**********************************************************************/
+/*                     The basic special forms                        */
+/**********************************************************************/
+/* NOTE!!! Every function that can call EVAL must protect its args
+and temporaries from garbage collection while it needs them.
+The definition of `For' shows what you have to do.  */
+DEFUN ("or", For, Sor, 0, UNEVALLED, 0 /*
+Eval args until one of them yields non-nil, then return that value.
+The remaining args are not evalled at all.
+If all args return nil, return nil.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+REGISTER Lisp_Object val;
+Lisp_Object args_left;
+struct gcpro gcpro1;
+if (NILP (args))
+return Qnil;
+args_left = args;
+GCPRO1 (args_left);
+do
+{
+val = Feval (Fcar (args_left));
+if (!NILP (val))
+	break;
+args_left = Fcdr (args_left);
+}
+while (!NILP (args_left));
+UNGCPRO;
+return val;
+}
+DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0 /*
+Eval args until one of them yields nil, then return nil.
+The remaining args are not evalled at all.
+If no arg yields nil, return the last arg's value.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+REGISTER Lisp_Object val;
+Lisp_Object args_left;
+struct gcpro gcpro1;
+if (NILP (args))
+return Qt;
+args_left = args;
+GCPRO1 (args_left);
+do
+{
+val = Feval (Fcar (args_left));
+if (NILP (val))
+	break;
+args_left = Fcdr (args_left);
+}
+while (!NILP (args_left));
+UNGCPRO;
+return val;
+}
+DEFUN ("if", Fif, Sif, 2, UNEVALLED, 0 /*
+(if COND THEN ELSE...): if COND yields non-nil, do THEN, else do ELSE...
+Returns the value of THEN or the value of the last of the ELSE's.
+THEN must be one expression, but ELSE... can be zero or more expressions.
+If COND yields nil, and there are no ELSE's, the value is nil.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+Lisp_Object cond;
+struct gcpro gcpro1;
+GCPRO1 (args);
+cond = Feval (Fcar (args));
+UNGCPRO;
+if (!NILP (cond))
+return Feval (Fcar (Fcdr (args)));
+return Fprogn (Fcdr (Fcdr (args)));
+}
+DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0 /*
+(cond CLAUSES...): try each clause until one succeeds.
+Each clause looks like (CONDITION BODY...).  CONDITION is evaluated
+and, if the value is non-nil, this clause succeeds:
+then the expressions in BODY are evaluated and the last one's
+value is the value of the cond-form.
+If no clause succeeds, cond returns nil.
+If a clause has one element, as in (CONDITION),
+CONDITION's value if non-nil is returned from the cond-form.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+REGISTER Lisp_Object clause, val;
+struct gcpro gcpro1;
+val = Qnil;
+GCPRO1 (args);
+while (!NILP (args))
+{
+clause = Fcar (args);
+val = Feval (Fcar (clause));
+if (!NILP (val))
+	{
+	  if (!EQ (XCDR (clause), Qnil))
+	    val = Fprogn (XCDR (clause));
+	  break;
+	}
+args = XCDR (args);
+}
+UNGCPRO;
+return val;
+}
+DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0 /*
+(progn BODY...): eval BODY forms sequentially and return value of last one.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+REGISTER Lisp_Object val;
+Lisp_Object args_left;
+struct gcpro gcpro1;
+#ifdef MOCKLISP_SUPPORT
+/* In Mucklisp code, symbols at the front of the progn arglist
+are to be bound to zero. */
+if (!EQ (Vmocklisp_arguments, Qt))
+{
+Lisp_Object tem;
+val = Qzero;
+while (!NILP (args) && (tem = Fcar (args), SYMBOLP (tem)))
+	{
+	  QUIT;
+	  specbind (tem, val), args = Fcdr (args);
+	}
+}
+#endif
+if (NILP (args))
+return Qnil;
+args_left = args;
+GCPRO1 (args_left);
+do
+{
+val = Feval (Fcar (args_left));
+args_left = Fcdr (args_left);
+}
+while (!NILP (args_left));
+UNGCPRO;
+return val;
+}
+DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0 /*
+(prog1 FIRST BODY...): eval FIRST and BODY sequentially; value from FIRST.
+The value of FIRST is saved during the evaluation of the remaining args,
+whose values are discarded.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+Lisp_Object val;
+REGISTER Lisp_Object args_left;
+struct gcpro gcpro1, gcpro2;
+REGISTER int argnum = 0;
+if (NILP (args))
+return Qnil;
+args_left = args;
+val = Qnil;
+GCPRO2 (args, val);
+do
+{
+if (!(argnum++))
+val = Feval (Fcar (args_left));
+else
+	Feval (Fcar (args_left));
+args_left = Fcdr (args_left);
+}
+while (!NILP (args_left));
+UNGCPRO;
+return val;
+}
+DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0 /*
+(prog2 X Y BODY...): eval X, Y and BODY sequentially; value from Y.
+The value of Y is saved during the evaluation of the remaining args,
+whose values are discarded.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+Lisp_Object val;
+REGISTER Lisp_Object args_left;
+struct gcpro gcpro1, gcpro2;
+REGISTER int argnum = -1;
+val = Qnil;
+if (NILP (args))
+return Qnil;
+args_left = args;
+val = Qnil;
+GCPRO2 (args, val);
+do
+{
+if (!(argnum++))
+val = Feval (Fcar (args_left));
+else
+	Feval (Fcar (args_left));
+args_left = Fcdr (args_left);
+}
+while (!NILP (args_left));
+UNGCPRO;
+return val;
+}
+DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0 /*
+(let* VARLIST BODY...): bind variables according to VARLIST then eval BODY.
+The value of the last form in BODY is returned.
+Each element of VARLIST is a symbol (which is bound to nil)
+or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
+Each VALUEFORM can refer to the symbols already bound by this VARLIST.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+Lisp_Object varlist, val, elt;
+int speccount = specpdl_depth_counter;
+struct gcpro gcpro1, gcpro2, gcpro3;
+GCPRO3 (args, elt, varlist);
+varlist = Fcar (args);
+while (!NILP (varlist))
+{
+QUIT;
+elt = Fcar (varlist);
+if (SYMBOLP (elt))
+	specbind (elt, Qnil);
+else if (! NILP (Fcdr (Fcdr (elt))))
+	signal_simple_error ("`let' bindings can have only one value-form",
+elt);
+else
+	{
+	  val = Feval (Fcar (Fcdr (elt)));
+	  specbind (Fcar (elt), val);
+	}
+varlist = Fcdr (varlist);
+}
+UNGCPRO;
+val = Fprogn (Fcdr (args));
+return unbind_to (speccount, val);
+}
+DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0 /*
+(let VARLIST BODY...): bind variables according to VARLIST then eval BODY.
+The value of the last form in BODY is returned.
+Each element of VARLIST is a symbol (which is bound to nil)
+or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
+All the VALUEFORMs are evalled before any symbols are bound.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+Lisp_Object *temps, tem;
+REGISTER Lisp_Object elt, varlist;
+int speccount = specpdl_depth_counter;
+REGISTER int argnum;
+struct gcpro gcpro1, gcpro2;
+varlist = Fcar (args);
+/* Make space to hold the values to give the bound variables */
+elt = Flength (varlist);
+temps = (Lisp_Object *) alloca (XINT (elt) * sizeof (Lisp_Object));
+/* Compute the values and store them in `temps' */
+GCPRO2 (args, *temps);
+gcpro2.nvars = 0;
+for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist))
+{
+QUIT;
+elt = Fcar (varlist);
+if (SYMBOLP (elt))
+	temps [argnum++] = Qnil;
+else if (! NILP (Fcdr (Fcdr (elt))))
+	signal_simple_error ("`let' bindings can have only one value-form",
+elt);
+else
+	temps [argnum++] = Feval (Fcar (Fcdr (elt)));
+gcpro2.nvars = argnum;
+}
+UNGCPRO;
+varlist = Fcar (args);
+for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist))
+{
+elt = Fcar (varlist);
+tem = temps[argnum++];
+if (SYMBOLP (elt))
+	specbind (elt, tem);
+else
+	specbind (Fcar (elt), tem);
+}
+elt = Fprogn (Fcdr (args));
+return unbind_to (speccount, elt);
+}
+DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0 /*
+(while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat.
+The order of execution is thus TEST, BODY, TEST, BODY and so on
+until TEST returns nil.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+Lisp_Object test, body, tem;
+struct gcpro gcpro1, gcpro2;
+GCPRO2 (test, body);
+test = Fcar (args);
+body = Fcdr (args);
+#ifdef MOCKLISP_SUPPORT
+while (tem = Feval (test),
+	 (!EQ (Vmocklisp_arguments, Qt) ? XINT (tem) : !NILP (tem)))
+#else
+while (tem = Feval (test), !NILP (tem))
+#endif
+{
+QUIT;
+Fprogn (body);
+}
+UNGCPRO;
+return Qnil;
+}
+Lisp_Object Qsetq;
+DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0 /*
+(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL.
+The symbols SYM are variables; they are literal (not evaluated).
+The values VAL are expressions; they are evaluated.
+Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
+The second VAL is not computed until after the first SYM is set, and so on;
+each VAL can use the new value of variables set earlier in the `setq'.
+The return value of the `setq' form is the value of the last VAL.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+REGISTER Lisp_Object args_left;
+REGISTER Lisp_Object val, sym;
+struct gcpro gcpro1;
+if (NILP (args))
+return Qnil;
+val = Flength (args);
+if (XINT (val) & 1)           /* Odd number of arguments? */
+Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, val));
+args_left = args;
+GCPRO1 (args);
+do
+{
+val = Feval (Fcar (Fcdr (args_left)));
+sym = Fcar (args_left);
+Fset (sym, val);
+args_left = Fcdr (Fcdr (args_left));
+}
+while (!NILP (args_left));
+UNGCPRO;
+return val;
+}
+DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0 /*
+Return the argument, without evaluating it.  `(quote x)' yields `x'.
+*/ )
+(args)
+Lisp_Object args;
+{
+return Fcar (args);
+}
+DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0 /*
+Like `quote', but preferred for objects which are functions.
+In byte compilation, `function' causes its argument to be compiled.
+`quote' cannot do that.
+*/ )
+(args)
+Lisp_Object args;
+{
+return Fcar (args);
+}
+/**********************************************************************/
+/*                     Defining functions/variables                   */
+/**********************************************************************/
+DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0 /*
+(defun NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
+The definition is (lambda ARGLIST [DOCSTRING] BODY...).
+See also the function `interactive'.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+Lisp_Object fn_name;
+Lisp_Object defn;
+fn_name = Fcar (args);
+defn = Fcons (Qlambda, Fcdr (args));
+if (purify_flag)
+defn = Fpurecopy (defn);
+Ffset (fn_name, defn);
+LOADHIST_ATTACH (fn_name);
+return fn_name;
+}
+DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0 /*
+(defmacro NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.
+The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).
+When the macro is called, as in (NAME ARGS...),
+the function (lambda ARGLIST BODY...) is applied to
+the list ARGS... as it appears in the expression,
+and the result should be a form to be evaluated instead of the original.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+Lisp_Object fn_name;
+Lisp_Object defn;
+fn_name = Fcar (args);
+defn = Fcons (Qmacro, Fcons (Qlambda, Fcdr (args)));
+if (purify_flag)
+defn = Fpurecopy (defn);
+Ffset (fn_name, defn);
+LOADHIST_ATTACH (fn_name);
+return fn_name;
+}
+DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0 /*
+(defvar SYMBOL INITVALUE DOCSTRING): define SYMBOL as a variable.
+You are not required to define a variable in order to use it,
+but the definition can supply documentation and an initial value
+in a way that tags can recognize.
+INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is
+void. (However, when you evaluate a defvar interactively, it acts like a
+defconst: SYMBOL's value is always set regardless of whether it's currently
+void.)
+If SYMBOL is buffer-local, its default value is what is set;
+buffer-local values are not affected.
+INITVALUE and DOCSTRING are optional.
+If DOCSTRING starts with *, this variable is identified as a user option.
+This means that M-x set-variable and M-x edit-options recognize it.
+If INITVALUE is missing, SYMBOL's value is not set.
+In lisp-interaction-mode defvar is treated as defconst.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+REGISTER Lisp_Object sym, tem, tail;
+sym = Fcar (args);
+tail = Fcdr (args);
+if (!NILP (Fcdr (Fcdr (tail))))
+error ("too many arguments");
+if (!NILP (tail))
+{
+tem = Fdefault_boundp (sym);
+if (NILP (tem))
+	Fset_default (sym, Feval (Fcar (Fcdr (args))));
+}
+#ifdef I18N3
+if (!NILP (Vfile_domain))
+pure_put (sym, Qvariable_domain, Vfile_domain);
+#endif
+tail = Fcdr (Fcdr (args));
+if (!NILP (Fcar (tail)))
+{
+tem = Fcar (tail);
+#if 0 /* FSFmacs */
+/* #### We should probably do this but it might be dangerous */
+if (purify_flag)
+	tem = Fpurecopy (tem);
+Fput (sym, Qvariable_documentation, tem);
+#else
+pure_put (sym, Qvariable_documentation, tem);
+#endif
+}
+LOADHIST_ATTACH (sym);
+return sym;
+}
+DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0 /*
+(defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant
+variable.
+The intent is that programs do not change this value, but users may.
+Always sets the value of SYMBOL to the result of evalling INITVALUE.
+If SYMBOL is buffer-local, its default value is what is set;
+buffer-local values are not affected.
+DOCSTRING is optional.
+If DOCSTRING starts with *, this variable is identified as a user option.
+This means that M-x set-variable and M-x edit-options recognize it.
+Note: do not use `defconst' for user options in libraries that are not
+normally loaded, since it is useful for users to be able to specify
+their own values for such variables before loading the library.
+Since `defconst' unconditionally assigns the variable,
+it would override the user's choice.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+REGISTER Lisp_Object sym, tem;
+sym = Fcar (args);
+if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
+error ("too many arguments");
+Fset_default (sym, Feval (Fcar (Fcdr (args))));
+#ifdef I18N3
+if (!NILP (Vfile_domain))
+pure_put (sym, Qvariable_domain, Vfile_domain);
+#endif
+tem = Fcar (Fcdr (Fcdr (args)));
+if (!NILP (tem))
+#if 0 /* FSFmacs */
+/* #### We should probably do this but it might be dangerous */
+{
+if (purify_flag)
+	tem = Fpurecopy (tem);
+Fput (sym, Qvariable_documentation, tem);
+}
+#else
+pure_put (sym, Qvariable_documentation, tem);
+#endif
+LOADHIST_ATTACH (sym);
+return sym;
+}
+DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0 /*
+Return t if VARIABLE is intended to be set and modified by users.
+\(The alternative is a variable used internally in a Lisp program.)
+Determined by whether the first character of the documentation
+for the variable is `*'.
+*/ )
+(variable)
+Lisp_Object variable;
+{
+Lisp_Object documentation;
+documentation = Fget (variable, Qvariable_documentation, Qnil);
+if (INTP (documentation) && XINT (documentation) < 0)
+return Qt;
+if ((STRINGP (documentation)) &&
+(string_byte (XSTRING (documentation), 0) == '*'))
+return Qt;
+/* If it is (STRING . INTEGER), a negative integer means a user variable.  */
+if (CONSP (documentation)
+&& STRINGP (XCAR (documentation))
+&& INTP (XCDR (documentation))
+&& XINT (XCDR (documentation)) < 0)
+return Qt;
+return Qnil;
+}
+DEFUN ("macroexpand-internal", Fmacroexpand_internal, Smacroexpand_internal,
+1, 2, 0 /*
+Return result of expanding macros at top level of FORM.
+If FORM is not a macro call, it is returned unchanged.
+Otherwise, the macro is expanded and the expansion is considered
+in place of FORM.  When a non-macro-call results, it is returned.
+The second optional arg ENVIRONMENT species an environment of macro
+definitions to shadow the loaded ones for use in file byte-compilation.
+*/ )
+(form, env)
+Lisp_Object form;
+Lisp_Object env;
+{
+/* This function can GC */
+/* With cleanups from Hallvard Furuseth.  */
+REGISTER Lisp_Object expander, sym, def, tem;
+while (1)
+{
+/* Come back here each time we expand a macro call,
+	 in case it expands into another macro call.  */
+if (!CONSP (form))
+	break;
+/* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
+def = sym = XCAR (form);
+tem = Qnil;
+/* Trace symbols aliases to other symbols
+	 until we get a symbol that is not an alias.  */
+while (SYMBOLP (def))
+	{
+	  QUIT;
+	  sym = def;
+	  tem = Fassq (sym, env);
+	  if (NILP (tem))
+	    {
+	      def = XSYMBOL (sym)->function;
+	      if (!UNBOUNDP (def))
+		continue;
+	    }
+	  break;
+	}
+/* Right now TEM is the result from SYM in ENV,
+	 and if TEM is nil then DEF is SYM's function definition.  */
+if (NILP (tem))
+	{
+	  /* SYM is not mentioned in ENV.
+	     Look at its function definition.  */
+	  if (UNBOUNDP (def)
+	      || !CONSP (def))
+	    /* Not defined or definition not suitable */
+	    break;
+	  if (EQ (XCAR (def), Qautoload))
+	    {
+	      /* Autoloading function: will it be a macro when loaded?  */
+	      tem = Felt (def, make_int (4));
+	      if (EQ (tem, Qt) || EQ (tem, Qmacro))
+		{
+		  /* Yes, load it and try again.  */
+		  do_autoload (def, sym);
+		  continue;
+		}
+	      else
+		break;
+	    }
+	  else if (!EQ (XCAR (def), Qmacro))
+	    break;
+	  else expander = XCDR (def);
+	}
+else
+	{
+	  expander = XCDR (tem);
+	  if (NILP (expander))
+	    break;
+	}
+form = apply1 (expander, XCDR (form));
+}
+return form;
+}
+/**********************************************************************/
+/*                          Non-local exits                           */
+/**********************************************************************/
+DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0 /*
+(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'.
+TAG is evalled to get the tag to use.  Then the BODY is executed.
+Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'.
+If no throw happens, `catch' returns the value of the last BODY form.
+If a throw happens, it specifies the value to return from `catch'.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+Lisp_Object tag;
+struct gcpro gcpro1;
+GCPRO1 (args);
+tag = Feval (Fcar (args));
+UNGCPRO;
+return internal_catch (tag, Fprogn, Fcdr (args), 0);
+}
+/* Set up a catch, then call C function FUNC on argument ARG.
+FUNC should return a Lisp_Object.
+This is how catches are done from within C code. */
+Lisp_Object
+internal_catch (Lisp_Object tag,
+Lisp_Object (*func) (Lisp_Object arg),
+Lisp_Object arg,
+int *threw)
+{
+/* This structure is made part of the chain `catchlist'.  */
+struct catchtag c;
+/* Fill in the components of c, and put it on the list.  */
+c.next = catchlist;
+c.tag = tag;
+c.val = Qnil;
+c.backlist = backtrace_list;
+#if 0 /* FSFmacs */
+/* #### */
+c.handlerlist = handlerlist;
+#endif
+c.lisp_eval_depth = lisp_eval_depth;
+c.pdlcount = specpdl_depth_counter;
+#if 0 /* FSFmacs */
+c.poll_suppress_count = async_timer_suppress_count;
+#endif
+c.gcpro = gcprolist;
+catchlist = &c;
+/* Call FUNC.  */
+if (SETJMP (c.jmp))
+{
+/* Throw works by a longjmp that comes right here.  */
+if (threw) *threw = 1;
+return (c.val);
+}
+c.val = (*func) (arg);
+if (threw) *threw = 0;
+catchlist = c.next;
+return (c.val);
+}
+/* Unwind the specbind, catch, and handler stacks back to CATCH, and
+jump to that CATCH, returning VALUE as the value of that catch.
+This is the guts Fthrow and Fsignal; they differ only in the way
+they choose the catch tag to throw to.  A catch tag for a
+condition-case form has a TAG of Qnil.
+Before each catch is discarded, unbind all special bindings and
+execute all unwind-protect clauses made above that catch.  Unwind
+the handler stack as we go, so that the proper handlers are in
+effect for each unwind-protect clause we run.  At the end, restore
+some static info saved in CATCH, and longjmp to the location
+specified in the
+This is used for correct unwinding in Fthrow and Fsignal.  */
+static void
+unwind_to_catch (struct catchtag *c, Lisp_Object val)
+{
+#if 0 /* FSFmacs */
+/* #### */
+register int last_time;
+#endif
+/* Unwind the specbind, catch, and handler stacks back to CATCH
+Before each catch is discarded, unbind all special bindings
+and execute all unwind-protect clauses made above that catch.
+At the end, restore some static info saved in CATCH,
+and longjmp to the location specified.
+*/
+/* Save the value somewhere it will be GC'ed.
+(Can't overwrite tag slot because an unwind-protect may
+want to throw to this same tag, which isn't yet invalid.) */
+c->val = val;
+#if 0 /* FSFmacs */
+/* Restore the polling-suppression count.  */
+set_poll_suppress_count (catch->poll_suppress_count);
+#endif
+#if 0 /* FSFmacs */
+/* #### FSFmacs has the following loop.  Is it more correct? */
+do
+{
+last_time = catchlist == c;
+/* Unwind the specpdl stack, and then restore the proper set of
+handlers.  */
+unbind_to (catchlist->pdlcount, Qnil);
+handlerlist = catchlist->handlerlist;
+catchlist = catchlist->next;
+}
+while (! last_time);
+#else /* Actual XEmacs code */
+/* Unwind the specpdl stack */
+unbind_to (c->pdlcount, Qnil);
+catchlist = c->next;
+#endif
+gcprolist = c->gcpro;
+backtrace_list = c->backlist;
+lisp_eval_depth = c->lisp_eval_depth;
+throw_level = 0;
+LONGJMP (c->jmp, 1);
+}
+static DOESNT_RETURN
+throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p,
+		   Lisp_Object sig, Lisp_Object data)
+{
+/* die if we recurse more than is reasonable */
+if (++throw_level > 20)
+abort();
+/* If bomb_out_p is t, this is being called from Fsignal as a
+"last resort" when there is no handler for this error and
+the debugger couldn't be invoked, so we are throwing to
+'top-level.  If this tag doesn't exist (happens during the
+initialization stages) we would get in an infinite recursive
+Fsignal/Fthrow loop, so instead we bomb out to the
+really-early-error-handler.
+Note that in fact the only time that the "last resort"
+occurs is when there's no catch for 'top-level -- the
+'top-level catch and the catch-all error handler are
+established at the same time, in initial_command_loop/
+top_level_1.
+#### Fix this horrifitude!
+*/
+while (1)
+{
+REGISTER struct catchtag *c;
+#if 0 /* FSFmacs */
+if (!NILP (tag)) /* #### */
+#endif
+for (c = catchlist; c; c = c->next)
+	{
+	  if (EQ (c->tag, tag))
+	    unwind_to_catch (c, val);
+	}
+if (!bomb_out_p)
+tag = Fsignal (Qno_catch, list2 (tag, val));
+else
+call1 (Qreally_early_error_handler, Fcons (sig, data));
+}
+/* can't happen.  who cares? - (Sun's compiler does) */
+/* throw_level--; */
+/* getting tired of compilation warnings */
+/* return Qnil; */
+}
+/* See above, where CATCHLIST is defined, for a description of how
+Fthrow() works.
+Fthrow() is also called by Fsignal(), to do a non-local jump
+back to the appropriate condition-case handler after (maybe)
+the debugger is entered.  In that case, TAG is the value
+of Vcondition_handlers that was in place just after the
+condition-case handler was set up.  The car of this will be
+some data referring to the handler: Its car will be Qunbound
+(thus, this tag can never be generated by Lisp code), and
+its CDR will be the HANDLERS argument to condition_case_1()
+(either Qerror, Qt, or a list of handlers as in `condition-case').
+This works fine because Fthrow() does not care what TAG was
+passed to it: it just looks up the catch list for something
+that is EQ() to TAG.  When it finds it, it will longjmp()
+back to the place that established the catch (in this case,
+condition_case_1).  See below for more info.
+*/
+DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0 /*
+(throw TAG VALUE): throw to the catch for TAG and return VALUE from it.
+Both TAG and VALUE are evalled.
+*/ )
+(tag, val)
+Lisp_Object tag, val;
+{
+throw_or_bomb_out (tag, val, 0, Qnil, Qnil); /* Doesn't return */
+return Qnil;
+}
+DEFUN ("unwind-protect", Funwind_protect, Sunwind_protect, 1, UNEVALLED, 0 /*
+Do BODYFORM, protecting with UNWINDFORMS.
+Usage looks like (unwind-protect BODYFORM UNWINDFORMS...).
+If BODYFORM completes normally, its value is returned
+after executing the UNWINDFORMS.
+If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+Lisp_Object val;
+int speccount = specpdl_depth_counter;
+record_unwind_protect (Fprogn, Fcdr (args));
+val = Feval (Fcar (args));
+return unbind_to (speccount, val);
+}
+/**********************************************************************/
+/*                    Signalling and trapping errors                  */
+/**********************************************************************/
+static Lisp_Object
+condition_bind_unwind (Lisp_Object loser)
+{
+struct Lisp_Cons *victim;
+/* ((handler-fun . handler-args) ... other handlers) */
+Lisp_Object tem = XCAR (loser);
+while (CONSP (tem))
+{
+victim = XCONS (tem);
+tem = victim->cdr;
+free_cons (victim);
+}
+victim = XCONS (loser);
+if (EQ (loser, Vcondition_handlers)) /* may have been rebound to some tail */
+Vcondition_handlers = victim->cdr;
+free_cons (victim);
+return (Qnil);
+}
+static Lisp_Object
+condition_case_unwind (Lisp_Object loser)
+{
+struct Lisp_Cons *victim;
+/* ((<unbound> . clauses) ... other handlers */
+victim = XCONS (XCAR (loser));
+free_cons (victim);
+victim = XCONS (loser);
+if (EQ (loser, Vcondition_handlers)) /* may have been rebound to some tail */
+Vcondition_handlers = victim->cdr;
+free_cons (victim);
+return (Qnil);
+}
+/* Split out from condition_case_3 so that primitive C callers
+don't have to cons up a lisp handler form to be evaluated. */
+/* Call a function BFUN of one argument BARG, trapping errors as
+specified by HANDLERS.  If no error occurs that is indicated by
+HANDLERS as something to be caught, the return value of this
+function is the return value from BFUN.  If such an error does
+occur, HFUN is called, and its return value becomes the
+return value of condition_case_1().  The second argument passed
+to HFUN will always be HARG.  The first argument depends on
+HANDLERS:
+If HANDLERS is Qt, all errors (this includes QUIT, but not
+non-local exits with `throw') cause HFUN to be invoked, and VAL
+(the first argument to HFUN) is a cons (SIG . DATA) of the
+arguments passed to `signal'.  The debugger is not invoked even if
+`debug-on-error' was set.
+A HANDLERS value of Qerror is the same as Qt except that the
+debugger is invoked if `debug-on-error' was set.
+Otherwise, HANDLERS should be a list of lists (CONDITION-NAME BODY ...)
+exactly as in `condition-case', and errors will be trapped
+as indicated in HANDLERS.  VAL (the first argument to HFUN) will
+be a cons whose car is the cons (SIG . DATA) and whose CDR is the
+list (BODY ...) from the appropriate slot in HANDLERS.
+This function pushes HANDLERS onto the front of Vcondition_handlers
+(actually with a Qunbound marker as well -- see Fthrow() above
+for why), establishes a catch whose tag is this new value of
+Vcondition_handlers, and calls BFUN.  When Fsignal() is called,
+it calls Fthrow(), setting TAG to this same new value of
+Vcondition_handlers and setting VAL to the same thing that will
+be passed to HFUN, as above.  Fthrow() longjmp()s back to the
+jump point we just established, and we in turn just call the
+HFUN and return its value.
+For a real condition-case, HFUN will always be
+run_condition_case_handlers() and HARG is the argument VAR
+to condition-case.  That function just binds VAR to the cons
+(SIG . DATA) that is the CAR of VAL, and calls the handler
+(BODY ...) that is the CDR of VAL.  Note that before calling
+Fthrow(), Fsignal() restored Vcondition_handlers to the value
+it had *before* condition_case_1() was called.  This maintains
+consistency (so that the state of things at exit of
+condition_case_1() is the same as at entry), and implies
+that the handler can signal the same error again (possibly
+after processing of its own), without getting in an infinite
+loop. */
+Lisp_Object
+condition_case_1 (Lisp_Object handlers,
+Lisp_Object (*bfun) (Lisp_Object barg),
+Lisp_Object barg,
+Lisp_Object (*hfun) (Lisp_Object val, Lisp_Object harg),
+Lisp_Object harg)
+{
+int speccount = specpdl_depth_counter;
+struct catchtag c;
+struct gcpro gcpro1;
+#if 0 /* FSFmacs */
+c.tag = Qnil;
+#else
+/* Do consing now so out-of-memory error happens up front */
+/* (unbound . stuff) is a special condition-case kludge marker
+which is known specially by Fsignal.
+This is an abomination, but to fix it would require either
+making condition_case cons (a union of the conditions of the clauses)
+or changing the byte-compiler output (no thanks). */
+c.tag = noseeum_cons (noseeum_cons (Qunbound, handlers),
+			Vcondition_handlers);
+#endif
+c.val = Qnil;
+c.backlist = backtrace_list;
+#if 0 /* FSFmacs */
+/* #### */
+c.handlerlist = handlerlist;
+#endif
+c.lisp_eval_depth = lisp_eval_depth;
+c.pdlcount = specpdl_depth_counter;
+#if 0 /* FSFmacs */
+c.poll_suppress_count = async_timer_suppress_count;
+#endif
+c.gcpro = gcprolist;
+/* #### FSFmacs does the following statement *after* the setjmp(). */
+c.next = catchlist;
+if (SETJMP (c.jmp))
+{
+/* throw does ungcpro, etc */
+return ((*hfun) (c.val, harg));
+}
+record_unwind_protect (condition_case_unwind, c.tag);
+catchlist = &c;
+#if 0 /* FSFmacs */
+h.handler = handlers;
+h.var = Qnil;
+h.next = handlerlist;
+h.tag = &c;
+handlerlist = &h;
+#else
+Vcondition_handlers = c.tag;
+#endif
+GCPRO1 (harg);                /* Somebody has to gc-protect */
+c.val = ((*bfun) (barg));
+/* The following is *not* true: (ben)
+ungcpro, restoring catchlist and condition_handlers are actually
+redundant since unbind_to now restores them.  But it looks funny not to
+have this code here, and it doesn't cost anything, so I'm leaving it.*/
+UNGCPRO;
+catchlist = c.next;
+Vcondition_handlers = XCDR (c.tag);
+return (unbind_to (speccount, c.val));
+}
+static Lisp_Object
+run_condition_case_handlers (Lisp_Object val, Lisp_Object var)
+{
+/* This function can GC */
+#if 0 /* FSFmacs */
+if (!NILP (h.var))
+specbind (h.var, c.val);
+val = Fprogn (Fcdr (h.chosen_clause));
+/* Note that this just undoes the binding of h.var; whoever
+longjumped to us unwound the stack to c.pdlcount before
+throwing. */
+unbind_to (c.pdlcount, Qnil);
+return val;
+#else
+int speccount;
+if (NILP (var))
+return (Fprogn (Fcdr (val))); /* tailcall */
+speccount = specpdl_depth_counter;
+specbind (var, Fcar (val));
+val = Fprogn (Fcdr (val));
+return unbind_to (speccount, val);
+#endif
+}
+/* Here for bytecode to call non-consfully.  This is exactly like
+condition-case except that it takes three arguments rather
+than a single list of arguments. */
+Lisp_Object
+Fcondition_case_3 (Lisp_Object bodyform,
+Lisp_Object var, Lisp_Object handlers)
+{
+/* This function can GC */
+Lisp_Object val;
+CHECK_SYMBOL (var);
+for (val = handlers; ! NILP (val); val = Fcdr (val))
+{
+Lisp_Object tem;
+tem = Fcar (val);
+if ((!NILP (tem))
+&& (!CONSP (tem)
+	      || (!SYMBOLP (XCAR (tem)) && !CONSP (XCAR (tem)))))
+	signal_simple_error ("Invalid condition handler", tem);
+}
+return condition_case_1 (handlers,
+Feval, bodyform,
+run_condition_case_handlers,
+var);
+}
+DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0 /*
+Regain control when an error is signalled.
+Usage looks like (condition-case VAR BODYFORM HANDLERS...).
+executes BODYFORM and returns its value if no error happens.
+Each element of HANDLERS looks like (CONDITION-NAME BODY...)
+where the BODY is made of Lisp expressions.
+A handler is applicable to an error if CONDITION-NAME is one of the
+error's condition names.  If an error happens, the first applicable
+handler is run.  As a special case, a CONDITION-NAME of t matches
+all errors, even those without the `error' condition name on them
+(e.g. `quit').
+The car of a handler may be a list of condition names
+instead of a single condition name.
+When a handler handles an error,
+control returns to the condition-case and the handler BODY... is executed
+with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).
+VAR may be nil; then you do not get access to the signal information.
+The value of the last BODY form is returned from the condition-case.
+See also the function `signal' for more info.
+Note that at the time the condition handler is invoked, the Lisp stack
+and the current catches, condition-cases, and bindings have all been
+popped back to the state they were in just before the call to
+`condition-case'.  This means that resignalling the error from
+within the handler will not result in an infinite loop.
+If you want to establish an error handler that is called with the
+Lisp stack, bindings, etc. as they were when `signal' was called,
+rather than when the handler was set, use `call-with-condition-handler'.
+*/ )
+(args)
+Lisp_Object args;
+{
+/* This function can GC */
+return Fcondition_case_3 (Fcar (Fcdr (args)),
+Fcar (args),
+Fcdr (Fcdr (args)));
+}
+DEFUN ("call-with-condition-handler",
+Fcall_with_condition_handler,
+Scall_with_condition_handler, 2, MANY, 0 /*
+Regain control when an error is signalled, without popping the stack.
+Usage looks like (call-with-condition-handler HANDLER FUNCTION &rest ARGS).
+This function is similar to `condition-case', but the handler is invoked
+with the same environment (Lisp stack, bindings, catches, condition-cases)
+that was current when `signal' was called, rather than when the handler
+was established.
+HANDLER should be a function of one argument, which is a cons of the args
+(SIG . DATA) that were passed to `signal'.  It is invoked whenever
+`signal' is called (this differs from `condition-case', which allows
+you to specify which errors are trapped).  If the handler function
+returns, `signal' continues as if the handler were never invoked.
+(It continues to look for handlers established earlier than this one,
+and invokes the standard error-handler if none is found.)
+*/ )
+(nargs, args)                 /* Note!  Args side-effected! */
+int nargs;
+Lisp_Object *args;
+{
+/* This function can GC */
+int speccount = specpdl_depth_counter;
+Lisp_Object tem;
+/* #### If there were a way to check that args[0] were a function
+which accepted one arg, that should be done here ... */
+/* (handler-fun . handler-args) */
+tem =	noseeum_cons (list1 (args[0]), Vcondition_handlers);
+record_unwind_protect (condition_bind_unwind, tem);
+Vcondition_handlers = tem;
+/* Caller should have GC-protected args */
+tem = Ffuncall (nargs - 1, args + 1);
+return (unbind_to (speccount, tem));
+}
+static int
+condition_type_p (Lisp_Object type, Lisp_Object conditions)
+{
+if (EQ (type, Qt))
+/* (condition-case c # (t c)) catches -all- signals
+*   Use with caution! */
+return (1);
+else
+{
+if (SYMBOLP (type))
+	{
+	  return (!NILP (Fmemq (type, conditions)));
+	}
+else if (CONSP (type))
+	{
+	  while (CONSP (type))
+	    {
+	      if (!NILP (Fmemq (Fcar (type), conditions)))
+		return 1;
+	      type = XCDR (type);
+	    }
+	  return 0;
+	}
+else
+	return 0;
+}
+}
+static Lisp_Object
+return_from_signal (Lisp_Object value)
+{
+#if 1 /* RMS Claims: */
+/* Most callers are not prepared to handle gc if this
+returns.  So, since this feature is not very useful,
+take it out.  */
+/* Have called debugger; return value to signaller  */
+return (value);
+#else  /* But the reality is that that stinks, because: */
+/* GACK!!! Really want some way for debug-on-quit errors
+to be continuable!! */
+error ("Returning a value from an error is no longer supported");
+#endif
+}
+extern int in_display;
+extern int gc_in_progress;
+/****************** the workhorse error-signaling function ******************/
+/* #### This function has not been synched with FSF.  It diverges
+significantly. */
+static Lisp_Object
+signal_1 (Lisp_Object sig, Lisp_Object data)
+{
+/* This function can GC */
+struct gcpro gcpro1, gcpro2;
+Lisp_Object conditions;
+Lisp_Object handlers;
+/* signal_call_debugger() could get called more than once
+(once when a call-with-condition-handler is about to
+be dealt with, and another when a condition-case handler
+is about to be invoked).  So make sure the debugger and/or
+stack trace aren't done more than once. */
+int stack_trace_displayed = 0;
+int debugger_entered = 0;
+GCPRO2 (conditions, handlers);
+if (!initialized)
+{
+/* who knows how much has been initialized?  Safest bet is
+just to bomb out immediately. */
+fprintf (stderr, "Error before initialization is complete!\n");
+abort ();
+}
+if (gc_in_progress || in_display)
+/* This is one of many reasons why you can't run lisp code from redisplay.
+There is no sensible way to handle errors there. */
+abort ();
+conditions = Fget (sig, Qerror_conditions, Qnil);
+for (handlers = Vcondition_handlers;
+CONSP (handlers);
+handlers = XCDR (handlers))
+{
+Lisp_Object handler_fun = XCAR (XCAR (handlers));
+Lisp_Object handler_data = XCDR (XCAR (handlers));
+Lisp_Object outer_handlers = XCDR (handlers);
+if (!UNBOUNDP (handler_fun))
+{
+/* call-with-condition-handler */
+Lisp_Object tem;
+Lisp_Object all_handlers = Vcondition_handlers;
+struct gcpro ngcpro1;
+NGCPRO1 (all_handlers);
+Vcondition_handlers = outer_handlers;
+tem = signal_call_debugger (conditions, sig, data,
+				      outer_handlers, 1,
+				      &stack_trace_displayed,
+				      &debugger_entered);
+if (!UNBOUNDP (tem))
+	    RETURN_NUNGCPRO (return_from_signal (tem));
+tem = Fcons (sig, data);
+if (NILP (handler_data))
+tem = call1 (handler_fun, tem);
+else
+{
+/* (This code won't be used (for now?).) */
+struct gcpro nngcpro1;
+Lisp_Object args[3];
+NNGCPRO1 (args[0]);
+nngcpro1.nvars = 3;
+args[0] = handler_fun;
+args[1] = tem;
+args[2] = handler_data;
+nngcpro1.var = args;
+tem = Fapply (3, args);
+NNUNGCPRO;
+}
+NUNGCPRO;
+#if 0
+if (!EQ (tem, Qsignal))
+return (return_from_signal (tem));
+#endif
+/* If handler didn't throw, try another handler */
+Vcondition_handlers = all_handlers;
+}
+/* It's a condition-case handler */
+/* t is used by handlers for all conditions, set up by C code.
+*  debugger is not called even if debug_on_error */
+else if (EQ (handler_data, Qt))
+	{
+UNGCPRO;
+return (Fthrow (handlers, Fcons (sig, data)));
+	}
+/* `error' is used similarly to the way `t' is used, but in
+addition it invokes the debugger if debug_on_error.
+	 This is normally used for the outer command-loop error
+	 handler. */
+else if (EQ (handler_data, Qerror))
+{
+Lisp_Object tem = signal_call_debugger (conditions, sig, data,
+outer_handlers, 0,
+						  &stack_trace_displayed,
+						  &debugger_entered);
+UNGCPRO;
+if (!UNBOUNDP (tem))
+return (return_from_signal (tem));
+tem = Fcons (sig, data);
+return (Fthrow (handlers, tem));
+}
+else
+	{
+/* handler established by real (Lisp) condition-case */
+Lisp_Object h;
+	  for (h = handler_data; CONSP (h); h = Fcdr (h))
+	    {
+	      Lisp_Object clause = Fcar (h);
+	      Lisp_Object tem = Fcar (clause);
+	      if (condition_type_p (tem, conditions))
+		{
+		  tem = signal_call_debugger (conditions, sig, data,
+outer_handlers, 1,
+					      &stack_trace_displayed,
+					      &debugger_entered);
+UNGCPRO;
+		  if (!UNBOUNDP (tem))
+return (return_from_signal (tem));
+/* Doesn't return */
+tem = Fcons (Fcons (sig, data), Fcdr (clause));
+return (Fthrow (handlers, tem));
+}
+	    }
+	}
+}
+/* If no handler is present now, try to run the debugger,
+and if that fails, throw to top level.
+#### The only time that no handler is present is during
+temacs or perhaps very early in XEmacs.  In both cases,
+there is no 'top-level catch. (That's why the
+"bomb-out" hack was added.)
+#### Fix this horrifitude!
+*/
+signal_call_debugger (conditions, sig, data, Qnil, 0,
+			&stack_trace_displayed,
+			&debugger_entered);
+UNGCPRO;
+throw_or_bomb_out (Qtop_level, Qt, 1, sig, data); /* Doesn't return */
+return Qnil;
+}
+/****************** Error functions class 1 ******************/
+/* Class 1: General functions that signal an error.
+These functions take an error type and a list of associated error
+data. */
+/* The simplest external error function: it would be called
+signal_continuable_error() in the terminology below, but it's
+Lisp-callable. */
+DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0 /*
+Signal a continuable error.  Args are ERROR-SYMBOL, and associated DATA.
+An error symbol is a symbol defined using `define-error'.
+DATA should be a list.  Its elements are printed as part of the error message.
+If the signal is handled, DATA is made available to the handler.
+See also the function `signal-error', and the functions to handle errors:
+`condition-case' and `call-with-condition-handler'.
+Note that this function can return, if the debugger is invoked and the
+user invokes the "return from signal" option.
+*/ )
+(error_symbol, data)
+Lisp_Object error_symbol, data;
+{
+/* Fsignal() is one of these functions that's called all the time
+with newly-created Lisp objects.  We allow this; but we must GC-
+protect the objects because all sorts of weird stuff could
+happen. */
+struct gcpro gcpro1;
+GCPRO1 (data);
+if (!NILP (Vcurrent_error_state))
+{
+if (!NILP (Vcurrent_warning_class))
+	warn_when_safe_lispobj (Vcurrent_warning_class, Qwarning,
+				Fcons (error_symbol, data));
+Fthrow (Qunbound_suspended_errors_tag, Qnil);
+abort (); /* Better not get here! */
+}
+RETURN_UNGCPRO (signal_1 (error_symbol, data));
+}
+/* Signal a non-continuable error. */
+DOESNT_RETURN
+signal_error (Lisp_Object sig, Lisp_Object data)
+{
+for (;;)
+Fsignal (sig, data);
+}
+static Lisp_Object
+call_with_suspended_errors_1 (Lisp_Object opaque_arg)
+{
+Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg);
+return (primitive_funcall
+	  ((Lisp_Object (*)()) get_opaque_ptr (kludgy_args[0]),
+	   XINT (kludgy_args[1]), kludgy_args + 2));
+}
+static Lisp_Object
+restore_current_warning_class (Lisp_Object warning_class)
+{
+Vcurrent_warning_class = warning_class;
+return Qnil;
+}
+static Lisp_Object
+restore_current_error_state (Lisp_Object error_state)
+{
+Vcurrent_error_state = error_state;
+return Qnil;
+}
+/* Many functions would like to do one of three things if an error
+occurs:
+(1) signal the error, as usual.
+(2) silently fail and return some error value.
+(3) do as (2) but issue a warning in the process.
+Currently there's lots of stuff that passes an Error_behavior
+value and calls maybe_signal_error() and other such functions.
+This approach is inherently error-prone and broken.  A much
+more robust and easier approach is to use call_with_suspended_errors().
+Wrap this around any function in which you might want errors
+to not be errors.
+*/
+Lisp_Object
+call_with_suspended_errors (Lisp_Object (*fun)(), Lisp_Object retval,
+			    Lisp_Object class, Error_behavior errb,
+			    int nargs, ...)
+{
+va_list vargs;
+int speccount;
+Lisp_Object kludgy_args[22];
+Lisp_Object *args = kludgy_args + 2;
+int i;
+Lisp_Object no_error;
+assert (SYMBOLP (class)); /* sanity-check */
+assert (!NILP (class));
+assert (nargs >= 0 && nargs < 20);
+/* ERROR_ME means don't trap errors. (However, if errors are
+already trapped, we leave them trapped.)
+Otherwise, we trap errors, and trap warnings if ERROR_ME_WARN.
+If ERROR_ME_NOT, it causes no warnings even if warnings
+were previously enabled.  However, we never change the
+warning class from one to another. */
+if (!ERRB_EQ (errb, ERROR_ME))
+{
+if (ERRB_EQ (errb, ERROR_ME_NOT)) /* person wants no warnings */
+	class = Qnil;
+errb = ERROR_ME_NOT;
+no_error = Qt;
+}
+else
+no_error = Qnil;
+va_start (vargs, nargs);
+for (i = 0; i < nargs; i++)
+args[i] = va_arg (vargs, Lisp_Object);
+va_end (vargs);
+/* If error-checking is not disabled, just call the function.
+It's important not to override disabled error-checking with
+enabled error-checking. */
+if (ERRB_EQ (errb, ERROR_ME))
+return primitive_funcall (fun, nargs, args);
+speccount = specpdl_depth ();
+if (NILP (class) || NILP (Vcurrent_warning_class))
+{
+/* If we're currently calling for no warnings, then make it so.
+	 If we're currently calling for warnings and we weren't
+	 previously, then set our warning class; otherwise, leave
+	 the existing one alone. */
+record_unwind_protect (restore_current_warning_class,
+			     Vcurrent_warning_class);
+Vcurrent_warning_class = class;
+}
+if (!EQ (Vcurrent_error_state, no_error))
+{
+record_unwind_protect (restore_current_error_state,
+			     Vcurrent_error_state);
+Vcurrent_error_state = no_error;
+}
+{
+int threw;
+Lisp_Object the_retval;
+Lisp_Object opaque1 = make_opaque_ptr (kludgy_args);
+Lisp_Object opaque2 = make_opaque_ptr ((void *) fun);
+struct gcpro gcpro1, gcpro2;
+GCPRO2 (opaque1, opaque2);
+kludgy_args[0] = opaque2;
+kludgy_args[1] = make_int (nargs);
+the_retval = internal_catch (Qunbound_suspended_errors_tag,
+				 call_with_suspended_errors_1,
+				 opaque1, &threw);
+free_opaque_ptr (opaque1);
+free_opaque_ptr (opaque2);
+UNGCPRO;
+/* Use the returned value except in non-local exit, when
+RETVAL applies. */
+if (!threw)
+retval = the_retval;
+return unbind_to (speccount, retval);
+}
+}
+/* Signal a non-continuable error or display a warning or do nothing,
+according to ERRB.  CLASS is the class of warning and should
+refer to what sort of operation is being done (e.g. Qtoolbar,
+Qresource, etc.). */
+void
+maybe_signal_error (Lisp_Object sig, Lisp_Object data, Lisp_Object class,
+		    Error_behavior errb)
+{
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return;
+else if (ERRB_EQ (errb, ERROR_ME_WARN))
+warn_when_safe_lispobj (class, Qwarning, Fcons (sig, data));
+else
+for (;;)
+Fsignal (sig, data);
+}
+/* Signal a continuable error or display a warning or do nothing,
+according to ERRB. */
+Lisp_Object
+maybe_signal_continuable_error (Lisp_Object sig, Lisp_Object data,
+				Lisp_Object class, Error_behavior errb)
+{
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return Qnil;
+else if (ERRB_EQ (errb, ERROR_ME_WARN))
+{
+warn_when_safe_lispobj (class, Qwarning, Fcons (sig, data));
+return Qnil;
+}
+else
+return Fsignal (sig, data);
+}
+/****************** Error functions class 2 ******************/
+/* Class 2: Printf-like functions that signal an error.
+These functions signal an error of type Qerror, whose data
+is a single string, created using the arguments. */
+/* dump an error message; called like printf */
+DOESNT_RETURN
+error (CONST char *fmt, ...)
+{
+Lisp_Object obj;
+va_list args;
+va_start (args, fmt);
+obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
+				args);
+va_end (args);
+/* Fsignal GC-protects its args */
+signal_error (Qerror, list1 (obj));
+}
+void
+maybe_error (Lisp_Object class, Error_behavior errb, CONST char *fmt, ...)
+{
+Lisp_Object obj;
+va_list args;
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return;
+va_start (args, fmt);
+obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
+				args);
+va_end (args);
+/* Fsignal GC-protects its args */
+maybe_signal_error (Qerror, list1 (obj), class, errb);
+}
+Lisp_Object
+continuable_error (CONST char *fmt, ...)
+{
+Lisp_Object obj;
+va_list args;
+va_start (args, fmt);
+obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
+				args);
+va_end (args);
+/* Fsignal GC-protects its args */
+return Fsignal (Qerror, list1 (obj));
+}
+Lisp_Object
+maybe_continuable_error (Lisp_Object class, Error_behavior errb,
+			 CONST char *fmt, ...)
+{
+Lisp_Object obj;
+va_list args;
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return Qnil;
+va_start (args, fmt);
+obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
+				args);
+va_end (args);
+/* Fsignal GC-protects its args */
+return maybe_signal_continuable_error (Qerror, list1 (obj), class, errb);
+}
+/****************** Error functions class 3 ******************/
+/* Class 3: Signal an error with a string and an associated object.
+These functions signal an error of type Qerror, whose data
+is two objects, a string and a related Lisp object (usually the object
+where the error is occurring). */
+DOESNT_RETURN
+signal_simple_error (CONST char *reason, Lisp_Object frob)
+{
+signal_error (Qerror, list2 (build_translated_string (reason), frob));
+}
+void
+maybe_signal_simple_error (CONST char *reason, Lisp_Object frob,
+			   Lisp_Object class, Error_behavior errb)
+{
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return;
+maybe_signal_error (Qerror, list2 (build_translated_string (reason), frob),
+				     class, errb);
+}
+Lisp_Object
+signal_simple_continuable_error (CONST char *reason, Lisp_Object frob)
+{
+return Fsignal (Qerror, list2 (build_translated_string (reason), frob));
+}
+Lisp_Object
+maybe_signal_simple_continuable_error (CONST char *reason, Lisp_Object frob,
+				       Lisp_Object class, Error_behavior errb)
+{
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return Qnil;
+return maybe_signal_continuable_error
+(Qerror, list2 (build_translated_string (reason),
+		    frob), class, errb);
+}
+/****************** Error functions class 4 ******************/
+/* Class 4: Printf-like functions that signal an error.
+These functions signal an error of type Qerror, whose data
+is a two objects, a string (created using the arguments) and a
+Lisp object.
+*/
+DOESNT_RETURN
+error_with_frob (Lisp_Object frob, CONST char *fmt, ...)
+{
+Lisp_Object obj;
+va_list args;
+va_start (args, fmt);
+obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
+				args);
+va_end (args);
+/* Fsignal GC-protects its args */
+signal_error (Qerror, list2 (obj, frob));
+}
+void
+maybe_error_with_frob (Lisp_Object frob, Lisp_Object class,
+		       Error_behavior errb, CONST char *fmt, ...)
+{
+Lisp_Object obj;
+va_list args;
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return;
+va_start (args, fmt);
+obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
+				args);
+va_end (args);
+/* Fsignal GC-protects its args */
+maybe_signal_error (Qerror, list2 (obj, frob), class, errb);
+}
+Lisp_Object
+continuable_error_with_frob (Lisp_Object frob, CONST char *fmt, ...)
+{
+Lisp_Object obj;
+va_list args;
+va_start (args, fmt);
+obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
+				args);
+va_end (args);
+/* Fsignal GC-protects its args */
+return Fsignal (Qerror, list2 (obj, frob));
+}
+Lisp_Object
+maybe_continuable_error_with_frob (Lisp_Object frob, Lisp_Object class,
+				   Error_behavior errb, CONST char *fmt, ...)
+{
+Lisp_Object obj;
+va_list args;
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return Qnil;
+va_start (args, fmt);
+obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1,
+				args);
+va_end (args);
+/* Fsignal GC-protects its args */
+return maybe_signal_continuable_error (Qerror, list2 (obj, frob),
+					 class, errb);
+}
+/****************** Error functions class 5 ******************/
+/* Class 5: Signal an error with a string and two associated objects.
+These functions signal an error of type Qerror, whose data
+is three objects, a string and two related Lisp objects. */
+DOESNT_RETURN
+signal_simple_error_2 (CONST char *reason,
+Lisp_Object frob0, Lisp_Object frob1)
+{
+signal_error (Qerror, list3 (build_translated_string (reason), frob0,
+			       frob1));
+}
+void
+maybe_signal_simple_error_2 (CONST char *reason, Lisp_Object frob0,
+			     Lisp_Object frob1, Lisp_Object class,
+			     Error_behavior errb)
+{
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return;
+maybe_signal_error (Qerror, list3 (build_translated_string (reason), frob0,
+				     frob1), class, errb);
+}
+Lisp_Object
+signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0,
+				   Lisp_Object frob1)
+{
+return Fsignal (Qerror, list3 (build_translated_string (reason), frob0,
+				 frob1));
+}
+Lisp_Object
+maybe_signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0,
+					 Lisp_Object frob1, Lisp_Object class,
+					 Error_behavior errb)
+{
+/* Optimization: */
+if (ERRB_EQ (errb, ERROR_ME_NOT))
+return Qnil;
+return maybe_signal_continuable_error
+(Qerror, list3 (build_translated_string (reason), frob0,
+		    frob1),
+class, errb);
+}
+/* This is what the QUIT macro calls to signal a quit */
+void
+signal_quit (void)
+{
+/* This function can GC */
+if (EQ (Vquit_flag, Qcritical))
+debug_on_quit |= 2;		/* set critical bit. */
+Vquit_flag = Qnil;
+/* note that this is continuable. */
+Fsignal (Qquit, Qnil);
+}
+/**********************************************************************/
+/*                            User commands                           */
+/**********************************************************************/
+DEFUN ("commandp", Fcommandp, Scommandp, 1, 1, 0 /*
+T if FUNCTION makes provisions for interactive calling.
+This means it contains a description for how to read arguments to give it.
+The value is nil for an invalid function or a symbol with no function
+definition.
+Interactively callable functions include
+-- strings and vectors (treated as keyboard macros)
+-- lambda-expressions that contain a top-level call to `interactive'
+-- autoload definitions made by `autoload' with non-nil fourth argument
+(i.e. the interactive flag)
+-- compiled-function objects with a non-nil `compiled-function-interactive'
+value
+-- subrs (built-in functions) that are interactively callable
+Also, a symbol satisfies `commandp' if its function definition does so.
+*/ )
+(function)
+Lisp_Object function;
+{
+REGISTER Lisp_Object fun;
+REGISTER Lisp_Object funcar;
+fun = function;
+fun = indirect_function (fun, 0);
+if (UNBOUNDP (fun))
+return Qnil;
+/* Emacs primitives are interactive if their DEFUN specifies an
+interactive spec.  */
+if (SUBRP (fun))
+{
+if (XSUBR (fun)->prompt)
+	return Qt;
+else
+	return Qnil;
+}
+else if (COMPILED_FUNCTIONP (fun))
+{
+return (((XCOMPILED_FUNCTION (fun)->flags.interactivep) ? Qt : Qnil));
+}
+/* Strings and vectors are keyboard macros.  */
+if (VECTORP (fun) || STRINGP (fun))
+return Qt;
+/* Lists may represent commands.  */
+if (!CONSP (fun))
+return Qnil;
+funcar = Fcar (fun);
+if (!SYMBOLP (funcar))
+return Fsignal (Qinvalid_function, list1 (fun));
+if (EQ (funcar, Qlambda))
+return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
+#ifdef MOCKLISP_SUPPORT
+if (EQ (funcar, Qmocklisp))
+return Qt;  /* All mocklisp functions can be called interactively */
+#endif
+if (EQ (funcar, Qautoload))
+return Fcar (Fcdr (Fcdr (Fcdr (fun))));
+else
+return Qnil;
+}
+DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 3, 0 /*
+Execute CMD as an editor command.
+CMD must be an object that satisfies the `commandp' predicate.
+Optional second arg RECORD-FLAG is as in `call-interactively'.
+The argument KEYS specifies the value to use instead of (this-command-keys)
+when reading the arguments.
+*/ )
+(cmd, record, keys)
+Lisp_Object cmd, record, keys;
+{
+/* This function can GC */
+Lisp_Object prefixarg;
+Lisp_Object final = cmd;
+struct backtrace backtrace;
+struct console *con = XCONSOLE (Vselected_console);
+prefixarg = con->prefix_arg;
+con->prefix_arg = Qnil;
+Vcurrent_prefix_arg = prefixarg;
+debug_on_next_call = 0; /* #### from FSFmacs; correct? */
+if (SYMBOLP (cmd) && !NILP (Fget (cmd, Qdisabled, Qnil)))
+return run_hook (Vdisabled_command_hook);
+for (;;)
+{
+final = indirect_function (cmd, 1);
+if (CONSP (final) && EQ (Fcar (final), Qautoload))
+	do_autoload (final, cmd);
+else
+	break;
+}
+if (CONSP (final) || SUBRP (final) || COMPILED_FUNCTIONP (final))
+{
+#ifdef EMACS_BTL
+backtrace.id_number = 0;
+#endif
+backtrace.next = backtrace_list;
+backtrace_list = &backtrace;
+backtrace.function = &Qcall_interactively;
+backtrace.args = &cmd;
+backtrace.nargs = 1;
+backtrace.evalargs = 0;
+backtrace.pdlcount = specpdl_depth ();
+backtrace.debug_on_exit = 0;
+final = Fcall_interactively (cmd, record, keys);
+backtrace_list = backtrace.next;
+return (final);
+}
+else if (STRINGP (final) || VECTORP (final))
+{
+return Fexecute_kbd_macro (final, prefixarg);
+}
+else
+{
+Fsignal (Qwrong_type_argument,
+	       Fcons (Qcommandp,
+		      ((EQ (cmd, final))
+? list1 (cmd)
+: list2 (cmd, final))));
+return Qnil;
+}
+}
+DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0 /*
+Return t if function in which this appears was called interactively.
+This means that the function was called with call-interactively (which
+includes being called as the binding of a key)
+and input is currently coming from the keyboard (not in keyboard macro).
+*/ )
+()
+{
+REGISTER struct backtrace *btp;
+REGISTER Lisp_Object fun;
+if (!INTERACTIVE)
+return Qnil;
+/*  Unless the object was compiled, skip the frame of interactive-p itself
+(if interpreted) or the frame of byte-code (if called from a compiled
+function).  Note that *btp->function may be a symbol pointing at a
+compiled function. */
+btp = backtrace_list;
+#if 0 /* FSFmacs */
+/* #### FSFmacs does the following instead.  I can't figure
+out which one is more correct. */
+/* If this isn't a byte-compiled function, there may be a frame at
+the top for Finteractive_p itself.  If so, skip it.  */
+fun = Findirect_function (*btp->function);
+if (SUBRP (fun) && XSUBR (fun) == &Sinteractive_p)
+btp = btp->next;
+/* If we're running an Emacs 18-style byte-compiled function, there
+may be a frame for Fbyte_code.  Now, given the strictest
+definition, this function isn't really being called
+interactively, but because that's the way Emacs 18 always builds
+byte-compiled functions, we'll accept it for now.  */
+if (EQ (*btp->function, Qbyte_code))
+btp = btp->next;
+/* If this isn't a byte-compiled function, then we may now be
+looking at several frames for special forms.  Skip past them.  */
+while (btp &&
+	 btp->nargs == UNEVALLED)
+btp = btp->next;
+#else
+if (! (COMPILED_FUNCTIONP (Findirect_function (*btp->function))))
+btp = btp->next;
+for (;
+btp && (btp->nargs == UNEVALLED
+	       || EQ (*btp->function, Qbyte_code));
+btp = btp->next)
+{}
+/* btp now points at the frame of the innermost function
+that DOES eval its args.
+If it is a built-in function (such as load or eval-region)
+return nil.  */
+/* Beats me why this is necessary, but it is */
+if (btp && EQ (*btp->function, Qcall_interactively))
+return Qt;
+#endif
+fun = Findirect_function (*btp->function);
+if (SUBRP (fun))
+return Qnil;
+/* btp points to the frame of a Lisp function that called interactive-p.
+Return t if that function was called interactively.  */
+if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
+return Qt;
+return Qnil;
+}
+/**********************************************************************/
+/*                            Autoloading                             */
+/**********************************************************************/
+DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0 /*
+Define FUNCTION to autoload from FILE.
+FUNCTION is a symbol; FILE is a file name string to pass to `load'.
+Third arg DOCSTRING is documentation for the function.
+Fourth arg INTERACTIVE if non-nil says function can be called interactively.
+Fifth arg TYPE indicates the type of the object:
+nil or omitted says FUNCTION is a function,
+`keymap' says FUNCTION is really a keymap, and
+`macro' or t says FUNCTION is really a macro.
+Third through fifth args give info about the real definition.
+They default to nil.
+If FUNCTION is already defined other than as an autoload,
+this does nothing and returns nil.
+*/ )
+(function, file, docstring, interactive, type)
+Lisp_Object function, file, docstring, interactive, type;
+{
+/* This function can GC */
+CHECK_SYMBOL (function);
+CHECK_STRING (file);
+/* If function is defined and not as an autoload, don't override */
+if (!UNBOUNDP (XSYMBOL (function)->function)
+&& !(CONSP (XSYMBOL (function)->function)
+	   && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
+return Qnil;
+if (purify_flag)
+{
+/* Attempt to avoid consing identical (string=) pure strings. */
+file = Fsymbol_name (Fintern (file, Qnil));
+}
+return Ffset (function,
+Fpurecopy (Fcons (Qautoload, list4 (file,
+docstring,
+interactive,
+type))));
+}
+Lisp_Object
+un_autoload (Lisp_Object oldqueue)
+{
+/* This function can GC */
+REGISTER Lisp_Object queue, first, second;
+/* Queue to unwind is current value of Vautoload_queue.
+oldqueue is the shadowed value to leave in Vautoload_queue.  */
+queue = Vautoload_queue;
+Vautoload_queue = oldqueue;
+while (CONSP (queue))
+{
+first = Fcar (queue);
+second = Fcdr (first);
+first = Fcar (first);
+if (NILP (second))
+	Vfeatures = first;
+else
+	Ffset (first, second);
+queue = Fcdr (queue);
+}
+return Qnil;
+}
+void
+do_autoload (Lisp_Object fundef,
+Lisp_Object funname)
+{
+/* This function can GC */
+int speccount = specpdl_depth_counter;
+Lisp_Object fun = funname;
+struct gcpro gcpro1, gcpro2;
+CHECK_SYMBOL (funname);
+GCPRO2 (fun, funname);
+/* Value saved here is to be restored into Vautoload_queue */
+record_unwind_protect (un_autoload, Vautoload_queue);
+Vautoload_queue = Qt;
+call4 (Qload, Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil,
+	 Qnil);
+{
+Lisp_Object queue = Vautoload_queue;
+/* Save the old autoloads, in case we ever do an unload. */
+queue = Vautoload_queue;
+while (CONSP (queue))
+{
+Lisp_Object first = Fcar (queue);
+Lisp_Object second = Fcdr (first);
+first = Fcar (first);
+/* Note: This test is subtle.  The cdr of an autoload-queue entry
+	 may be an atom if the autoload entry was generated by a defalias
+	 or fset. */
+if (CONSP (second))
+	Fput (first, Qautoload, (Fcdr (second)));
+queue = Fcdr (queue);
+}
+}
+/* Once loading finishes, don't undo it.  */
+Vautoload_queue = Qt;
+unbind_to (speccount, Qnil);
+fun = indirect_function (fun, 0);
+#if 0 /* FSFmacs */
+if (!NILP (Fequal (fun, fundef)))
+#else
+if (UNBOUNDP (fun)
+|| (CONSP (fun)
+&& EQ (XCAR (fun), Qautoload)))
+#endif
+error ("Autoloading failed to define function %s",
+	   string_data (XSYMBOL (funname)->name));
+UNGCPRO;
+}
+/**********************************************************************/
+/*                         eval, funcall, apply                       */
+/**********************************************************************/
+static Lisp_Object funcall_lambda (Lisp_Object fun,
+int nargs, Lisp_Object args[]);
+static Lisp_Object apply_lambda (Lisp_Object fun,
+int nargs, Lisp_Object args);
+static Lisp_Object funcall_subr (struct Lisp_Subr *sub, Lisp_Object args[]);
+static int in_warnings;
+static Lisp_Object
+in_warnings_restore (Lisp_Object minimus)
+{
+in_warnings = 0;
+return Qnil;
+}
+DEFUN ("eval", Feval, Seval, 1, 1, 0 /*
+Evaluate FORM and return its value.
+*/ )
+(form)
+Lisp_Object form;
+{
+/* This function can GC */
+Lisp_Object fun, val, original_fun, original_args;
+int nargs;
+struct backtrace backtrace;
+/* I think this is a pretty safe place to call Lisp code, don't you? */
+while (!in_warnings && !NILP (Vpending_warnings))
+{
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+int speccount = specpdl_depth ();
+Lisp_Object this_warning_cons, this_warning, class, level, messij;
+record_unwind_protect (in_warnings_restore, Qnil);
+in_warnings = 1;
+this_warning_cons = Vpending_warnings;
+this_warning = XCAR (this_warning_cons);
+/* in case an error occurs in the warn function, at least
+	 it won't happen infinitely */
+Vpending_warnings = XCDR (Vpending_warnings);
+free_cons (XCONS (this_warning_cons));
+class = XCAR (this_warning);
+level = XCAR (XCDR (this_warning));
+messij = XCAR (XCDR (XCDR (this_warning)));
+free_list (this_warning);
+if (NILP (Vpending_warnings))
+	Vpending_warnings_tail = Qnil; /* perhaps not strictly necessary,
+					  but safer */
+GCPRO4 (form, class, level, messij);
+if (!STRINGP (messij))
+	messij = Fprin1_to_string (messij, Qnil);
+call3 (Qdisplay_warning, class, messij, level);
+UNGCPRO;
+unbind_to (speccount, Qnil);
+}
+if (!CONSP (form))
+{
+if (!SYMBOLP (form))
+	return form;
+val = Fsymbol_value (form);
+#ifdef MOCKLISP_SUPPORT
+if (!EQ (Vmocklisp_arguments, Qt))
+	{
+	  if (NILP (val))
+	    val = Qzero;
+	  else if (EQ (val, Qt))
+	    val = make_int (1);
+	}
+#endif
+return val;
+}
+QUIT;
+if ((consing_since_gc > gc_cons_threshold) || always_gc)
+{
+struct gcpro gcpro1;
+GCPRO1 (form);
+garbage_collect_1 ();
+UNGCPRO;
+}
+if (++lisp_eval_depth > max_lisp_eval_depth)
+{
+if (max_lisp_eval_depth < 100)
+	max_lisp_eval_depth = 100;
+if (lisp_eval_depth > max_lisp_eval_depth)
+	error ("Lisp nesting exceeds `max-lisp-eval-depth'");
+}
+original_fun = Fcar (form);
+original_args = Fcdr (form);
+nargs = XINT (Flength (original_args));
+#ifdef EMACS_BTL
+backtrace.id_number = 0;
+#endif
+backtrace.pdlcount = specpdl_depth_counter;
+backtrace.next = backtrace_list;
+backtrace_list = &backtrace;
+backtrace.function = &original_fun; /* This also protects them from gc */
+backtrace.args = &original_args;
+backtrace.nargs = UNEVALLED;
+backtrace.evalargs = 1;
+backtrace.debug_on_exit = 0;
+if (debug_on_next_call)
+do_debug_on_call (Qt);
+/* At this point, only original_fun and original_args
+have values that will be used below */
+retry:
+fun = indirect_function (original_fun, 1);
+if (SUBRP (fun))
+{
+struct Lisp_Subr *subr = XSUBR (fun);
+int max_args = subr->max_args;
+Lisp_Object argvals[SUBR_MAX_ARGS];
+Lisp_Object args_left;
+REGISTER int i;
+args_left = original_args;
+if (nargs < subr->min_args
+	  || (max_args >= 0 && max_args < nargs))
+	{
+	  return Fsignal (Qwrong_number_of_arguments,
+			  list2 (fun, make_int (nargs)));
+	}
+if (max_args == UNEVALLED)
+	{
+	  backtrace.evalargs = 0;
+	  val = ((subr_function (subr)) (args_left));
+	}
+else if (max_args == MANY)
+	{
+	  /* Pass a vector of evaluated arguments */
+	  Lisp_Object *vals;
+	  REGISTER int argnum;
+struct gcpro gcpro1, gcpro2, gcpro3;
+	  vals = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
+	  GCPRO3 (args_left, fun, vals[0]);
+	  gcpro3.nvars = 0;
+	  argnum = 0;
+while (!NILP (args_left))
+	    {
+	      vals[argnum++] = Feval (Fcar (args_left));
+	      args_left = Fcdr (args_left);
+	      gcpro3.nvars = argnum;
+	    }
+	  backtrace.args = vals;
+	  backtrace.nargs = nargs;
+	  val = ((subr_function (subr)) (nargs, vals));
+/* Have to duplicate this code because if the
+*  debugger is called it must be in a scope in
+*  which the `alloca'-ed data in vals is still valid.
+*  (And GC-protected.)
+*/
+lisp_eval_depth--;
+#ifdef MOCKLISP_SUPPORT
+if (!EQ (Vmocklisp_arguments, Qt))
+	    {
+	      if (NILP (val))
+		val = Qzero;
+	      else if (EQ (val, Qt))
+		val = make_int (1);
+	    }
+#endif
+if (backtrace.debug_on_exit)
+val = do_debug_on_exit (val);
+backtrace_list = backtrace.next;
+	  UNGCPRO;
+return (val);
+	}
+else
+{
+struct gcpro gcpro1, gcpro2, gcpro3;
+	  GCPRO3 (args_left, fun, fun);
+	  gcpro3.var = argvals;
+	  gcpro3.nvars = 0;
+	  for (i = 0; i < nargs; args_left = Fcdr (args_left))
+	    {
+	      argvals[i] = Feval (Fcar (args_left));
+	      gcpro3.nvars = ++i;
+	    }
+	  UNGCPRO;
+	  for (i = nargs; i < max_args; i++)
+argvals[i] = Qnil;
+backtrace.args = argvals;
+backtrace.nargs = nargs;
+val = funcall_subr (subr, argvals);
+}
+}
+else if (COMPILED_FUNCTIONP (fun))
+val = apply_lambda (fun, nargs, original_args);
+else
+{
+Lisp_Object funcar;
+if (!CONSP (fun))
+goto invalid_function;
+funcar = Fcar (fun);
+if (!SYMBOLP (funcar))
+goto invalid_function;
+if (EQ (funcar, Qautoload))
+	{
+	  do_autoload (fun, original_fun);
+	  goto retry;
+	}
+if (EQ (funcar, Qmacro))
+	val = Feval (apply1 (Fcdr (fun), original_args));
+else if (EQ (funcar, Qlambda))
+val = apply_lambda (fun, nargs, original_args);
+#ifdef MOCKLISP_SUPPORT
+else if (EQ (funcar, Qmocklisp))
+	val = ml_apply (fun, original_args);
+#endif
+else
+	{
+	invalid_function:
+	  return Fsignal (Qinvalid_function, list1 (fun));
+	}
+}
+lisp_eval_depth--;
+#ifdef MOCKLISP_SUPPORT
+if (!EQ (Vmocklisp_arguments, Qt))
+{
+if (NILP (val))
+	val = Qzero;
+else if (EQ (val, Qt))
+	val = make_int (1);
+}
+#endif
+if (backtrace.debug_on_exit)
+val = do_debug_on_exit (val);
+backtrace_list = backtrace.next;
+return (val);
+}
+Lisp_Object
+funcall_recording_as (Lisp_Object recorded_as, int nargs,
+		      Lisp_Object *args)
+{
+/* This function can GC */
+Lisp_Object fun;
+Lisp_Object val;
+struct backtrace backtrace;
+REGISTER int i;
+QUIT;
+if ((consing_since_gc > gc_cons_threshold) || always_gc)
+/* Callers should gcpro lexpr args */
+garbage_collect_1 ();
+if (++lisp_eval_depth > max_lisp_eval_depth)
+{
+if (max_lisp_eval_depth < 100)
+	max_lisp_eval_depth = 100;
+if (lisp_eval_depth > max_lisp_eval_depth)
+	error ("Lisp nesting exceeds `max-lisp-eval-depth'");
+}
+/* Count number of arguments to function */
+nargs = nargs - 1;
+#ifdef EMACS_BTL
+backtrace.id_number = 0;
+#endif
+backtrace.pdlcount = specpdl_depth_counter;
+backtrace.next = backtrace_list;
+backtrace.function = &args[0];
+backtrace.args = &args[1];
+backtrace.nargs = nargs;
+backtrace.evalargs = 0;
+backtrace.debug_on_exit = 0;
+/* XEmacs: make sure this is done last so we don't get race
+conditions in the profiling code. */
+backtrace_list = &backtrace;
+if (debug_on_next_call)
+do_debug_on_call (Qlambda);
+retry:
+fun = args[0];
+#ifdef EMACS_BTL
+{
+extern int emacs_btl_elisp_only_p;
+extern int btl_symbol_id_number ();
+if (emacs_btl_elisp_only_p)
+backtrace.id_number = btl_symbol_id_number (fun);
+}
+#endif
+if (SYMBOLP (fun))
+fun = indirect_function (fun, 1);
+if (SUBRP (fun))
+{
+struct Lisp_Subr *subr = XSUBR (fun);
+int max_args = subr->max_args;
+if (max_args == UNEVALLED)
+	return Fsignal (Qinvalid_function, list1 (fun));
+if (nargs < subr->min_args
+	  || (max_args >= 0 && max_args < nargs))
+	{
+	  return Fsignal (Qwrong_number_of_arguments,
+list2 (fun, make_int (nargs)));
+	}
+if (max_args == MANY)
+	{
+	  val = ((subr_function (subr)) (nargs, args + 1));
+	}
+else if (max_args > nargs)
+	{
+Lisp_Object argvals[SUBR_MAX_ARGS];
+/* Default optionals to nil */
+for (i = 0; i < nargs; i++)
+argvals[i] = args[i + 1];
+	  for (i = nargs; i < max_args; i++)
+	    argvals[i] = Qnil;
+val = funcall_subr (subr, argvals);
+	}
+else
+val = funcall_subr (subr, args + 1);
+}
+else if (COMPILED_FUNCTIONP (fun))
+val = funcall_lambda (fun, nargs, args + 1);
+else if (!CONSP (fun))
+{
+invalid_function:
+return Fsignal (Qinvalid_function, list1 (fun));
+}
+else
+{
+Lisp_Object funcar = Fcar (fun);
+if (!SYMBOLP (funcar))
+goto invalid_function;
+if (EQ (funcar, Qlambda))
+	val = funcall_lambda (fun, nargs, args + 1);
+#ifdef MOCKLISP_SUPPORT
+else if (EQ (funcar, Qmocklisp))
+	val = ml_apply (fun, Flist (nargs, args + 1));
+#endif
+else if (EQ (funcar, Qautoload))
+	{
+	  do_autoload (fun, args[0]);
+	  goto retry;
+	}
+else
+	{
+goto invalid_function;
+	}
+}
+lisp_eval_depth--;
+if (backtrace.debug_on_exit)
+val = do_debug_on_exit (val);
+backtrace_list = backtrace.next;
+return val;
+}
+DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0 /*
+Call first argument as a function, passing remaining arguments to it.
+Thus, (funcall 'cons 'x 'y) returns (x . y).
+*/ )
+(nargs, args)
+int nargs;
+Lisp_Object *args;
+{
+return funcall_recording_as (args[0], nargs, args);
+}
+DEFUN ("function-min-args", Ffunction_min_args, Sfunction_min_args,
+1, 1, 0 /*
+Return the number of arguments a function may be called with.  The
+function may be any form that can be passed to `funcall', any special
+form, or any macro.
+*/ )
+(function)
+Lisp_Object function;
+{
+Lisp_Object orig_function = function;
+Lisp_Object arglist;
+int argcount;
+retry:
+if (SYMBOLP (function))
+function = indirect_function (function, 1);
+if (SUBRP (function))
+return Fsubr_min_args (function);
+else if (!COMPILED_FUNCTIONP (function) && !CONSP (function))
+{
+invalid_function:
+return Fsignal (Qinvalid_function, list1 (function));
+}
+if (CONSP (function))
+{
+Lisp_Object funcar = Fcar (function);
+if (!SYMBOLP (funcar))
+goto invalid_function;
+if (EQ (funcar, Qmacro))
+	{
+	  function = Fcdr (function);
+	  goto retry;
+	}
+if (EQ (funcar, Qautoload))
+	{
+	  do_autoload (function, orig_function);
+	  goto retry;
+	}
+if (EQ (funcar, Qlambda))
+	arglist = Fcar (Fcdr (function));
+else
+	goto invalid_function;
+}
+else
+arglist = XCOMPILED_FUNCTION (function)->arglist;
+argcount = 0;
+while (!NILP (arglist))
+{
+QUIT;
+if (EQ (Fcar (arglist), Qand_optional)
+	  || EQ (Fcar (arglist), Qand_rest))
+	break;
+argcount++;
+arglist = Fcdr (arglist);
+}
+return make_int (argcount);
+}
+DEFUN ("function-max-args", Ffunction_max_args, Sfunction_max_args,
+1, 1, 0 /*
+Return the number of arguments a function may be called with.  If the
+function takes an arbitrary number of arguments or is a built-in
+special form, nil is returned.  The function may be any form that can
+be passed to `funcall', any special form, or any macro.
+*/ )
+(function)
+Lisp_Object function;
+{
+Lisp_Object orig_function = function;
+Lisp_Object arglist;
+int argcount;
+retry:
+if (SYMBOLP (function))
+function = indirect_function (function, 1);
+if (SUBRP (function))
+return Fsubr_max_args (function);
+else if (!COMPILED_FUNCTIONP (function) && !CONSP (function))
+{
+invalid_function:
+return Fsignal (Qinvalid_function, list1 (function));
+}
+if (CONSP (function))
+{
+Lisp_Object funcar = Fcar (function);
+if (!SYMBOLP (funcar))
+goto invalid_function;
+if (EQ (funcar, Qmacro))
+	{
+	  function = Fcdr (function);
+	  goto retry;
+	}
+if (EQ (funcar, Qautoload))
+	{
+	  do_autoload (function, orig_function);
+	  goto retry;
+	}
+if (EQ (funcar, Qlambda))
+	arglist = Fcar (Fcdr (function));
+else
+	goto invalid_function;
+}
+else
+arglist = XCOMPILED_FUNCTION (function)->arglist;
+argcount = 0;
+while (!NILP (arglist))
+{
+QUIT;
+if (EQ (Fcar (arglist), Qand_optional))
+	{
+	  arglist = Fcdr (arglist);
+	  continue;
+	}
+if (EQ (Fcar (arglist), Qand_rest))
+	return Qnil;
+argcount++;
+arglist = Fcdr (arglist);
+}
+return make_int (argcount);
+}
+DEFUN ("apply", Fapply, Sapply, 2, MANY, 0 /*
+Call FUNCTION with our remaining args, using our last arg as list of args.
+Thus, (apply '+ 1 2 '(3 4)) returns 10.
+*/ )
+(nargs, args)
+int nargs;
+Lisp_Object *args;
+{
+/* This function can GC */
+Lisp_Object fun = args[0];
+Lisp_Object spread_arg = args [nargs - 1];
+int numargs;
+int funcall_nargs;
+CHECK_LIST (spread_arg);
+numargs = XINT (Flength (spread_arg));
+if (numargs == 0)
+/* (apply foo 0 1 '()) */
+return Ffuncall (nargs - 1, args);
+else if (numargs == 1)
+{
+/* (apply foo 0 1 '(2)) */
+args [nargs - 1] = XCAR (spread_arg);
+return Ffuncall (nargs, args);
+}
+/* -1 for function, -1 for spread arg */
+numargs = nargs - 2 + numargs;
+/* +1 for function */
+funcall_nargs = 1 + numargs;
+if (SYMBOLP (fun))
+fun = indirect_function (fun, 0);
+if (UNBOUNDP (fun))
+{
+/* Let funcall get the error */
+fun = args[0];
+}
+else if (SUBRP (fun))
+{
+struct Lisp_Subr *subr = XSUBR (fun);
+int max_args = subr->max_args;
+if (numargs < subr->min_args
+	  || (max_args >= 0 && max_args < numargs))
+{
+/* Let funcall get the error */
+}
+else if (max_args > numargs)
+	{
+	  /* Avoid having funcall cons up yet another new vector of arguments
+	     by explicitly supplying nil's for optional values */
+funcall_nargs += (max_args - numargs);
+}
+}
+{
+REGISTER int i;
+REGISTER Lisp_Object *funcall_args
+= (Lisp_Object *) alloca (funcall_nargs * sizeof (Lisp_Object));
+struct gcpro gcpro1;
+GCPRO1 (*funcall_args);
+gcpro1.nvars = funcall_nargs;
+/* Copy in the unspread args */
+memcpy (funcall_args, args, (nargs - 1) * sizeof (Lisp_Object));
+/* Spread the last arg we got.  Its first element goes in
+the slot that it used to occupy, hence this value of I.  */
+for (i = nargs - 1;
+!NILP (spread_arg);    /* i < 1 + numargs */
+i++, spread_arg = XCDR (spread_arg))
+{
+	funcall_args [i] = XCAR (spread_arg);
+}
+/* Supply nil for optional args (to subrs) */
+for (; i < funcall_nargs; i++)
+funcall_args[i] = Qnil;
+RETURN_UNGCPRO (Ffuncall (funcall_nargs, funcall_args));
+}
+}
+static Lisp_Object
+primitive_funcall (Lisp_Object (*fn) (), int nargs, Lisp_Object args[])
+{
+switch (nargs)
+{
+case 0:
+return ((*fn) ());
+case 1:
+return ((*fn) (args[0]));
+case 2:
+return ((*fn) (args[0], args[1]));
+case 3:
+return ((*fn) (args[0], args[1], args[2]));
+case 4:
+return ((*fn) (args[0], args[1], args[2], args[3]));
+case 5:
+return ((*fn) (args[0], args[1], args[2], args[3], args[4]));
+case 6:
+return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5]));
+case 7:
+return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
+		     args[6]));
+case 8:
+return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
+		     args[6], args[7]));
+case 9:
+return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
+		     args[6], args[7], args[8]));
+case 10:
+return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
+		     args[6], args[7], args[8], args[9]));
+case 11:
+return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
+		     args[6], args[7], args[8], args[9], args[10]));
+case 12:
+return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
+		     args[6], args[7], args[8], args[9], args[10], args[11]));
+default:
+/* Someone has created a subr that takes more arguments than
+	 is supported by this code.  We need to either rewrite the
+	 subr to use a different argument protocol, or add more
+	 cases to this switch.  */
+abort ();
+}
+return Qnil;	/* suppress compiler warning */
+}
+static Lisp_Object
+funcall_subr (struct Lisp_Subr *subr, Lisp_Object args[])
+{
+return primitive_funcall (subr_function (subr), subr->max_args, args);
+}
+/* FSFmacs has an extra arg EVAL_FLAG.  If false, some of
+the statements below are not done.  But it's always true
+in all the calls to apply_lambda(). */
+static Lisp_Object
+apply_lambda (Lisp_Object fun, int numargs, Lisp_Object unevalled_args)
+{
+/* This function can GC */
+struct gcpro gcpro1, gcpro2, gcpro3;
+REGISTER int i;
+REGISTER Lisp_Object tem;
+REGISTER Lisp_Object *arg_vector
+= (Lisp_Object *) alloca (numargs * sizeof (Lisp_Object));
+GCPRO3 (*arg_vector, unevalled_args, fun);
+gcpro1.nvars = 0;
+for (i = 0; i < numargs;)
+{
+tem = Fcar (unevalled_args), unevalled_args = Fcdr (unevalled_args);
+tem = Feval (tem);
+arg_vector[i++] = tem;
+gcpro1.nvars = i;
+}
+UNGCPRO;
+backtrace_list->args = arg_vector;
+backtrace_list->nargs = i;
+backtrace_list->evalargs = 0;
+tem = funcall_lambda (fun, numargs, arg_vector);
+/* Do the debug-on-exit now, while arg_vector still exists.  */
+if (backtrace_list->debug_on_exit)
+tem = do_debug_on_exit (tem);
+/* Don't do it again when we return to eval.  */
+backtrace_list->debug_on_exit = 0;
+return (tem);
+}
+/* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
+and return the result of evaluation.
+FUN must be either a lambda-expression or a compiled-code object.  */
+static Lisp_Object
+funcall_lambda (Lisp_Object fun, int nargs, Lisp_Object arg_vector[])
+{
+/* This function can GC */
+Lisp_Object val, tem;
+REGISTER Lisp_Object syms_left;
+REGISTER Lisp_Object next;
+int speccount = specpdl_depth_counter;
+REGISTER int i;
+int optional = 0, rest = 0;
+#ifdef MOCKLISP_SUPPORT
+if (!EQ (Vmocklisp_arguments, Qt))
+specbind (Qmocklisp_arguments, Qt); /* t means NOT mocklisp! */
+#endif
+if (CONSP (fun))
+syms_left = Fcar (Fcdr (fun));
+else if (COMPILED_FUNCTIONP (fun))
+syms_left = XCOMPILED_FUNCTION (fun)->arglist;
+else abort ();
+i = 0;
+for (; !NILP (syms_left); syms_left = Fcdr (syms_left))
+{
+QUIT;
+next = Fcar (syms_left);
+if (!SYMBOLP (next))
+	signal_error (Qinvalid_function, list1 (fun));
+if (EQ (next, Qand_rest))
+	rest = 1;
+else if (EQ (next, Qand_optional))
+	optional = 1;
+else if (rest)
+	{
+	  specbind (next, Flist (nargs - i, &arg_vector[i]));
+	  i = nargs;
+	}
+else if (i < nargs)
+	{
+	  tem = arg_vector[i++];
+	  specbind (next, tem);
+	}
+else if (!optional)
+	return Fsignal (Qwrong_number_of_arguments,
+list2 (fun, make_int (nargs)));
+else
+	specbind (next, Qnil);
+}
+if (i < nargs)
+return Fsignal (Qwrong_number_of_arguments,
+list2 (fun, make_int (nargs)));
+if (CONSP (fun))
+val = Fprogn (Fcdr (Fcdr (fun)));
+else
+{
+struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (fun);
+/* If we have not actually read the bytecode string
+	 and constants vector yet, fetch them from the file.  */
+if (CONSP (b->bytecodes))
+	Ffetch_bytecode (fun);
+val = Fbyte_code (b->bytecodes,
+b->constants,
+make_int (b->maxdepth));
+}
+return unbind_to (speccount, val);
+}
+DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
+1, 1, 0 /*
+If byte-compiled OBJECT is lazy-loaded, fetch it now.
+*/ )
+(object)
+Lisp_Object object;
+{
+Lisp_Object tem;
+if (COMPILED_FUNCTIONP (object)
+&& CONSP (XCOMPILED_FUNCTION (object)->bytecodes))
+{
+tem = read_doc_string (XCOMPILED_FUNCTION (object)->bytecodes);
+if (!CONSP (tem))
+	signal_simple_error ("invalid lazy-loaded byte code", tem);
+/* VERY IMPORTANT to purecopy here!!!!!
+	 See load_force_doc_string_unwind. */
+XCOMPILED_FUNCTION (object)->bytecodes = Fpurecopy (XCAR (tem));
+XCOMPILED_FUNCTION (object)->constants = Fpurecopy (XCDR (tem));
+}
+return object;
+}
+/**********************************************************************/
+/*                   Run hook variables in various ways.              */
+/**********************************************************************/
+DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 1, MANY, 0 /*
+Run each hook in HOOKS.  Major mode functions use this.
+Each argument should be a symbol, a hook variable.
+These symbols are processed in the order specified.
+If a hook symbol has a non-nil value, that value may be a function
+or a list of functions to be called to run the hook.
+If the value is a function, it is called with no arguments.
+If it is a list, the elements are called, in order, with no arguments.
+To make a hook variable buffer-local, use `make-local-hook',
+not `make-local-variable'.
+*/ )
+(nargs, args)
+int nargs;
+Lisp_Object *args;
+{
+Lisp_Object hook[1];
+REGISTER int i;
+for (i = 0; i < nargs; i++)
+{
+hook[0] = args[i];
+run_hook_with_args (1, hook, RUN_HOOKS_TO_COMPLETION);
+}
+return Qnil;
+}
+DEFUN ("run-hook-with-args",
+Frun_hook_with_args, Srun_hook_with_args, 1, MANY, 0 /*
+Run HOOK with the specified arguments ARGS.
+HOOK should be a symbol, a hook variable.  If HOOK has a non-nil
+value, that value may be a function or a list of functions to be
+called to run the hook.  If the value is a function, it is called with
+the given arguments and its return value is returned.  If it is a list
+of functions, those functions are called, in order,
+with the given arguments ARGS.
+It is best not to depend on the value return by `run-hook-with-args',
+as that may change.
+To make a hook variable buffer-local, use `make-local-hook',
+not `make-local-variable'.
+*/ )
+(nargs, args)
+int nargs;
+Lisp_Object *args;
+{
+return run_hook_with_args (nargs, args, RUN_HOOKS_TO_COMPLETION);
+}
+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.
+HOOK should be a symbol, a hook variable.  Its value should
+be a list of functions.  We call those functions, one by one,
+passing arguments ARGS to each of them, until one of them
+returns a non-nil value.  Then we return that value.
+If all the functions return nil, we return nil.
+To make a hook variable buffer-local, use `make-local-hook',
+not `make-local-variable'.
+*/ )
+(nargs, args)
+int nargs;
+Lisp_Object *args;
+{
+return run_hook_with_args (nargs, args, RUN_HOOKS_UNTIL_SUCCESS);
+}
+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.
+HOOK should be a symbol, a hook variable.  Its value should
+be a list of functions.  We call those functions, one by one,
+passing arguments ARGS to each of them, until one of them
+returns nil.  Then we return nil.
+If all the functions return non-nil, we return non-nil.
+To make a hook variable buffer-local, use `make-local-hook',
+not `make-local-variable'.
+*/ )
+(nargs, args)
+int nargs;
+Lisp_Object *args;
+{
+return run_hook_with_args (nargs, args, RUN_HOOKS_UNTIL_FAILURE);
+}
+/* ARGS[0] should be a hook symbol.
+Call each of the functions in the hook value, passing each of them
+as arguments all the rest of ARGS (all NARGS - 1 elements).
+COND specifies a condition to test after each call
+to decide whether to stop.
+The caller (or its caller, etc) must gcpro all of ARGS,
+except that it isn't necessary to gcpro ARGS[0].  */
+Lisp_Object
+run_hook_with_args_in_buffer (struct buffer *buf, int nargs, Lisp_Object *args,
+			      enum run_hooks_condition cond)
+{
+Lisp_Object sym, val, ret;
+struct gcpro gcpro1, gcpro2;
+if (!initialized || preparing_for_armageddon)
+/* We need to bail out of here pronto. */
+return Qnil;
+/* Whenever gc_in_progress is true, preparing_for_armageddon
+will also be true unless something is really hosed. */
+assert (!gc_in_progress);
+sym = args[0];
+val = symbol_value_in_buffer (sym, make_buffer (buf));
+ret = (cond == RUN_HOOKS_UNTIL_FAILURE ? Qt : Qnil);
+if (UNBOUNDP (val) || NILP (val))
+return ret;
+else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
+{
+args[0] = val;
+return Ffuncall (nargs, args);
+}
+else
+{
+GCPRO2 (sym, val);
+for (;
+	   CONSP (val) && ((cond == RUN_HOOKS_TO_COMPLETION)
+			   || (cond == RUN_HOOKS_UNTIL_SUCCESS ? NILP (ret)
+			       : !NILP (ret)));
+	   val = XCDR (val))
+	{
+	  if (EQ (XCAR (val), Qt))
+	    {
+	      /* t indicates this hook has a local binding;
+		 it means to run the global binding too.  */
+	      Lisp_Object globals;
+	      for (globals = Fdefault_value (sym);
+		   CONSP (globals) && ((cond == RUN_HOOKS_TO_COMPLETION)
+				       || (cond == RUN_HOOKS_UNTIL_SUCCESS
+					   ? NILP (ret)
+					   : !NILP (ret)));
+		   globals = XCDR (globals))
+		{
+		  args[0] = XCAR (globals);
+		  /* In a global value, t should not occur.  If it does, we
+		     must ignore it to avoid an endless loop.  */
+		  if (!EQ (args[0], Qt))
+		    ret = Ffuncall (nargs, args);
+		}
+	    }
+	  else
+	    {
+	      args[0] = XCAR (val);
+	      ret = Ffuncall (nargs, args);
+	    }
+	}
+UNGCPRO;
+return ret;
+}
+}
+Lisp_Object
+run_hook_with_args (int nargs, Lisp_Object *args,
+		    enum run_hooks_condition cond)
+{
+return run_hook_with_args_in_buffer (current_buffer, nargs, args, cond);
+}
+#if 0
+/* From FSF 19.30, not currently used */
+/* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
+present value of that symbol.
+Call each element of FUNLIST,
+passing each of them the rest of ARGS.
+The caller (or its caller, etc) must gcpro all of ARGS,
+except that it isn't necessary to gcpro ARGS[0].  */
+Lisp_Object
+run_hook_list_with_args (Lisp_Object funlist, int nargs, Lisp_Object *args)
+{
+Lisp_Object sym;
+Lisp_Object val;
+struct gcpro gcpro1, gcpro2;
+sym = args[0];
+GCPRO2 (sym, val);
+for (val = funlist; CONSP (val); val = XCDR (val))
+{
+if (EQ (XCAR (val), Qt))
+	{
+	  /* t indicates this hook has a local binding;
+	     it means to run the global binding too.  */
+	  Lisp_Object globals;
+	  for (globals = Fdefault_value (sym);
+	       CONSP (globals);
+	       globals = XCDR (globals))
+	    {
+	      args[0] = XCAR (globals);
+	      /* In a global value, t should not occur.  If it does, we
+		 must ignore it to avoid an endless loop.  */
+	      if (!EQ (args[0], Qt))
+		Ffuncall (nargs, args);
+	    }
+	}
+else
+	{
+	  args[0] = XCAR (val);
+	  Ffuncall (nargs, args);
+	}
+}
+UNGCPRO;
+return Qnil;
+}
+#endif /* 0 */
+void
+va_run_hook_with_args (Lisp_Object hook_var, int nargs, ...)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+int i;
+va_list vargs;
+Lisp_Object *funcall_args =
+(Lisp_Object *) alloca ((1 + nargs) * sizeof (Lisp_Object));
+va_start (vargs, nargs);
+funcall_args[0] = hook_var;
+for (i = 0; i < nargs; i++)
+funcall_args[i + 1] = va_arg (vargs, Lisp_Object);
+va_end (vargs);
+GCPRO1 (*funcall_args);
+gcpro1.nvars = nargs + 1;
+run_hook_with_args (nargs + 1, funcall_args, RUN_HOOKS_TO_COMPLETION);
+UNGCPRO;
+}
+void
+va_run_hook_with_args_in_buffer (struct buffer *buf, Lisp_Object hook_var,
+				 int nargs, ...)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+int i;
+va_list vargs;
+Lisp_Object *funcall_args =
+(Lisp_Object *) alloca ((1 + nargs) * sizeof (Lisp_Object));
+va_start (vargs, nargs);
+funcall_args[0] = hook_var;
+for (i = 0; i < nargs; i++)
+funcall_args[i + 1] = va_arg (vargs, Lisp_Object);
+va_end (vargs);
+GCPRO1 (*funcall_args);
+gcpro1.nvars = nargs + 1;
+run_hook_with_args_in_buffer (buf, nargs + 1, funcall_args,
+				RUN_HOOKS_TO_COMPLETION);
+UNGCPRO;
+}
+Lisp_Object
+run_hook (Lisp_Object hook)
+{
+Frun_hooks (1, &hook);
+return Qnil;
+}
+/**********************************************************************/
+/*                  Front-ends to eval, funcall, apply                */
+/**********************************************************************/
+/* Apply fn to arg */
+Lisp_Object
+apply1 (Lisp_Object fn, Lisp_Object arg)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+Lisp_Object args[2];
+if (NILP (arg))
+return (Ffuncall (1, &fn));
+GCPRO1 (args[0]);
+gcpro1.nvars = 2;
+args[0] = fn;
+args[1] = arg;
+RETURN_UNGCPRO (Fapply (2, args));
+}
+/* Call function fn on no arguments */
+Lisp_Object
+call0 (Lisp_Object fn)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+GCPRO1 (fn);
+RETURN_UNGCPRO (Ffuncall (1, &fn));
+}
+/* Call function fn with argument arg0 */
+Lisp_Object
+call1 (Lisp_Object fn,
+Lisp_Object arg0)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+Lisp_Object args[2];
+args[0] = fn;
+args[1] = arg0;
+GCPRO1 (args[0]);
+gcpro1.nvars = 2;
+RETURN_UNGCPRO (Ffuncall (2, args));
+}
+/* Call function fn with arguments arg0, arg1 */
+Lisp_Object
+call2 (Lisp_Object fn,
+Lisp_Object arg0, Lisp_Object arg1)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+Lisp_Object args[3];
+args[0] = fn;
+args[1] = arg0;
+args[2] = arg1;
+GCPRO1 (args[0]);
+gcpro1.nvars = 3;
+RETURN_UNGCPRO (Ffuncall (3, args));
+}
+/* Call function fn with arguments arg0, arg1, arg2 */
+Lisp_Object
+call3 (Lisp_Object fn,
+Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+Lisp_Object args[4];
+args[0] = fn;
+args[1] = arg0;
+args[2] = arg1;
+args[3] = arg2;
+GCPRO1 (args[0]);
+gcpro1.nvars = 4;
+RETURN_UNGCPRO (Ffuncall (4, args));
+}
+/* Call function fn with arguments arg0, arg1, arg2, arg3 */
+Lisp_Object
+call4 (Lisp_Object fn,
+Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
+Lisp_Object arg3)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+Lisp_Object args[5];
+args[0] = fn;
+args[1] = arg0;
+args[2] = arg1;
+args[3] = arg2;
+args[4] = arg3;
+GCPRO1 (args[0]);
+gcpro1.nvars = 5;
+RETURN_UNGCPRO (Ffuncall (5, args));
+}
+/* Call function fn with arguments arg0, arg1, arg2, arg3, arg4 */
+Lisp_Object
+call5 (Lisp_Object fn,
+Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
+Lisp_Object arg3, Lisp_Object arg4)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+Lisp_Object args[6];
+args[0] = fn;
+args[1] = arg0;
+args[2] = arg1;
+args[3] = arg2;
+args[4] = arg3;
+args[5] = arg4;
+GCPRO1 (args[0]);
+gcpro1.nvars = 6;
+RETURN_UNGCPRO (Ffuncall (6, args));
+}
+Lisp_Object
+call6 (Lisp_Object fn,
+Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
+Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+Lisp_Object args[7];
+args[0] = fn;
+args[1] = arg0;
+args[2] = arg1;
+args[3] = arg2;
+args[4] = arg3;
+args[5] = arg4;
+args[6] = arg5;
+GCPRO1 (args[0]);
+gcpro1.nvars = 7;
+RETURN_UNGCPRO (Ffuncall (7, args));
+}
+Lisp_Object
+call7 (Lisp_Object fn,
+Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
+Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5,
+Lisp_Object arg6)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+Lisp_Object args[8];
+args[0] = fn;
+args[1] = arg0;
+args[2] = arg1;
+args[3] = arg2;
+args[4] = arg3;
+args[5] = arg4;
+args[6] = arg5;
+args[7] = arg6;
+GCPRO1 (args[0]);
+gcpro1.nvars = 8;
+RETURN_UNGCPRO (Ffuncall (8, args));
+}
+Lisp_Object
+call8 (Lisp_Object fn,
+Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
+Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5,
+Lisp_Object arg6, Lisp_Object arg7)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+Lisp_Object args[9];
+args[0] = fn;
+args[1] = arg0;
+args[2] = arg1;
+args[3] = arg2;
+args[4] = arg3;
+args[5] = arg4;
+args[6] = arg5;
+args[7] = arg6;
+args[8] = arg7;
+GCPRO1 (args[0]);
+gcpro1.nvars = 9;
+RETURN_UNGCPRO (Ffuncall (9, args));
+}
+Lisp_Object
+call0_in_buffer (struct buffer *buf, Lisp_Object fn)
+{
+int speccount = specpdl_depth ();
+Lisp_Object val;
+if (current_buffer != buf)
+{
+record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+set_buffer_internal (buf);
+}
+val = call0 (fn);
+unbind_to (speccount, Qnil);
+return val;
+}
+Lisp_Object
+call1_in_buffer (struct buffer *buf, Lisp_Object fn,
+		 Lisp_Object arg0)
+{
+int speccount = specpdl_depth ();
+Lisp_Object val;
+if (current_buffer != buf)
+{
+record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+set_buffer_internal (buf);
+}
+val = call1 (fn, arg0);
+unbind_to (speccount, Qnil);
+return val;
+}
+Lisp_Object
+call2_in_buffer (struct buffer *buf, Lisp_Object fn,
+		 Lisp_Object arg0, Lisp_Object arg1)
+{
+int speccount = specpdl_depth ();
+Lisp_Object val;
+if (current_buffer != buf)
+{
+record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+set_buffer_internal (buf);
+}
+val = call2 (fn, arg0, arg1);
+unbind_to (speccount, Qnil);
+return val;
+}
+Lisp_Object
+call3_in_buffer (struct buffer *buf, Lisp_Object fn,
+		 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2)
+{
+int speccount = specpdl_depth ();
+Lisp_Object val;
+if (current_buffer != buf)
+{
+record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+set_buffer_internal (buf);
+}
+val = call3 (fn, arg0, arg1, arg2);
+unbind_to (speccount, Qnil);
+return val;
+}
+Lisp_Object
+call4_in_buffer (struct buffer *buf, Lisp_Object fn,
+		 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
+		 Lisp_Object arg3)
+{
+int speccount = specpdl_depth ();
+Lisp_Object val;
+if (current_buffer != buf)
+{
+record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+set_buffer_internal (buf);
+}
+val = call4 (fn, arg0, arg1, arg2, arg3);
+unbind_to (speccount, Qnil);
+return val;
+}
+Lisp_Object
+call5_in_buffer (struct buffer *buf, Lisp_Object fn,
+		 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
+		 Lisp_Object arg3, Lisp_Object arg4)
+{
+int speccount = specpdl_depth ();
+Lisp_Object val;
+if (current_buffer != buf)
+{
+record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+set_buffer_internal (buf);
+}
+val = call5 (fn, arg0, arg1, arg2, arg3, arg4);
+unbind_to (speccount, Qnil);
+return val;
+}
+Lisp_Object
+call6_in_buffer (struct buffer *buf, Lisp_Object fn,
+		 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
+		 Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5)
+{
+int speccount = specpdl_depth ();
+Lisp_Object val;
+if (current_buffer != buf)
+{
+record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+set_buffer_internal (buf);
+}
+val = call6 (fn, arg0, arg1, arg2, arg3, arg4, arg5);
+unbind_to (speccount, Qnil);
+return val;
+}
+Lisp_Object
+eval_in_buffer (struct buffer *buf, Lisp_Object form)
+{
+int speccount = specpdl_depth ();
+Lisp_Object val;
+if (current_buffer != buf)
+{
+record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+set_buffer_internal (buf);
+}
+val = Feval (form);
+unbind_to (speccount, Qnil);
+return val;
+}
+/***** Error-catching front-ends to eval, funcall, apply */
+/* Call function fn on no arguments, with condition handler */
+Lisp_Object
+call0_with_handler (Lisp_Object handler, Lisp_Object fn)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+Lisp_Object args[2];
+args[0] = handler;
+args[1] = fn;
+GCPRO1 (args[0]);
+gcpro1.nvars = 2;
+RETURN_UNGCPRO (Fcall_with_condition_handler (2, args));
+}
+/* Call function fn with argument arg0, with condition handler */
+Lisp_Object
+call1_with_handler (Lisp_Object handler, Lisp_Object fn,
+Lisp_Object arg0)
+{
+/* This function can GC */
+struct gcpro gcpro1;
+Lisp_Object args[3];
+args[0] = handler;
+args[1] = fn;
+args[2] = arg0;
+GCPRO1 (args[0]);
+gcpro1.nvars = 3;
+RETURN_UNGCPRO (Fcall_with_condition_handler (3, args));
+}
+/* The following functions provide you with error-trapping versions
+of the various front-ends above.  They take an additional
+"warning_string" argument; if non-zero, a warning with this
+string and the actual error that occurred will be displayed
+in the *Warnings* buffer if an error occurs.  In all cases,
+QUIT is inhibited while these functions are running, and if
+an error occurs, Qunbound is returned instead of the normal
+return value.
+*/
+/* #### This stuff needs to catch throws as well.  We need to
+improve internal_catch() so it can take a "catch anything"
+argument similar to Qt or Qerror for condition_case_1(). */
+static Lisp_Object
+caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
+{
+if (!NILP (errordata))
+{
+Lisp_Object args[2];
+if (!NILP (arg))
+{
+char *str = (char *) get_opaque_ptr (arg);
+args[0] = build_string (str);
+}
+else
+args[0] = build_string ("error");
+/* #### This should call
+	 (with-output-to-string (display-error errordata))
+	 but that stuff is all in Lisp currently. */
+args[1] = errordata;
+warn_when_safe_lispobj
+	(Qerror, Qwarning,
+	 emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s",
+				   Qnil, -1, 2, args));
+}
+return Qunbound;
+}
+static Lisp_Object
+allow_quit_caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
+{
+if (CONSP (errordata) && EQ (XCAR (errordata), Qquit))
+return Fsignal (Qquit, XCDR (errordata));
+return caught_a_squirmer (errordata, arg);
+}
+static Lisp_Object
+safe_run_hook_caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg)
+{
+Lisp_Object hook = Fcar (arg);
+arg = Fcdr (arg);
+/* Clear out the hook. */
+Fset (hook, Qnil);
+return caught_a_squirmer (errordata, arg);
+}
+static Lisp_Object
+allow_quit_safe_run_hook_caught_a_squirmer (Lisp_Object errordata,
+					    Lisp_Object arg)
+{
+Lisp_Object hook = Fcar (arg);
+arg = Fcdr (arg);
+if (!CONSP (errordata) || !EQ (XCAR (errordata), Qquit))
+/* Clear out the hook. */
+Fset (hook, Qnil);
+return allow_quit_caught_a_squirmer (errordata, arg);
+}
+static Lisp_Object
+catch_them_squirmers_eval_in_buffer (Lisp_Object cons)
+{
+return eval_in_buffer (XBUFFER (XCAR (cons)), XCDR (cons));
+}
+Lisp_Object
+eval_in_buffer_trapping_errors (CONST char *warning_string,
+				struct buffer *buf, Lisp_Object form)
+{
+int speccount = specpdl_depth ();
+Lisp_Object tem;
+Lisp_Object buffer = Qnil;
+Lisp_Object cons;
+Lisp_Object opaque;
+struct gcpro gcpro1, gcpro2;
+XSETBUFFER (buffer, buf);
+specbind (Qinhibit_quit, Qt);
+/* gc_currently_forbidden = 1; Currently no reason to do this; */
+cons = noseeum_cons (buffer, form);
+opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+GCPRO2 (cons, opaque);
+/* Qerror not Qt, so you can get a backtrace */
+tem = condition_case_1 (Qerror,
+catch_them_squirmers_eval_in_buffer, cons,
+			  caught_a_squirmer, opaque);
+free_cons (XCONS (cons));
+if (OPAQUEP (opaque))
+free_opaque_ptr (opaque);
+UNGCPRO;
+/* gc_currently_forbidden = 0; */
+return unbind_to (speccount, tem);
+}
+static Lisp_Object
+catch_them_squirmers_run_hook (Lisp_Object hook_symbol)
+{
+/* This function can GC */
+run_hook (hook_symbol);
+return Qnil;
+}
+Lisp_Object
+run_hook_trapping_errors (CONST char *warning_string, Lisp_Object hook_symbol)
+{
+int speccount = specpdl_depth ();
+Lisp_Object tem;
+Lisp_Object opaque;
+struct gcpro gcpro1;
+if (!initialized || preparing_for_armageddon)
+return Qnil;
+tem = find_symbol_value (hook_symbol);
+if (NILP (tem) || UNBOUNDP (tem))
+return Qnil;
+specbind (Qinhibit_quit, Qt);
+opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+GCPRO1 (opaque);
+/* Qerror not Qt, so you can get a backtrace */
+tem = condition_case_1 (Qerror,
+catch_them_squirmers_run_hook, hook_symbol,
+caught_a_squirmer, opaque);
+if (OPAQUEP (opaque))
+free_opaque_ptr (opaque);
+UNGCPRO;
+return unbind_to (speccount, tem);
+}
+/* Same as run_hook_trapping_errors() but also set the hook to nil
+if an error occurs. */
+Lisp_Object
+safe_run_hook_trapping_errors (CONST char *warning_string,
+			       Lisp_Object hook_symbol,
+			       int allow_quit)
+{
+int speccount = specpdl_depth ();
+Lisp_Object tem;
+Lisp_Object cons = Qnil;
+struct gcpro gcpro1;
+if (!initialized || preparing_for_armageddon)
+return Qnil;
+tem = find_symbol_value (hook_symbol);
+if (NILP (tem) || UNBOUNDP (tem))
+return Qnil;
+if (!allow_quit)
+specbind (Qinhibit_quit, Qt);
+cons = noseeum_cons (hook_symbol,
+		       warning_string ? make_opaque_ptr (warning_string)
+		       : Qnil);
+GCPRO1 (cons);
+/* Qerror not Qt, so you can get a backtrace */
+tem = condition_case_1 (Qerror,
+catch_them_squirmers_run_hook,
+			  hook_symbol,
+			  allow_quit ?
+			  allow_quit_safe_run_hook_caught_a_squirmer :
+safe_run_hook_caught_a_squirmer,
+			  cons);
+if (OPAQUEP (XCDR (cons)))
+free_opaque_ptr (XCDR (cons));
+free_cons (XCONS (cons));
+UNGCPRO;
+return unbind_to (speccount, tem);
+}
+static Lisp_Object
+catch_them_squirmers_call0 (Lisp_Object function)
+{
+/* This function can GC */
+return call0 (function);
+}
+Lisp_Object
+call0_trapping_errors (CONST char *warning_string, Lisp_Object function)
+{
+int speccount = specpdl_depth ();
+Lisp_Object tem;
+Lisp_Object opaque = Qnil;
+struct gcpro gcpro1, gcpro2;
+if (SYMBOLP (function))
+{
+tem = XSYMBOL (function)->function;
+if (NILP (tem) || UNBOUNDP (tem))
+	return (Qnil);
+}
+GCPRO2 (opaque, function);
+specbind (Qinhibit_quit, Qt);
+/* gc_currently_forbidden = 1; Currently no reason to do this; */
+opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+/* Qerror not Qt, so you can get a backtrace */
+tem = condition_case_1 (Qerror,
+catch_them_squirmers_call0, function,
+caught_a_squirmer, opaque);
+if (OPAQUEP (opaque))
+free_opaque_ptr (opaque);
+UNGCPRO;
+/* gc_currently_forbidden = 0; */
+return unbind_to (speccount, tem);
+}
+static Lisp_Object
+catch_them_squirmers_call1 (Lisp_Object cons)
+{
+/* This function can GC */
+return call1 (XCAR (cons), XCDR (cons));
+}
+static Lisp_Object
+catch_them_squirmers_call2 (Lisp_Object cons)
+{
+/* This function can GC */
+return call2 (XCAR (cons), XCAR (XCDR (cons)), XCAR (XCDR (XCDR (cons))));
+}
+Lisp_Object
+call1_trapping_errors (CONST char *warning_string, Lisp_Object function,
+		       Lisp_Object object)
+{
+int speccount = specpdl_depth ();
+Lisp_Object tem;
+Lisp_Object cons = Qnil;
+Lisp_Object opaque = Qnil;
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+if (SYMBOLP (function))
+{
+tem = XSYMBOL (function)->function;
+if (NILP (tem) || UNBOUNDP (tem))
+	return (Qnil);
+}
+GCPRO4 (cons, opaque, function, object);
+specbind (Qinhibit_quit, Qt);
+/* gc_currently_forbidden = 1; Currently no reason to do this; */
+cons = noseeum_cons (function, object);
+opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+/* Qerror not Qt, so you can get a backtrace */
+tem = condition_case_1 (Qerror,
+catch_them_squirmers_call1, cons,
+caught_a_squirmer, opaque);
+if (OPAQUEP (opaque))
+free_opaque_ptr (opaque);
+free_cons (XCONS (cons));
+UNGCPRO;
+/* gc_currently_forbidden = 0; */
+return unbind_to (speccount, tem);
+}
+Lisp_Object
+call2_trapping_errors (CONST char *warning_string, Lisp_Object function,
+		       Lisp_Object object1, Lisp_Object object2)
+{
+int speccount = specpdl_depth ();
+Lisp_Object tem;
+Lisp_Object cons = Qnil;
+Lisp_Object opaque = Qnil;
+struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+if (SYMBOLP (function))
+{
+tem = XSYMBOL (function)->function;
+if (NILP (tem) || UNBOUNDP (tem))
+	return (Qnil);
+}
+GCPRO5 (cons, opaque, function, object1, object2);
+specbind (Qinhibit_quit, Qt);
+/* gc_currently_forbidden = 1; Currently no reason to do this; */
+cons = list3 (function, object1, object2);
+opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
+/* Qerror not Qt, so you can get a backtrace */
+tem = condition_case_1 (Qerror,
+catch_them_squirmers_call2, cons,
+caught_a_squirmer, opaque);
+if (OPAQUEP (opaque))
+free_opaque_ptr (opaque);
+free_list (cons);
+UNGCPRO;
+/* gc_currently_forbidden = 0; */
+return unbind_to (speccount, tem);
+}
+/**********************************************************************/
+/*                     The special binding stack                      */
+/**********************************************************************/
+static void
+grow_specpdl (void)
+{
+if (specpdl_size >= max_specpdl_size)
+{
+if (max_specpdl_size < 400)
+	max_specpdl_size = 400;
+if (specpdl_size >= max_specpdl_size)
+	{
+	  if (!NILP (Vdebug_on_error) || !NILP (Vdebug_on_signal))
+	    /* Leave room for some specpdl in the debugger.  */
+	    max_specpdl_size = specpdl_size + 100;
+	  continuable_error
+	    ("Variable binding depth exceeds max-specpdl-size");
+	}
+}
+specpdl_size *= 2;
+if (specpdl_size > max_specpdl_size)
+specpdl_size = max_specpdl_size;
+specpdl = ((struct specbinding *)
+	     xrealloc (specpdl, specpdl_size * sizeof (struct specbinding)));
+specpdl_ptr = specpdl + specpdl_depth_counter;
+}
+/* Handle unbinding buffer-local variables */
+static Lisp_Object
+specbind_unwind_local (Lisp_Object ovalue)
+{
+Lisp_Object current = Fcurrent_buffer ();
+Lisp_Object symbol = specpdl_ptr->symbol;
+struct Lisp_Cons *victim = XCONS (ovalue);
+Lisp_Object buf = get_buffer (victim->car, 0);
+ovalue = victim->cdr;
+free_cons (victim);
+if (NILP (buf))
+{
+/* Deleted buffer -- do nothing */
+}
+else if (symbol_value_buffer_local_info (symbol, XBUFFER (buf)) == 0)
+{
+/* Was buffer-local when binding was made, now no longer is.
+*  (kill-local-variable can do this.)
+* Do nothing in this case.
+*/
+}
+else if (EQ (buf, current))
+Fset (symbol, ovalue);
+else
+{
+/* Urk! Somebody switched buffers */
+struct gcpro gcpro1;
+GCPRO1 (current);
+Fset_buffer (buf);
+Fset (symbol, ovalue);
+Fset_buffer (current);
+UNGCPRO;
+}
+return (symbol);
+}
+static Lisp_Object
+specbind_unwind_wasnt_local (Lisp_Object buffer)
+{
+Lisp_Object current = Fcurrent_buffer ();
+Lisp_Object symbol = specpdl_ptr->symbol;
+buffer = get_buffer (buffer, 0);
+if (NILP (buffer))
+{
+/* Deleted buffer -- do nothing */
+}
+else if (symbol_value_buffer_local_info (symbol, XBUFFER (buffer)) == 0)
+{
+/* Was buffer-local when binding was made, now no longer is.
+*  (kill-local-variable can do this.)
+* Do nothing in this case.
+*/
+}
+else if (EQ (buffer, current))
+Fkill_local_variable (symbol);
+else
+{
+/* Urk! Somebody switched buffers */
+struct gcpro gcpro1;
+GCPRO1 (current);
+Fset_buffer (buffer);
+Fkill_local_variable (symbol);
+Fset_buffer (current);
+UNGCPRO;
+}
+return (symbol);
+}
+/* Don't want to include buffer.h just for this */
+extern struct buffer *current_buffer;
+void
+specbind (Lisp_Object symbol, Lisp_Object value)
+{
+int buffer_local;
+CHECK_SYMBOL (symbol);
+if (specpdl_depth_counter >= specpdl_size)
+grow_specpdl ();
+buffer_local = symbol_value_buffer_local_info (symbol, current_buffer);
+if (buffer_local == 0)
+{
+specpdl_ptr->old_value = find_symbol_value (symbol);
+specpdl_ptr->func = 0;      /* Handled specially by unbind_to */
+}
+else if (buffer_local > 0)
+{
+/* Already buffer-local */
+specpdl_ptr->old_value = noseeum_cons (Fcurrent_buffer (),
+					     find_symbol_value (symbol));
+specpdl_ptr->func = specbind_unwind_local;
+}
+else
+{
+/* About to become buffer-local */
+specpdl_ptr->old_value = Fcurrent_buffer ();
+specpdl_ptr->func = specbind_unwind_wasnt_local;
+}
+specpdl_ptr->symbol = symbol;
+specpdl_ptr++;
+specpdl_depth_counter++;
+Fset (symbol, value);
+}
+void
+record_unwind_protect (Lisp_Object (*function) (Lisp_Object arg),
+Lisp_Object arg)
+{
+if (specpdl_depth_counter >= specpdl_size)
+grow_specpdl ();
+specpdl_ptr->func = function;
+specpdl_ptr->symbol = Qnil;
+specpdl_ptr->old_value = arg;
+specpdl_ptr++;
+specpdl_depth_counter++;
+}
+extern int check_sigio (void);
+Lisp_Object
+unbind_to (int count, Lisp_Object value)
+{
+int quitf;
+struct gcpro gcpro1;
+GCPRO1 (value);
+check_quit (); /* make Vquit_flag accurate */
+quitf = !NILP (Vquit_flag);
+Vquit_flag = Qnil;
+while (specpdl_depth_counter != count)
+{
+Lisp_Object ovalue;
+--specpdl_ptr;
+--specpdl_depth_counter;
+ovalue = specpdl_ptr->old_value;
+if (specpdl_ptr->func != 0)
+/* An unwind-protect */
+	(*specpdl_ptr->func) (ovalue);
+else
+Fset (specpdl_ptr->symbol, ovalue);
+#ifndef EXCEEDINGLY_QUESTIONABLE_CODE
+/* There should never be anything here for us to remove.
+	 If so, it indicates a logic error in Emacs.  Catches
+	 should get removed when a throw or signal occurs, or
+	 when a catch or condition-case exits normally.  But
+	 it's too dangerous to just remove this code. --ben */
+/* Furthermore, this code is not in FSFmacs!!!
+	 Braino on mly's part? */
+/* If we're unwound past the pdlcount of a catch frame,
+that catch can't possibly still be valid. */
+while (catchlist && catchlist->pdlcount > specpdl_depth_counter)
+{
+catchlist = catchlist->next;
+/* Don't mess with gcprolist, backtrace_list here */
+}
+#endif
+}
+if (quitf)
+Vquit_flag = Qt;
+UNGCPRO;
+return (value);
+}
+int
+specpdl_depth (void)
+{
+return (specpdl_depth_counter);
+}
+/* Get the value of symbol's global binding, even if that binding is
+not now dynamically visible.  May return Qunbound or magic values. */
+Lisp_Object
+top_level_value (Lisp_Object symbol)
+{
+REGISTER struct specbinding *ptr = specpdl;
+CHECK_SYMBOL (symbol);
+for (; ptr != specpdl_ptr; ptr++)
+{
+if (EQ (ptr->symbol, symbol))
+	return ptr->old_value;
+}
+return XSYMBOL (symbol)->value;
+}
+#if 0
+Lisp_Object
+top_level_set (Lisp_Object symbol, Lisp_Object newval)
+{
+REGISTER struct specbinding *ptr = specpdl;
+CHECK_SYMBOL (symbol);
+for (; ptr != specpdl_ptr; ptr++)
+{
+if (EQ (ptr->symbol, symbol))
+	{
+	  ptr->old_value = newval;
+	  return newval;
+	}
+}
+return Fset (symbol, newval);
+}
+#endif /* 0 */
+/**********************************************************************/
+/*                            Backtraces                              */
+/**********************************************************************/
+DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0 /*
+Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
+The debugger is entered when that frame exits, if the flag is non-nil.
+*/ )
+(level, flag)
+Lisp_Object level, flag;
+{
+REGISTER struct backtrace *backlist = backtrace_list;
+REGISTER int i;
+CHECK_INT (level);
+for (i = 0; backlist && i < XINT (level); i++)
+{
+backlist = backlist->next;
+}
+if (backlist)
+backlist->debug_on_exit = !NILP (flag);
+return flag;
+}
+static void
+backtrace_specials (int speccount, int speclimit, Lisp_Object stream)
+{
+int printing_bindings = 0;
+for (; speccount > speclimit; speccount--)
+{
+if (specpdl[speccount - 1].func == 0
+|| specpdl[speccount - 1].func == specbind_unwind_local
+|| specpdl[speccount - 1].func == specbind_unwind_wasnt_local)
+	{
+	  write_c_string (((!printing_bindings) ? "  # bind (" : " "),
+			  stream);
+	  Fprin1 (specpdl[speccount - 1].symbol, stream);
+	  printing_bindings = 1;
+	}
+else
+	{
+	  if (printing_bindings) write_c_string (")\n", stream);
+	  write_c_string ("  # (unwind-protect ...)\n", stream);
+	  printing_bindings = 0;
+	}
+}
+if (printing_bindings) write_c_string (")\n", stream);
+}
+DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 2, "" /*
+Print a trace of Lisp function calls currently active.
+Option arg STREAM specifies the output stream to send the backtrace to,
+and defaults to the value of `standard-output'.  Optional second arg
+DETAILED means show places where currently active variable bindings,
+catches, condition-cases, and unwind-protects were made as well as
+function calls.
+*/ )
+(stream, detailed)
+Lisp_Object stream, detailed;
+{
+struct backtrace *backlist = backtrace_list;
+struct catchtag *catches = catchlist;
+int speccount = specpdl_depth_counter;
+int old_nl = print_escape_newlines;
+int old_pr = print_readably;
+Lisp_Object old_level = Vprint_level;
+Lisp_Object oiq = Vinhibit_quit;
+struct gcpro gcpro1, gcpro2;
+/* We can't allow quits in here because that could cause the values
+of print_readably and print_escape_newlines to get screwed up.
+Normally we would use a record_unwind_protect but that would
+screw up the functioning of this function. */
+Vinhibit_quit = Qt;
+entering_debugger = 0;
+Vprint_level = make_int (3);
+print_readably = 0;
+print_escape_newlines = 1;
+GCPRO2 (stream, old_level);
+if (NILP (stream))
+stream = Vstandard_output;
+if (!noninteractive && (NILP (stream) || EQ (stream, Qt)))
+stream = Fselected_frame (Qnil);
+for (;;)
+{
+if (!NILP (detailed) && catches && catches->backlist == backlist)
+	{
+int catchpdl = catches->pdlcount;
+if (specpdl[catchpdl].func == condition_case_unwind
+&& speccount > catchpdl)
+/* This is a condition-case catchpoint */
+catchpdl = catchpdl + 1;
+backtrace_specials (speccount, catchpdl, stream);
+speccount = catches->pdlcount;
+if (catchpdl == speccount)
+	    {
+	      write_c_string ("  # (catch ", stream);
+	      Fprin1 (catches->tag, stream);
+	      write_c_string (" ...)\n", stream);
+	    }
+else
+{
+write_c_string ("  # (condition-case ... . ", stream);
+Fprin1 (Fcdr (Fcar (catches->tag)), stream);
+write_c_string (")\n", stream);
+}
+catches = catches->next;
+	}
+else if (!backlist)
+	break;
+else
+	{
+	  if (!NILP (detailed) && backlist->pdlcount < speccount)
+	    {
+	      backtrace_specials (speccount, backlist->pdlcount, stream);
+	      speccount = backlist->pdlcount;
+	    }
+	  write_c_string (((backlist->debug_on_exit) ? "* " : "  "),
+			  stream);
+	  if (backlist->nargs == UNEVALLED)
+	    {
+	      Fprin1 (Fcons (*backlist->function, *backlist->args), stream);
+	      write_c_string ("\n", stream); /* from FSFmacs 19.30 */
+	    }
+	  else
+	    {
+	      Lisp_Object tem = *backlist->function;
+	      Fprin1 (tem, stream); /* This can QUIT */
+	      write_c_string ("(", stream);
+	      if (backlist->nargs == MANY)
+		{
+		  int i;
+		  Lisp_Object tail = Qnil;
+		  struct gcpro ngcpro1;
+		  NGCPRO1 (tail);
+		  for (tail = *backlist->args, i = 0;
+		       !NILP (tail);
+		       tail = Fcdr (tail), i++)
+		    {
+		      if (i != 0) write_c_string (" ", stream);
+		      Fprin1 (Fcar (tail), stream);
+		    }
+		  NUNGCPRO;
+		}
+	      else
+		{
+		  int i;
+		  for (i = 0; i < backlist->nargs; i++)
+		    {
+		      if (i != 0) write_c_string (" ", stream);
+		      Fprin1 (backlist->args[i], stream);
+		    }
+		}
+	    }
+	  write_c_string (")\n", stream);
+	  backlist = backlist->next;
+	}
+}
+Vprint_level = old_level;
+print_readably = old_pr;
+print_escape_newlines = old_nl;
+UNGCPRO;
+Vinhibit_quit = oiq;
+return Qnil;
+}
+DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, "" /*
+Return the function and arguments N frames up from current execution point.
+If that frame has not evaluated the arguments yet (or is a special form),
+the value is (nil FUNCTION ARG-FORMS...).
+If that frame has evaluated its arguments and called its function already,
+the value is (t FUNCTION ARG-VALUES...).
+A &rest arg is represented as the tail of the list ARG-VALUES.
+FUNCTION is whatever was supplied as car of evaluated list,
+or a lambda expression for macro calls.
+If N is more than the number of frames, the value is nil.
+*/ )
+(nframes)
+Lisp_Object nframes;
+{
+REGISTER struct backtrace *backlist = backtrace_list;
+REGISTER int i;
+Lisp_Object tem;
+CHECK_NATNUM (nframes);
+/* Find the frame requested.  */
+for (i = XINT (nframes); backlist && (i-- > 0);)
+backlist = backlist->next;
+if (!backlist)
+return Qnil;
+if (backlist->nargs == UNEVALLED)
+return Fcons (Qnil, Fcons (*backlist->function, *backlist->args));
+else
+{
+if (backlist->nargs == MANY)
+	tem = *backlist->args;
+else
+	tem = Flist (backlist->nargs, backlist->args);
+return Fcons (Qt, Fcons (*backlist->function, tem));
+}
+}
+/**********************************************************************/
+/*                            Warnings                                */
+/**********************************************************************/
+void
+warn_when_safe_lispobj (Lisp_Object class, Lisp_Object level,
+			Lisp_Object obj)
+{
+obj = list1 (list3 (class, level, obj));
+if (NILP (Vpending_warnings))
+Vpending_warnings = Vpending_warnings_tail = obj;
+else
+{
+Fsetcdr (Vpending_warnings_tail, obj);
+Vpending_warnings_tail = obj;
+}
+}
+/* #### This should probably accept Lisp objects; but then we have
+to make sure that Feval() isn't called, since it might not be safe.
+An alternative approach is to just pass some non-string type of
+Lisp Object to warn_when_safe_lispobj(); `prin1-to-string' will
+automatically be called when it is safe to do so. */
+void
+warn_when_safe (Lisp_Object class, Lisp_Object level, CONST char *fmt, ...)
+{
+Lisp_Object obj;
+va_list args;
+va_start (args, fmt);
+obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt),
+				Qnil, -1, args);
+va_end (args);
+warn_when_safe_lispobj (class, level, obj);
+}
+/**********************************************************************/
+/*                          Initialization                            */
+/**********************************************************************/
+void
+syms_of_eval (void)
+{
+defsymbol (&Qinhibit_quit, "inhibit-quit");
+defsymbol (&Qautoload, "autoload");
+defsymbol (&Qdebug_on_error, "debug-on-error");
+defsymbol (&Qstack_trace_on_error, "stack-trace-on-error");
+defsymbol (&Qdebug_on_signal, "debug-on-signal");
+defsymbol (&Qstack_trace_on_signal, "stack-trace-on-signal");
+defsymbol (&Qdebugger, "debugger");
+defsymbol (&Qmacro, "macro");
+defsymbol (&Qand_rest, "&rest");
+defsymbol (&Qand_optional, "&optional");
+/* Note that the process code also uses Qexit */
+defsymbol (&Qexit, "exit");
+defsymbol (&Qsetq, "setq");
+defsymbol (&Qinteractive, "interactive");
+defsymbol (&Qcommandp, "commandp");
+defsymbol (&Qdefun, "defun");
+defsymbol (&Qprogn, "progn");
+defsymbol (&Qvalues, "values");
+defsymbol (&Qdisplay_warning, "display-warning");
+defsymbol (&Qrun_hooks, "run-hooks");
+defsubr (&Sor);
+defsubr (&Sand);
+defsubr (&Sif);
+defsubr (&Scond);
+defsubr (&Sprogn);
+defsubr (&Sprog1);
+defsubr (&Sprog2);
+defsubr (&Ssetq);
+defsubr (&Squote);
+defsubr (&Sfunction);
+defsubr (&Sdefun);
+defsubr (&Sdefmacro);
+defsubr (&Sdefvar);
+defsubr (&Sdefconst);
+defsubr (&Suser_variable_p);
+defsubr (&Slet);
+defsubr (&SletX);
+defsubr (&Swhile);
+defsubr (&Smacroexpand_internal);
+defsubr (&Scatch);
+defsubr (&Sthrow);
+defsubr (&Sunwind_protect);
+defsubr (&Scondition_case);
+defsubr (&Scall_with_condition_handler);
+defsubr (&Ssignal);
+defsubr (&Sinteractive_p);
+defsubr (&Scommandp);
+defsubr (&Scommand_execute);
+defsubr (&Sautoload);
+defsubr (&Seval);
+defsubr (&Sapply);
+defsubr (&Sfuncall);
+defsubr (&Sfunction_min_args);
+defsubr (&Sfunction_max_args);
+defsubr (&Srun_hooks);
+defsubr (&Srun_hook_with_args);
+defsubr (&Srun_hook_with_args_until_success);
+defsubr (&Srun_hook_with_args_until_failure);
+defsubr (&Sfetch_bytecode);
+defsubr (&Sbacktrace_debug);
+defsubr (&Sbacktrace);
+defsubr (&Sbacktrace_frame);
+}
+void
+reinit_eval (void)
+{
+specpdl_ptr = specpdl;
+specpdl_depth_counter = 0;
+catchlist = 0;
+Vcondition_handlers = Qnil;
+backtrace_list = 0;
+Vquit_flag = Qnil;
+debug_on_next_call = 0;
+lisp_eval_depth = 0;
+entering_debugger = 0;
+}
+void
+vars_of_eval (void)
+{
+DEFVAR_INT ("max-specpdl-size", &max_specpdl_size /*
+Limit on number of Lisp variable bindings & unwind-protects before error.
+*/ );
+DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth /*
+Limit on depth in `eval', `apply' and `funcall' before error.
+This limit is to catch infinite recursions for you before they cause
+actual stack overflow in C, which would be fatal for Emacs.
+You can safely make it considerably larger than its default value,
+if that proves inconveniently small.
+*/ );
+DEFVAR_LISP ("quit-flag", &Vquit_flag /*
+Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
+Typing C-G sets `quit-flag' non-nil, regardless of `inhibit-quit'.
+*/ );
+Vquit_flag = Qnil;
+DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit /*
+Non-nil inhibits C-g quitting from happening immediately.
+Note that `quit-flag' will still be set by typing C-g,
+so a quit will be signalled as soon as `inhibit-quit' is nil.
+To prevent this happening, set `quit-flag' to nil
+before making `inhibit-quit' nil.  The value of `inhibit-quit' is
+ignored if a critical quit is requested by typing control-shift-G in
+an X frame.
+*/ );
+Vinhibit_quit = Qnil;
+DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error /*
+*Non-nil means automatically display a backtrace buffer
+after any error that is not handled by a `condition-case'.
+If the value is a list, an error only means to display a backtrace
+if one of its condition symbols appears in the list.
+See also variable `stack-trace-on-signal'.
+*/ );
+Vstack_trace_on_error = Qnil;
+DEFVAR_LISP ("stack-trace-on-signal", &Vstack_trace_on_signal /*
+*Non-nil means automatically display a backtrace buffer
+after any error that is signalled, whether or not it is handled by
+a `condition-case'.
+If the value is a list, an error only means to display a backtrace
+if one of its condition symbols appears in the list.
+See also variable `stack-trace-on-error'.
+*/ );
+Vstack_trace_on_signal = Qnil;
+DEFVAR_LISP ("debug-on-error", &Vdebug_on_error /*
+*Non-nil means enter debugger if an unhandled error is signalled.
+The debugger will not be entered if the error is handled by
+a `condition-case'.
+If the value is a list, an error only means to enter the debugger
+if one of its condition symbols appears in the list.
+See also variables `debug-on-quit' and `debug-on-signal'.
+*/ );
+Vdebug_on_error = Qnil;
+DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal /*
+*Non-nil means enter debugger if an error is signalled.
+The debugger will be entered whether or not the error is handled by
+a `condition-case'.
+If the value is a list, an error only means to enter the debugger
+if one of its condition symbols appears in the list.
+See also variable `debug-on-quit'.
+*/ );
+Vdebug_on_signal = Qnil;
+DEFVAR_BOOL ("debug-on-quit", &debug_on_quit /*
+*Non-nil means enter debugger if quit is signalled (C-G, for example).
+Does not apply if quit is handled by a `condition-case'.  Entering the
+debugger can also be achieved at any time (for X11 console) by typing
+control-shift-G to signal a critical quit.
+*/ );
+debug_on_quit = 0;
+DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call /*
+Non-nil means enter debugger before next `eval', `apply' or `funcall'.
+*/ );
+DEFVAR_LISP ("debugger", &Vdebugger /*
+Function to call to invoke debugger.
+If due to frame exit, args are `exit' and the value being returned;
+this function's value will be returned instead of that.
+If due to error, args are `error' and a list of the args to `signal'.
+If due to `apply' or `funcall' entry, one arg, `lambda'.
+If due to `eval' entry, one arg, t.
+*/ );
+Vdebugger = Qnil;
+preparing_for_armageddon = 0;
+staticpro (&Vpending_warnings);
+Vpending_warnings = Qnil;
+Vpending_warnings_tail = Qnil; /* no need to protect this */
+in_warnings = 0;
+staticpro (&Vautoload_queue);
+Vautoload_queue = Qnil;
+staticpro (&Vcondition_handlers);
+staticpro (&Vcurrent_warning_class);
+Vcurrent_warning_class = Qnil;
+staticpro (&Vcurrent_error_state);
+Vcurrent_error_state = Qnil; /* errors as normal */
+Qunbound_suspended_errors_tag = make_opaque_long (0);
+staticpro (&Qunbound_suspended_errors_tag);
+specpdl_size = 50;
+specpdl_depth_counter = 0;
+specpdl = (struct specbinding *)
+xmalloc (specpdl_size * sizeof (struct specbinding));
+/* XEmacs change: increase these values. */
+max_specpdl_size = 3000;
+max_lisp_eval_depth = 500;
+throw_level = 0;
+reinit_eval ();
+}

Mercurial > hg > xemacs-beta

comparison src/eval.c @ 0:376386a54a3c r19-14