xemacs-beta: src/eval.c comparison

comparison src/eval.c @ 380:8626e4521993 r21-2-5

Import from CVS: tag r21-2-5

author	cvs
date	Mon, 13 Aug 2007 11:07:10 +0200
parents	cc15677e0335
children	74fd4e045ea6

comparison

equal deleted inserted replaced

-:76b7d63099ad
+:8626e4521993
 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"
 #include "commands.h"
 #include "bytecode.h"
 #include "buffer.h"
 #include "console.h"
 #include "opaque.h"
+#ifdef ERROR_CHECK_GC
+int always_gc;			/* Debugging hack */
+#else
+#define always_gc 0
+#endif
 struct backtrace *backtrace_list;
-/* Note you must always fill all of the fields in a backtrace structure
+/* Note: you must always fill in all of the fields in a backtrace structure
 before pushing them on the backtrace_list.  The profiling code depends
 on this. */
-#define PUSH_BACKTRACE(bt) \
+#define PUSH_BACKTRACE(bt) do {		\
-do { (bt).next = backtrace_list; backtrace_list = &(bt); } while (0)
+(bt).next = backtrace_list;		\
+backtrace_list = &(bt);		\
-#define POP_BACKTRACE(bt) \
+} while (0)
-do { backtrace_list = (bt).next; } while (0)
+#define POP_BACKTRACE(bt) do {		\
+backtrace_list = (bt).next;		\
+} while (0)
+/* Macros for calling subrs with an argument list whose length is only
+known at runtime.  See EXFUN and DEFUN for similar hackery.  */
+#define AV_0(av)
+#define AV_1(av) av[0]
+#define AV_2(av) AV_1(av), av[1]
+#define AV_3(av) AV_2(av), av[2]
+#define AV_4(av) AV_3(av), av[3]
+#define AV_5(av) AV_4(av), av[4]
+#define AV_6(av) AV_5(av), av[5]
+#define AV_7(av) AV_6(av), av[6]
+#define AV_8(av) AV_7(av), av[7]
+#define PRIMITIVE_FUNCALL_1(fn, av, ac) \
+(((Lisp_Object (*)(EXFUN_##ac)) (fn)) (AV_##ac (av)))
+/* If subrs take more than 8 arguments, more cases need to be added
+to this switch.  (But wait - don't do it - if you really need
+a SUBR with more than 8 arguments, use max_args == MANY.
+See the DEFUN macro in lisp.h)  */
+#define PRIMITIVE_FUNCALL(rv, fn, av, ac) do {			\
+void (*PF_fn)() = (void (*)()) (fn);				\
+Lisp_Object *PF_av = (av);					\
+switch (ac)							\
+{								\
+default: abort();						\
+case 0: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break;	\
+case 1: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 1); break;	\
+case 2: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 2); break;	\
+case 3: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 3); break;	\
+case 4: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 4); break;	\
+case 5: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 5); break;	\
+case 6: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 6); break;	\
+case 7: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 7); break;	\
+case 8: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 8); break;	\
+}								\
+} while (0)
+#define FUNCALL_SUBR(rv, subr, av, ac) \
+	PRIMITIVE_FUNCALL (rv, subr_function (subr), av, ac);
 /* 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
 Lisp_Object Qinhibit_quit;
 Lisp_Object Qrun_hooks;
 Lisp_Object Qsetq;
 Lisp_Object Qdisplay_warning;
 Lisp_Object Vpending_warnings, Vpending_warnings_tail;
+Lisp_Object Qif;
 /* 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.
 /* 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;
+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 file should use
+/* specpdl_ptr - specpdl */
-*  specpdl_depth () function-call */
+int specpdl_depth_counter;
-static int specpdl_depth_counter;
 /* Maximum size allowed for specpdl allocation */
 int max_specpdl_size;
 /* Depth in Lisp evaluations and function calls.  */
 invoked in the environment that `signal' was invoked
 in.
 */
 static Lisp_Object Vcondition_handlers;
+#if 0 /* no longer used */
 /* Used for error catching purposes by throw_or_bomb_out */
 static int throw_level;
+#endif /* unused */
-static Lisp_Object primitive_funcall (lisp_fn_t fn, int nargs,
-				      Lisp_Object args[]);
-/**********************************************************************/
+/************************************************************************/
-/*                 The subr and compiled-function types               */
+/*			The subr object type				*/
-/**********************************************************************/
+/************************************************************************/
 static void
 print_subr (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 {
-struct Lisp_Subr *subr = XSUBR (obj);
+Lisp_Subr *subr = XSUBR (obj);
+CONST char *header =
+(subr->max_args == UNEVALLED) ? "#<special-form " : "#<subr ";
+CONST char *name = subr_name (subr);
+CONST char *trailer = subr->prompt ? " (interactive)>" : ">";
 if (print_readably)
-error ("printing unreadable object #<subr %s>",
+error ("printing unreadable object %s%s%s", header, name, trailer);
-	   subr_name (subr));
+write_c_string (header,  printcharfun);
-write_c_string (((subr->max_args == UNEVALLED)
+write_c_string (name,    printcharfun);
-? "#<special-form "
+write_c_string (trailer, printcharfun);
-: "#<subr "),
-printcharfun);
-write_c_string (subr_name (subr), printcharfun);
-write_c_string (((subr->prompt) ? " (interactive)>" : ">"),
-printcharfun);
 }
 DEFINE_LRECORD_IMPLEMENTATION ("subr", subr,
 this_one_is_unmarkable, print_subr, 0, 0, 0,
-			       struct Lisp_Subr);
+			       Lisp_Subr);
-static Lisp_Object
+/************************************************************************/
-mark_compiled_function (Lisp_Object obj, void (*markobj) (Lisp_Object))
+/*			 Entering the debugger				*/
-{
+/************************************************************************/
-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));
-}
-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);
-/**********************************************************************/
-/*                       Entering the debugger                        */
-/**********************************************************************/
 /* unwind-protect used by call_debugger() to restore the value of
-enterring_debugger. (We cannot use specbind() because the
+entering_debugger. (We cannot use specbind() because the
 variable is not Lisp-accessible.) */
 static Lisp_Object
 restore_entering_debugger (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
+some room on the eval and specpdl stacks, and bind entering_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),
+when entering 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
+enter the debugger.) entering_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
 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;
+speccount = specpdl_depth();
 record_unwind_protect (restore_entering_debugger,
 (entering_debugger ? Qt : Qnil));
 entering_debugger = 1;
 val = internal_catch (Qdebugger, call_debugger_259, arg, &threw);
 {
 /* This function can GC */
 Lisp_Object val = Qunbound;
 Lisp_Object all_handlers = Vcondition_handlers;
 Lisp_Object temp_data = Qnil;
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 struct gcpro gcpro1, gcpro2;
 GCPRO2 (all_handlers, temp_data);
 Vcondition_handlers = active_handlers;
 if (!entering_debugger && !*stack_trace_displayed && !signal_vars_only
 && wants_debugger (Vstack_trace_on_error, conditions)
 && !skip_debugger (conditions, temp_data))
 {
-specbind (Qdebug_on_error, Qnil);
+specbind (Qdebug_on_error,	Qnil);
-specbind (Qstack_trace_on_error, Qnil);
+specbind (Qstack_trace_on_error,	Qnil);
-specbind (Qdebug_on_signal, Qnil);
+specbind (Qdebug_on_signal,	Qnil);
 specbind (Qstack_trace_on_signal, Qnil);
-internal_with_output_to_temp_buffer ("*Backtrace*",
+internal_with_output_to_temp_buffer (build_string ("*Backtrace*"),
 					   backtrace_259,
 					   Qnil,
 					   Qnil);
 unbind_to (speccount, Qnil);
 *stack_trace_displayed = 1;
 	  ? debug_on_quit
 	  : wants_debugger (Vdebug_on_error, conditions))
 && !skip_debugger (conditions, temp_data))
 {
 debug_on_quit &= ~2;	/* reset critical bit */
-specbind (Qdebug_on_error, Qnil);
+specbind (Qdebug_on_error,	Qnil);
-specbind (Qstack_trace_on_error, Qnil);
+specbind (Qstack_trace_on_error,	Qnil);
-specbind (Qdebug_on_signal, 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 (Qdebug_on_error,	Qnil);
-specbind (Qstack_trace_on_error, Qnil);
+specbind (Qstack_trace_on_error,	Qnil);
-specbind (Qdebug_on_signal, Qnil);
+specbind (Qdebug_on_signal,	Qnil);
 specbind (Qstack_trace_on_signal, Qnil);
-internal_with_output_to_temp_buffer ("*Backtrace*",
+internal_with_output_to_temp_buffer (build_string ("*Backtrace*"),
 					   backtrace_259,
 					   Qnil,
 					   Qnil);
 unbind_to (speccount, Qnil);
 *stack_trace_displayed = 1;
 && (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 (Qdebug_on_error,	Qnil);
-specbind (Qstack_trace_on_error, Qnil);
+specbind (Qstack_trace_on_error,	Qnil);
-specbind (Qdebug_on_signal, Qnil);
+specbind (Qdebug_on_signal,	Qnil);
 specbind (Qstack_trace_on_signal, Qnil);
 val = call_debugger (list2 (Qerror, (Fcons (sig, data))));
 *debugger_entered = 1;
 }
 Vcondition_handlers = all_handlers;
 return unbind_to (speccount, val);
 }
-/**********************************************************************/
+/************************************************************************/
-/*                     The basic special forms                        */
+/*		       The basic special forms				*/
-/**********************************************************************/
+/************************************************************************/
-/* NOTE!!! Every function that can call EVAL must protect its args
+/* Except for Fprogn(), the basic special forms below are only called
-and temporaries from garbage collection while it needs them.
+from interpreted code.  The byte compiler turns them into bytecodes. */
-The definition of `For' shows what you have to do.  */
 DEFUN ("or", For, 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))
 {
 /* This function can GC */
-REGISTER Lisp_Object tail;
+REGISTER Lisp_Object arg, val;
-struct gcpro gcpro1;
+LIST_LOOP_2 (arg, args)
-GCPRO1 (args);
+{
+if (!NILP (val = Feval (arg)))
-LIST_LOOP (tail, args)
+	return val;
-{
+}
-Lisp_Object val = Feval (XCAR (tail));
-if (!NILP (val))
-	{
-	  UNGCPRO;
-	  return val;
-	}
-}
-UNGCPRO;
 return Qnil;
 }
 DEFUN ("and", Fand, 0, UNEVALLED, 0, /*
 Eval args until one of them yields nil, then return nil.
 If no arg yields nil, return the last arg's value.
 */
 (args))
 {
 /* This function can GC */
-REGISTER Lisp_Object tail, val = Qt;
+REGISTER Lisp_Object arg, val = Qt;
-struct gcpro gcpro1;
+LIST_LOOP_2 (arg, args)
-GCPRO1 (args);
+{
+if (NILP (val = Feval (arg)))
-LIST_LOOP (tail, args)
+	return val;
-{
+}
-val = Feval (XCAR (tail));
-if (NILP (val))
-	break;
-}
-UNGCPRO;
 return val;
 }
 DEFUN ("if", Fif, 2, UNEVALLED, 0, /*
 \(if COND THEN ELSE...): if COND yields non-nil, do THEN, else do ELSE...
 If COND yields nil, and there are no ELSE's, the value is nil.
 */
 (args))
 {
 /* This function can GC */
-Lisp_Object val;
+Lisp_Object condition  = XCAR (args);
-struct gcpro gcpro1;
+Lisp_Object then_form  = XCAR (XCDR (args));
+Lisp_Object else_forms = XCDR (XCDR (args));
-GCPRO1 (args);
+if (!NILP (Feval (condition)))
-if (!NILP (Feval (XCAR (args))))
+return Feval (then_form);
-val = Feval (XCAR (XCDR ((args))));
 else
-val = Fprogn (XCDR (XCDR (args)));
+return Fprogn (else_forms);
+}
-UNGCPRO;
-return val;
+/* Macros `when' and `unless' are trivially defined in Lisp,
+but it helps for bootstrapping to have them ALWAYS defined. */
+DEFUN ("when", Fwhen, 1, MANY, 0, /*
+\(when COND BODY...): if COND yields non-nil, do BODY, else return nil.
+BODY can be zero or more expressions.  If BODY is nil, return nil.
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object cond = args[0];
+Lisp_Object body;
+switch (nargs)
+{
+case 1:  body = Qnil; break;
+case 2:  body = args[1]; break;
+default: body = Fcons (Qprogn, Flist (nargs-1, args+1)); break;
+}
+return list3 (Qif, cond, body);
+}
+DEFUN ("unless", Funless, 1, MANY, 0, /*
+\(unless COND BODY...): if COND yields nil, do BODY, else return nil.
+BODY can be zero or more expressions.  If BODY is nil, return nil.
+*/
+(int nargs, Lisp_Object *args))
+{
+Lisp_Object cond = args[0];
+Lisp_Object body = Flist (nargs-1, args+1);
+return Fcons (Qif, Fcons (cond, Fcons (Qnil, body)));
 }
 DEFUN ("cond", Fcond, 0, UNEVALLED, 0, /*
 (cond CLAUSES...): try each clause until one succeeds.
 Each clause looks like (CONDITION BODY...).  CONDITION is evaluated
 CONDITION's value if non-nil is returned from the cond-form.
 */
 (args))
 {
 /* This function can GC */
-REGISTER Lisp_Object tail;
+REGISTER Lisp_Object val, clause;
-struct gcpro gcpro1;
+LIST_LOOP_2 (clause, args)
-GCPRO1 (args);
+{
-LIST_LOOP (tail, args)
-{
-Lisp_Object val;
-Lisp_Object clause = XCAR (tail);
 CHECK_CONS (clause);
-val = Feval (XCAR (clause));
+if (!NILP (val = Feval (XCAR (clause))))
-if (!NILP (val))
 	{
-	  Lisp_Object clause_tail = XCDR (clause);
+	  if (!NILP (clause = XCDR (clause)))
-	  if (!NILP (clause_tail))
 	    {
-	      CHECK_TRUE_LIST (clause_tail);
+	      CHECK_TRUE_LIST (clause);
-	      val = Fprogn (clause_tail);
+	      val = Fprogn (clause);
 	    }
-	  UNGCPRO;
 	  return val;
 	}
 }
-UNGCPRO;
 return Qnil;
 }
 DEFUN ("progn", Fprogn, 0, UNEVALLED, 0, /*
 \(progn BODY...): eval BODY forms sequentially and return value of last one.
 */
 (args))
 {
 /* This function can GC */
-REGISTER Lisp_Object tail, val = Qnil;
+/* Caller must provide a true list in ARGS */
+REGISTER Lisp_Object form, val = Qnil;
 struct gcpro gcpro1;
 GCPRO1 (args);
-LIST_LOOP (tail, args)
+{
-val = Feval (XCAR (tail));
+LIST_LOOP_2 (form, args)
+val = Feval (form);
+}
 UNGCPRO;
 return val;
 }
+/* Fprog1() is the canonical example of a function that must GCPRO a
+Lisp_Object across calls to Feval(). */
 DEFUN ("prog1", Fprog1, 1, UNEVALLED, 0, /*
-\(prog1 FIRST BODY...): eval FIRST and BODY sequentially; value from FIRST.
+Similar to `progn', but the value of the first form is returned.
-The value of FIRST is saved during the evaluation of the remaining args,
+\(prog1 FIRST BODY...): All the arguments are evaluated sequentially.
+The value of FIRST is saved during evaluation of the remaining args,
 whose values are discarded.
 */
 (args))
 {
 /* This function can GC */
-REGISTER Lisp_Object tail = args;
+REGISTER Lisp_Object val, form;
-Lisp_Object val = Qnil;
+struct gcpro gcpro1;
-struct gcpro gcpro1, gcpro2;
+val = Feval (XCAR (args));
-GCPRO2 (args, val);
+GCPRO1 (val);
-val = Feval (XCAR (tail));
+{
-LIST_LOOP (tail, XCDR (tail))
+LIST_LOOP_2 (form, XCDR (args))
-Feval (XCAR (tail));
+Feval (form);
+}
 UNGCPRO;
 return val;
 }
 DEFUN ("prog2", Fprog2, 2, UNEVALLED, 0, /*
-\(prog2 X Y BODY...): eval X, Y and BODY sequentially; value from Y.
+Similar to `progn', but the value of the second form is returned.
-The value of Y is saved during the evaluation of the remaining args,
+\(prog2 FIRST SECOND BODY...): All the arguments are evaluated sequentially.
+The value of SECOND is saved during evaluation of the remaining args,
 whose values are discarded.
 */
 (args))
 {
 /* This function can GC */
-REGISTER Lisp_Object tail = args;
+REGISTER Lisp_Object val, form, tail;
-Lisp_Object val = Qnil;
+struct gcpro gcpro1;
-struct gcpro gcpro1, gcpro2;
+Feval (XCAR (args));
-GCPRO2 (args, val);
+args = XCDR (args);
+val = Feval (XCAR (args));
-Feval (XCAR (tail));
+args = XCDR (args);
-tail = XCDR (tail);
-val = Feval (XCAR (tail));
+GCPRO1 (val);
-LIST_LOOP (tail, XCDR (tail))
+LIST_LOOP_3 (form, args, tail)
-Feval (XCAR (tail));
+Feval (form);
 UNGCPRO;
 return val;
 }
 Each VALUEFORM can refer to the symbols already bound by this VARLIST.
 */
 (args))
 {
 /* This function can GC */
+Lisp_Object var, tail;
 Lisp_Object varlist = XCAR (args);
-Lisp_Object tail;
+Lisp_Object body    = XCDR (args);
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
-struct gcpro gcpro1;
+EXTERNAL_LIST_LOOP_3 (var, varlist, tail)
-GCPRO1 (args);
+{
+Lisp_Object symbol, value, tem;
-EXTERNAL_LIST_LOOP (tail, varlist)
+if (SYMBOLP (var))
-{
+	symbol = var, value = Qnil;
-Lisp_Object elt = XCAR (tail);
-QUIT;
-if (SYMBOLP (elt))
-	specbind (elt, Qnil);
 else
 	{
-	  Lisp_Object sym, form;
+	  CHECK_CONS (var);
-	  CHECK_CONS (elt);
+	  symbol = XCAR (var);
-	  sym = XCAR (elt);
+	  tem    = XCDR (var);
-	  elt = XCDR (elt);
+	  if (NILP (tem))
-	  if (NILP (elt))
+	    value = Qnil;
-	    form = Qnil;
 	  else
 	    {
-	      CHECK_CONS (elt);
+	      CHECK_CONS (tem);
-	      form = XCAR (elt);
+	      value = Feval (XCAR (tem));
-	      elt  = XCDR (elt);
+	      if (!NILP (XCDR (tem)))
-	      if (!NILP (elt))
 		signal_simple_error
-		  ("`let' bindings can have only one value-form",
+		  ("`let' bindings can have only one value-form", var);
-		   XCAR (tail));
 	    }
-	  specbind (sym, Feval (form));
 	}
-}
+specbind (symbol, value);
-UNGCPRO;
+}
-return unbind_to (speccount, Fprogn (XCDR (args)));
+return unbind_to (speccount, Fprogn (body));
 }
 DEFUN ("let", Flet, 1, UNEVALLED, 0, /*
 \(let VARLIST BODY...): bind variables according to VARLIST then eval BODY.
 The value of the last form in BODY is returned.
 All the VALUEFORMs are evalled before any symbols are bound.
 */
 (args))
 {
 /* This function can GC */
+Lisp_Object var, tail;
 Lisp_Object varlist = XCAR (args);
-REGISTER Lisp_Object tail;
+Lisp_Object body    = XCDR (args);
+int speccount = specpdl_depth();
 Lisp_Object *temps;
-int speccount = specpdl_depth_counter;
+int idx;
-REGISTER int argnum = 0;
+struct gcpro gcpro1;
-struct gcpro gcpro1, gcpro2;
 /* Make space to hold the values to give the bound variables. */
 {
-int varcount = 0;
+int varcount;
-EXTERNAL_LIST_LOOP (tail, varlist)
+GET_EXTERNAL_LIST_LENGTH (varlist, varcount);
-varcount++;
 temps = alloca_array (Lisp_Object, varcount);
 }
 /* Compute the values and store them in `temps' */
+GCPRO1 (*temps);
-GCPRO2 (args, *temps);
+gcpro1.nvars = 0;
-gcpro2.nvars = 0;
+idx = 0;
-LIST_LOOP (tail, varlist)
+LIST_LOOP_3 (var, varlist, tail)
 {
-Lisp_Object elt = XCAR (tail);
+Lisp_Object *value = &temps[idx++];
-QUIT;
+if (SYMBOLP (var))
-if (SYMBOLP (elt))
+	*value = Qnil;
-	temps[argnum++] = Qnil;
 else
 	{
-	  CHECK_CONS (elt);
+	  Lisp_Object tem;
-	  elt = XCDR (elt);
+	  CHECK_CONS (var);
-	  if (NILP (elt))
+	  tem = XCDR (var);
-	    temps[argnum++] = Qnil;
+	  if (NILP (tem))
+	    *value = Qnil;
 	  else
 	    {
-	      CHECK_CONS (elt);
+	      CHECK_CONS (tem);
-	      temps[argnum++] = Feval (XCAR (elt));
+	      *value = Feval (XCAR (tem));
-	      gcpro2.nvars = argnum;
+	      gcpro1.nvars = idx;
-	      if (!NILP (XCDR (elt)))
+	      if (!NILP (XCDR (tem)))
 		signal_simple_error
-		  ("`let' bindings can have only one value-form",
+		  ("`let' bindings can have only one value-form", var);
-		   XCAR (tail));
 	    }
 	}
 }
+idx = 0;
+LIST_LOOP_3 (var, varlist, tail)
+{
+specbind (SYMBOLP (var) ? var : XCAR (var), temps[idx++]);
+}
 UNGCPRO;
-argnum = 0;
+return unbind_to (speccount, Fprogn (body));
-LIST_LOOP (tail, varlist)
-{
-Lisp_Object elt = XCAR (tail);
-specbind (SYMBOLP (elt) ? elt : XCAR (elt), temps[argnum++]);
-}
-return unbind_to (speccount, Fprogn (XCDR (args)));
 }
 DEFUN ("while", Fwhile, 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))
 {
 /* This function can GC */
-Lisp_Object tem;
 Lisp_Object test = XCAR (args);
 Lisp_Object body = XCDR (args);
-struct gcpro gcpro1, gcpro2;
+while (!NILP (Feval (test)))
-GCPRO2 (test, body);
-while (tem = Feval (test), !NILP (tem))
 {
 QUIT;
 Fprogn (body);
 }
-UNGCPRO;
 return Qnil;
 }
 DEFUN ("setq", Fsetq, 0, UNEVALLED, 0, /*
 \(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL.
 The return value of the `setq' form is the value of the last VAL.
 */
 (args))
 {
 /* This function can GC */
+Lisp_Object symbol, tail, val = Qnil;
+int nargs;
 struct gcpro gcpro1;
-Lisp_Object val = Qnil;
+GET_LIST_LENGTH (args, nargs);
-GCPRO1 (args);
+if (nargs & 1)		/* Odd number of arguments? */
-{
+Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, make_int (nargs)));
-REGISTER int i = 0;
-Lisp_Object args2;
+GCPRO1 (val);
-for (args2 = args; !NILP (args2); args2 = XCDR (args2))
-{
+PROPERTY_LIST_LOOP (tail, symbol, val, args)
-	i++;
+{
-	/*
+val = Feval (val);
-	 * uncomment the QUIT if there is some way a circular
+Fset (symbol, val);
-	 * arglist can get in here.  I think Feval or Fapply would
-	 * spin first and the list would never get here.
-	 */
-	/* QUIT; */
-}
-if (i & 1)           /* Odd number of arguments? */
-Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, make_int(i)));
-}
-while (!NILP (args))
-{
-Lisp_Object sym = XCAR (args);
-val = Feval (XCAR (XCDR (args)));
-Fset (sym, val);
-args = XCDR (XCDR (args));
 }
 UNGCPRO;
 return val;
 }
 {
 return XCAR (args);
 }
-/**********************************************************************/
+/************************************************************************/
-/*                     Defining functions/variables                   */
+/*			Defining functions/variables			*/
-/**********************************************************************/
+/************************************************************************/
+static Lisp_Object
+define_function (Lisp_Object name, Lisp_Object defn)
+{
+if (purify_flag)
+defn = Fpurecopy (defn);
+Ffset (name, defn);
+LOADHIST_ATTACH (name);
+return name;
+}
 DEFUN ("defun", Fdefun, 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))
 {
 /* This function can GC */
-Lisp_Object fn_name = XCAR (args);
+return define_function (XCAR (args),
-Lisp_Object defn = Fcons (Qlambda, XCDR (args));
+			  Fcons (Qlambda, XCDR (args)));
-if (purify_flag)
-defn = Fpurecopy (defn);
-Ffset (fn_name, defn);
-LOADHIST_ATTACH (fn_name);
-return fn_name;
 }
 DEFUN ("defmacro", Fdefmacro, 2, UNEVALLED, 0, /*
 \(defmacro NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.
 The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).
 and the result should be a form to be evaluated instead of the original.
 */
 (args))
 {
 /* This function can GC */
-Lisp_Object fn_name = XCAR (args);
+return define_function (XCAR (args),
-Lisp_Object defn = Fcons (Qmacro, Fcons (Qlambda, XCDR (args)));
+			  Fcons (Qmacro, Fcons (Qlambda, XCDR (args))));
-if (purify_flag)
-defn = Fpurecopy (defn);
-Ffset (fn_name, defn);
-LOADHIST_ATTACH (fn_name);
-return fn_name;
 }
 DEFUN ("defvar", Fdefvar, 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,
 if (!NILP (args = XCDR (args)))
 {
 Lisp_Object val = XCAR (args);
 if (NILP (Fdefault_boundp (sym)))
-	Fset_default (sym, Feval (val));
+	{
+	  struct gcpro gcpro1;
+	  GCPRO1 (val);
+	  val = Feval (val);
+	  Fset_default (sym, val);
+	  UNGCPRO;
+	}
 if (!NILP (args = XCDR (args)))
 	{
 	  Lisp_Object doc = XCAR (args);
 #if 0 /* FSFmacs */
 */
 (args))
 {
 /* This function can GC */
 Lisp_Object sym = XCAR (args);
-Lisp_Object val = XCAR (args = XCDR (args));
+Lisp_Object val = Feval (XCAR (args = XCDR (args)));
+struct gcpro gcpro1;
-Fset_default (sym, Feval (val));
+GCPRO1 (val);
+Fset_default (sym, val);
+UNGCPRO;
 if (!NILP (args = XCDR (args)))
 {
 Lisp_Object doc = XCAR (args);
 #if 0 /* FSFmacs */
 Determined by whether the first character of the documentation
 for the variable is `*'.
 */
 (variable))
 {
-Lisp_Object documentation;
+Lisp_Object documentation = Fget (variable, Qvariable_documentation, Qnil);
-documentation = Fget (variable, Qvariable_documentation, Qnil);
+return
-if (INTP (documentation) && XINT (documentation) < 0)
+((INTP (documentation) && XINT (documentation) < 0) ||
-return Qt;
-if ((STRINGP (documentation)) &&
+((STRINGP (documentation)) &&
-(string_byte (XSTRING (documentation), 0) == '*'))
+(string_byte (XSTRING (documentation), 0) == '*')) ||
-return Qt;
-/* If it is (STRING . INTEGER), a negative integer means a user variable.  */
+/* If (STRING . INTEGER), a negative integer means a user variable. */
-if (CONSP (documentation)
+(CONSP (documentation)
 && STRINGP (XCAR (documentation))
 && INTP (XCDR (documentation))
-&& XINT (XCDR (documentation)) < 0)
+&& XINT (XCDR (documentation)) < 0)) ?
-return Qt;
+Qt : Qnil;
-return Qnil;
 }
 DEFUN ("macroexpand-internal", Fmacroexpand_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.
 }
 return form;
 }
-/**********************************************************************/
+/************************************************************************/
-/*                          Non-local exits                           */
+/*			    Non-local exits				*/
-/**********************************************************************/
+/************************************************************************/
 DEFUN ("catch", Fcatch, 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 a throw happens, it specifies the value to return from `catch'.
 */
 (args))
 {
 /* This function can GC */
-Lisp_Object tag;
+Lisp_Object tag  = Feval (XCAR (args));
-struct gcpro gcpro1;
+Lisp_Object body = XCDR (args);
+return internal_catch (tag, Fprogn, body, 0);
-GCPRO1 (args);
-tag = Feval (XCAR (args));
-UNGCPRO;
-return internal_catch (tag, Fprogn, XCDR (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. */
 #if 0 /* FSFmacs */
 /* #### */
 c.handlerlist = handlerlist;
 #endif
 c.lisp_eval_depth = lisp_eval_depth;
-c.pdlcount = specpdl_depth_counter;
+c.pdlcount = specpdl_depth();
 #if 0 /* FSFmacs */
 c.poll_suppress_count = async_timer_suppress_count;
 #endif
 c.gcpro = gcprolist;
 catchlist = &c;
 gcprolist = c->gcpro;
 backtrace_list = c->backlist;
 lisp_eval_depth = c->lisp_eval_depth;
+#if 0 /* no longer used */
 throw_level = 0;
+#endif
 LONGJMP (c->jmp, 1);
 }
 static DOESNT_RETURN
 throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p,
 If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
 */
 (args))
 {
 /* This function can GC */
-Lisp_Object val;
+int speccount = specpdl_depth();
-int speccount = specpdl_depth_counter;
 record_unwind_protect (Fprogn, XCDR (args));
-val = Feval (XCAR (args));
+return unbind_to (speccount, Feval (XCAR (args)));
-return unbind_to (speccount, val);
 }
-/**********************************************************************/
+/************************************************************************/
-/*                    Signalling and trapping errors                  */
+/*		      Signalling and trapping errors			*/
-/**********************************************************************/
+/************************************************************************/
 static Lisp_Object
 condition_bind_unwind (Lisp_Object loser)
 {
 struct Lisp_Cons *victim;
 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;
+int speccount = specpdl_depth();
 struct catchtag c;
 struct gcpro gcpro1;
 #if 0 /* FSFmacs */
 c.tag = Qnil;
 #if 0 /* FSFmacs */
 /* #### */
 c.handlerlist = handlerlist;
 #endif
 c.lisp_eval_depth = lisp_eval_depth;
-c.pdlcount = specpdl_depth_counter;
+c.pdlcount = specpdl_depth();
 #if 0 /* FSFmacs */
 c.poll_suppress_count = async_timer_suppress_count;
 #endif
 c.gcpro = gcprolist;
 /* #### FSFmacs does the following statement *after* the setjmp(). */
 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
+longjmp()ed to us unwound the stack to c.pdlcount before
 throwing. */
 unbind_to (c.pdlcount, Qnil);
 return val;
 #else
 int speccount;
+CHECK_TRUE_LIST (val);
 if (NILP (var))
-return Fprogn (Fcdr (val)); /* tailcall */
+return Fprogn (Fcdr (val)); /* tail call */
-speccount = specpdl_depth_counter;
+speccount = specpdl_depth();
 specbind (var, Fcar (val));
 val = Fprogn (Fcdr (val));
 return unbind_to (speccount, val);
 #endif
 }
 than a single list of arguments. */
 Lisp_Object
 condition_case_3 (Lisp_Object bodyform, Lisp_Object var, Lisp_Object handlers)
 {
 /* This function can GC */
-Lisp_Object val;
+Lisp_Object handler;
+EXTERNAL_LIST_LOOP_2 (handler, handlers)
+{
+if (NILP (handler))
+	;
+else if (CONSP (handler))
+	{
+	  Lisp_Object conditions = XCAR (handler);
+	  /* CONDITIONS must a condition name or a list of condition names */
+	  if (SYMBOLP (conditions))
+	    ;
+	  else
+	    {
+	      Lisp_Object condition;
+	      EXTERNAL_LIST_LOOP_2 (condition, conditions)
+		if (!SYMBOLP (condition))
+		  goto invalid_condition_handler;
+	    }
+	}
+else
+	{
+	invalid_condition_handler:
+	  signal_simple_error ("Invalid condition handler", handler);
+	}
+}
 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,
+			   Feval, bodyform,
-run_condition_case_handlers,
+			   run_condition_case_handlers,
-var);
+			   var);
 }
 DEFUN ("condition-case", Fcondition_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.
+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
 rather than when the handler was set, use `call-with-condition-handler'.
 */
 (args))
 {
 /* This function can GC */
-return condition_case_3 (XCAR (XCDR (args)),
+Lisp_Object var = XCAR (args);
-			   XCAR (args),
+Lisp_Object bodyform = XCAR (XCDR (args));
-			   XCDR (XCDR (args)));
+Lisp_Object handlers = XCDR (XCDR (args));
+return condition_case_3 (bodyform, var, handlers);
 }
 DEFUN ("call-with-condition-handler", Fcall_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).
 and invokes the standard error-handler if none is found.)
 */
 (int nargs, Lisp_Object *args)) /* Note!  Args side-effected! */
 {
 /* This function can GC */
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 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);
+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, 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))
-if (SYMBOLP (type))
+return !NILP (Fmemq (type, conditions));
-	{
-	  return !NILP (Fmemq (type, conditions));
+for (; CONSP (type); type = XCDR (type))
-	}
+if (!NILP (Fmemq (XCAR (type), conditions)))
-else if (CONSP (type))
+return 1;
-	{
-	  while (CONSP (type))
+return 0;
-	    {
-	      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)
 {
 }
 extern int in_display;
-/****************** the workhorse error-signaling function ******************/
+/************************************************************************/
+/*		 the workhorse error-signaling function			*/
+/************************************************************************/
 /* #### This function has not been synched with FSF.  It diverges
 significantly. */
 static Lisp_Object
 }
 static Lisp_Object
 call_with_suspended_errors_1 (Lisp_Object opaque_arg)
 {
+Lisp_Object val;
 Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg);
-return primitive_funcall ((lisp_fn_t) get_opaque_ptr (kludgy_args[0]),
+PRIMITIVE_FUNCALL (val, get_opaque_ptr (kludgy_args[0]),
-			    XINT (kludgy_args[1]), kludgy_args + 2);
+		     kludgy_args + 2, XINT (kludgy_args[1]));
+return val;
 }
 static Lisp_Object
 restore_current_warning_class (Lisp_Object warning_class)
 {
 /* 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);
+{
+Lisp_Object val;
-speccount = specpdl_depth_counter;
+PRIMITIVE_FUNCALL (val, fun, args, nargs);
+return val;
+}
+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
 /* note that this is continuable. */
 Fsignal (Qquit, Qnil);
 }
-/**********************************************************************/
+/* Used in core lisp functions for efficiency */
-/*                            User commands                           */
+void
-/**********************************************************************/
+signal_void_function_error (Lisp_Object function)
+{
+Fsignal (Qvoid_function, list1 (function));
+}
+static void
+signal_invalid_function_error (Lisp_Object function)
+{
+Fsignal (Qinvalid_function, list1 (function));
+}
+static void
+signal_wrong_number_of_arguments_error (Lisp_Object function, int nargs)
+{
+Fsignal (Qwrong_number_of_arguments, list2 (function, make_int (nargs)));
+}
+/* Used in list traversal macros for efficiency. */
+void
+signal_malformed_list_error (Lisp_Object list)
+{
+Fsignal (Qmalformed_list, list1 (list));
+}
+void
+signal_malformed_property_list_error (Lisp_Object list)
+{
+Fsignal (Qmalformed_property_list, list1 (list));
+}
+void
+signal_circular_list_error (Lisp_Object list)
+{
+Fsignal (Qcircular_list, list1 (list));
+}
+void
+signal_circular_property_list_error (Lisp_Object list)
+{
+Fsignal (Qcircular_property_list, list1 (list));
+}
+/************************************************************************/
+/*			      User commands				*/
+/************************************************************************/
 DEFUN ("commandp", Fcommandp, 1, 1, 0, /*
 Return 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
 */
 (function))
 {
 Lisp_Object fun = indirect_function (function, 0);
-if (UNBOUNDP (fun))
+if (COMPILED_FUNCTIONP (fun))
-return Qnil;
+return XCOMPILED_FUNCTION (fun)->flags.interactivep ? Qt : Qnil;
+/* Lists may represent commands.  */
+if (CONSP (fun))
+{
+Lisp_Object funcar = XCAR (fun);
+if (EQ (funcar, Qlambda))
+	return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
+if (EQ (funcar, Qautoload))
+	return Fcar (Fcdr (Fcdr (Fcdr (fun))));
+else
+	return Qnil;
+}
 /* Emacs primitives are interactive if their DEFUN specifies an
 interactive spec.  */
 if (SUBRP (fun))
 return XSUBR (fun)->prompt ? Qt : Qnil;
-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.  */
+/* Everything else (including Qunbound) is not a command.  */
-if (!CONSP (fun))
+return Qnil;
-return Qnil;
-{
-Lisp_Object funcar = XCAR (fun);
-if (!SYMBOLP (funcar))
-return Fsignal (Qinvalid_function, list1 (fun));
-if (EQ (funcar, Qlambda))
-return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
-if (EQ (funcar, Qautoload))
-return Fcar (Fcdr (Fcdr (Fcdr (fun))));
-else
-return Qnil;
-}
 }
 DEFUN ("command-execute", Fcommand_execute, 1, 3, 0, /*
 Execute CMD as an editor command.
 CMD must be an object that satisfies the `commandp' predicate.
 	break;
 }
 if (CONSP (final) || SUBRP (final) || COMPILED_FUNCTIONP (final))
 {
-#ifdef EMACS_BTL
-backtrace.id_number = 0;
-#endif
 backtrace.function = &Qcall_interactively;
 backtrace.args = &cmd;
 backtrace.nargs = 1;
 backtrace.evalargs = 0;
-backtrace.pdlcount = specpdl_depth_counter;
+backtrace.pdlcount = specpdl_depth();
 backtrace.debug_on_exit = 0;
 PUSH_BACKTRACE (backtrace);
 final = Fcall_interactively (cmd, record, keys);
 return Qt;
 return Qnil;
 }
-/**********************************************************************/
+/************************************************************************/
-/*                            Autoloading                             */
+/*			      Autoloading				*/
-/**********************************************************************/
+/************************************************************************/
 DEFUN ("autoload", Fautoload, 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.
 /* 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)
+Lisp_Object f = XSYMBOL (function)->function;
-	   && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
+if (!UNBOUNDP (f) && !(CONSP (f) && EQ (XCAR (f), Qautoload)))
 return Qnil;
+}
 if (purify_flag)
 {
 /* Attempt to avoid consing identical (string=) pure strings. */
 file = Fsymbol_name (Fintern (file, Qnil));
 oldqueue is the shadowed value to leave in Vautoload_queue.  */
 queue = Vautoload_queue;
 Vautoload_queue = oldqueue;
 while (CONSP (queue))
 {
-first = Fcar (queue);
+first = XCAR (queue);
 second = Fcdr (first);
 first = Fcar (first);
 if (NILP (second))
 	Vfeatures = first;
 else
 void
 do_autoload (Lisp_Object fundef,
 Lisp_Object funname)
 {
 /* This function can GC */
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 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,
+call4 (Qload, Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil);
-	 Qnil);
 {
-Lisp_Object queue = Vautoload_queue;
+Lisp_Object queue;
 /* Save the old autoloads, in case we ever do an unload. */
-queue = Vautoload_queue;
+for (queue = Vautoload_queue; CONSP (queue); queue = XCDR (queue))
-while (CONSP (queue))
+{
-{
+	Lisp_Object first  = XCAR (queue);
-Lisp_Object first = Fcar (queue);
+	Lisp_Object second = Fcdr (first);
-Lisp_Object second = Fcdr (first);
+	first = Fcar (first);
-first = Fcar (first);
+	/* Note: This test is subtle.  The cdr of an autoload-queue entry
-/* 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
-	 may be an atom if the autoload entry was generated by a defalias
+	   or fset. */
-	 or fset. */
+	if (CONSP (second))
-if (CONSP (second))
+	  Fput (first, Qautoload, (XCDR (second)));
-	Fput (first, Qautoload, (Fcdr (second)));
+}
-queue = Fcdr (queue);
-}
 }
 /* Once loading finishes, don't undo it.  */
 Vautoload_queue = Qt;
 unbind_to (speccount, Qnil);
 	   string_data (XSYMBOL (funname)->name));
 UNGCPRO;
 }
-/**********************************************************************/
+/************************************************************************/
-/*                         eval, funcall, apply                       */
+/*			   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 int in_warnings;
 static Lisp_Object
 in_warnings_restore (Lisp_Object minimus)
 {
 in_warnings = 0;
 return Qnil;
-}
-#define AV_0(av)
-#define AV_1(av) av[0]
-#define AV_2(av) AV_1(av), av[1]
-#define AV_3(av) AV_2(av), av[2]
-#define AV_4(av) AV_3(av), av[3]
-#define AV_5(av) AV_4(av), av[4]
-#define AV_6(av) AV_5(av), av[5]
-#define AV_7(av) AV_6(av), av[6]
-#define AV_8(av) AV_7(av), av[7]
-#define PRIMITIVE_FUNCALL(fn, av, ac) \
-(((Lisp_Object (*)(EXFUN_##ac)) (fn)) (AV_##ac (av)))
-/* If subr's take more than 8 arguments, more cases need to be added
-to this switch.  (But don't do it - if you really need a SUBR with
-more than 8 arguments, use max_args == MANY.
-See the DEFUN macro in lisp.h)  */
-#define inline_funcall_fn(rv, fn, av, ac) do {		\
-switch (ac) {						\
-case 0: rv = PRIMITIVE_FUNCALL(fn, av, 0); break;	\
-case 1: rv = PRIMITIVE_FUNCALL(fn, av, 1); break;	\
-case 2: rv = PRIMITIVE_FUNCALL(fn, av, 2); break;	\
-case 3: rv = PRIMITIVE_FUNCALL(fn, av, 3); break;	\
-case 4: rv = PRIMITIVE_FUNCALL(fn, av, 4); break;	\
-case 5: rv = PRIMITIVE_FUNCALL(fn, av, 5); break;	\
-case 6: rv = PRIMITIVE_FUNCALL(fn, av, 6); break;	\
-case 7: rv = PRIMITIVE_FUNCALL(fn, av, 7); break;	\
-case 8: rv = PRIMITIVE_FUNCALL(fn, av, 8); break;	\
-default: abort(); rv = Qnil; break;			\
-}							\
-} while (0)
-#define inline_funcall_subr(rv, subr, av) do {		\
-void (*fn)() = (void (*)()) (subr_function(subr));	\
-inline_funcall_fn (rv, fn, av, subr->max_args);	\
-} while (0)
-static Lisp_Object
-primitive_funcall (lisp_fn_t fn, int nargs, Lisp_Object args[])
-{
-Lisp_Object rv;
-inline_funcall_fn (rv, fn, args, nargs);
-return rv;
 }
 DEFUN ("eval", Feval, 1, 1, 0, /*
 Evaluate FORM and return its value.
 */
 /* 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_counter;
+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;
 call3 (Qdisplay_warning, class, messij, level);
 UNGCPRO;
 unbind_to (speccount, Qnil);
 }
-if (SYMBOLP (form))
-return Fsymbol_value (form);
 if (!CONSP (form))
-return form;
+{
+if (SYMBOLP (form))
+	return Fsymbol_value (form);
+else
+	return form;
+}
 QUIT;
 if ((consing_since_gc > gc_cons_threshold) || always_gc)
 {
 struct gcpro gcpro1;
 	max_lisp_eval_depth = 100;
 if (lisp_eval_depth > max_lisp_eval_depth)
 	error ("Lisp nesting exceeds `max-lisp-eval-depth'");
 }
-/*
+/* We guaranteed CONSP (form) above */
-* At this point we know that `form' is a Lisp_Cons so we can safely
+original_fun  = XCAR (form);
-* use XCAR and XCDR.
-*/
-original_fun = XCAR (form);
 original_args = XCDR (form);
-/*
+GET_EXTERNAL_LIST_LENGTH (original_args, nargs);
-* Formerly we used a call to Flength here, but that is slow and
-* wasteful due to type checking, stack push/pop and initialization.
+backtrace.pdlcount = specpdl_depth();
-* We know we're dealing with a cons, so open code it for speed.
-*
-* We call QUIT in the loop so that a circular arg list won't lock
-* up the editor.
-*/
-for (nargs = 0, val = original_args ; CONSP (val) ; val = XCDR (val))
-{
-nargs++;
-QUIT;
-}
-if (! NILP (val))
-signal_simple_error ("Argument list must be nil-terminated",
-			 original_args);
-#ifdef EMACS_BTL
-backtrace.id_number = 0;
-#endif
-backtrace.pdlcount = specpdl_depth_counter;
 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 (profiling_active)
 profile_increase_call_count (original_fun);
 /* At this point, only original_fun and original_args
-have values that will be used below */
+have values that will be used below. */
 retry:
 fun = indirect_function (original_fun, 1);
 if (SUBRP (fun))
 {
-struct Lisp_Subr *subr = XSUBR (fun);
+Lisp_Subr *subr = XSUBR (fun);
 int max_args = subr->max_args;
-Lisp_Object argvals[SUBR_MAX_ARGS];
-Lisp_Object args_left;
+if (nargs < subr->min_args)
-REGISTER int i;
+	goto wrong_number_of_arguments;
-args_left = original_args;
+if (max_args == UNEVALLED) /* Optimize for the common case */
-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 = ((Lisp_Object (*) (Lisp_Object)) (subr_function (subr))) (args_left);
+	  val = (((Lisp_Object (*) (Lisp_Object)) (subr_function (subr)))
+		 (original_args));
 	}
+else if (nargs <= max_args)
+{
+struct gcpro gcpro1;
+	  Lisp_Object args[SUBR_MAX_ARGS];
+	  REGISTER Lisp_Object *p = args;
+	  GCPRO1 (args[0]);
+	  gcpro1.nvars = 0;
+	  {
+	    REGISTER Lisp_Object arg;
+	    LIST_LOOP_2 (arg, original_args)
+	      {
+		*p++ = Feval (arg);
+		gcpro1.nvars++;
+	      }
+	  }
+	  /* &optional args default to nil. */
+	  while (p - args < max_args)
+	    *p++ = Qnil;
+backtrace.args  = args;
+backtrace.nargs = nargs;
+	  FUNCALL_SUBR (val, subr, args, max_args);
+	  UNGCPRO;
+}
 else if (max_args == MANY)
 	{
 	  /* Pass a vector of evaluated arguments */
-	  Lisp_Object *vals;
+struct gcpro gcpro1;
-	  REGISTER int argnum;
+	  Lisp_Object *args = alloca_array (Lisp_Object, nargs);
-struct gcpro gcpro1, gcpro2, gcpro3;
+	  REGISTER Lisp_Object *p = args;
-	  vals = alloca_array (Lisp_Object, nargs);
+	  GCPRO1 (args[0]);
+	  gcpro1.nvars = 0;
-	  GCPRO3 (args_left, fun, vals[0]);
-	  gcpro3.nvars = 0;
+	  {
+	    REGISTER Lisp_Object arg;
-	  argnum = 0;
+	    LIST_LOOP_2 (arg, original_args)
-while (CONSP (args_left))
+	      {
-	    {
+		*p++ = Feval (arg);
-	      vals[argnum++] = Feval (XCAR (args_left));
+		gcpro1.nvars++;
-	      args_left = XCDR (args_left);
+	      }
-	      gcpro3.nvars = argnum;
+	  }
-	    }
+	  backtrace.args  = args;
-	  backtrace.args = vals;
 	  backtrace.nargs = nargs;
-	  val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
+	  val = (((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
-	    (nargs, vals);
+		 (nargs, args));
-/* 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--;
-if (backtrace.debug_on_exit)
-val = do_debug_on_exit (val);
-	  POP_BACKTRACE (backtrace);
 	  UNGCPRO;
-return val;
 	}
 else
-{
+	{
-struct gcpro gcpro1, gcpro2, gcpro3;
+	wrong_number_of_arguments:
+	  signal_wrong_number_of_arguments_error (fun, nargs);
-	  GCPRO3 (args_left, fun, fun);
+	}
-	  gcpro3.var = argvals;
-	  gcpro3.nvars = 0;
-	  for (i = 0; i < nargs; args_left = XCDR (args_left))
-	    {
-	      argvals[i] = Feval (XCAR (args_left));
-	      gcpro3.nvars = ++i;
-	    }
-	  UNGCPRO;
-	  /* i == nargs at this point */
-	  for (; i < max_args; i++)
-argvals[i] = Qnil;
-backtrace.args = argvals;
-backtrace.nargs = nargs;
-/* val = funcall_subr (subr, argvals); */
-	  inline_funcall_subr (val, subr, argvals);
-}
 }
 else if (COMPILED_FUNCTIONP (fun))
-val = apply_lambda (fun, nargs, original_args);
+{
-else
+struct gcpro gcpro1;
-{
+Lisp_Object *args = alloca_array (Lisp_Object, nargs);
-Lisp_Object funcar;
+REGISTER Lisp_Object *p = args;
-if (!CONSP (fun))
+GCPRO1 (args[0]);
-goto invalid_function;
+gcpro1.nvars = 0;
-funcar = XCAR (fun);
-if (!SYMBOLP (funcar))
+{
-goto invalid_function;
+	REGISTER Lisp_Object arg;
+	LIST_LOOP_2 (arg, original_args)
+	  {
+	    *p++ = Feval (arg);
+	    gcpro1.nvars++;
+	  }
+}
+backtrace.args     = args;
+backtrace.nargs    = nargs;
+backtrace.evalargs = 0;
+val = funcall_compiled_function (fun, nargs, args);
+/* Do the debug-on-exit now, while args is still GCPROed.  */
+if (backtrace.debug_on_exit)
+	val = do_debug_on_exit (val);
+/* Don't do it again when we return to eval.  */
+backtrace.debug_on_exit = 0;
+UNGCPRO;
+}
+else if (CONSP (fun))
+{
+Lisp_Object funcar = XCAR (fun);
 if (EQ (funcar, Qautoload))
 	{
 	  do_autoload (fun, original_fun);
 	  goto retry;
 	}
-if (EQ (funcar, Qmacro))
+else if (EQ (funcar, Qmacro))
-	val = Feval (apply1 (XCDR (fun), original_args));
+	{
+	  val = Feval (apply1 (XCDR (fun), original_args));
+	}
 else if (EQ (funcar, Qlambda))
-val = apply_lambda (fun, nargs, original_args);
+	{
+	  struct gcpro gcpro1;
+	  Lisp_Object *args = alloca_array (Lisp_Object, nargs);
+	  REGISTER Lisp_Object *p = args;
+	  GCPRO1 (args[0]);
+	  gcpro1.nvars = 0;
+	  {
+	    REGISTER Lisp_Object arg;
+	    LIST_LOOP_2 (arg, original_args)
+	      {
+		*p++ = Feval (arg);
+		gcpro1.nvars++;
+	      }
+	  }
+	  UNGCPRO;
+	  backtrace.args     = args; /* this also GCPROs `args' */
+	  backtrace.nargs    = nargs;
+	  backtrace.evalargs = 0;
+	  val = funcall_lambda (fun, nargs, args);
+	  /* Do the debug-on-exit now, while args is still GCPROed.  */
+	  if (backtrace.debug_on_exit)
+	    val = do_debug_on_exit (val);
+	  /* Don't do it again when we return to eval.  */
+	  backtrace.debug_on_exit = 0;
+	}
 else
 	{
-	invalid_function:
+	  goto invalid_function;
-	  return Fsignal (Qinvalid_function, list1 (fun));
 	}
+}
+else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */
+{
+invalid_function:
+signal_invalid_function_error (fun);
 }
 lisp_eval_depth--;
 if (backtrace.debug_on_exit)
 val = do_debug_on_exit (val);
 POP_BACKTRACE (backtrace);
 return val;
 }
-Lisp_Object
+DEFUN ("funcall", Ffuncall, 1, MANY, 0, /*
-funcall_recording_as (Lisp_Object recorded_as, int nargs,
+Call first argument as a function, passing the remaining arguments to it.
-		      Lisp_Object *args)
+Thus, (funcall 'cons 'x 'y) returns (x . y).
+*/
+(int nargs, Lisp_Object *args))
 {
 /* This function can GC */
 Lisp_Object fun;
 Lisp_Object val;
 struct backtrace backtrace;
-REGISTER int i;
+int fun_nargs = nargs - 1;
+Lisp_Object *fun_args = args + 1;
 QUIT;
 if ((consing_since_gc > gc_cons_threshold) || always_gc)
 /* Callers should gcpro lexpr args */
 garbage_collect_1 ();
 	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 */
+backtrace.pdlcount = specpdl_depth();
-nargs = nargs - 1;
-#ifdef EMACS_BTL
-backtrace.id_number = 0;
-#endif
-backtrace.pdlcount = specpdl_depth_counter;
 backtrace.function = &args[0];
-backtrace.args = &args[1];
+backtrace.args  = fun_args;
-backtrace.nargs = nargs;
+backtrace.nargs = fun_nargs;
 backtrace.evalargs = 0;
 backtrace.debug_on_exit = 0;
 PUSH_BACKTRACE (backtrace);
 if (debug_on_next_call)
 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
 /* It might be useful to place this *after* all the checks.  */
 if (profiling_active)
 profile_increase_call_count (fun);
+/* We could call indirect_function directly, but profiling shows
+this is worth optimizing by partially unrolling the loop.  */
 if (SYMBOLP (fun))
-fun = indirect_function (fun, 1);
+{
+fun = XSYMBOL (fun)->function;
+if (SYMBOLP (fun))
+	{
+	  fun = XSYMBOL (fun)->function;
+	  if (SYMBOLP (fun))
+	    fun = indirect_function (fun, 1);
+	}
+}
 if (SUBRP (fun))
 {
-struct Lisp_Subr *subr = XSUBR (fun);
+Lisp_Subr *subr = XSUBR (fun);
 int max_args = subr->max_args;
+Lisp_Object spacious_args[SUBR_MAX_ARGS];
-if (max_args == UNEVALLED)
-	return Fsignal (Qinvalid_function, list1 (fun));
+if (fun_nargs < subr->min_args)
+	goto wrong_number_of_arguments;
-if (nargs < subr->min_args
-	  || (max_args >= 0 && max_args < nargs))
+if (fun_nargs == max_args) /* Optimize for the common case */
 	{
-	  return Fsignal (Qwrong_number_of_arguments,
+	funcall_subr:
-list2 (fun, make_int (nargs)));
+	  FUNCALL_SUBR (val, subr, fun_args, max_args);
 	}
+else if (fun_nargs < max_args)
-if (max_args == MANY)
+	{
+	  Lisp_Object *p = spacious_args;
+/* Default optionals to nil */
+	  while (fun_nargs--)
+	    *p++ = *fun_args++;
+	  while (p - spacious_args < max_args)
+	    *p++ = Qnil;
+	  fun_args = spacious_args;
+	  goto funcall_subr;
+	}
+else if (max_args == MANY)
 	{
 	  val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
-	    (nargs, args + 1);
+	    (fun_nargs, fun_args);
 	}
+else if (max_args == UNEVALLED) /* Can't funcall a special form */
-else if (max_args > nargs)
 	{
-Lisp_Object argvals[SUBR_MAX_ARGS];
+	  goto invalid_function;
-/* 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); */
-	  inline_funcall_subr (val, subr, argvals);
 	}
 else
-/* val = funcall_subr (subr, args + 1); */
+	{
-inline_funcall_subr (val, subr, (&args[1]));
+	wrong_number_of_arguments:
+	  signal_wrong_number_of_arguments_error (fun, fun_nargs);
+	}
 }
 else if (COMPILED_FUNCTIONP (fun))
-val = funcall_lambda (fun, nargs, args + 1);
+{
-else if (!CONSP (fun))
+val = funcall_compiled_function (fun, fun_nargs, fun_args);
-{
+}
-invalid_function:
+else if (CONSP (fun))
-return Fsignal (Qinvalid_function, list1 (fun));
+{
-}
-else
-{
-/* `fun' is a Lisp_Cons so XCAR is safe */
 Lisp_Object funcar = XCAR (fun);
-if (!SYMBOLP (funcar))
-goto invalid_function;
 if (EQ (funcar, Qlambda))
-	val = funcall_lambda (fun, nargs, args + 1);
+	{
+	  val = funcall_lambda (fun, fun_nargs, fun_args);
+	}
 else if (EQ (funcar, Qautoload))
 	{
 	  do_autoload (fun, args[0]);
 	  goto retry;
 	}
-else
+else /* Can't funcall a macro */
 	{
-goto invalid_function;
+	  goto invalid_function;
 	}
 }
+else if (UNBOUNDP (fun))
+{
+signal_void_function_error (args[0]);
+}
+else
+{
+invalid_function:
+signal_invalid_function_error (fun);
+}
 lisp_eval_depth--;
 if (backtrace.debug_on_exit)
 val = do_debug_on_exit (val);
 POP_BACKTRACE (backtrace);
 return val;
 }
-DEFUN ("funcall", Ffuncall, 1, MANY, 0, /*
+DEFUN ("functionp", Ffunctionp, 1, 1, 0, /*
-Call first argument as a function, passing remaining arguments to it.
+Return t if OBJECT can be called as a function, else nil.
-Thus, (funcall 'cons 'x 'y) returns (x . y).
+A function is an object that can be applied to arguments,
+using for example `funcall' or `apply'.
 */
-(int nargs, Lisp_Object *args))
+(object))
 {
-return funcall_recording_as (args[0], nargs, args);
+if (SYMBOLP (object))
-}
+object = indirect_function (object, 0);
-DEFUN ("function-min-args", Ffunction_min_args, 1, 1, 0, /*
+return
-Return the number of arguments a function may be called with.  The
+(SUBRP (object) ||
-function may be any form that can be passed to `funcall', any special
+COMPILED_FUNCTIONP (object) ||
-form, or any macro.
+(CONSP (object) &&
-*/
+(EQ (XCAR (object), Qlambda) ||
-(function))
+EQ (XCAR (object), Qautoload))))
+? Qt : Qnil;
+}
+static Lisp_Object
+function_argcount (Lisp_Object function, int function_min_args_p)
 {
 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))
+return function_min_args_p ?
-{
+	Fsubr_min_args (function):
-invalid_function:
+	Fsubr_max_args (function);
-return Fsignal (Qinvalid_function, list1 (function));
+}
-}
+else if (COMPILED_FUNCTIONP (function))
+{
-if (CONSP (function))
+arglist = compiled_function_arglist (XCOMPILED_FUNCTION (function));
+}
+else if (CONSP (function))
 {
 Lisp_Object funcar = XCAR (function);
-if (!SYMBOLP (funcar))
-goto invalid_function;
 if (EQ (funcar, Qmacro))
 	{
 	  function = XCDR (function);
 	  goto retry;
 	}
-if (EQ (funcar, Qautoload))
+else if (EQ (funcar, Qautoload))
 	{
 	  do_autoload (function, orig_function);
 	  goto retry;
 	}
-if (EQ (funcar, Qlambda))
+else if (EQ (funcar, Qlambda))
-	arglist = Fcar (XCDR (function));
+	{
+	  arglist = Fcar (XCDR (function));
+	}
 else
-	goto invalid_function;
+	{
+	  goto invalid_function;
+	}
 }
 else
-arglist = XCOMPILED_FUNCTION (function)->arglist;
+{
+invalid_function:
-argcount = 0;
+return Fsignal (Qinvalid_function, list1 (function));
-while (!NILP (arglist))
+}
-{
-QUIT;
+{
-if (EQ (Fcar (arglist), Qand_optional)
+int argcount = 0;
-	  || EQ (Fcar (arglist), Qand_rest))
+Lisp_Object arg;
-	break;
-argcount++;
+EXTERNAL_LIST_LOOP_2 (arg, arglist)
-arglist = Fcdr (arglist);
+{
-}
+	if (EQ (arg, Qand_optional))
+	  {
-return make_int (argcount);
+	    if (function_min_args_p)
-}
+	      break;
+	  }
-DEFUN ("function-max-args", Ffunction_max_args, 1, 1, 0, /*
+	else if (EQ (arg, Qand_rest))
-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
+	    if (function_min_args_p)
-special form, nil is returned.  The function may be any form that can
+	      break;
-be passed to `funcall', any special form, or any macro.
+	    else
+	      return Qnil;
+	  }
+	else
+	  {
+	    argcount++;
+	  }
+}
+return make_int (argcount);
+}
+}
+DEFUN ("function-min-args", Ffunction_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 orig_function = function;
+return function_argcount (function, 1);
-Lisp_Object arglist;
+}
-int argcount;
+DEFUN ("function-max-args", Ffunction_max_args, 1, 1, 0, /*
-retry:
+Return the number of arguments a function may be called with.
+The function may be any form that can be passed to `funcall',
-if (SYMBOLP (function))
+any special form, or any macro.
-function = indirect_function (function, 1);
+If the function takes an arbitrary number of arguments or is
+a built-in special form, nil is returned.
-if (SUBRP (function))
+*/
-return Fsubr_max_args (function);
+(function))
-else if (!COMPILED_FUNCTIONP (function) && !CONSP (function))
+{
-{
+return function_argcount (function, 0);
-invalid_function:
-return Fsignal (Qinvalid_function, list1 (function));
-}
-if (CONSP (function))
-{
-Lisp_Object funcar = XCAR (function);
-if (!SYMBOLP (funcar))
-goto invalid_function;
-if (EQ (funcar, Qmacro))
-	{
-	  function = XCDR (function);
-	  goto retry;
-	}
-if (EQ (funcar, Qautoload))
-	{
-	  do_autoload (function, orig_function);
-	  goto retry;
-	}
-if (EQ (funcar, Qlambda))
-	arglist = Fcar (XCDR (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, 2, MANY, 0, /*
-Call FUNCTION with our remaining args, using our last arg as list of args.
+Call FUNCTION with the remaining args, using the last arg as a list of args.
 Thus, (apply '+ 1 2 '(3 4)) returns 10.
 */
 (int nargs, Lisp_Object *args))
 {
 /* This function can GC */
 Lisp_Object fun = args[0];
-Lisp_Object spread_arg = args [nargs - 1], p;
+Lisp_Object spread_arg = args [nargs - 1];
 int numargs;
 int funcall_nargs;
-CHECK_LIST (spread_arg);
+GET_EXTERNAL_LIST_LENGTH (spread_arg, numargs);
-/*
-* Formerly we used a call to Flength here, but that is slow and
-* wasteful due to type checking, stack push/pop and initialization.
-* We know we're dealing with a cons, so open code it for speed.
-*
-* We call QUIT in the loop so that a circular arg list won't lock
-* up the editor.
-*/
-for (numargs = 0, p = spread_arg ; CONSP (p) ; p = XCDR (p))
-{
-numargs++;
-QUIT;
-}
-if (! NILP (p))
-signal_simple_error ("Argument list must be nil-terminated", spread_arg);
 if (numargs == 0)
 /* (apply foo 0 1 '()) */
 return Ffuncall (nargs - 1, args);
 else if (numargs == 1)
 /* +1 for function */
 funcall_nargs = 1 + numargs;
 if (SYMBOLP (fun))
 fun = indirect_function (fun, 0);
-if (UNBOUNDP (fun))
-{
+if (SUBRP (fun))
-/* Let funcall get the error */
+{
-fun = args[0];
+Lisp_Subr *subr = XSUBR (fun);
-}
-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))
 {
 	  /* Avoid having funcall cons up yet another new vector of arguments
 	     by explicitly supplying nil's for optional values */
 funcall_nargs += (max_args - numargs);
 }
 }
+else if (UNBOUNDP (fun))
+{
+/* Let funcall get the error */
+fun = args[0];
+}
 {
 REGISTER int i;
 Lisp_Object *funcall_args = alloca_array (Lisp_Object, funcall_nargs);
 struct gcpro gcpro1;
 RETURN_UNGCPRO (Ffuncall (funcall_nargs, funcall_args));
 }
 }
-/* FSFmacs has an extra arg EVAL_FLAG.  If false, some of
+/* Apply lambda list FUN to the NARGS evaluated arguments in ARGS and
-the statements below are not done.  But it's always true
+return the result of evaluation. */
-in all the calls to apply_lambda(). */
 static Lisp_Object
-apply_lambda (Lisp_Object fun, int numargs, Lisp_Object unevalled_args)
+funcall_lambda (Lisp_Object fun, int nargs, Lisp_Object args[])
 {
 /* This function can GC */
-struct gcpro gcpro1, gcpro2, gcpro3;
+Lisp_Object symbol, arglist, body, tail;
-REGISTER int i;
+int speccount = specpdl_depth();
-REGISTER Lisp_Object tem;
+REGISTER int i = 0;
-REGISTER Lisp_Object *arg_vector = alloca_array (Lisp_Object, numargs);
+tail = XCDR (fun);
-GCPRO3 (*arg_vector, unevalled_args, fun);
-gcpro1.nvars = 0;
+if (!CONSP (tail))
+goto invalid_function;
-for (i = 0; i < numargs;)
-{
+arglist = XCAR (tail);
-/*
+body    = XCDR (tail);
-* unevalled_args is always a normal list, or Feval would have
-* rejected it, so use XCAR and XCDR.
+{
-*/
+int optional = 0, rest = 0;
-tem = XCAR (unevalled_args), unevalled_args = XCDR (unevalled_args);
-tem = Feval (tem);
+EXTERNAL_LIST_LOOP_3 (symbol, arglist, tail)
-arg_vector[i++] = tem;
+{
-gcpro1.nvars = i;
+	if (!SYMBOLP (symbol))
-}
+	  goto invalid_function;
+	if (EQ (symbol, Qand_rest))
-UNGCPRO;
+	  rest = 1;
+	else if (EQ (symbol, Qand_optional))
-backtrace_list->args = arg_vector;
+	  optional = 1;
-backtrace_list->nargs = i;
+	else if (rest)
-backtrace_list->evalargs = 0;
+	  {
-tem = funcall_lambda (fun, numargs, arg_vector);
+	    specbind (symbol, Flist (nargs - i, &args[i]));
+	    i = nargs;
-/* Do the debug-on-exit now, while arg_vector still exists.  */
+	  }
-if (backtrace_list->debug_on_exit)
+	else if (i < nargs)
-tem = do_debug_on_exit (tem);
+	  specbind (symbol, args[i++]);
-/* Don't do it again when we return to eval.  */
+	else if (!optional)
-backtrace_list->debug_on_exit = 0;
+	  goto wrong_number_of_arguments;
-return tem;
+	else
-}
+	  specbind (symbol, Qnil);
+}
-DEFUN ("fetch-bytecode", Ffetch_bytecode, 1, 1, 0, /*
+}
-If byte-compiled OBJECT is lazy-loaded, fetch it now.
-*/
-(object))
-{
-if (COMPILED_FUNCTIONP (object)
-&& CONSP (XCOMPILED_FUNCTION (object)->bytecodes))
-{
-Lisp_Object tem =
-	read_doc_string (XCOMPILED_FUNCTION (object)->bytecodes);
-if (!CONSP (tem))
-	signal_simple_error ("invalid lazy-loaded byte code", tem);
-/* v18 or v19 bytecode file.  Need to Ebolify. */
-if (XCOMPILED_FUNCTION (object)->flags.ebolified
-	  && VECTORP (XCDR (tem)))
-	ebolify_bytecode_constants (XCDR (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;
-}
-/* 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;
-if (CONSP (fun))
-syms_left = Fcar (XCDR (fun));
-else if (COMPILED_FUNCTIONP (fun))
-syms_left = XCOMPILED_FUNCTION (fun)->arglist;
-else abort ();
-i = 0;
-for (; CONSP (syms_left); syms_left = XCDR (syms_left))
-{
-QUIT;
-next = XCAR (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,
+goto wrong_number_of_arguments;
-list2 (fun, make_int (nargs)));
+return unbind_to (speccount, Fprogn (body));
-if (CONSP (fun))
-val = Fprogn (Fcdr (XCDR (fun)));
+wrong_number_of_arguments:
-else
+return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs)));
-{
-struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (fun);
+invalid_function:
-/* If we have not actually read the bytecode string
+return Fsignal (Qinvalid_function, list1 (fun));
-	 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);
-}
-/**********************************************************************/
+/************************************************************************/
-/*                   Run hook variables in various ways.              */
+/*		     Run hook variables in various ways.		*/
-/**********************************************************************/
+/************************************************************************/
 DEFUN ("run-hooks", Frun_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.
 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;
 args[0] = val;
 return Ffuncall (nargs, args);
 }
 else
 {
+struct gcpro gcpro1, gcpro2;
 GCPRO2 (sym, val);
 for (;
 	   CONSP (val) && ((cond == RUN_HOOKS_TO_COMPLETION)
 			   || (cond == RUN_HOOKS_UNTIL_SUCCESS ? NILP (ret)
 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 sym = args[0];
 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))
 Frun_hooks (1, &hook);
 return Qnil;
 }
-/**********************************************************************/
+/************************************************************************/
-/*                  Front-ends to eval, funcall, apply                */
+/*		    Front-ends to eval, funcall, apply			*/
-/**********************************************************************/
+/************************************************************************/
 /* Apply fn to arg */
 Lisp_Object
 apply1 (Lisp_Object fn, Lisp_Object arg)
 {
 if (current_buffer == buf)
 return call0 (fn);
 else
 {
 Lisp_Object val;
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 set_buffer_internal (buf);
 val = call0 (fn);
 unbind_to (speccount, Qnil);
 return val;
 if (current_buffer == buf)
 return call1 (fn, arg0);
 else
 {
 Lisp_Object val;
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 set_buffer_internal (buf);
 val = call1 (fn, arg0);
 unbind_to (speccount, Qnil);
 return val;
 if (current_buffer == buf)
 return call2 (fn, arg0, arg1);
 else
 {
 Lisp_Object val;
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 set_buffer_internal (buf);
 val = call2 (fn, arg0, arg1);
 unbind_to (speccount, Qnil);
 return val;
 if (current_buffer == buf)
 return call3 (fn, arg0, arg1, arg2);
 else
 {
 Lisp_Object val;
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 set_buffer_internal (buf);
 val = call3 (fn, arg0, arg1, arg2);
 unbind_to (speccount, Qnil);
 return val;
 if (current_buffer == buf)
 return call4 (fn, arg0, arg1, arg2, arg3);
 else
 {
 Lisp_Object val;
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
 set_buffer_internal (buf);
 val = call4 (fn, arg0, arg1, arg2, arg3);
 unbind_to (speccount, Qnil);
 return val;
 if (current_buffer == buf)
 return Feval (form);
 else
 {
 Lisp_Object val;
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 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 */
+/************************************************************************/
+/*	   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)
 {
 Lisp_Object
 eval_in_buffer_trapping_errors (CONST char *warning_string,
 				struct buffer *buf, Lisp_Object form)
 {
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 Lisp_Object tem;
 Lisp_Object buffer;
 Lisp_Object cons;
 Lisp_Object opaque;
 struct gcpro gcpro1, gcpro2;
 return Qnil;
 tem = find_symbol_value (hook_symbol);
 if (NILP (tem) || UNBOUNDP (tem))
 return Qnil;
-speccount = specpdl_depth_counter;
+speccount = specpdl_depth();
 specbind (Qinhibit_quit, Qt);
 opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil);
 GCPRO1 (opaque);
 /* Qerror not Qt, so you can get a backtrace */
 Lisp_Object
 safe_run_hook_trapping_errors (CONST char *warning_string,
 			       Lisp_Object hook_symbol,
 			       int allow_quit)
 {
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 Lisp_Object tem;
 Lisp_Object cons = Qnil;
 struct gcpro gcpro1;
 if (!initialized || preparing_for_armageddon)
 if (NILP (tem) || UNBOUNDP (tem))
 	return Qnil;
 }
 GCPRO2 (opaque, function);
-speccount = specpdl_depth_counter;
+speccount = specpdl_depth();
 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 */
 Lisp_Object
 call1_trapping_errors (CONST char *warning_string, Lisp_Object function,
 		       Lisp_Object object)
 {
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 Lisp_Object tem;
 Lisp_Object cons = Qnil;
 Lisp_Object opaque = Qnil;
 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 Lisp_Object
 call2_trapping_errors (CONST char *warning_string, Lisp_Object function,
 		       Lisp_Object object1, Lisp_Object object2)
 {
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 Lisp_Object tem;
 Lisp_Object cons = Qnil;
 Lisp_Object opaque = Qnil;
 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 /* gc_currently_forbidden = 0; */
 return unbind_to (speccount, tem);
 }
-/**********************************************************************/
+/************************************************************************/
-/*                     The special binding stack                      */
+/*		       The special binding stack			*/
-/**********************************************************************/
+/* Most C code should simply use specbind() and unbind_to().		*/
+/* When performance is critical, use the macros in backtrace.h.		*/
+/************************************************************************/
 #define min_max_specpdl_size 400
-static void
+void
-grow_specpdl (void)
+grow_specpdl (size_t reserved)
 {
-if (specpdl_size >= max_specpdl_size)
+size_t size_needed = specpdl_depth() + reserved;
+if (size_needed >= max_specpdl_size)
 {
 if (max_specpdl_size < min_max_specpdl_size)
 	max_specpdl_size = min_max_specpdl_size;
-if (specpdl_size >= max_specpdl_size)
+if (size_needed >= max_specpdl_size)
 	{
-	  if (!NILP (Vdebug_on_error) || !NILP (Vdebug_on_signal))
+	  if (!NILP (Vdebug_on_error) ||
+	      !NILP (Vdebug_on_signal))
 	    /* Leave room for some specpdl in the debugger.  */
-	    max_specpdl_size = specpdl_size + 100;
+	    max_specpdl_size = size_needed + 100;
 	  continuable_error
 	    ("Variable binding depth exceeds max-specpdl-size");
 	}
 }
-specpdl_size *= 2;
+while (specpdl_size < size_needed)
-if (specpdl_size > max_specpdl_size)
+{
-specpdl_size = max_specpdl_size;
+specpdl_size *= 2;
+if (specpdl_size > max_specpdl_size)
+	specpdl_size = max_specpdl_size;
+}
 XREALLOC_ARRAY (specpdl, struct specbinding, specpdl_size);
-specpdl_ptr = specpdl + specpdl_depth_counter;
+specpdl_ptr = specpdl + specpdl_depth();
 }
 /* Handle unbinding buffer-local variables */
 static Lisp_Object
 void
 specbind (Lisp_Object symbol, Lisp_Object value)
 {
-int buffer_local;
+SPECBIND (symbol, value);
+}
-CHECK_SYMBOL (symbol);
+void
-if (specpdl_depth_counter >= specpdl_size)
+specbind_magic (Lisp_Object symbol, Lisp_Object value)
-grow_specpdl ();
+{
+int buffer_local =
-buffer_local = symbol_value_buffer_local_info (symbol, current_buffer);
+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 */
 }
 void
 record_unwind_protect (Lisp_Object (*function) (Lisp_Object arg),
 Lisp_Object arg)
 {
-if (specpdl_depth_counter >= specpdl_size)
+SPECPDL_RESERVE (1);
-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);
+/* Unwind the stack till specpdl_depth() == COUNT.
+VALUE is not used, except that, purely as a convenience to the
+caller, it is protected from garbage-protection. */
 Lisp_Object
 unbind_to (int count, Lisp_Object value)
 {
+UNBIND_TO_GCPRO (count, value);
+return value;
+}
+/* Don't call this directly.
+Only for use by UNBIND_TO* macros in backtrace.h */
+void
+unbind_to_hairy (int count)
+{
 int quitf;
-struct gcpro gcpro1;
-GCPRO1 (value);
 check_quit (); /* make Vquit_flag accurate */
 quitf = !NILP (Vquit_flag);
 Vquit_flag = Qnil;
+++specpdl_ptr;
+++specpdl_depth_counter;
 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);
+	(*specpdl_ptr->func) (specpdl_ptr->old_value);
 else
-Fset (specpdl_ptr->symbol, ovalue);
+	{
+	  /* We checked symbol for validity when we specbound it,
+	     so only need to call Fset if symbol has magic value.  */
+	  struct Lisp_Symbol *sym = XSYMBOL (specpdl_ptr->symbol);
+	  if (!SYMBOL_VALUE_MAGIC_P (sym->value))
+	    sym->value = specpdl_ptr->old_value;
+	  else
+	    Fset (specpdl_ptr->symbol, specpdl_ptr->old_value);
+	}
+#if 0 /* martin */
 #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
 {
 catchlist = catchlist->next;
 /* Don't mess with gcprolist, backtrace_list here */
 }
 #endif
+#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. */
 }
 #endif /* 0 */
-/**********************************************************************/
+/************************************************************************/
-/*                            Backtraces                              */
+/*			      Backtraces				*/
-/**********************************************************************/
+/************************************************************************/
 DEFUN ("backtrace-debug", Fbacktrace_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.
 */
 (stream, detailed))
 {
 /* This function can GC */
 struct backtrace *backlist = backtrace_list;
 struct catchtag *catches = catchlist;
-int speccount = specpdl_depth_counter;
+int speccount = specpdl_depth();
 int old_nl = print_escape_newlines;
 int old_pr = print_readably;
 Lisp_Object old_level = Vprint_level;
 Lisp_Object oiq = Vinhibit_quit;
 return Fcons (Qt, Fcons (*backlist->function, tem));
 }
 }
-/**********************************************************************/
+/************************************************************************/
-/*                            Warnings                                */
+/*			      Warnings					*/
-/**********************************************************************/
+/************************************************************************/
 void
 warn_when_safe_lispobj (Lisp_Object class, Lisp_Object level,
 			Lisp_Object 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
+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, ...)
 {
 }
-/**********************************************************************/
+/************************************************************************/
-/*                          Initialization                            */
+/*			    Initialization				*/
-/**********************************************************************/
+/************************************************************************/
 void
 syms_of_eval (void)
 {
 defsymbol (&Qinhibit_quit, "inhibit-quit");
 defsymbol (&Qdefun, "defun");
 defsymbol (&Qprogn, "progn");
 defsymbol (&Qvalues, "values");
 defsymbol (&Qdisplay_warning, "display-warning");
 defsymbol (&Qrun_hooks, "run-hooks");
+defsymbol (&Qif, "if");
 DEFSUBR (For);
 DEFSUBR (Fand);
 DEFSUBR (Fif);
+DEFSUBR_MACRO (Fwhen);
+DEFSUBR_MACRO (Funless);
 DEFSUBR (Fcond);
 DEFSUBR (Fprogn);
 DEFSUBR (Fprog1);
 DEFSUBR (Fprog2);
 DEFSUBR (Fsetq);
 DEFSUBR (Fcommand_execute);
 DEFSUBR (Fautoload);
 DEFSUBR (Feval);
 DEFSUBR (Fapply);
 DEFSUBR (Ffuncall);
+DEFSUBR (Ffunctionp);
 DEFSUBR (Ffunction_min_args);
 DEFSUBR (Ffunction_max_args);
 DEFSUBR (Frun_hooks);
 DEFSUBR (Frun_hook_with_args);
 DEFSUBR (Frun_hook_with_args_until_success);
 DEFSUBR (Frun_hook_with_args_until_failure);
-DEFSUBR (Ffetch_bytecode);
 DEFSUBR (Fbacktrace_debug);
 DEFSUBR (Fbacktrace);
 DEFSUBR (Fbacktrace_frame);
 }
 specpdl_depth_counter = 0;
 specpdl = xnew_array (struct specbinding, specpdl_size);
 /* XEmacs change: increase these values. */
 max_specpdl_size = 3000;
 max_lisp_eval_depth = 500;
+#if 0 /* no longer used */
 throw_level = 0;
+#endif
 reinit_eval ();
 }

Mercurial > hg > xemacs-beta

comparison src/eval.c @ 380:8626e4521993 r21-2-5