From xemacs-m  Sun Sep 21 14:28:26 1997
Received: from relay7.UU.NET (relay7.UU.NET [192.48.96.17])
	by xemacs.org (8.8.5/8.8.5) with ESMTP id OAA26358
	for <xemacs-beta@xemacs.org>; Sun, 21 Sep 1997 14:28:25 -0500 (CDT)
Received: from crystal.WonderWorks.COM by relay7.UU.NET with ESMTP 
	(peer crosschecked as: crystal.WonderWorks.com [192.203.206.1])
	id QQdhzp07770; Sun, 21 Sep 1997 15:28:23 -0400 (EDT)
Received: by crystal.WonderWorks.COM 
	id QQdhzp12434; Sun, 21 Sep 1997 15:28:24 -0400 (EDT)
Date: Sun, 21 Sep 1997 15:28:24 -0400 (EDT)
Message-Id: <QQdhzp12434.199709211928@crystal.WonderWorks.COM>
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
From: Kyle Jones <kyle_jones@wonderworks.com>
To: xemacs-beta@xemacs.org
Subject: [PATCH] 20.3-b23: wot i need, bench-mark-loop
X-Mailer: VM 6.34 under 19.16 "" XEmacs Lucid (beta91)
X-Face: /cA45WHG7jWq>(O3&Z57Y<"WsX5ddc,4c#w0F*zrV#=M
        0@~@,s;b,aMtR5Sqs"+nU.z^CSFQ9t`z2>W,S,]:[+2^
        Nbf6v4g>!&,7R4Ot4Wg{&tm=WX7P["9%a)_da48-^tGy
        ,qz]Z,Zz\{E.,]'EO+F)@$KtF&V

Speed patches.  This is my attack on the bench-mark-loop test.
Executive summary: slow symbol refs, slow symbol stores and
unnecessary function calls in critical areas were slowing it down.
XEmacs now benches much faster than FSF Emacs on this test on my
system.

Sun Sep 21 14:14:44 1997  Kyle Jones  <kyle_jones@wonderworks.com>

	* src/lisp.h: underspecify lisp_fn_t function prototype
	  to avoid compiler errors in inline_funcall_subr().

	* src/eval.c (Fprogn): Walk forms list with XCDR, access
	  with XCAR.  Check forms list CONSP, so that XCDR and XCAR are
	  safe.

	* src/eval.c (Fsetq): replace Flength call with for-loop
	  to compute list length.  Walk arg list with XCDR,
	  access with XCAR.  Check arg list with CONSP, so that
	  XCDR and XCAR are safe.

	* src/eval.c: New macro inline_funcall_subr, an inline
	  version of funcall_subr + primitive_funcall.

	* src/eval.c (Feval): replace Flength call with for-loop
	  to compute list length.  Use XCAR and XCDR in some
	  places where it is safe to do so.  Use
	  inline_funcall_subr() in place of funcall_subr().

	* src/eval.c (funcall_recording_as): Use XCAR instead of
	  Fcar where it was safe.

	* src/eval.c (Fapply): replace Flength call with for-loop
	  to compute list length.
	
	* src/eval.c (apply_lambda):Use XCAR and XCDR in some
	  places where it is safe to do so.

	* src/eval.c (funcall_lambda):  Walk param list with XCDR, access
	  with XCAR.  Check param list CONSP, so that XCDR and XCAR are
	  safe.

	* src/symbols.c (find_symbol_value): return quickly if no
	  symbol magic is involved, to avoid the expensive call
	  to find_symbol_value_1.

	* src/symbols.c (store_symval_forwarding): don't call
	  reject_constant_symbols unless there is a chance a
	  constant symbol is involved.  This break the
	  encapsulation of the constants check, but symbol stores
	  are used heavily and speed is most important than
	  cleanliness in this case.

--- 1.1	1997/09/21 19:05:19
+++ src/lisp.h	1997/09/21 19:06:58
@@ -1080,7 +1080,7 @@
 
 /*********** subr ***********/
 
-typedef Lisp_Object (*lisp_fn_t) (Lisp_Object, ...);
+typedef Lisp_Object (*lisp_fn_t) ();
 
 struct Lisp_Subr
 {
--- 1.1	1997/09/21 19:05:19
+++ src/eval.c	1997/09/21 19:17:27
@@ -771,7 +771,7 @@
   Lisp_Object args_left;
   struct gcpro gcpro1;
 
-  if (NILP (args))
+  if (! CONSP (args))
     return Qnil;
 
   args_left = args;
@@ -779,10 +779,10 @@
 
   do
     {
-      val = Feval (Fcar (args_left));
-      args_left = Fcdr (args_left);
+      val = Feval (XCAR (args_left));
+      args_left = XCDR (args_left);
     }
-  while (!NILP (args_left));
+  while (CONSP (args_left));
 
   UNGCPRO;
   return val;
@@ -997,21 +997,33 @@
   if (NILP (args))
     return Qnil;
 
-  val = Flength (args);
-  if (XINT (val) & 1)           /* Odd number of arguments? */
-    Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, val));
+  {
+    REGISTER int i;
+    for (i = 0, val = args ; CONSP (val); val = XCDR (val))
+      {
+	i++;
+	/*
+	 * uncomment the QUIT if there is some way a circular
+	 * 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)));
+  }
 
   args_left = args;
   GCPRO1 (args);
 
   do
     {
-      val = Feval (Fcar (Fcdr (args_left)));
-      sym = Fcar (args_left);
+      val = Feval (XCAR (XCDR (args_left)));
+      sym = XCAR (args_left);
       Fset (sym, val);
-      args_left = Fcdr (Fcdr (args_left));
+      args_left = XCDR (XCDR (args_left));
     }
-  while (!NILP (args_left));
+  while (CONSP (args_left));
 
   UNGCPRO;
   return val;
@@ -2853,6 +2865,46 @@
   return Qnil;
 }
 
+#define inline_funcall_subr(rv, subr, av) \
+  do { \
+    switch (subr->max_args) { \
+      case  0: rv = (subr_function(subr))(); \
+	       break; \
+      case  1: rv = (subr_function(subr))(av[0]); \
+	       break; \
+      case  2: rv = (subr_function(subr))(av[0], av[1]); \
+	       break; \
+      case  3: rv = (subr_function(subr))(av[0], av[1], av[2]); \
+	       break; \
+      case  4: rv = (subr_function(subr))(av[0], av[1], av[2], av[3]); \
+	       break; \
+      case  5: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4]); \
+	       break; \
+      case  6: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
+					  av[5]); \
+	       break; \
+      case  7: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
+					  av[5], av[6]); \
+	       break; \
+      case  8: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
+					  av[5], av[6], av[7]); \
+	       break; \
+      case  9: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
+					  av[5], av[6], av[7], av[8]); \
+	       break; \
+      case 10: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
+					  av[5], av[6], av[7], av[8], av[9]); \
+	       break; \
+      case 11: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
+					  av[5], av[6], av[7], av[8], av[9], \
+					  av[10]); \
+	       break; \
+      case 12: rv = (subr_function(subr))(av[0], av[1], av[2], av[3], av[4], \
+					  av[5], av[6], av[7], av[8], av[9], \
+					  av[10], av[11]); \
+	       break; \
+    } \
+  } while (0)
 
 DEFUN ("eval", Feval, 1, 1, 0, /*
 Evaluate FORM and return its value.
@@ -2923,9 +2975,28 @@
 	error ("Lisp nesting exceeds `max-lisp-eval-depth'");
     }
 
-  original_fun = Fcar (form);
-  original_args = Fcdr (form);
-  nargs = XINT (Flength (original_args));
+  /*
+   * At this point we know that `form' is a Lisp_Cons so we can safely
+   * use XCAR and XCDR.
+   */
+  original_fun = XCAR (form);
+  original_args = XCDR (form);
+
+  /*
+   * 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 (nargs = 0, val = original_args ; CONSP (val) ; val = XCDR (val))
+    {
+      nargs++;
+      QUIT;
+    }
+  if (! NILP (val))
+    error ("malformed argument list", original_args);
 
 #ifdef EMACS_BTL
   backtrace.id_number = 0;
@@ -2982,10 +3053,10 @@
 	  gcpro3.nvars = 0;
 
 	  argnum = 0;
-          while (!NILP (args_left))
+          while (CONSP (args_left))
 	    {
-	      vals[argnum++] = Feval (Fcar (args_left));
-	      args_left = Fcdr (args_left);
+	      vals[argnum++] = Feval (XCAR (args_left));
+	      args_left = XCDR (args_left);
 	      gcpro3.nvars = argnum;
 	    }
 
@@ -3016,21 +3087,23 @@
 	  gcpro3.var = argvals;
 	  gcpro3.nvars = 0;
 
-	  for (i = 0; i < nargs; args_left = Fcdr (args_left))
+	  for (i = 0; i < nargs; args_left = XCDR (args_left))
 	    {
-	      argvals[i] = Feval (Fcar (args_left));
+	      argvals[i] = Feval (XCAR (args_left));
 	      gcpro3.nvars = ++i;
 	    }
 
 	  UNGCPRO;
 
-	  for (i = nargs; i < max_args; i++)
+	  /* i == nargs at this point */
+	  for (; i < max_args; i++)
             argvals[i] = Qnil;
 
           backtrace.args = argvals;
           backtrace.nargs = nargs;
 
-          val = funcall_subr (subr, argvals);
+          /* val = funcall_subr (subr, argvals); */
+	  inline_funcall_subr(val, subr, argvals);
         }
     }
   else if (COMPILED_FUNCTIONP (fun))
@@ -3041,7 +3114,7 @@
 
       if (!CONSP (fun))
         goto invalid_function;
-      funcar = Fcar (fun);
+      funcar = XCAR (fun);
       if (!SYMBOLP (funcar))
         goto invalid_function;
       if (EQ (funcar, Qautoload))
@@ -3050,7 +3123,7 @@
 	  goto retry;
 	}
       if (EQ (funcar, Qmacro))
-	val = Feval (apply1 (Fcdr (fun), original_args));
+	val = Feval (apply1 (XCDR (fun), original_args));
       else if (EQ (funcar, Qlambda))
         val = apply_lambda (fun, nargs, original_args);
       else
@@ -3155,10 +3228,12 @@
 	  for (i = nargs; i < max_args; i++)
 	    argvals[i] = Qnil;
 
-          val = funcall_subr (subr, argvals);
+          /* val = funcall_subr (subr, argvals); */
+	  inline_funcall_subr(val, subr, argvals);
 	}
       else
-        val = funcall_subr (subr, args + 1);
+        /* val = funcall_subr (subr, args + 1); */
+        inline_funcall_subr(val, subr, (&args[1]));
     }
   else if (COMPILED_FUNCTIONP (fun))
     val = funcall_lambda (fun, nargs, args + 1);
@@ -3169,7 +3244,8 @@
     }
   else
     {
-      Lisp_Object funcar = Fcar (fun);
+      /* `fun' is a Lisp_Cons so XCAR is safe */
+      Lisp_Object funcar = XCAR (fun);
 
       if (!SYMBOLP (funcar))
         goto invalid_function;
@@ -3339,13 +3415,27 @@
 {
   /* This function can GC */
   Lisp_Object fun = args[0];
-  Lisp_Object spread_arg = args [nargs - 1];
+  Lisp_Object spread_arg = args [nargs - 1], p;
   int numargs;
   int funcall_nargs;
 
   CHECK_LIST (spread_arg);
 
-  numargs = XINT (Flength (spread_arg));
+  /*
+   * 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))
+    error ("malformed argument list", spread_arg);
 
   if (numargs == 0)
     /* (apply foo 0 1 '()) */
@@ -3482,7 +3572,11 @@
 
   for (i = 0; i < numargs;)
     {
-      tem = Fcar (unevalled_args), unevalled_args = Fcdr (unevalled_args);
+      /*
+       * unevalled_args is always a normal list, or Feval would have
+       * rejected it, so use XCAR and XCDR.
+       */
+      tem = XCAR (unevalled_args), unevalled_args = XCDR (unevalled_args);
       tem = Feval (tem);
       arg_vector[i++] = tem;
       gcpro1.nvars = i;
@@ -3519,16 +3613,16 @@
   int optional = 0, rest = 0;
 
   if (CONSP (fun))
-    syms_left = Fcar (Fcdr (fun));
+    syms_left = Fcar (XCDR (fun));
   else if (COMPILED_FUNCTIONP (fun))
     syms_left = XCOMPILED_FUNCTION (fun)->arglist;
   else abort ();
 
   i = 0;
-  for (; !NILP (syms_left); syms_left = Fcdr (syms_left))
+  for (; CONSP (syms_left); syms_left = XCDR (syms_left))
     {
       QUIT;
-      next = Fcar (syms_left);
+      next = XCAR (syms_left);
       if (!SYMBOLP (next))
 	signal_error (Qinvalid_function, list1 (fun));
       if (EQ (next, Qand_rest))
@@ -3557,7 +3651,7 @@
                     list2 (fun, make_int (nargs)));
 
   if (CONSP (fun))
-    val = Fprogn (Fcdr (Fcdr (fun)));
+    val = Fprogn (Fcdr (XCDR (fun)));
   else
     {
       struct Lisp_Compiled_Function *b = XCOMPILED_FUNCTION (fun);
--- 1.1	1997/09/21 19:05:19
+++ src/symbols.c	1997/09/21 19:07:00
@@ -1510,8 +1510,14 @@
   /* WARNING: This function can be called when current_buffer is 0
      and Vselected_console is Qnil, early in initialization. */
   struct console *dev;
+  Lisp_Object valcontents;
 
   CHECK_SYMBOL (sym);
+
+  valcontents = XSYMBOL (sym)->value;
+  if (!SYMBOL_VALUE_MAGIC_P (valcontents))
+    return valcontents;
+
   if (CONSOLEP (Vselected_console))
     dev = XCONSOLE (Vselected_console);
   else
@@ -1588,9 +1594,16 @@
   CHECK_SYMBOL (sym);
 
  retry:
-  reject_constant_symbols (sym, newval, 0,
-			   UNBOUNDP (newval) ? Qmakunbound : Qset);
   valcontents = XSYMBOL (sym)->value;
+  if (NILP (sym) || EQ (sym, Qt) || SYMBOL_VALUE_MAGIC_P (valcontents))
+    reject_constant_symbols (sym, newval, 0,
+			     UNBOUNDP (newval) ? Qmakunbound : Qset);
+  else
+    {
+      XSYMBOL (sym)->value = newval;
+      return newval;
+    }
+
  retry_2:
 
   if (SYMBOL_VALUE_MAGIC_P (valcontents))

