Make variable forwarding explicit rather the using special values.

Basically, this makes the structure of buffer-local values and object
forwarding explicit in the type of Lisp_Symbols rather than use
special Lisp_Objects for that.  This tends to lead to slightly more
verbose code, but is more C-like, simpler, and makes it easier to make
sure we handled all cases, among other things by letting the compiler
help us check it.
* lisp.h (enum Lisp_Misc_Type, union Lisp_Misc):
Removing forwarding objects.
(enum Lisp_Fwd_Type, enum symbol_redirect, union Lisp_Fwd): New types.
(struct Lisp_Symbol): Make the various forms of variable-forwarding
explicit rather than hiding them inside Lisp_Object "values".
(XFWDTYPE): New macro.
(XINTFWD, XBOOLFWD, XOBJFWD, XKBOARD_OBJFWD): Redefine.
(XBUFFER_LOCAL_VALUE): Remove.
(SYMBOL_VAL, SYMBOL_ALIAS, SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL)
(SET_SYMBOL_ALIAS, SET_SYMBOL_BLV, SET_SYMBOL_FWD): New macros.
(SYMBOL_VALUE, SET_SYMBOL_VALUE): Remove.
(struct Lisp_Intfwd, struct Lisp_Boolfwd, struct Lisp_Objfwd)
(struct Lisp_Buffer_Objfwd, struct Lisp_Kboard_Objfwd):
Remove the Lisp_Misc_* header.
(struct Lisp_Buffer_Local_Value): Redefine.
(BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE): New macros.
(struct Lisp_Misc_Any): Add filler to get the right size.
(struct Lisp_Free): Use struct Lisp_Misc_Any rather than struct
Lisp_Intfwd.
(DEFVAR_LISP, DEFVAR_LISP_NOPRO, DEFVAR_BOOL, DEFVAR_INT)
(DEFVAR_KBOARD): Allocate a forwarding object.
* data.c (do_blv_forwarding, store_blv_forwarding): New macros.
(let_shadows_global_binding_p): New function.
(union Lisp_Val_Fwd): New type.
(make_blv): New function.
(swap_in_symval_forwarding, indirect_variable, do_symval_forwarding)
(store_symval_forwarding, swap_in_global_binding, Fboundp)
(swap_in_symval_forwarding, find_symbol_value, Fset)
(let_shadows_buffer_binding_p, set_internal, default_value)
(Fset_default, Fmake_variable_buffer_local, Fmake_local_variable)
(Fkill_local_variable, Fmake_variable_frame_local)
(Flocal_variable_p, Flocal_variable_if_set_p)
(Fvariable_binding_locus):
* xdisp.c (select_frame_for_redisplay):
* lread.c (Fintern, Funintern, init_obarray, defvar_int)
(defvar_bool, defvar_lisp_nopro, defvar_lisp, defvar_kboard):
* frame.c (store_frame_param):
* eval.c (Fdefvaralias, Fuser_variable_p, specbind, unbind_to):
* bytecode.c (Fbyte_code) <varref, varset>: Adapt to the new symbol
value structure.
* buffer.c (PER_BUFFER_SYMBOL): Move from buffer.h.
(clone_per_buffer_values): Only adjust markers into the current buffer.
(reset_buffer_local_variables): PER_BUFFER_IDX is never -2.
(Fbuffer_local_value, set_buffer_internal_1)
(swap_out_buffer_local_variables):
Adapt to the new symbol value structure.
(DEFVAR_PER_BUFFER): Allocate a Lisp_Buffer_Objfwd object.
(defvar_per_buffer): Take a new arg for the fwd object.
(buffer_lisp_local_variables): Return a proper alist (different fix
for bug#4138).
* alloc.c (Fmake_symbol): Use SET_SYMBOL_VAL.
(Fgarbage_collect): Don't handle buffer_defaults specially.
(mark_object): Handle new symbol value structure rather than the old
special Lisp_Misc_* objects.
(gc_sweep) <symbols>: Free also the buffer-local-value objects.
* term.c (set_tty_color_mode):
* bidi.c (bidi_initialize): Don't access the ->value field directly.
* buffer.h (PER_BUFFER_VAR_OFFSET): Don't bother with
a buffer_local_flags.
* print.c (print_object): Get rid of impossible forwarding objects.

1 files changed, 129 insertions, 85 deletions

diff --git a/src/eval.c b/src/eval.c
index 6609d3b5c8a..cb1d435cb8b 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -767,24 +767,46 @@ The return value is BASE-VARIABLE.  */)
   CHECK_SYMBOL (new_alias);
   CHECK_SYMBOL (base_variable);
 
-  if (SYMBOL_CONSTANT_P (new_alias))
-    error ("Cannot make a constant an alias");
-
   sym = XSYMBOL (new_alias);
+
+  if (sym->constant)
+    if (sym->redirect == SYMBOL_VARALIAS)
+      sym->constant = 0;        /* Reset.  */
+    else
+      /* Not sure why.  */
+      error ("Cannot make a constant an alias");
+
+  switch (sym->redirect)
+    {
+    case SYMBOL_FORWARDED:
+      error ("Cannot make an internal variable an alias");
+    case SYMBOL_LOCALIZED:
+      error ("Don't know how to make a localized variable an alias");
+    }
+
   /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
-     If n_a is bound, but b_v is not, set the value of b_v to n_a.
-     This is for the sake of define-obsolete-variable-alias and user
-     customizations.  */
-  if (NILP (Fboundp (base_variable)) && !NILP (Fboundp (new_alias)))
-    XSYMBOL(base_variable)->value = sym->value;
-  sym->indirect_variable = 1;
-  sym->value = base_variable;
+     If n_a is bound, but b_v is not, set the value of b_v to n_a,
+     so that old-code that affects n_a before the aliasing is setup
+     still works.  */
+  if (NILP (Fboundp (base_variable)))
+    set_internal (base_variable, find_symbol_value (new_alias), NULL, 1);
+
+  {
+    struct specbinding *p;
+
+    for (p = specpdl_ptr - 1; p >= specpdl; p--)
+      if (p->func == NULL
+          && (EQ (new_alias,
+                  CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
+        error ("Don't know how to make a let-bound variable an alias");
+  }
+
+  sym->redirect = SYMBOL_VARALIAS;
+  SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
   sym->constant = SYMBOL_CONSTANT_P (base_variable);
   LOADHIST_ATTACH (new_alias);
-  if (!NILP (docstring))
-    Fput (new_alias, Qvariable_documentation, docstring);
-  else
-    Fput (new_alias, Qvariable_documentation, Qnil);
+  /* Even if docstring is nil: remove old docstring.  */
+  Fput (new_alias, Qvariable_documentation, docstring);
 
   return base_variable;
 }
@@ -944,7 +966,7 @@ chain of symbols.  */)
       return Qnil;
 
   /* If indirect and there's an alias loop, don't check anything else.  */
-  if (XSYMBOL (variable)->indirect_variable
+  if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS
       && NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
                                           Qt, user_variable_p_eh)))
     return Qnil;
@@ -968,11 +990,11 @@ chain of symbols.  */)
           || (!NILP (Fget (variable, intern ("custom-autoload")))))
         return Qt;
 
-      if (!XSYMBOL (variable)->indirect_variable)
+      if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS))
         return Qnil;
 
       /* An indirect variable?  Let's follow the chain.  */
-      variable = XSYMBOL (variable)->value;
+      XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable)));
     }
 }
 
@@ -3263,78 +3285,94 @@ void
 specbind (symbol, value)
      Lisp_Object symbol, value;
 {
-  Lisp_Object valcontents;
+  struct Lisp_Symbol *sym;
+
+  eassert (!handling_signal);
 
   CHECK_SYMBOL (symbol);
+  sym = XSYMBOL (symbol);
   if (specpdl_ptr == specpdl + specpdl_size)
     grow_specpdl ();
 
-  /* The most common case is that of a non-constant symbol with a
-     trivial value.  Make that as fast as we can.  */
-  valcontents = SYMBOL_VALUE (symbol);
-  if (!MISCP (valcontents) && !SYMBOL_CONSTANT_P (symbol))
-    {
-      specpdl_ptr->symbol = symbol;
-      specpdl_ptr->old_value = valcontents;
-      specpdl_ptr->func = NULL;
-      ++specpdl_ptr;
-      SET_SYMBOL_VALUE (symbol, value);
-    }
-  else
-    {
-      Lisp_Object ovalue = find_symbol_value (symbol);
-      specpdl_ptr->func = 0;
-      specpdl_ptr->old_value = ovalue;
-
-      valcontents = XSYMBOL (symbol)->value;
-
-      if (BUFFER_LOCAL_VALUEP (valcontents)
-          || BUFFER_OBJFWDP (valcontents))
-        {
-          Lisp_Object where, current_buffer;
-
-          current_buffer = Fcurrent_buffer ();
-
-          /* For a local variable, record both the symbol and which
-             buffer's or frame's value we are saving.  */
-          if (!NILP (Flocal_variable_p (symbol, Qnil)))
-            where = current_buffer;
-          else if (BUFFER_LOCAL_VALUEP (valcontents)
-                   && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
-            where = XBUFFER_LOCAL_VALUE (valcontents)->frame;
+ start:
+  switch (sym->redirect)
+    {
+    case SYMBOL_VARALIAS:
+      sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
+    case SYMBOL_PLAINVAL:
+        { /* The most common case is that of a non-constant symbol with a
+             trivial value.  Make that as fast as we can.  */
+          specpdl_ptr->symbol = symbol;
+          specpdl_ptr->old_value = SYMBOL_VAL (sym);
+          specpdl_ptr->func = NULL;
+          ++specpdl_ptr;
+          if (!sym->constant)
+            SET_SYMBOL_VAL (sym, value);
           else
-            where = Qnil;
-
-          /* We're not using the `unused' slot in the specbinding
-             structure because this would mean we have to do more
-             work for simple variables.  */
-          specpdl_ptr->symbol = Fcons (symbol, Fcons (where, current_buffer));
-
-          /* If SYMBOL is a per-buffer variable which doesn't have a
-             buffer-local value here, make the `let' change the global
-             value by changing the value of SYMBOL in all buffers not
-             having their own value.  This is consistent with what
-             happens with other buffer-local variables.  */
-          if (NILP (where)
-              && BUFFER_OBJFWDP (valcontents))
-            {
-              ++specpdl_ptr;
-              Fset_default (symbol, value);
-              return;
-            }
+            set_internal (symbol, value, 0, 1);
+          break;
         }
-      else
-        specpdl_ptr->symbol = symbol;
-
-      specpdl_ptr++;
-      /* We used to do
-            if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
-              store_symval_forwarding (symbol, ovalue, value, NULL);
-            else
-         but ovalue comes from find_symbol_value which should never return
-         such an internal value.  */
-      eassert (!(BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue)));
-      set_internal (symbol, value, 0, 1);
+    case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED:
+      {
+        Lisp_Object ovalue = find_symbol_value (symbol);
+        specpdl_ptr->func = 0;
+        specpdl_ptr->old_value = ovalue;
+
+        eassert (sym->redirect != SYMBOL_LOCALIZED
+                 || (EQ (SYMBOL_BLV (sym)->where,
+                         SYMBOL_BLV (sym)->frame_local ?
+                         Fselected_frame () : Fcurrent_buffer ())));
+
+        if (sym->redirect == SYMBOL_LOCALIZED
+            || BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
+          {
+            Lisp_Object where, cur_buf = Fcurrent_buffer ();
+
+            /* For a local variable, record both the symbol and which
+               buffer's or frame's value we are saving.  */
+            if (!NILP (Flocal_variable_p (symbol, Qnil)))
+              {
+                eassert (sym->redirect != SYMBOL_LOCALIZED
+                         || (BLV_FOUND (SYMBOL_BLV (sym))
+                             && EQ (cur_buf, SYMBOL_BLV (sym)->where)));
+                where = cur_buf;
+              }
+            else if (sym->redirect == SYMBOL_LOCALIZED
+                     && BLV_FOUND (SYMBOL_BLV (sym)))
+              where = SYMBOL_BLV (sym)->where;
+            else
+              where = Qnil;
+
+            /* We're not using the `unused' slot in the specbinding
+               structure because this would mean we have to do more
+               work for simple variables.  */
+            /* FIXME: The third value `current_buffer' is only used in
+               let_shadows_buffer_binding_p which is itself only used
+               in set_internal for local_if_set.  */
+            specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf));
+
+            /* If SYMBOL is a per-buffer variable which doesn't have a
+               buffer-local value here, make the `let' change the global
+               value by changing the value of SYMBOL in all buffers not
+               having their own value.  This is consistent with what
+               happens with other buffer-local variables.  */
+            if (NILP (where)
+                && sym->redirect == SYMBOL_FORWARDED)
+              {
+                eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym)));
+                ++specpdl_ptr;
+                Fset_default (symbol, value);
+                return;
+              }
+          }
+        else
+          specpdl_ptr->symbol = symbol;
+
+        specpdl_ptr++;
+        set_internal (symbol, value, 0, 1);
+        break;
+      }
+    default: abort ();
     }
 }
 
@@ -3394,7 +3432,12 @@ unbind_to (count, value)
           if (NILP (where))
             Fset_default (symbol, this_binding.old_value);
           else if (BUFFERP (where))
-            set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
+            if (!NILP (Flocal_variable_p (symbol, where)))
+              set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
+            /* else if (!NILP (Fbuffer_live_p (where)))
+              error ("Unbinding local %s to global!", symbol); */
+            else
+              ;
           else
             set_internal (symbol, this_binding.old_value, NULL, 1);
         }
@@ -3403,8 +3446,9 @@ unbind_to (count, value)
           /* If variable has a trivial value (no forwarding), we can
              just set it.  No need to check for constant symbols here,
              since that was already done by specbind.  */
-          if (!MISCP (SYMBOL_VALUE (this_binding.symbol)))
-            SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value);
+          if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL)
+            SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol),
+                            this_binding.old_value);
           else
             set_internal (this_binding.symbol, this_binding.old_value, 0, 1);
         }