Patch to remove a bit of duplicated code in eval.c

[Federico Tedin <federicotedin@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1463 bytes --]

Hi Emacs developers,

Reading eval.c I realized that there is very similar code in both
'eval_sub' and 'funcall_subr', where they invoke the subroutine itself.

I figured, since we have 'apply_lambda' (that gets called from
'eval_sub'), why not have an 'apply_subr' as well, to be used for
subroutines? So I wrote a small patch (WIP) that adds 'apply_subr',
which in turn calls 'funcall_subr'. I had to adapt 'funcall_subr' so
that it accepts 'max_args=UNEVALLED' subroutines.

I think the advantages of doing this are that 1) it should make making
changes to the structure of subroutines slightly easier (less code to
update!) and 2) makes 'eval_sub' much more readable. In fact, now the
function-calling part of 'eval_sub' is relatively short (~45 lines),
which makes understanding the general structure of the function much
easier in my opinion.

My concerns now are:
1) Could I have broken anything without realizing it, since this is such
a central function in Lisp code evaluation? Everything seems to be
compiling fine (without warnings) and so far I haven't had any crashes.
2) I removed a comment that made reference to Bug#21245, but it seems
like it makes sense since the variable it refers to is no longer needed.
3) Have I maybe made Emacs slower by always using SAFE_ALLOCA_LISP for
the subroutine arguments (instead of only for 'max_args=MANY')?

Any feedback is appreciated, in order to decide if it makes sense to
work further on this.

Thanks!


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-diff, Size: 7893 bytes --]

From b6f95e5c0ae4415fbec0d327c05ac0417f99c84b Mon Sep 17 00:00:00 2001
From: Federico Tedin <federicotedin@gmail.com>
Date: Thu, 16 Sep 2021 23:31:27 +0200
Subject: [PATCH] WIP eval.c: apply_subr

---
 src/data.c |   2 +-
 src/eval.c | 165 ++++++++++++++++++-----------------------------------
 src/lisp.h |   2 +-
 3 files changed, 57 insertions(+), 112 deletions(-)

diff --git a/src/data.c b/src/data.c
index 27b642df28..cc9e5b713b 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1737,7 +1737,7 @@ notify_variable_watchers (Lisp_Object symbol,
       if (SUBRP (watcher))
         {
           Lisp_Object args[] = { symbol, newval, operation, where };
-          funcall_subr (XSUBR (watcher), ARRAYELTS (args), args);
+          funcall_subr (XSUBR (watcher), ARRAYELTS (args), args, false);
         }
       else
         CALLN (Ffuncall, watcher, symbol, newval, operation, where);
diff --git a/src/eval.c b/src/eval.c
index 48104bd0f4..a75cdb186b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -65,6 +65,7 @@ Copyright (C) 1985-1987, 1993-1995, 1999-2021 Free Software Foundation,
 
 static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
 static Lisp_Object apply_lambda (Lisp_Object, Lisp_Object, ptrdiff_t);
+static Lisp_Object apply_subr (struct Lisp_Subr *subr, Lisp_Object args, ptrdiff_t count);
 static Lisp_Object lambda_arity (Lisp_Object);
 
 static Lisp_Object
@@ -2451,9 +2452,6 @@ eval_sub (Lisp_Object form)
     do_debug_on_call (Qt, count);
 
   Lisp_Object fun, val, funcar;
-  /* Declare here, as this array may be accessed by call_debugger near
-     the end of this function.  See Bug#21245.  */
-  Lisp_Object argvals[8];
 
  retry:
 
@@ -2465,108 +2463,7 @@ eval_sub (Lisp_Object form)
     fun = indirect_function (fun);
 
   if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun))
-    {
-      Lisp_Object args_left = original_args;
-      ptrdiff_t numargs = list_length (args_left);
-
-      if (numargs < XSUBR (fun)->min_args
-	  || (XSUBR (fun)->max_args >= 0
-	      && XSUBR (fun)->max_args < numargs))
-	xsignal2 (Qwrong_number_of_arguments, original_fun,
-		  make_fixnum (numargs));
-
-      else if (XSUBR (fun)->max_args == UNEVALLED)
-	val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
-      else if (XSUBR (fun)->max_args == MANY)
-	{
-	  /* Pass a vector of evaluated arguments.  */
-	  Lisp_Object *vals;
-	  ptrdiff_t argnum = 0;
-	  USE_SAFE_ALLOCA;
-
-	  SAFE_ALLOCA_LISP (vals, numargs);
-
-	  while (CONSP (args_left) && argnum < numargs)
-	    {
-	      Lisp_Object arg = XCAR (args_left);
-	      args_left = XCDR (args_left);
-	      vals[argnum++] = eval_sub (arg);
-	    }
-
-	  set_backtrace_args (specpdl + count, vals, argnum);
-
-	  val = XSUBR (fun)->function.aMANY (argnum, vals);
-
-	  lisp_eval_depth--;
-	  /* Do the debug-on-exit now, while VALS still exists.  */
-	  if (backtrace_debug_on_exit (specpdl + count))
-	    val = call_debugger (list2 (Qexit, val));
-	  SAFE_FREE ();
-	  specpdl_ptr--;
-	  return val;
-	}
-      else
-	{
-	  int i, maxargs = XSUBR (fun)->max_args;
-
-	  for (i = 0; i < maxargs; i++)
-	    {
-	      argvals[i] = eval_sub (Fcar (args_left));
-	      args_left = Fcdr (args_left);
-	    }
-
-	  set_backtrace_args (specpdl + count, argvals, numargs);
-
-	  switch (i)
-	    {
-	    case 0:
-	      val = (XSUBR (fun)->function.a0 ());
-	      break;
-	    case 1:
-	      val = (XSUBR (fun)->function.a1 (argvals[0]));
-	      break;
-	    case 2:
-	      val = (XSUBR (fun)->function.a2 (argvals[0], argvals[1]));
-	      break;
-	    case 3:
-	      val = (XSUBR (fun)->function.a3
-		     (argvals[0], argvals[1], argvals[2]));
-	      break;
-	    case 4:
-	      val = (XSUBR (fun)->function.a4
-		     (argvals[0], argvals[1], argvals[2], argvals[3]));
-	      break;
-	    case 5:
-	      val = (XSUBR (fun)->function.a5
-		     (argvals[0], argvals[1], argvals[2], argvals[3],
-		      argvals[4]));
-	      break;
-	    case 6:
-	      val = (XSUBR (fun)->function.a6
-		     (argvals[0], argvals[1], argvals[2], argvals[3],
-		      argvals[4], argvals[5]));
-	      break;
-	    case 7:
-	      val = (XSUBR (fun)->function.a7
-		     (argvals[0], argvals[1], argvals[2], argvals[3],
-		      argvals[4], argvals[5], argvals[6]));
-	      break;
-
-	    case 8:
-	      val = (XSUBR (fun)->function.a8
-		     (argvals[0], argvals[1], argvals[2], argvals[3],
-		      argvals[4], argvals[5], argvals[6], argvals[7]));
-	      break;
-
-	    default:
-	      /* Someone has created a subr that takes more arguments than
-		 is supported by this code.  We need to either rewrite the
-		 subr to use a different argument protocol, or add more
-		 cases to this switch.  */
-	      emacs_abort ();
-	    }
-	}
-    }
+    return apply_subr (XSUBR (fun), original_args, count);
   else if (COMPILEDP (fun)
 	   || SUBR_NATIVE_COMPILED_DYNP (fun)
 	   || MODULE_FUNCTIONP (fun))
@@ -3048,7 +2945,7 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
     fun = indirect_function (fun);
 
   if (SUBRP (fun) && !SUBR_NATIVE_COMPILED_DYNP (fun))
-    val = funcall_subr (XSUBR (fun), numargs, args + 1);
+    val = funcall_subr (XSUBR (fun), numargs, args + 1, false);
   else if (COMPILEDP (fun)
 	   || SUBR_NATIVE_COMPILED_DYNP (fun)
 	   || MODULE_FUNCTIONP (fun))
@@ -3081,11 +2978,52 @@ DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
 }
 \f
 
+static Lisp_Object
+apply_subr (struct Lisp_Subr *subr, Lisp_Object args, ptrdiff_t count)
+{
+  Lisp_Object *arg_vector;
+  Lisp_Object tem;
+  USE_SAFE_ALLOCA;
+
+  ptrdiff_t numargs = list_length (args);
+
+  if (subr->max_args != UNEVALLED)
+    {
+      Lisp_Object args_left = args;
+      SAFE_ALLOCA_LISP (arg_vector, numargs);
+
+      for (ptrdiff_t i = 0; i < numargs; i++)
+	{
+	  tem = Fcar (args_left);
+	  args_left = Fcdr(args_left);
+	  tem = eval_sub(tem);
+
+	  arg_vector[i] = tem;
+	}
+    }
+  else
+    {
+      SAFE_ALLOCA_LISP (arg_vector, 1);
+      arg_vector[0] = args;
+    }
+
+  set_backtrace_args (specpdl + count, arg_vector, subr->max_args != UNEVALLED ? numargs : 1);
+  tem = funcall_subr (subr, numargs, arg_vector, true);
+
+  lisp_eval_depth--;
+
+  if (backtrace_debug_on_exit (specpdl + count))
+    tem = call_debugger (list2 (Qexit, tem));
+  SAFE_FREE ();
+  specpdl_ptr--;
+  return tem;
+}
+
 /* Apply a C subroutine SUBR to the NUMARGS evaluated arguments in ARG_VECTOR
    and return the result of evaluation.  */
 
 Lisp_Object
-funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args)
+funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args, bool unevalled_ok)
 {
   if (numargs < subr->min_args
       || (subr->max_args >= 0 && subr->max_args < numargs))
@@ -3097,9 +3035,16 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args)
 
   else if (subr->max_args == UNEVALLED)
     {
-      Lisp_Object fun;
-      XSETSUBR (fun, subr);
-      xsignal1 (Qinvalid_function, fun);
+      if (unevalled_ok)
+	{
+	  return (subr->function.aUNEVALLED (args[0]));
+	}
+      else
+	{
+	  Lisp_Object fun;
+	  XSETSUBR (fun, subr);
+	  xsignal1 (Qinvalid_function, fun);
+	}
     }
 
   else if (subr->max_args == MANY)
diff --git a/src/lisp.h b/src/lisp.h
index 7bfc69b647..e0c056a5bb 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4145,7 +4145,7 @@ xsignal (Lisp_Object error_symbol, Lisp_Object data)
 extern AVOID signal_error (const char *, Lisp_Object);
 extern AVOID overflow_error (void);
 extern bool FUNCTIONP (Lisp_Object);
-extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector);
+extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector, bool unevalled_ok);
 extern Lisp_Object eval_sub (Lisp_Object form);
 extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
 extern Lisp_Object call0 (Lisp_Object);
-- 
2.25.1