guile-elisp bootstrap (C)

* src/data.c (Fsetq_default): Remove

* src/editfns.c (Fsave_excursion, Fsave_current_buffer)
  (Fsave_restriction): Change to functions taking thunks as arguments.

* src/eval.c (eval_fn, funcall_fn): New variables.
  (init_eval_once): Increase initial vales of max_specpdl_size and
  max_lisp_eval_depth. Define eval_fn and funcall_fn.
  (Fif, Fsetq, Fquote): Remove.
  (Ffunction): Don't define as DEFUN.
  Whitespace change.
  (Fdefvar, Fdefconst, FletX, Flet): Remove.
  (Fcatch): Take thunk as evaluated argument.
  (Funwind_protect): Remove.
  (Fcondition_case): Replace with Fcall_with_handler.
  (eval_sub_1): Only supported compiled and Scheme procedures.
  (Fapply): Don't define as DEFUN.
  (Ffuncall1): Don't define as DEFUN. Just call funcall_fn.
  (syms_of_eval): Don't unintern internal-interpreter-environment.

* src/fns.c (Fwidget_apply): Call `apply' instead of Fapply.

* src/keyboard.c (Ftrack_mouse): Take thunk as evaluated argument.

* src/lisp.h (WRAP1): Define a global symbol for the wrapped function.

6 files changed, 48 insertions, 573 deletions

diff --git a/src/data.c b/src/data.c
index 03a2a12ff9..7991275cd7 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1435,39 +1435,6 @@ for this variable.  */)
     default: emacs_abort ();
     }
 }
-
-DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0,
-       doc: /* Set the default value of variable VAR to VALUE.
-VAR, the variable name, is literal (not evaluated);
-VALUE is an expression: it is evaluated and its value returned.
-The default value of a variable is seen in buffers
-that do not have their own values for the variable.
-
-More generally, you can use multiple variables and values, as in
-  (setq-default VAR VALUE VAR VALUE...)
-This sets each VAR's default value to the corresponding VALUE.
-The VALUE for the Nth VAR can refer to the new default values
-of previous VARs.
-usage: (setq-default [VAR VALUE]...)  */)
-  (Lisp_Object args)
-{
-  Lisp_Object args_left, symbol, val;
-  struct gcpro gcpro1;
-
-  args_left = val = args;
-  GCPRO1 (args);
-
-  while (CONSP (args_left))
-    {
-      val = eval_sub (Fcar (XCDR (args_left)));
-      symbol = XCAR (args_left);
-      Fset_default (symbol, val);
-      args_left = Fcdr (XCDR (args_left));
-    }
-
-  UNGCPRO;
-  return val;
-}
 
 /* Lisp functions for creating and removing buffer-local variables.  */
 
diff --git a/src/editfns.c b/src/editfns.c
index 747f59ead7..5be3288b22 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -915,7 +915,7 @@ save_excursion_restore (Lisp_Object info)
   free_misc (info);
 }
 
-DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0,
+DEFUN ("call-with-save-excursion", Fsave_excursion, Ssave_excursion, 1, 1, 0,
        doc: /* Save point, mark, and current buffer; execute BODY; restore those things.
 Executes BODY just like `progn'.
 The values of point, mark and the current buffer are restored
@@ -931,28 +931,28 @@ If you only want to save the current buffer but not point nor mark,
 then just use `save-current-buffer', or even `with-current-buffer'.
 
 usage: (save-excursion &rest BODY)  */)
-  (Lisp_Object args)
+  (Lisp_Object thunk)
 {
   register Lisp_Object val;
   dynwind_begin ();
 
   record_unwind_protect (save_excursion_restore, save_excursion_save ());
 
-  val = Fprogn (args);
+  val = call0 (thunk);
   dynwind_end ();
   return val;
 }
 
-DEFUN ("save-current-buffer", Fsave_current_buffer, Ssave_current_buffer, 0, UNEVALLED, 0,
+DEFUN ("call-with-save-current-buffer", Fsave_current_buffer, Ssave_current_buffer, 1, 1, 0,
        doc: /* Record which buffer is current; execute BODY; make that buffer current.
 BODY is executed just like `progn'.
 usage: (save-current-buffer &rest BODY)  */)
-  (Lisp_Object args)
+  (Lisp_Object thunk)
 {
   dynwind_begin ();
 
   record_unwind_current_buffer ();
-  Lisp_Object tem0 = Fprogn (args);
+  Lisp_Object tem0 = call0 (thunk);
   dynwind_end ();
   return tem0;
 }
@@ -3388,7 +3388,7 @@ save_restriction_restore (Lisp_Object data)
     set_buffer_internal (cur);
 }
 
-DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0,
+DEFUN ("call-with-save-restriction", Fsave_restriction, Ssave_restriction, 1, 1, 0,
        doc: /* Execute BODY, saving and restoring current buffer's restrictions.
 The buffer's restrictions make parts of the beginning and end invisible.
 \(They are set up with `narrow-to-region' and eliminated with `widen'.)
diff --git a/src/eval.c b/src/eval.c
index da416b9ec6..4314d9076e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -246,6 +246,9 @@ make_condition_handler (Lisp_Object tag)
   return c;
 }
 
+static Lisp_Object eval_fn;
+static Lisp_Object funcall_fn;
+
 void
 init_eval_once (void)
 {
@@ -254,10 +257,13 @@ init_eval_once (void)
   specpdl_size = size;
   specpdl = specpdl_ptr = pdlvec + 1;
   /* Don't forget to update docs (lispref node "Local Variables").  */
-  max_specpdl_size = 1300; /* 1000 is not enough for CEDET's c-by.el.  */
-  max_lisp_eval_depth = 600;
+  max_specpdl_size = 10000; /* 1000 is not enough for CEDET's c-by.el.  */
+  max_lisp_eval_depth = 10000;
 
   Vrun_hooks = Qnil;
+
+  eval_fn = scm_c_public_ref ("language elisp runtime", "eval-elisp");
+  funcall_fn = scm_c_public_ref ("elisp-functions", "funcall");
 }
 
 static struct handler *handlerlist_sentinel;
@@ -351,26 +357,6 @@ do_debug_on_call (Lisp_Object code)
   call_debugger (list1 (code));
 }
 
-DEFUN ("if", Fif, Sif, 2, UNEVALLED, 0,
-       doc: /* 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.
-usage: (if COND THEN ELSE...)  */)
-  (Lisp_Object args)
-{
-  Lisp_Object cond;
-  struct gcpro gcpro1;
-
-  GCPRO1 (args);
-  cond = eval_sub (XCAR (args));
-  UNGCPRO;
-
-  if (!NILP (cond))
-    return eval_sub (Fcar (XCDR (args)));
-  return Fprogn (XCDR (XCDR (args)));
-}
-
 DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
        doc: /* Eval BODY forms sequentially and return value of last one.
 usage: (progn BODY...)  */)
@@ -400,75 +386,8 @@ unwind_body (Lisp_Object body)
   Fprogn (body);
 }
 
-DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
-       doc: /* 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.
-usage: (setq [SYM VAL]...)  */)
-  (Lisp_Object args)
-{
-  Lisp_Object val, sym, lex_binding;
-
-  val = args;
-  if (CONSP (args))
-    {
-      Lisp_Object args_left = args;
-      struct gcpro gcpro1;
-      GCPRO1 (args);
-
-      do
-	{
-	  val = eval_sub (Fcar (XCDR (args_left)));
-	  sym = XCAR (args_left);
-
-	  /* Like for eval_sub, we do not check declared_special here since
-	     it's been done when let-binding.  */
-	  if (!NILP (Vinternal_interpreter_environment) /* Mere optimization!  */
-	      && SYMBOLP (sym)
-	      && !NILP (lex_binding
-			= Fassq (sym, Vinternal_interpreter_environment)))
-	    XSETCDR (lex_binding, val); /* SYM is lexically bound.  */
-	  else
-	    Fset (sym, val);	/* SYM is dynamically bound.  */
-
-	  args_left = Fcdr (XCDR (args_left));
-	}
-      while (CONSP (args_left));
-
-      UNGCPRO;
-    }
-
-  return val;
-}
-
-DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
-       doc: /* Return the argument, without evaluating it.  `(quote x)' yields `x'.
-Warning: `quote' does not construct its return value, but just returns
-the value that was pre-constructed by the Lisp reader (see info node
-`(elisp)Printed Representation').
-This means that '(a . b) is not identical to (cons 'a 'b): the former
-does not cons.  Quoting should be reserved for constants that will
-never be modified by side-effects, unless you like self-modifying code.
-See the common pitfall in info node `(elisp)Rearrangement' for an example
-of unexpected results when a quoted object is modified.
-usage: (quote ARG)  */)
-  (Lisp_Object args)
-{
-  if (CONSP (XCDR (args)))
-    xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
-  return XCAR (args);
-}
-
-DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
-       doc: /* Like `quote', but preferred for objects which are functions.
-In byte compilation, `function' causes its argument to be compiled.
-`quote' cannot do that.
-usage: (function ARG)  */)
-  (Lisp_Object args)
+Lisp_Object
+Ffunction (Lisp_Object args)
 {
   Lisp_Object quoted = XCAR (args);
 
@@ -487,7 +406,6 @@ usage: (function ARG)  */)
     return quoted;
 }
 
-
 DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
        doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
 Aliased variables always have the same value; setting one sets the other.
@@ -592,127 +510,6 @@ DEFUN ("set-default-toplevel-value", Fset_default_toplevel_value,
   return Qnil;
 }
 
-DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
-       doc: /* Define SYMBOL as a variable, and return SYMBOL.
-You are not required to define a variable in order to use it, but
-defining it lets you supply an initial value and documentation, which
-can be referred to by the Emacs help facilities and other programming
-tools.  The `defvar' form also declares the variable as \"special\",
-so that it is always dynamically bound even if `lexical-binding' is t.
-
-The optional argument INITVALUE is evaluated, and used to set SYMBOL,
-only if SYMBOL's value is void.  If SYMBOL is buffer-local, its
-default value is what is set; buffer-local values are not affected.
-If INITVALUE is missing, SYMBOL's value is not set.
-
-If SYMBOL has a local binding, then this form affects the local
-binding.  This is usually not what you want.  Thus, if you need to
-load a file defining variables, with this form or with `defconst' or
-`defcustom', you should always load that file _outside_ any bindings
-for these variables.  \(`defconst' and `defcustom' behave similarly in
-this respect.)
-
-The optional argument DOCSTRING is a documentation string for the
-variable.
-
-To define a user option, use `defcustom' instead of `defvar'.
-usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
-  (Lisp_Object args)
-{
-  Lisp_Object sym, tem, tail;
-
-  sym = XCAR (args);
-  tail = XCDR (args);
-
-  if (CONSP (tail))
-    {
-      if (CONSP (XCDR (tail)) && CONSP (XCDR (XCDR (tail))))
-	error ("Too many arguments");
-
-      tem = Fdefault_boundp (sym);
-
-      /* Do it before evaluating the initial value, for self-references.  */
-      SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1);
-
-      if (NILP (tem))
-	Fset_default (sym, eval_sub (XCAR (tail)));
-      else
-	{ /* Check if there is really a global binding rather than just a let
-	     binding that shadows the global unboundness of the var.  */
-	  union specbinding *binding = default_toplevel_binding (sym);
-	  if (binding && EQ (specpdl_old_value (binding), Qunbound))
-	    {
-	      set_specpdl_old_value (binding, eval_sub (XCAR (tail)));
-	    }
-	}
-      tail = XCDR (tail);
-      tem = Fcar (tail);
-      if (!NILP (tem))
-	{
-	  if (!NILP (Vpurify_flag))
-	    tem = Fpurecopy (tem);
-	  Fput (sym, Qvariable_documentation, tem);
-	}
-      LOADHIST_ATTACH (sym);
-    }
-  else if (!NILP (Vinternal_interpreter_environment)
-	   && ! SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym)))
-    /* A simple (defvar foo) with lexical scoping does "nothing" except
-       declare that var to be dynamically scoped *locally* (i.e. within
-       the current file or let-block).  */
-    Vinternal_interpreter_environment
-      = Fcons (sym, Vinternal_interpreter_environment);
-  else
-    {
-      /* Simple (defvar <var>) should not count as a definition at all.
-	 It could get in the way of other definitions, and unloading this
-	 package could try to make the variable unbound.  */
-    }
-
-  return sym;
-}
-
-DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0,
-       doc: /* Define SYMBOL as a constant variable.
-This declares that neither programs nor users should ever change the
-value.  This constancy is not actually enforced by Emacs Lisp, but
-SYMBOL is marked as a special variable so that it is never lexically
-bound.
-
-The `defconst' form 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.  If SYMBOL has a
-local binding, then this form sets the local binding's value.
-However, you should normally not make local bindings for variables
-defined with this form.
-
-The optional DOCSTRING specifies the variable's documentation string.
-usage: (defconst SYMBOL INITVALUE [DOCSTRING])  */)
-  (Lisp_Object args)
-{
-  Lisp_Object sym, tem;
-
-  sym = XCAR (args);
-  if (CONSP (Fcdr (XCDR (XCDR (args)))))
-    error ("Too many arguments");
-
-  tem = eval_sub (Fcar (XCDR (args)));
-  if (!NILP (Vpurify_flag))
-    tem = Fpurecopy (tem);
-  Fset_default (sym, tem);
-  SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1);
-  tem = Fcar (XCDR (XCDR (args)));
-  if (!NILP (tem))
-    {
-      if (!NILP (Vpurify_flag))
-	tem = Fpurecopy (tem);
-      Fput (sym, Qvariable_documentation, tem);
-    }
-  Fput (sym, Qrisky_local_variable, Qt);
-  LOADHIST_ATTACH (sym);
-  return sym;
-}
-
 /* Make SYMBOL lexically scoped.  */
 DEFUN ("internal-make-var-non-special", Fmake_var_non_special,
        Smake_var_non_special, 1, 1, 0,
@@ -725,141 +522,6 @@ DEFUN ("internal-make-var-non-special", Fmake_var_non_special,
 }
 
 
-DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
-       doc: /* 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.
-usage: (let* VARLIST BODY...)  */)
-  (Lisp_Object args)
-{
-  Lisp_Object varlist, var, val, elt, lexenv;
-  dynwind_begin ();
-  struct gcpro gcpro1, gcpro2, gcpro3;
-
-  GCPRO3 (args, elt, varlist);
-
-  lexenv = Vinternal_interpreter_environment;
-
-  varlist = XCAR (args);
-  while (CONSP (varlist))
-    {
-      QUIT;
-
-      elt = XCAR (varlist);
-      if (SYMBOLP (elt))
-	{
-	  var = elt;
-	  val = Qnil;
-	}
-      else if (! NILP (Fcdr (Fcdr (elt))))
-	signal_error ("`let' bindings can have only one value-form", elt);
-      else
-	{
-	  var = Fcar (elt);
-	  val = eval_sub (Fcar (Fcdr (elt)));
-	}
-
-      if (!NILP (lexenv) && SYMBOLP (var)
-	  && ! SYMBOL_DECLARED_SPECIAL (XSYMBOL (var))
-	  && NILP (Fmemq (var, Vinternal_interpreter_environment)))
-	/* Lexically bind VAR by adding it to the interpreter's binding
-	   alist.  */
-	{
-	  Lisp_Object newenv
-	    = Fcons (Fcons (var, val), Vinternal_interpreter_environment);
-	  if (EQ (Vinternal_interpreter_environment, lexenv))
-	    /* Save the old lexical environment on the specpdl stack,
-	       but only for the first lexical binding, since we'll never
-	       need to revert to one of the intermediate ones.  */
-	    specbind (Qinternal_interpreter_environment, newenv);
-	  else
-	    Vinternal_interpreter_environment = newenv;
-	}
-      else
-	specbind (var, val);
-
-      varlist = XCDR (varlist);
-    }
-  UNGCPRO;
-  val = Fprogn (XCDR (args));
-  dynwind_end ();
-  return val;
-}
-
-DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0,
-       doc: /* 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.
-usage: (let VARLIST BODY...)  */)
-  (Lisp_Object args)
-{
-  Lisp_Object *temps, tem, lexenv;
-  register Lisp_Object elt, varlist;
-  dynwind_begin ();
-  ptrdiff_t argnum;
-  struct gcpro gcpro1, gcpro2;
-  USE_SAFE_ALLOCA;
-
-  varlist = XCAR (args);
-
-  /* Make space to hold the values to give the bound variables.  */
-  elt = Flength (varlist);
-  SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
-
-  /* Compute the values and store them in `temps'.  */
-
-  GCPRO2 (args, *temps);
-  gcpro2.nvars = 0;
-
-  for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
-    {
-      QUIT;
-      elt = XCAR (varlist);
-      if (SYMBOLP (elt))
-	temps [argnum++] = Qnil;
-      else if (! NILP (Fcdr (Fcdr (elt))))
-	signal_error ("`let' bindings can have only one value-form", elt);
-      else
-	temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
-      gcpro2.nvars = argnum;
-    }
-  UNGCPRO;
-
-  lexenv = Vinternal_interpreter_environment;
-
-  varlist = XCAR (args);
-  for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
-    {
-      Lisp_Object var;
-
-      elt = XCAR (varlist);
-      var = SYMBOLP (elt) ? elt : Fcar (elt);
-      tem = temps[argnum++];
-
-      if (!NILP (lexenv) && SYMBOLP (var)
-	  && ! SYMBOL_DECLARED_SPECIAL (XSYMBOL (var))
-	  && NILP (Fmemq (var, Vinternal_interpreter_environment)))
-	/* Lexically bind VAR by adding it to the lexenv alist.  */
-	lexenv = Fcons (Fcons (var, tem), lexenv);
-      else
-	/* Dynamically bind VAR.  */
-	specbind (var, tem);
-    }
-
-  if (!EQ (lexenv, Vinternal_interpreter_environment))
-    /* Instantiate a new lexical environment.  */
-    specbind (Qinternal_interpreter_environment, lexenv);
-
-  elt = Fprogn (XCDR (args));
-  SAFE_FREE ();
-  dynwind_end ();
-  return elt;
-}
-
 DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0,
        doc: /* Return result of expanding macros at top level of FORM.
 If FORM is not a macro call, it is returned unchanged.
@@ -931,7 +593,7 @@ definitions to shadow the loaded ones for use in file byte-compilation.  */)
   return form;
 }
 
-DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0,
+DEFUN ("call-with-catch", Fcatch, Scatch, 2, 2, 0,
        doc: /* Eval BODY allowing nonlocal exits using `throw'.
 TAG is evalled to get the tag to use; it must not be nil.
 
@@ -940,15 +602,9 @@ Within BODY, a call to `throw' with the same TAG exits BODY and 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'.
 usage: (catch TAG BODY...)  */)
-  (Lisp_Object args)
+  (Lisp_Object tag, Lisp_Object thunk)
 {
-  register Lisp_Object tag;
-  struct gcpro gcpro1;
-
-  GCPRO1 (args);
-  tag = eval_sub (XCAR (args));
-  UNGCPRO;
-  return internal_catch (tag, Fprogn, XCDR (args));
+  return internal_catch (tag, call0, thunk);
 }
 
 /* Assert that E is true, as a comment only.  Use this instead of
@@ -1132,26 +788,8 @@ Both TAG and VALUE are evalled.  */)
       }
   xsignal2 (Qno_catch, tag, value);
 }
-
-
-DEFUN ("unwind-protect", Funwind_protect, Sunwind_protect, 1, UNEVALLED, 0,
-       doc: /* Do BODYFORM, protecting with UNWINDFORMS.
-If BODYFORM completes normally, its value is returned
-after executing the UNWINDFORMS.
-If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.
-usage: (unwind-protect BODYFORM UNWINDFORMS...)  */)
-  (Lisp_Object args)
-{
-  Lisp_Object val;
-  dynwind_begin ();
-
-  record_unwind_protect (unwind_body, XCDR (args));
-  val = eval_sub (XCAR (args));
-  dynwind_end ();
-  return val;
-}
 
-DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
+DEFUN ("call-with-handler", Fcall_with_handler, Scall_with_handler, 4, 4, 0,
        doc: /* Regain control when an error is signaled.
 Executes BODYFORM and returns its value if no error happens.
 Each element of HANDLERS looks like (CONDITION-NAME BODY...)
@@ -1177,13 +815,14 @@ expression.
 
 See also the function `signal' for more info.
 usage: (condition-case VAR BODYFORM &rest HANDLERS)  */)
-  (Lisp_Object args)
+  (Lisp_Object var,
+   Lisp_Object conditions,
+   Lisp_Object hthunk,
+   Lisp_Object thunk)
 {
-  Lisp_Object var = XCAR (args);
-  Lisp_Object bodyform = XCAR (XCDR (args));
-  Lisp_Object handlers = XCDR (XCDR (args));
-
-  return internal_lisp_condition_case (var, bodyform, handlers);
+  return internal_lisp_condition_case (var,
+                                       list2 (intern ("funcall"), thunk),
+                                       list1 (list2 (conditions, list2 (intern ("funcall"), hthunk))));
 }
 
 static Lisp_Object
@@ -2015,63 +1654,10 @@ eval_sub_1 (Lisp_Object form)
   else if (!NILP (fun) && (fun = SYMBOL_FUNCTION (fun), SYMBOLP (fun)))
     fun = indirect_function (fun);
 
-  if (scm_is_true (scm_procedure_p (fun)))
-    {
-      Lisp_Object args_left = original_args;
-      Lisp_Object nargs = Flength (args_left);
-      Lisp_Object *args;
-      size_t argnum = 0;
-
-      SAFE_ALLOCA_LISP (args, XINT (nargs));
-
-      while (! NILP (args_left))
-        {
-          args[argnum++] = eval_sub (Fcar (args_left));
-          args_left = Fcdr (args_left);
-        }
-      set_backtrace_args (specpdl_ptr - 1, args);
-      set_backtrace_nargs (specpdl_ptr - 1, argnum);
-      val = scm_call_n (fun, args, argnum);
-    }
-  else if (CONSP (fun) && EQ (XCAR (fun), Qspecial_operator))
-    {
-      val = scm_apply_0 (XCDR (fun), original_args);
-    }
-  else if (COMPILEDP (fun))
+  if (COMPILEDP (fun))
     val = apply_lambda (fun, original_args);
   else
-    {
-      if (NILP (fun))
-	xsignal1 (Qvoid_function, original_fun);
-      if (!CONSP (fun))
-	xsignal1 (Qinvalid_function, original_fun);
-      funcar = XCAR (fun);
-      if (!SYMBOLP (funcar))
-	xsignal1 (Qinvalid_function, original_fun);
-      if (EQ (funcar, Qautoload))
-	{
-	  Fautoload_do_load (fun, original_fun, Qnil);
-	  goto retry;
-	}
-      if (EQ (funcar, Qmacro))
-	{
-	  dynwind_begin ();
-	  Lisp_Object exp;
-	  /* Bind lexical-binding during expansion of the macro, so the
-	     macro can know reliably if the code it outputs will be
-	     interpreted using lexical-binding or not.  */
-	  specbind (Qlexical_binding,
-		    NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
-	  exp = apply1 (Fcdr (fun), original_args);
-	  dynwind_end ();
-	  val = eval_sub (exp);
-	}
-      else if (EQ (funcar, Qlambda)
-	       || EQ (funcar, Qclosure))
-	val = apply_lambda (fun, original_args);
-      else
-	xsignal1 (Qinvalid_function, original_fun);
-    }
+    val = scm_call_1 (eval_fn, form);
 
   if (backtrace_debug_on_exit (specpdl_ptr - 1))
     val = call_debugger (list2 (Qexit, val));
@@ -2116,12 +1702,8 @@ DEFUN ("values", Fvalues, Svalues, 0, MANY, 0,
   return scm_c_values (args, nargs);
 }
 
-DEFUN ("apply", Fapply, Sapply, 1, MANY, 0,
-       doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.
-Then return the value FUNCTION returns.
-Thus, (apply '+ 1 2 '(3 4)) returns 10.
-usage: (apply FUNCTION &rest ARGUMENTS)  */)
-  (ptrdiff_t nargs, Lisp_Object *args)
+Lisp_Object
+Fapply (ptrdiff_t nargs, Lisp_Object *args)
 {
   ptrdiff_t i;
   EMACS_INT numargs;
@@ -2561,85 +2143,10 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
   return Qnil;
 }
 
-DEFUN ("funcall", Ffuncall1, Sfuncall, 1, MANY, 0,
-       doc: /* Call first argument as a function, passing remaining arguments to it.
-Return the value that function returns.
-Thus, (funcall 'cons 'x 'y) returns (x . y).
-usage: (funcall FUNCTION &rest ARGUMENTS)  */)
-  (ptrdiff_t nargs, Lisp_Object *args)
+Lisp_Object
+Ffuncall1 (ptrdiff_t nargs, Lisp_Object *args)
 {
-  Lisp_Object fun, original_fun;
-  Lisp_Object funcar;
-  ptrdiff_t numargs = nargs - 1;
-  Lisp_Object lisp_numargs;
-  Lisp_Object val;
-  register Lisp_Object *internal_args;
-  ptrdiff_t i;
-
-  QUIT;
-
-  scm_dynwind_begin (0);
-  scm_dynwind_unwind_handler (set_lisp_eval_depth,
-                              (void *) lisp_eval_depth,
-                              SCM_F_WIND_EXPLICITLY);
-
-  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'");
-    }
-
-  /* This also GCPROs them.  */
-  record_in_backtrace (args[0], &args[1], nargs - 1);
-
-  /* Call GC after setting up the backtrace, so the latter GCPROs the args.  */
-  maybe_gc ();
-
-  if (debug_on_next_call)
-    do_debug_on_call (Qlambda);
-
-  original_fun = args[0];
-
- retry:
-
-  /* Optimize for no indirection.  */
-  fun = original_fun;
-  if (SYMBOLP (fun) && !NILP (fun)
-      && (fun = SYMBOL_FUNCTION (fun), SYMBOLP (fun)))
-    fun = indirect_function (fun);
-
-  if (scm_is_true (scm_procedure_p (fun)))
-    {
-      val = scm_call_n (fun, args + 1, numargs);
-    }
-  else if (COMPILEDP (fun))
-    val = funcall_lambda (fun, numargs, args + 1);
-  else
-    {
-      if (NILP (fun))
-	xsignal1 (Qvoid_function, original_fun);
-      if (!CONSP (fun))
-	xsignal1 (Qinvalid_function, original_fun);
-      funcar = XCAR (fun);
-      if (!SYMBOLP (funcar))
-	xsignal1 (Qinvalid_function, original_fun);
-      if (EQ (funcar, Qlambda)
-	  || EQ (funcar, Qclosure))
-	val = funcall_lambda (fun, numargs, args + 1);
-      else if (EQ (funcar, Qautoload))
-	{
-	  Fautoload_do_load (fun, original_fun, Qnil);
-	  goto retry;
-	}
-      else
-	xsignal1 (Qinvalid_function, original_fun);
-    }
-  if (backtrace_debug_on_exit (specpdl_ptr - 1))
-    val = call_debugger (list2 (Qexit, val));
-  scm_dynwind_end ();
-  return val;
+  return scm_call_n (funcall_fn, args, nargs);
 }
 
 Lisp_Object
@@ -3568,7 +3075,7 @@ alist of active lexical bindings.  */);
   Vinternal_interpreter_environment = Qnil;
   /* Don't export this variable to Elisp, so no one can mess with it
      (Just imagine if someone makes it buffer-local).  */
-  Funintern (Qinternal_interpreter_environment, Qnil);
+  //Funintern (Qinternal_interpreter_environment, Qnil);
 
   DEFSYM (Vrun_hooks, "run-hooks");
 
diff --git a/src/fns.c b/src/fns.c
index 91f788f5eb..fc5d044560 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2743,16 +2743,13 @@ usage: (widget-apply WIDGET PROPERTY &rest ARGS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
   /* This function can GC.  */
-  Lisp_Object newargs[3];
   struct gcpro gcpro1, gcpro2;
   Lisp_Object result;
 
-  newargs[0] = Fwidget_get (args[0], args[1]);
-  newargs[1] = args[0];
-  newargs[2] = Flist (nargs - 2, args + 2);
-  GCPRO2 (newargs[0], newargs[2]);
-  result = Fapply (3, newargs);
-  UNGCPRO;
+  result = call3 (intern ("apply"),
+                  Fwidget_get (args[0], args[1]),
+                  args[0],
+                  Flist (nargs - 2, args + 2));
   return result;
 }
 
diff --git a/src/keyboard.c b/src/keyboard.c
index 96814aca51..7fcc681867 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1295,13 +1295,13 @@ tracking_off (Lisp_Object old_value)
     }
 }
 
-DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0,
+DEFUN ("call-with-track-mouse", Ftrack_mouse, Strack_mouse, 1, 1, 0,
        doc: /* Evaluate BODY with mouse movement events enabled.
 Within a `track-mouse' form, mouse motion generates input events that
 you can read with `read-event'.
 Normally, mouse motion is ignored.
 usage: (track-mouse BODY...)  */)
-  (Lisp_Object args)
+  (Lisp_Object thunk)
 {
   dynwind_begin ();
   Lisp_Object val;
@@ -1310,7 +1310,7 @@ usage: (track-mouse BODY...)  */)
 
   do_mouse_tracking = Qt;
 
-  val = Fprogn (args);
+  val = call0 (thunk);
   dynwind_end ();
   return val;
 }
diff --git a/src/lisp.h b/src/lisp.h
index 9a9b31e85f..66e3c450d8 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2389,7 +2389,11 @@ CHECK_NUMBER_CDR (Lisp_Object x)
 #define DEFUN_ARGS_8	(Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
 			 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
 
-#define WRAP1(cfn, lfn) Lisp_Object cfn (Lisp_Object a) { return call1 (intern (lfn), a); }
+#define WRAP1(cfn, lfn) \
+  SCM_SNARF_INIT (DEFSYM (cfn ## _sym, lfn)) \
+  static Lisp_Object cfn ## _sym; \
+  Lisp_Object cfn (Lisp_Object a) \
+  { return call1 (cfn ## _sym, a); }
 #define WRAP2(cfn, lfn) Lisp_Object cfn (Lisp_Object a, Lisp_Object b) { return call2 (intern (lfn), a, b); }
 
 /* True if OBJ is a Lisp function.  */