diff src/eval.c @ 107984:bef5d1738c0b

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.

--- a/src/eval.c	Mon Apr 19 14:33:11 2010 -0400
+++ b/src/eval.c	Mon Apr 19 21:50:52 2010 -0400
@@ -767,24 +767,46 @@
   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 @@
       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 @@
           || (!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 @@
 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
+ start:
+  switch (sym->redirect)
     {
-      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;
+    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 @@
 	  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 @@
 	  /* 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);
 	}