Tune UNEVALLED functions by using XCAR instead of Fcar, etc.

* data.c (Fsetq_default):
* eval.c (Fif, Fcond, Fprog1, Fsetq, Fquote, Ffunction, Fdefvar)
(Fdefconst, FletX, Flet, Fwhile, Fcatch, Funwind_protect)
(Fcondition_case):
Tune by taking advantage of the fact that ARGS is always a list
when a function is declared to have UNEVALLED args.

diff --git a/src/ChangeLog b/src/ChangeLog
index 97d9cc9..3d6725f 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,13 @@
 2013-07-23  Paul Eggert  <eggert@cs.ucla.edu>
 
+       Tune UNEVALLED functions by using XCAR instead of Fcar, etc.
+       * data.c (Fsetq_default):
+       * eval.c (Fif, Fcond, Fprog1, Fsetq, Fquote, Ffunction, Fdefvar)
+       (Fdefconst, FletX, Flet, Fwhile, Fcatch, Funwind_protect)
+       (Fcondition_case):
+       Tune by taking advantage of the fact that ARGS is always a list
+       when a function is declared to have UNEVALLED args.
+
        * emacsgtkfixed.c: Port to GCC 4.6.
        GCC 4.6 complains about -Wunused-local-typedefs, introduced in 4.7.
 

diff --git a/src/data.c b/src/data.c
index dedbd51..f04d6da 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -1478,24 +1478,19 @@ of previous VARs.
 usage: (setq-default [VAR VALUE]...)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object args_left;
-  register Lisp_Object val, symbol;
+  Lisp_Object args_left, symbol, val;
   struct gcpro gcpro1;
 
-  if (NILP (args))
-    return Qnil;
-
-  args_left = args;
+  args_left = val = args;
   GCPRO1 (args);
 
-  do
+  while (CONSP (args_left))
     {
-      val = eval_sub (Fcar (Fcdr (args_left)));
+      val = eval_sub (Fcar (XCDR (args_left)));
       symbol = XCAR (args_left);
       Fset_default (symbol, val);
       args_left = Fcdr (XCDR (args_left));
     }
-  while (!NILP (args_left));
 
   UNGCPRO;
   return val;

diff --git a/src/eval.c b/src/eval.c
index 1212227..6cb2b7a 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -393,16 +393,16 @@ If COND yields nil, and there are no ELSE's, the value is nil.
 usage: (if COND THEN ELSE...)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object cond;
+  Lisp_Object cond;
   struct gcpro gcpro1;
 
   GCPRO1 (args);
-  cond = eval_sub (Fcar (args));
+  cond = eval_sub (XCAR (args));
   UNGCPRO;
 
   if (!NILP (cond))
-    return eval_sub (Fcar (Fcdr (args)));
-  return Fprogn (Fcdr (Fcdr (args)));
+    return eval_sub (Fcar (XCDR (args)));
+  return Fprogn (XCDR (XCDR (args)));
 }
 
 DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
@@ -417,18 +417,17 @@ CONDITION's value if non-nil is returned from the cond-form.
 usage: (cond CLAUSES...)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object clause, val;
+  Lisp_Object val = args;
   struct gcpro gcpro1;
 
-  val = Qnil;
   GCPRO1 (args);
-  while (!NILP (args))
+  while (CONSP (args))
     {
-      clause = Fcar (args);
+      Lisp_Object clause = XCAR (args);
       val = eval_sub (Fcar (clause));
       if (!NILP (val))
        {
-         if (!EQ (XCDR (clause), Qnil))
+         if (!NILP (XCDR (clause)))
            val = Fprogn (XCDR (clause));
          break;
        }
@@ -476,11 +475,11 @@ usage: (prog1 FIRST BODY...)  */)
   (Lisp_Object args)
 {
   Lisp_Object val;
-  register Lisp_Object args_left;
+  Lisp_Object args_left;
   struct gcpro gcpro1, gcpro2;
 
   args_left = args;
-  val = Qnil;
+  val = args;
   GCPRO2 (args, val);
 
   val = eval_sub (XCAR (args_left));
@@ -517,36 +516,37 @@ The return value of the `setq' form is the value of the last VAL.
 usage: (setq [SYM VAL]...)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object args_left;
-  register Lisp_Object val, sym, lex_binding;
-  struct gcpro gcpro1;
-
-  if (NILP (args))
-    return Qnil;
+  Lisp_Object val, sym, lex_binding;
 
-  args_left = args;
-  GCPRO1 (args);
-
-  do
+  val = args;
+  if (CONSP (args))
     {
-      val = eval_sub (Fcar (Fcdr (args_left)));
-      sym = Fcar (args_left);
+      Lisp_Object args_left = args;
+      struct gcpro gcpro1;
+      GCPRO1 (args);
 
-      /* 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.  */
+      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 (Fcdr (args_left));
+         args_left = Fcdr (XCDR (args_left));
+       }
+      while (CONSP (args_left));
+
+      UNGCPRO;
     }
-  while (!NILP (args_left));
 
-  UNGCPRO;
   return val;
 }
 
@@ -563,9 +563,9 @@ of unexpected results when a quoted object is modified.
 usage: (quote ARG)  */)
   (Lisp_Object args)
 {
-  if (!NILP (Fcdr (args)))
+  if (CONSP (XCDR (args)))
     xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
-  return Fcar (args);
+  return XCAR (args);
 }
 
 DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
@@ -577,7 +577,7 @@ usage: (function ARG)  */)
 {
   Lisp_Object quoted = XCAR (args);
 
-  if (!NILP (Fcdr (args)))
+  if (CONSP (XCDR (args)))
     xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
 
   if (!NILP (Vinternal_interpreter_environment)
@@ -679,21 +679,23 @@ To define a user option, use `defcustom' instead of `defvar'.
 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object sym, tem, tail;
+  Lisp_Object sym, tem, tail;
 
-  sym = Fcar (args);
-  tail = Fcdr (args);
-  if (!NILP (Fcdr (Fcdr (tail))))
-    error ("Too many arguments");
+  sym = XCAR (args);
+  tail = XCDR (args);
 
-  tem = Fdefault_boundp (sym);
-  if (!NILP (tail))
+  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.  */
       XSYMBOL (sym)->declared_special = 1;
 
       if (NILP (tem))
-       Fset_default (sym, eval_sub (Fcar (tail)));
+       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.  */
@@ -711,7 +713,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
                }
            }
        }
-      tail = Fcdr (tail);
+      tail = XCDR (tail);
       tem = Fcar (tail);
       if (!NILP (tem))
        {
@@ -756,18 +758,18 @@ The optional DOCSTRING specifies the variable's documentation string.
 usage: (defconst SYMBOL INITVALUE [DOCSTRING])  */)
   (Lisp_Object args)
 {
-  register Lisp_Object sym, tem;
+  Lisp_Object sym, tem;
 
-  sym = Fcar (args);
-  if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
+  sym = XCAR (args);
+  if (CONSP (Fcdr (XCDR (XCDR (args)))))
     error ("Too many arguments");
 
-  tem = eval_sub (Fcar (Fcdr (args)));
+  tem = eval_sub (Fcar (XCDR (args)));
   if (!NILP (Vpurify_flag))
     tem = Fpurecopy (tem);
   Fset_default (sym, tem);
   XSYMBOL (sym)->declared_special = 1;
-  tem = Fcar (Fcdr (Fcdr (args)));
+  tem = Fcar (XCDR (XCDR (args)));
   if (!NILP (tem))
     {
       if (!NILP (Vpurify_flag))
@@ -808,7 +810,7 @@ usage: (let* VARLIST BODY...)  */)
 
   lexenv = Vinternal_interpreter_environment;
 
-  varlist = Fcar (args);
+  varlist = XCAR (args);
   while (CONSP (varlist))
     {
       QUIT;
@@ -849,7 +851,7 @@ usage: (let* VARLIST BODY...)  */)
       varlist = XCDR (varlist);
     }
   UNGCPRO;
-  val = Fprogn (Fcdr (args));
+  val = Fprogn (XCDR (args));
   return unbind_to (count, val);
 }
 
@@ -869,7 +871,7 @@ usage: (let VARLIST BODY...)  */)
   struct gcpro gcpro1, gcpro2;
   USE_SAFE_ALLOCA;
 
-  varlist = Fcar (args);
+  varlist = XCAR (args);
 
   /* Make space to hold the values to give the bound variables.  */
   elt = Flength (varlist);
@@ -896,7 +898,7 @@ usage: (let VARLIST BODY...)  */)
 
   lexenv = Vinternal_interpreter_environment;
 
-  varlist = Fcar (args);
+  varlist = XCAR (args);
   for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
     {
       Lisp_Object var;
@@ -919,7 +921,7 @@ usage: (let VARLIST BODY...)  */)
     /* Instantiate a new lexical environment.  */
     specbind (Qinternal_interpreter_environment, lexenv);
 
-  elt = Fprogn (Fcdr (args));
+  elt = Fprogn (XCDR (args));
   SAFE_FREE ();
   return unbind_to (count, elt);
 }
@@ -936,8 +938,8 @@ usage: (while TEST BODY...)  */)
 
   GCPRO2 (test, body);
 
-  test = Fcar (args);
-  body = Fcdr (args);
+  test = XCAR (args);
+  body = XCDR (args);
   while (!NILP (eval_sub (test)))
     {
       QUIT;
@@ -1034,9 +1036,9 @@ usage: (catch TAG BODY...)  */)
   struct gcpro gcpro1;
 
   GCPRO1 (args);
-  tag = eval_sub (Fcar (args));
+  tag = eval_sub (XCAR (args));
   UNGCPRO;
-  return internal_catch (tag, Fprogn, Fcdr (args));
+  return internal_catch (tag, Fprogn, XCDR (args));
 }
 
 /* Set up a catch, then call C function FUNC on argument ARG.
@@ -1150,8 +1152,8 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...)  */)
   Lisp_Object val;
   ptrdiff_t count = SPECPDL_INDEX ();
 
-  record_unwind_protect (unwind_body, Fcdr (args));
-  val = eval_sub (Fcar (args));
+  record_unwind_protect (unwind_body, XCDR (args));
+  val = eval_sub (XCAR (args));
   return unbind_to (count, val);
 }
 \f
@@ -1183,9 +1185,9 @@ See also the function `signal' for more info.
 usage: (condition-case VAR BODYFORM &rest HANDLERS)  */)
   (Lisp_Object args)
 {
-  Lisp_Object var = Fcar (args);
-  Lisp_Object bodyform = Fcar (Fcdr (args));
-  Lisp_Object handlers = Fcdr (Fcdr (args));
+  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);
 }