emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] trunk r113501: Tune UNEVALLED functions by using XCAR inst


From: Paul Eggert
Subject: [Emacs-diffs] trunk r113501: Tune UNEVALLED functions by using XCAR instead of Fcar, etc.
Date: Tue, 23 Jul 2013 06:48:40 +0000
User-agent: Bazaar (2.6b2)

------------------------------------------------------------
revno: 113501
revision-id: address@hidden
parent: address@hidden
committer: Paul Eggert <address@hidden>
branch nick: trunk
timestamp: Tue 2013-07-23 07:48:34 +0100
message:
  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.
modified:
  src/ChangeLog                  changelog-20091113204419-o5vbwnq5f7feedwu-1438
  src/data.c                     data.c-20091113204419-o5vbwnq5f7feedwu-251
  src/eval.c                     eval.c-20091113204419-o5vbwnq5f7feedwu-237
=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2013-07-23 06:38:51 +0000
+++ b/src/ChangeLog     2013-07-23 06:48:34 +0000
@@ -1,5 +1,13 @@
 2013-07-23  Paul Eggert  <address@hidden>
 
+       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.
 

=== modified file 'src/data.c'
--- a/src/data.c        2013-07-06 08:05:21 +0000
+++ b/src/data.c        2013-07-23 06:48:34 +0000
@@ -1478,24 +1478,19 @@
 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;

=== modified file 'src/eval.c'
--- a/src/eval.c        2013-07-21 04:22:33 +0000
+++ b/src/eval.c        2013-07-23 06:48:34 +0000
@@ -393,16 +393,16 @@
 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 @@
 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 @@
   (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 @@
 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;
-
-  args_left = args;
-  GCPRO1 (args);
-
-  do
+  Lisp_Object val, sym, lex_binding;
+
+  val = args;
+  if (CONSP (args))
     {
-      val = eval_sub (Fcar (Fcdr (args_left)));
-      sym = Fcar (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));
+      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;
     }
-  while (!NILP (args_left));
 
-  UNGCPRO;
   return val;
 }
 
@@ -563,9 +563,9 @@
 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 @@
 {
   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 @@
 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object sym, tem, tail;
-
-  sym = Fcar (args);
-  tail = Fcdr (args);
-  if (!NILP (Fcdr (Fcdr (tail))))
-    error ("Too many arguments");
-
-  tem = Fdefault_boundp (sym);
-  if (!NILP (tail))
+  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.  */
       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 @@
                }
            }
        }
-      tail = Fcdr (tail);
+      tail = XCDR (tail);
       tem = Fcar (tail);
       if (!NILP (tem))
        {
@@ -756,18 +758,18 @@
 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 @@
 
   lexenv = Vinternal_interpreter_environment;
 
-  varlist = Fcar (args);
+  varlist = XCAR (args);
   while (CONSP (varlist))
     {
       QUIT;
@@ -849,7 +851,7 @@
       varlist = XCDR (varlist);
     }
   UNGCPRO;
-  val = Fprogn (Fcdr (args));
+  val = Fprogn (XCDR (args));
   return unbind_to (count, val);
 }
 
@@ -869,7 +871,7 @@
   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 @@
 
   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 @@
     /* 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 @@
 
   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 @@
   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 @@
   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);
 }
 
@@ -1183,9 +1185,9 @@
 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);
 }


reply via email to

[Prev in Thread] Current Thread [Next in Thread]