From e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6 Mon Sep 17 00:00:00 2001
From: Stefan Monnier
Date: Sat, 5 Mar 2011 23:48:17 -0500
Subject: Fix pcase memoizing; change lexbound byte-code marker. *
 src/bytecode.c (exec_byte_code): Remove old lexical binding slot handling and
 replace it with the a integer args-desc handling. * eval.c (funcall_lambda):
 Adjust arglist test accordingly. * lisp/emacs-lisp/bytecomp.el
 (byte-compile-arglist-signature): Handle integer arglist descriptor.
 (byte-compile-make-args-desc): Make integer arglist descriptor.
 (byte-compile-lambda): Use integer arglist descriptor to mark lexical
 byte-coded functions instead of an extra slot. * lisp/help-fns.el
 (help-add-fundoc-usage): Don't add a dummy doc. (help-split-fundoc): Return a
 nil doc if there was no actual doc. (help-function-arglist): Generate an
 arglist from an integer arg-desc. * lisp/emacs-lisp/pcase.el
 (pcase--memoize): Rename from pcase-memoize; Make only the key weak. (pcase):
 Change the key used in the memoization table, so it does not always get GC'd
 away. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Slight change to the
 pcase pattern to generate slightly better code.

---
 src/bytecode.c | 71 ++++++++++++++++++++++++++++++++++------------------------
 1 file changed, 42 insertions(+), 29 deletions(-)

(limited to 'src/bytecode.c')

diff --git a/src/bytecode.c b/src/bytecode.c
index 9693a5a9196..dbab02886e2 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -502,37 +502,50 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
   stacke = stack.bottom - 1 + XFASTINT (maxdepth);
 #endif
 
-  if (! NILP (args_template))
-    /* We should push some arguments on the stack.  */
+  if (INTEGERP (args_template))
     {
-      Lisp_Object at;
-      int pushed = 0, optional = 0;
-
-      for (at = args_template; CONSP (at); at = XCDR (at))
-	if (EQ (XCAR (at), Qand_optional))
-	  optional = 1;
-	else if (EQ (XCAR (at), Qand_rest))
-	  {
-	    PUSH (pushed < nargs
-		  ? Flist (nargs - pushed, args)
-		  : Qnil);
-	    pushed = nargs;
-	    at = Qnil;
-	    break;
-	  }
-	else if (pushed < nargs)
-	  {
-	    PUSH (*args++);
-	    pushed++;
-	  }
-	else if (optional)
-	  PUSH (Qnil);
-	else
-	  break;
-
-      if (pushed != nargs || !NILP (at))
+      int at = XINT (args_template);
+      int rest = at & 128;
+      int mandatory = at & 127;
+      int nonrest = at >> 8;
+      eassert (mandatory <= nonrest);
+      if (nargs <= nonrest)
+	{
+	  int i;
+	  for (i = 0 ; i < nargs; i++, args++)
+	    PUSH (*args);
+	  if (nargs < mandatory)
+	    /* Too few arguments.  */
+	    Fsignal (Qwrong_number_of_arguments,
+		     Fcons (Fcons (make_number (mandatory),
+				   rest ? Qand_rest : make_number (nonrest)),
+			    Fcons (make_number (nargs), Qnil)));
+	  else
+	    {
+	      for (; i < nonrest; i++)
+		PUSH (Qnil);
+	      if (rest)
+		PUSH (Qnil);
+	    }
+	}
+      else if (rest)
+	{
+	  int i;
+	  for (i = 0 ; i < nonrest; i++, args++)
+	    PUSH (*args);
+	  PUSH (Flist (nargs - nonrest, args));
+	}
+      else
+	/* Too many arguments.  */
 	Fsignal (Qwrong_number_of_arguments,
-		 Fcons (args_template, Fcons (make_number (nargs), Qnil)));
+		 Fcons (Fcons (make_number (mandatory),
+			       make_number (nonrest)),
+			Fcons (make_number (nargs), Qnil)));
+    }
+  else if (! NILP (args_template))
+    /* We should push some arguments on the stack.  */
+    {
+      error ("Unknown args template!");
     }
 
   while (1)
-- 
cgit v1.2.1