scratch/lexspaces 09821e3 03/17: Store symbol value into the binding

[Andrea Corallo]

branch: scratch/lexspaces
commit 09821e3c4755131cafce6018bf29b2630901573c
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>

    Store symbol value into the binding
---
 src/alloc.c     |  4 +--
 src/data.c      |  2 ++
 src/lexspaces.c |  2 ++
 src/lisp.h      | 91 ++++++++++++++++++++++++++++++++-------------------------
 src/pdumper.c   |  3 +-
 5 files changed, 59 insertions(+), 43 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index cc9ba8d..e7ba4dd 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3523,7 +3523,7 @@ init_symbol (Lisp_Object val, Lisp_Object name)
   set_symbol_name (val, name);
   set_symbol_plist (val, Qnil);
   p->u.s.redirect = SYMBOL_PLAINVAL;
-  SET_SYMBOL_VAL (p, Qunbound);
+  p->u.s.val.value = Qunbound;
   set_symbol_function (val, Qnil);
   set_symbol_next (val, NULL);
   p->u.s.gcmarkbit = false;
@@ -6652,7 +6652,7 @@ mark_object (Lisp_Object arg)
        mark_object (ptr->u.s.plist);
        switch (ptr->u.s.redirect)
          {
-         case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break;
+         case SYMBOL_PLAINVAL: mark_object (ptr->u.s.val.value); break;
          case SYMBOL_VARALIAS:
            {
              Lisp_Object tem;
diff --git a/src/data.c b/src/data.c
index 1db0a98..1ab203f 100644
--- a/src/data.c
+++ b/src/data.c
@@ -259,6 +259,8 @@ for example, (type-of 1) returns `integer'.  */)
           }
         case PVEC_MODULE_FUNCTION:
           return Qmodule_function;
+       case PVEC_BINDING:
+         return Qbinding;
         case PVEC_XWIDGET:
           return Qxwidget;
         case PVEC_XWIDGET_VIEW:
diff --git a/src/lexspaces.c b/src/lexspaces.c
index feb0adf..bfb59a1 100644
--- a/src/lexspaces.c
+++ b/src/lexspaces.c
@@ -20,6 +20,8 @@ along with GNU Emacs.  If not, see 
<https://www.gnu.org/licenses/>.  */
 #include <config.h>
 #include "lisp.h"
 
+EMACS_INT curr_lexspace;
+
 DEFUN ("in-lexspace", Fin_lexspace, Sin_lexspace, 1, 1, 0,
        doc: /* Set NAME as current lexspace.  Create it in case.   */)
   (Lisp_Object name)
diff --git a/src/lisp.h b/src/lisp.h
index 15b1f8d..eff7d30 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -377,14 +377,10 @@ typedef EMACS_INT Lisp_Word;
        & ((1 << INTTYPEBITS) - 1)))
 #define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float)
 #define lisp_h_NILP(x) EQ (x, Qnil)
-#define lisp_h_SET_SYMBOL_VAL(sym, v) \
-   (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \
-    (sym)->u.s.val.value = (v))
+
 #define lisp_h_SYMBOL_CONSTANT_P(sym) \
    (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE)
 #define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write)
-#define lisp_h_SYMBOL_VAL(sym) \
-   (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value)
 #define lisp_h_SYMBOLP(x) TAGGEDP (x, Lisp_Symbol)
 #define lisp_h_TAGGEDP(a, tag) \
    (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
@@ -2168,16 +2164,56 @@ typedef jmp_buf sys_jmp_buf;
 
 #include "thread.h"
 
+
+/* Lexspaces and binding. */
+
+#define MAX_LEXSPACES 256
+
+extern EMACS_INT curr_lexspace;
+
+INLINE Lisp_Object make_binding (void);
+
+struct Lisp_Binding
+{
+  union vectorlike_header header;
+  Lisp_Object b[MAX_LEXSPACES];
+};
+
+INLINE bool
+BINDINGP (Lisp_Object a)
+{
+  return PSEUDOVECTORP (a, PVEC_BINDING);
+}
+
+INLINE void
+CHECK_BINDING (Lisp_Object b)
+{
+  CHECK_TYPE (BINDINGP (b), Qbinding, b);
+}
+
+INLINE struct Lisp_Binding *
+XBINDING (Lisp_Object b)
+{
+  eassert (BINDINGP (b));
+  return XUNTAG (b, Lisp_Vectorlike, struct Lisp_Binding);
+}
+
 /***********************************************************************
                               Symbols
  ***********************************************************************/
 
 /* Value is name of symbol.  */
 
+/* FIXME move back to macro.  */
 INLINE Lisp_Object
-(SYMBOL_VAL) (struct Lisp_Symbol *sym)
+SYMBOL_VAL (struct Lisp_Symbol *sym)
 {
-  return lisp_h_SYMBOL_VAL (sym);
+  eassert (sym->u.s.redirect == SYMBOL_PLAINVAL);
+  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];
 }
 
 INLINE struct Lisp_Symbol *
@@ -2199,10 +2235,15 @@ SYMBOL_FWD (struct Lisp_Symbol *sym)
   return sym->u.s.val.fwd;
 }
 
+/* FIXME move it back to macro. */
 INLINE void
-(SET_SYMBOL_VAL) (struct Lisp_Symbol *sym, Lisp_Object v)
+SET_SYMBOL_VAL (struct Lisp_Symbol *sym, Lisp_Object v)
 {
-  lisp_h_SET_SYMBOL_VAL (sym, v);
+  eassert (sym->u.s.redirect == SYMBOL_PLAINVAL);
+  if (EQ (sym->u.s.val.value, Qunbound))
+    sym->u.s.val.value = make_binding ();
+  struct Lisp_Binding *binding = XBINDING (sym->u.s.val.value);
+  binding->b[curr_lexspace] = v;
 }
 
 INLINE void
@@ -2938,12 +2979,6 @@ RECORDP (Lisp_Object a)
   return PSEUDOVECTORP (a, PVEC_RECORD);
 }
 
-INLINE bool
-BINDINGP (Lisp_Object a)
-{
-  return PSEUDOVECTORP (a, PVEC_BINDING);
-}
-
 INLINE void
 CHECK_RECORD (Lisp_Object x)
 {
@@ -5043,36 +5078,12 @@ maybe_gc (void)
     maybe_garbage_collect ();
 }
 
-
-/* Lexspaces and binding. */
-
-#define MAX_LEXSPACES 256
-
-struct Lisp_Binding
-{
-  union vectorlike_header header;
-  Lisp_Object b[MAX_LEXSPACES];
-};
-
-INLINE void
-CHECK_BINDING (Lisp_Object b)
-{
-  CHECK_TYPE (BINDINGP (b), Qbinding, b);
-}
-
-INLINE struct Lisp_Binding *
-XBINDING (Lisp_Object b)
-{
-  eassert (BINDINGP (b));
-  return XUNTAG (b, Lisp_Vectorlike, struct Lisp_Binding);
-}
-
 INLINE Lisp_Object
 make_binding (void)
 {
   struct Lisp_Binding *binding =
     ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Binding,
-                                 b[MAX_LEXSPACES], PVEC_BINDING);
+                                 b[MAX_LEXSPACES - 1], PVEC_BINDING);
   for (EMACS_INT i = 0; i < MAX_LEXSPACES; i++)
     binding->b[i] = Qunbound;
   return make_lisp_ptr (binding, Lisp_Vectorlike);
diff --git a/src/pdumper.c b/src/pdumper.c
index 63424c5..a94145e 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2959,7 +2959,7 @@ dump_vectorlike (struct dump_context *ctx,
                  Lisp_Object lv,
                  dump_off offset)
 {
-#if CHECK_STRUCTS && !defined HASH_pvec_type_A4A6E9984D
+#if CHECK_STRUCTS && !defined HASH_pvec_type_57B9D77DC2
 # error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
 #endif
   const struct Lisp_Vector *v = XVECTOR (lv);
@@ -2980,6 +2980,7 @@ 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: