From 7fecbf57e2946c5541c4c707cf9b8f68f5716034 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Fri, 8 May 2020 06:54:42 +0100
Subject: [PATCH] Add lexspace redirection

---
 src/lexspaces.c |  6 ++++--
 src/lisp.h      | 22 +++++++++++++++++-----
 src/pdumper.c   | 19 +++++++++++++++++--
 3 files changed, 38 insertions(+), 9 deletions(-)

diff --git a/src/lexspaces.c b/src/lexspaces.c
index 587ca94ab1a..6e6a7a3a541 100644
--- a/src/lexspaces.c
+++ b/src/lexspaces.c
@@ -39,12 +39,14 @@ lexspace_copy (EMACS_INT dst, EMACS_INT src)
 		&& !EQ (sym->u.s.val.value, Qunbound))
 	      {
 		struct Lisp_Binding *binding = XBINDING (sym->u.s.val.value);
-		binding->b[dst] = binding->b[src];
+		binding->r[dst] = true;
+		binding->b[dst] = make_fixnum (src);
 	      }
 	    if (!NILP (sym->u.s._function))
 	      {
 		struct Lisp_Binding *binding = XBINDING (sym->u.s._function);
-		binding->b[dst] = binding->b[src];
+		binding->r[dst] = true;
+		binding->b[dst] = make_fixnum (src);
 	      }
 	    if (sym->u.s.next == 0)
 	      break;
diff --git a/src/lisp.h b/src/lisp.h
index 29df243c0aa..a24e5f219be 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2177,6 +2177,8 @@ struct Lisp_Binding
 {
   union vectorlike_header header;
   Lisp_Object b[MAX_LEXSPACES];
+  /* true if redirect.  */
+  bool r[MAX_LEXSPACES];
 };
 
 INLINE bool
@@ -2212,16 +2214,25 @@ SYMBOL_VAL (struct Lisp_Symbol *sym)
   if (EQ (sym->u.s.val.value, Qunbound))
     return Qunbound;
   eassert (BINDINGP (sym->u.s.val.value));
- /* FIXME: add loop to follow indirection.  */
-  return XBINDING (sym->u.s.val.value)->b[curr_lexspace];
+  EMACS_INT lexspace = curr_lexspace;
+  struct Lisp_Binding *binding = XBINDING (sym->u.s.val.value);
+  /* Follow redirections.  */
+  while (binding->r[lexspace])
+    lexspace = XFIXNUM (binding->b[lexspace]);
+  return binding->b[lexspace];
 }
 
 INLINE Lisp_Object
 SYMBOL_FUNCTION (struct Lisp_Symbol *sym)
 {
-  if (!NILP (sym->u.s._function))
-    return XBINDING (sym->u.s._function)->b[curr_lexspace];
-  return Qnil;
+  if (NILP (sym->u.s._function))
+    return Qnil;
+  EMACS_INT lexspace = curr_lexspace;
+  struct Lisp_Binding *binding = XBINDING (sym->u.s._function);
+  /* Follow redirections.  */
+  while (binding->r[lexspace])
+    lexspace = XFIXNUM (binding->b[lexspace]);
+  return binding->b[lexspace];
 }
 
 INLINE struct Lisp_Symbol *
@@ -2251,6 +2262,7 @@ SET_SYMBOL_VAL (struct Lisp_Symbol *sym, Lisp_Object v)
   if (EQ (sym->u.s.val.value, Qunbound))
     sym->u.s.val.value = make_binding (Qunbound);
   struct Lisp_Binding *binding = XBINDING (sym->u.s.val.value);
+  binding->r[curr_lexspace] = false;
   binding->b[curr_lexspace] = v;
 }
 
diff --git a/src/pdumper.c b/src/pdumper.c
index 20dd2ff4dcd..9be6d56850c 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -1758,7 +1758,7 @@ dump_roots (struct dump_context *ctx)
   visit_static_gc_roots (visitor);
 }
 
-enum { PDUMPER_MAX_OBJECT_SIZE = 2048 };
+enum { PDUMPER_MAX_OBJECT_SIZE = 4096 };
 
 static dump_off
 field_relpos (const void *in_start, const void *in_field)
@@ -2935,6 +2935,19 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
   return dump_object_finish (ctx, &out, sizeof (out));
 }
 
+static dump_off
+dump_binding (struct dump_context *ctx, const struct Lisp_Binding *binding)
+{
+#if CHECK_STRUCTS && !defined (HASH_Lisp_Binding_A2586197DB)
+# error "Lisp_Binding changed. See CHECK_STRUCTS comment in config.h."
+#endif
+  START_DUMP_PVEC (ctx, &binding->header, struct Lisp_Binding, out);
+  dump_pseudovector_lisp_fields (ctx, &out->header, &binding->header);
+  for (ptrdiff_t i = 0; i < MAX_LEXSPACES; ++i)
+      DUMP_FIELD_COPY (out, binding, r[i]);
+  return finish_dump_pvec (ctx, &out->header);
+}
+
 static void
 fill_pseudovec (union vectorlike_header *header, Lisp_Object item)
 {
@@ -2980,7 +2993,6 @@ dump_vectorlike (struct dump_context *ctx,
     case PVEC_CHAR_TABLE:
     case PVEC_SUB_CHAR_TABLE:
     case PVEC_RECORD:
-    case PVEC_BINDING:
       offset = dump_vectorlike_generic (ctx, &v->header);
       break;
     case PVEC_BOOL_VECTOR:
@@ -2995,6 +3007,9 @@ dump_vectorlike (struct dump_context *ctx,
     case PVEC_SUBR:
       offset = dump_subr (ctx, XSUBR (lv));
       break;
+    case PVEC_BINDING:
+      offset = dump_binding (ctx, XBINDING (lv));
+      break;
     case PVEC_FRAME:
     case PVEC_WINDOW:
     case PVEC_PROCESS:
-- 
2.39.5