Re: MPS: Forwording symbols

[Helmut Eller <eller.helmut@gmail.com>]

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

On Sat, Jun 22 2024, Gerd Möllmann wrote:

>> The symbol is needed in store_symval_forwarding.  It looks in the plist
>> for 'choice and 'range.  In addition to the five symbols mentioned in
>> the definition of Lisp_Buffer_Objfwd, predicate can also be
>> 'overwrite-mode, 'vertical-scroll-bar and 'fraction.  I think those have
>> those properties; weird.
>
> I guess then it's better to leave the enum part out. That seems to
> become too much work. What an ugly corner.

Here is an attempt to use an enum.  I'm not sure that it's easier to
read and the enum constants have odd names.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Introduce-an-enum-Lisp_Fwd_Predicate.patch --]
[-- Type: text/x-diff, Size: 5946 bytes --]

From ad356aea9eb894baec5541d2203e97a0f42e382e Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Sun, 23 Jun 2024 21:46:16 +0200
Subject: [PATCH] Introduce an enum Lisp_Fwd_Predicate

Using an enum instead of a symbol makes it obvious that this field is
of no concern to the GC.

* src/lisp.h (enum Lisp_Fwd_Predicate): New.
(struct Lisp_Fwd): Use it instead of a symbol.
* src/buffer.c (DEFVAR_PER_BUFFER): Create the necessary enum constant
instead of a symbol.
* src/data.c (check_fwd_predicate, check_choice): New helpers.
(store_symval_forwarding): Use it.
---
 src/buffer.c | 22 ++++++--------
 src/data.c   | 83 ++++++++++++++++++++++++++++++++++------------------
 src/lisp.h   | 17 ++++++++---
 3 files changed, 77 insertions(+), 45 deletions(-)

diff --git a/src/buffer.c b/src/buffer.c
index ae5016df50e..39b5e29067a 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -5017,19 +5017,15 @@ init_buffer (void)
    that nil is allowed too).  DOC is a dummy where you write the doc
    string as a comment.  */
 
-/* FIXME: use LISPSYM_INITIALLY instead of TAG_PTR_INITIALLY */
-#define DEFVAR_PER_BUFFER(lname, vname, predicate_, doc)		\
-  do {									\
-    const Lisp_Object sym						\
-      = TAG_PTR_INITIALLY (Lisp_Symbol, (intptr_t)((i##predicate_)	\
-						   * sizeof *lispsym));	\
-    static const struct Lisp_Fwd bo_fwd					\
-	= { .type = Lisp_Fwd_Buffer_Obj,				\
-	    .bufoffset = offsetof (struct buffer, vname##_),		\
-	    .u.bufpredicate = sym };					\
-    static_assert (offsetof (struct buffer, vname##_)			\
-		   < (1 << 8 * sizeof bo_fwd.bufoffset));		\
-    defvar_per_buffer (&bo_fwd, lname);					\
+#define DEFVAR_PER_BUFFER(lname, vname, predicate, doc)		\
+  do {								\
+    static const struct Lisp_Fwd bo_fwd				\
+	= { .type = Lisp_Fwd_Buffer_Obj,			\
+	    .bufoffset = offsetof (struct buffer, vname##_),	\
+	    .u.bufpredicate = FWDPRED_##predicate };		\
+    static_assert (offsetof (struct buffer, vname##_)		\
+		   < (1 << 8 * sizeof bo_fwd.bufoffset));	\
+    defvar_per_buffer (&bo_fwd, lname);				\
   } while (0)
 
 static void
diff --git a/src/data.c b/src/data.c
index e0133d81771..9fd439e07b5 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1399,6 +1399,59 @@ wrong_range (Lisp_Object min, Lisp_Object max, Lisp_Object wrong)
 	    wrong);
 }
 
+static void
+check_choice (Lisp_Object choice, Lisp_Object val)
+{
+  eassert (CONSP (choice));
+  if (NILP (Fmemq (val, choice)))
+    wrong_choice (choice, val);
+}
+
+static void
+check_fwd_predicate (enum Lisp_Fwd_Predicate p, Lisp_Object val)
+{
+  switch (p)
+    {
+    case FWDPRED_Qnil:
+      return;
+    case FWDPRED_Qstringp:
+      if (!STRINGP (val))
+	wrong_type_argument (Qstringp, val);
+      return;
+    case FWDPRED_Qsymbolp:
+      if (!SYMBOLP (val))
+	wrong_type_argument (Qsymbolp, val);
+      return;
+    case FWDPRED_Qintegerp:
+      if (!INTEGERP (val))
+	wrong_type_argument (Qintegerp, val);
+      return;
+    case FWDPRED_Qnumberp:
+      if (!NUMBERP (val))
+	wrong_type_argument (Qnumberp, val);
+      return;
+    case FWDPRED_Qfraction:
+      {
+	if (!NUMBERP (val))
+	  wrong_type_argument (Qnumberp, val);
+	Lisp_Object range = Fget (Qfraction, Qrange);
+	eassert (CONSP (range));
+	Lisp_Object min = XCAR (range);
+	Lisp_Object max = XCDR (range);
+	if (NILP (CALLN (Fleq, min, val, max)))
+	  wrong_range (min, max, val);
+      }
+      return;
+    case FWDPRED_Qvertical_scroll_bar:
+      check_choice (Fget (Qvertical_scroll_bar, Qchoice), val);
+      return;
+    case FWDPRED_Qoverwrite_mode:
+      check_choice (Fget (Qoverwrite_mode, Qchoice), val);
+      return;
+    }
+  emacs_abort ();
+}
+
 /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
    of SYMBOL.  If SYMBOL is buffer-local, VALCONTENTS should be the
    buffer-independent contents of the value cell: forwarded just one
@@ -1459,34 +1512,8 @@ store_symval_forwarding (lispfwd valcontents, Lisp_Object newval,
     case Lisp_Fwd_Buffer_Obj:
       {
 	int offset = XBUFFER_OFFSET (valcontents);
-	Lisp_Object predicate = valcontents->u.bufpredicate;
-
-	if (!NILP (newval) && !NILP (predicate))
-	  {
-	    eassert (SYMBOLP (predicate));
-	    Lisp_Object choiceprop = Fget (predicate, Qchoice);
-	    if (!NILP (choiceprop))
-	      {
-		if (NILP (Fmemq (newval, choiceprop)))
-		  wrong_choice (choiceprop, newval);
-	      }
-	    else
-	      {
-		Lisp_Object rangeprop = Fget (predicate, Qrange);
-		if (CONSP (rangeprop))
-		  {
-		    Lisp_Object min = XCAR (rangeprop), max = XCDR (rangeprop);
-		    if (! NUMBERP (newval)
-			|| NILP (CALLN (Fleq, min, newval, max)))
-		      wrong_range (min, max, newval);
-		  }
-		else if (FUNCTIONP (predicate))
-		  {
-		    if (NILP (call1 (predicate, newval)))
-		      wrong_type_argument (predicate, newval);
-		  }
-	      }
-	  }
+	if (!NILP (newval))
+	  check_fwd_predicate (valcontents->u.bufpredicate, newval);
 	if (buf == NULL)
 	  buf = current_buffer;
 	set_per_buffer_value (buf, offset, newval);
diff --git a/src/lisp.h b/src/lisp.h
index c20bc9aa76e..e3c2dce7df0 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3158,6 +3158,18 @@ #define INT_TO_INTEGER(expr) \
     Lisp_Object valcell;
   };
 
+enum Lisp_Fwd_Predicate
+{
+  FWDPRED_Qnil,
+  FWDPRED_Qintegerp,
+  FWDPRED_Qsymbolp,
+  FWDPRED_Qstringp,
+  FWDPRED_Qnumberp,
+  FWDPRED_Qfraction,
+  FWDPRED_Qvertical_scroll_bar,
+  FWDPRED_Qoverwrite_mode,
+};
+
 /* A struct Lisp_Fwd is used to locate a variable.  See Lisp_Fwd_Type
    for the various types of variables.
 
@@ -3174,10 +3186,7 @@ #define INT_TO_INTEGER(expr) \
     intmax_t *intvar;
     bool *boolvar;
     Lisp_Object *objvar;
-    /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp, Qnumberp,
-       Qfraction, Qvertical_scroll_bar, or Qoverwrite_mode.
-     */
-    Lisp_Object bufpredicate;
+    enum Lisp_Fwd_Predicate bufpredicate;
     int kbdoffset;
   } u;
 };
-- 
2.39.2