[PATCH] (Updated) Run hook when variable is set

[Kelly Dean <kelly@prtime.org>]

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

Stefan Monnier wrote:
>> I've removed «void». I recommend making makunbound stop working on
>> non-globals too.
>
> `let' on dynamically-scoped variables doesn't make them non-local.
>
> Or rather, whether it does or not is a philosophical question (does
> `let' create a new variable which shadows the outer one, or does it just
> temporarily change the value of the variable?).

Saying there's only a global variable doesn't remove the absurdity of makunbound within the extent of a «let». Suppose foo is currently unbound. Then:
(defvar foo 0) ; Now foo is bound to 0
(let ((foo 1)) ; Now it's bound to 1
  (makunbound 'foo)) ; Now it's bound to unboundedness
;; Now it's unbound from unboundedness, and thereby rebound to 0

You can't just say that makunbound in that case unbinds foo, because then the question arises, from what is foo unbound when the let-binding form exits? If foo were already unbound by makunbound, then there would be nothing left to unbind it from when «let» exits.

Surely you can't say with a straight face that binding to unboundedness is not an absurd concept. Yet that's the alternative to the interpretation that Qunbound escapes as a special second-class value into the Lisp world. Either way, the behavior of makunbound is wrong.

>>> - OLDVAL is either a list of one element containing the old value, or
>>> nil (when that old value is Qunbound).
>> Then run_varhook must cons. That'll generate a lot of garbage if you use it
>> for profiling, or for debugging in a way where you don't just pause to
>> inspect every hooked variable. Is that ok?
>
> I think it's OK, yes.

This seems to be the least-bad option, so I did it this way, even though it makes the API a bit gross. Unfortunately, when you do:
(require 'cl)
(setq x 0)
(symbol-hook 'x)
(benchmark-run-compiled 100000 (incf x))

it now spends half the time doing garbage collection. That's a high price to pay to cater to the brain-dead misbehavior of makunbound.

>> Or to avoid needing to cons in run_varhook, it could specbind something like
>> Qsymbol_newval_void (to t if the new value is Qunbound), so the hook
>
> Yuck.  That's even worse than using a value that is hopefully never
> used elsewhere, like `::value--unbound::'.

Then you'll probably also say ‟yuck” to my xref-push-mark patch that I posted to emacs-devel just now, since it uses that tactic.

>> Would ⌜const_hooked⌝ be ok?
>
> How 'bout `writable' with values yes/no/thrufunction?

That would make sense, but the meaning is inverted from how the code is written, e.g. the code has:
if (constant) a...;
else b...;

so to account for the inversion, it would have to change to:
if (!writeable) a...;
else b...;

which introduces an extra «not» operator. To avoid the extra operator, it would have to change to:
if (writeable) b...;
else a...;

Usually the «a» ends with return, error, or xsignal1, which means no «else» is needed for «b», so changing the order to avoid the extra «not» operator would make the code more awkward.

Since you think of variables as ‟vetted” if they might not be freely writeable, and the meaning of that term isn't inverted, I think ⌜vetted⌝ is the least-bad short name to replace ⌜constant⌝ in the places where it's used to mean «constant or hooked». (Where it means specifically «constant», i.e. the vetting is hardcoded to disallow writing, it still is called ‟constant”, e.g. in the standard macro SYMBOL_CONSTANT_P).

Updated patch attached.

BTW, I accidentally inlined a little too much for set_internal last time. This time I've factored out the part that doesn't need to be inline. This has no speed impact on the hot path, but it reduces the size of the executable by a few kB, and makes the source code a bit clearer too.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: varhook-advice-2.patch --]
[-- Type: text/x-diff, Size: 29019 bytes --]

--- src/lisp.h
+++ src/lisp.h
@@ -305,6 +305,15 @@
 #endif
 
 
+/* These are the masks for the vetted field of Lisp_Symbol.
+   Bit 0 stores the constant field.  Bit 1 stores the hooked field.  */
+#define SYM_CONST 1
+#define SYM_HOOKED 2
+
+# define SYM_CONST_P(sym) (((sym)->vetted) & SYM_CONST)
+# define SYM_HOOKED_P(sym) (((sym)->vetted) & SYM_HOOKED)
+
+
 /* Some operations are so commonly executed that they are implemented
    as macros, not functions, because otherwise runtime performance would
    suffer too much when compiling with GCC without optimization.
@@ -359,7 +370,7 @@
 #define lisp_h_NILP(x) EQ (x, Qnil)
 #define lisp_h_SET_SYMBOL_VAL(sym, v) \
    (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
-#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant)
+#define lisp_h_SYMBOL_CONSTANT_P(sym) (SYM_CONST_P (XSYMBOL (sym)))
 #define lisp_h_SYMBOL_VAL(sym) \
    (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
 #define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
@@ -1597,10 +1608,13 @@
      3 : it's a forwarding variable, the value is in `forward'.  */
   ENUM_BF (symbol_redirect) redirect : 3;
 
-  /* Non-zero means symbol is constant, i.e. changing its value
-     should signal an error.  If the value is 3, then the var
-     can be changed, but only by `defconst'.  */
-  unsigned constant : 2;
+  /* When masked with SYM_CONST, non-zero means symbol is constant,
+     i.e. changing its value should signal an error.
+     When masked with SYM_HOOKED, non-zero means setting symbol will
+     run varhook.  These two fields are combined into one in order
+     to optimize the fast path of non-hooked non-constants by
+     having only one conditional branch for that case.  */
+  unsigned vetted : 2;
 
   /* Interned state of the symbol.  This is an enumerator from
      enum symbol_interned.  */
@@ -3391,6 +3405,14 @@
 EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST;
 
 /* Defined in data.c.  */
+typedef enum
+  { /* See set_internal for a description of these values.  */
+    Dyn_Unbind = -1,
+    Dyn_Current = 0,
+    Dyn_Bind = 1,
+    Dyn_Skip = 2,
+    Dyn_Global = 3
+  } Dyn_Bind_Env;
 extern Lisp_Object indirect_function (Lisp_Object);
 extern Lisp_Object find_symbol_value (Lisp_Object);
 enum Arith_Comparison {
@@ -3438,7 +3460,15 @@
 					   Lisp_Object);
 extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
 extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
-extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool);
+extern Lisp_Object run_varhook (struct Lisp_Symbol*, bool, Dyn_Bind_Env,
+				Lisp_Object, Lisp_Object);
+extern void set_internal_vetted (Lisp_Object, Lisp_Object, Lisp_Object, bool,
+					 Dyn_Bind_Env, struct Lisp_Symbol *);
+extern void set_internal_localized_or_forwarded (Lisp_Object, Lisp_Object,
+						 Lisp_Object, bool,
+						 Dyn_Bind_Env,
+						 struct Lisp_Symbol *);
+extern void set_default_internal (Lisp_Object, Lisp_Object, Dyn_Bind_Env);
 extern void syms_of_data (void);
 extern void swap_in_global_binding (struct Lisp_Symbol *);
 
@@ -4595,6 +4626,56 @@
     return false;
 }
 
+/* Store the value NEWVAL into SYMBOL.
+   If buffer/frame-locality is an issue, WHERE specifies which context to use.
+   (nil stands for the current buffer/frame).
+
+   If BINDFLAG is false, then if this symbol is supposed to become
+   local in every buffer where it is set, then we make it local.
+   If BINDFLAG is true, we don't do that.
+
+   ENV indicates the dynamic environment for this function call, i.e. whether
+   this call is due to a variable binding (Dyn_Bind), an unbinding (Dyn_Unbind),
+   or neither (Dyn_Current). As special cases, a value of Dyn_Skip is a flag
+   to disable run_varhook so that varhooks aren't run during backtraces, and
+   a value of Dyn_Global is a flag indicating that this function call is due
+   to set_default, which allows run_varhook to distinguish beween the global
+   and the dyn-local binding.  */
+
+INLINE void
+set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
+	      bool bindflag, Dyn_Bind_Env env)
+{
+  struct Lisp_Symbol *sym;
+
+  /* If restoring in a dead buffer, do nothing.  */
+  /* if (BUFFERP (where) && NILP (XBUFFER (where)->name))
+      return; */
+
+  CHECK_SYMBOL (symbol);
+  sym = XSYMBOL (symbol);
+  if (sym->vetted)
+    {
+      set_internal_vetted (symbol, newval, where, bindflag, env, sym);
+      return;
+    }
+
+ start:
+  switch (sym->redirect)
+    {
+    case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym, newval); return;
+    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+    default: set_internal_localized_or_forwarded
+	(symbol, newval, where, bindflag, env, sym);
+    }
+}
+
+#define MAYBE_RUN_VARHOOK(result, sym, buf_local, env, oldval, newval)	\
+  {									\
+    if (SYM_HOOKED_P (sym))						\
+      (result) = run_varhook (sym, buf_local, env, oldval, newval);	\
+  }
+
 INLINE_HEADER_END
 
 #endif /* EMACS_LISP_H */
--- src/eval.c
+++ src/eval.c
@@ -267,7 +267,7 @@
   max_lisp_eval_depth = XINT (XCDR (data));
 }
 
-static void grow_specpdl (void);
+static inline void grow_specpdl (void);
 
 /* Call the Lisp debugger, giving it argument ARG.  */
 
@@ -547,7 +547,8 @@
 			= Fassq (sym, Vinternal_interpreter_environment)))
 	    XSETCDR (lex_binding, val); /* SYM is lexically bound.  */
 	  else
-	    Fset (sym, val);	/* SYM is dynamically bound.  */
+	    /* SYM is dynamically bound.  */
+	    set_internal (sym, val, Qnil, false, Dyn_Current);
 
 	  args_left = Fcdr (XCDR (args_left));
 	}
@@ -620,7 +620,7 @@
 
   sym = XSYMBOL (new_alias);
 
-  if (sym->constant)
+  if (SYM_CONST_P (sym))
     /* Not sure why, but why not?  */
     error ("Cannot make a constant an alias");
 
@@ -637,7 +637,7 @@
      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), Qnil, 1);
+    set_internal (base_variable, find_symbol_value (new_alias), Qnil, true, Dyn_Current);
 
   {
     union specbinding *p;
@@ -652,7 +652,7 @@
   XSYMBOL (base_variable)->declared_special = 1;
   sym->redirect = SYMBOL_VARALIAS;
   SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
-  sym->constant = SYMBOL_CONSTANT_P (base_variable);
+  sym->vetted = SYMBOL_CONSTANT_P (base_variable);
   LOADHIST_ATTACH (new_alias);
   /* Even if docstring is nil: remove old docstring.  */
   Fput (new_alias, Qvariable_documentation, docstring);
@@ -2007,7 +2007,7 @@
    never-used entry just before the bottom of the stack; sometimes its
    address is taken.  */
 
-static void
+static inline void
 grow_specpdl (void)
 {
   specpdl_ptr++;
@@ -3132,8 +3132,6 @@
  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.  */
@@ -3141,11 +3139,15 @@
       specpdl_ptr->let.symbol = symbol;
       specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
       grow_specpdl ();
-      if (!sym->constant)
-	SET_SYMBOL_VAL (sym, value);
+      if (!sym->vetted) SET_SYMBOL_VAL (sym, value);
+      else if (SYM_HOOKED_P (sym))
+	SET_SYMBOL_VAL (sym, run_varhook
+			(sym, false, Dyn_Bind, sym->val.value, value));
       else
-	set_internal (symbol, value, Qnil, 1);
+	set_internal (symbol, value, Qnil, true, Dyn_Bind);
       break;
+    case SYMBOL_VARALIAS:
+      sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
     case SYMBOL_LOCALIZED:
       if (SYMBOL_BLV (sym)->frame_local)
 	error ("Frame-local vars cannot be let-bound");
@@ -3176,7 +3178,7 @@
 	      {
 		specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
 		grow_specpdl ();
-		Fset_default (symbol, value);
+		set_default_internal (symbol, value, Dyn_Bind);
 		return;
 	      }
 	  }
@@ -3184,7 +3186,7 @@
 	  specpdl_ptr->let.kind = SPECPDL_LET;
 
 	grow_specpdl ();
-	set_internal (symbol, value, Qnil, 1);
+	set_internal (symbol, value, Qnil, true, Dyn_Bind);
 	break;
       }
     default: emacs_abort ();
@@ -3319,7 +3321,9 @@
 	    struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (specpdl_ptr));
 	    if (sym->redirect == SYMBOL_PLAINVAL)
 	      {
-		SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr));
+		Lisp_Object oldval = specpdl_old_value (specpdl_ptr);
+		MAYBE_RUN_VARHOOK (oldval, sym, false, Dyn_Unbind, sym->val.value, oldval);
+		SET_SYMBOL_VAL (sym, oldval);
 		break;
 	      }
 	    else
@@ -3329,8 +3333,8 @@
 	      }
 	  }
 	case SPECPDL_LET_DEFAULT:
-	  Fset_default (specpdl_symbol (specpdl_ptr),
-			specpdl_old_value (specpdl_ptr));
+	  set_default_internal (specpdl_symbol (specpdl_ptr),
+				specpdl_old_value (specpdl_ptr), Dyn_Unbind);
 	  break;
 	case SPECPDL_LET_LOCAL:
 	  {
@@ -3342,7 +3346,7 @@
 	    /* If this was a local binding, reset the value in the appropriate
 	       buffer, but only if that buffer's binding still exists.  */
 	    if (!NILP (Flocal_variable_p (symbol, where)))
-	      set_internal (symbol, old_value, where, 1);
+	      set_internal (symbol, old_value, where, true, Dyn_Unbind);
 	  }
 	  break;
 	}
@@ -3537,7 +3541,7 @@
 	    Lisp_Object sym = specpdl_symbol (tmp);
 	    Lisp_Object old_value = specpdl_old_value (tmp);
 	    set_specpdl_old_value (tmp, Fdefault_value (sym));
-	    Fset_default (sym, old_value);
+	    set_default_internal (sym, old_value, Dyn_Skip);
 	  }
 	  break;
 	case SPECPDL_LET_LOCAL:
@@ -3553,7 +3557,7 @@
 	      {
 		set_specpdl_old_value
 		  (tmp, Fbuffer_local_value (symbol, where));
-		set_internal (symbol, old_value, where, 1);
+		set_internal (symbol, old_value, where, true, Dyn_Skip);
 	      }
 	  }
 	  break;
@@ -3828,6 +3832,51 @@
 still determine whether to handle the particular condition.  */);
   Vdebug_on_signal = Qnil;
 
+  DEFVAR_LISP ("symbol-setter-function", Vsymbol_setter_function,
+       doc: /* This function is called whenever a hooked variable is set.
+It takes four arguments: SYMBOL, ENV, OLDVAL, NEWVAL. By default, it just
+returns NEWVAL unchanged.
+
+SYMBOL is the symbol being set. ENV is the environment is which it's being
+set. OLDVAL is a singleton list wrapping the current value, or nil if unbound.
+NEWVAL is a singleton list wrapping the new value to which the setter,
+i.e. the caller of a function such as `setq', is attempting to set the
+variable, or nil if the setter called `makunbound'. The actual new value to
+which the variable will be set is the `car' of the return value of this
+function. The return value is NEWVAL if this function doesn't have advice that
+overrides it. If the return value is nil, then the variable will be unbound.
+
+The possible values of ENV are these symbols, with these meanings:
+global: The global environment.
+buf-local: The setter's buffer-local environment.
+dyn-local: The innermost dynamic environment in which SYMBOL is bound.
+dyn-bind: A new dynamic environment, such as creatable using `let'.
+dyn-unbind: The next-outer dynamic environment in which SYMBOL is still bound,
+or the buffer-local environment if SYMBOL is not bound in any dynamic
+environment, or the global environment is SYMBOL is not in the buffer-local
+environment, unshadowed due to destruction of the setter's current
+dynamic environment, such as due to exit of a `let' form.
+
+If you use overriding advice, your advice must return the value to which to
+set the variable. To avoid overriding the setter's attempt to set the variable
+to NEWVAL, return NEWVAL. To block the attempt, and leave the variable
+unchanged, return OLDVAL. If ENV is dyn-bind or dyn-unbind, you can block
+the change of value, but you can't prevent the corresponding creation or
+destruction of a dynamic environment. Therefore, blocking when ENV is
+dyn-bind will set SYMBOL in the new environment to its value in the outer
+environment, and blocking when ENV is dyn-unbind will set SYMBOL in the
+outer environment to its value in the environment being destroyed.
+
+Don't set the variable in your advice; that would cause a recursive call
+to this function. Instead, if your advice needs to set the variable, use
+`add-function' with overriding advice.
+
+To hook all variables of a symbol, use `symbol-hook'. To unhook them,
+use `symbol-unhook'. If you only want to watch or override some variables
+of a symbol, then filter according to ENV, and if you use overriding advice,
+simply return NEWVAL for the ones you don't want to process.  */);
+  Vsymbol_setter_function = Qnil; /* Set in subr.el */
+
   /* When lexical binding is being used,
    Vinternal_interpreter_environment is non-nil, and contains an alist
    of lexically-bound variable, or (t), indicating an empty
--- src/data.c
+++ src/data.c
@@ -612,6 +613,20 @@
 \f
 /* Extract and set components of symbols.  */
 
+DEFUN ("symbol-hooked-p", Fsymbol_hooked_p, Ssymbol_hooked_p, 1, 1, 0,
+       doc: /* Return t if SYMBOL is hooked.
+To hook and unhook it, use `symbol-hook' and `symbol-unhook'.
+When hooked, setting SYMBOL will run `symbol-setter-function'.  */)
+  (register Lisp_Object symbol)
+{
+  struct Lisp_Symbol *sym;
+  CHECK_SYMBOL (symbol);
+  sym = XSYMBOL (symbol);
+  while (sym->redirect == SYMBOL_VARALIAS)
+    sym = indirect_variable (sym);
+  return SYM_HOOKED_P (sym) ? Qt : Qnil;
+}
+
 DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0,
        doc: /* Return t if SYMBOL's value is not void.
 Note that if `lexical-binding' is in effect, this refers to the
@@ -661,6 +676,46 @@
   return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
 }
 
+DEFUN ("symbol-hook", Fsymbol_hook, Ssymbol_hook, 1, 1, 0,
+       doc: /* Hook SYMBOL.
+When hooked, setting it will run `symbol-setter-function'.
+To unhook it, use `symbol-unhook'.
+To test whether it's hooked, use `symbol-hooked-p'.
+Return SYMBOL.  */)
+  (register Lisp_Object symbol)
+{
+  struct Lisp_Symbol *sym;
+  CHECK_SYMBOL (symbol);
+  sym = XSYMBOL (symbol);
+  sym->vetted |= SYM_HOOKED;
+  while (sym->redirect == SYMBOL_VARALIAS)
+    {
+      sym = indirect_variable (sym);
+      sym->vetted |= SYM_HOOKED;
+    }
+  return symbol;
+}
+
+DEFUN ("symbol-unhook", Fsymbol_unhook, Ssymbol_unhook, 1, 1, 0,
+       doc: /* Unhook SYMBOL.
+When unhooked, setting it will not run `symbol-setter-function'.
+To hook it, use `symbol-hook'.
+To test whether it's hooked, use `symbol-hooked-p'.
+Return SYMBOL.  */)
+  (register Lisp_Object symbol)
+{
+  struct Lisp_Symbol *sym;
+  CHECK_SYMBOL (symbol);
+  sym = XSYMBOL (symbol);
+  sym->vetted &= (SYM_HOOKED ^ -1);
+  while (sym->redirect == SYMBOL_VARALIAS)
+    {
+      sym = indirect_variable (sym);
+      sym->vetted &= (SYM_HOOKED ^ -1);
+    }
+  return symbol;
+}
+
 DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
        doc: /* Make SYMBOL's value be void.
 Return SYMBOL.  */)
@@ -1137,8 +1192,8 @@
  start:
   switch (sym->redirect)
     {
-    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
+    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_LOCALIZED:
       {
 	struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
@@ -1167,54 +1222,112 @@
   xsignal1 (Qvoid_variable, symbol);
 }
 
+/* For the symbol S being set, run symbol-setter-function with these arguments:
+   0. S
+   1. A symbol indicating the environment in which S is being set.
+   2. The current value of S in that environment.
+   3. The value to which the setter is attempting to set the variable.
+
+   Arguments #2 and #3 are wrapped into singleton lists, unless they're
+   Qunbound, in which case they're replaced by nil.
+
+   Return the unwrapped result of symbol-setter-function. The variable will be
+   set (by code that calls run_varhook) to that result, overriding the value
+   to which the setter is attempting to set the variable.  */
+
+Lisp_Object
+run_varhook (struct Lisp_Symbol* sym, bool buf_local, Dyn_Bind_Env rawenv,
+	     Lisp_Object oldval, Lisp_Object newval)
+{
+  Lisp_Object symbol;
+  Lisp_Object env;
+  if (rawenv == Dyn_Skip) /* From backtrace_eval_unrewind */
+    return newval;
+  XSETSYMBOL (symbol, sym);
+  switch (rawenv) /* Disambiguate Dyn_Current and Dyn_Global */
+    {
+    case Dyn_Current:
+      {
+	bool shadowed = (buf_local ? let_shadows_buffer_binding_p (sym)
+                         : let_shadows_global_binding_p (symbol));
+	if (shadowed) env = Qdyn_local;
+	else if (buf_local) env = Qbuf_local;
+	else env = Qglobal;
+	break;
+      }
+    case Dyn_Global:
+      {
+	/* let_shadows_buffer_binding_p doesn't disambiguate this case */
+	if (let_shadows_global_binding_p (symbol) &&
+	    NILP (Flocal_variable_p (symbol, Qnil)))
+	  env = Qdyn_local;
+	else env = Qglobal;
+	break;
+      }
+    case Dyn_Bind: env = Qdyn_bind; break;
+    case Dyn_Unbind: env = Qdyn_unbind; break;
+    default: emacs_abort ();
+    }
+  oldval = EQ (oldval, Qunbound) ? Qnil : list1 (oldval);
+  newval = EQ (newval, Qunbound) ? Qnil : list1 (newval);
+  newval = call4 (Vsymbol_setter_function, symbol, env, oldval, newval);
+  CHECK_LIST (newval);
+  return EQ (newval, Qnil) ? Qunbound : XCAR (newval);
+}
+
 DEFUN ("set", Fset, Sset, 2, 2, 0,
        doc: /* Set SYMBOL's value to NEWVAL, and return NEWVAL.  */)
   (register Lisp_Object symbol, Lisp_Object newval)
 {
-  set_internal (symbol, newval, Qnil, 0);
+  set_internal (symbol, newval, Qnil, false, Dyn_Current);
   return newval;
 }
 
-/* Store the value NEWVAL into SYMBOL.
-   If buffer/frame-locality is an issue, WHERE specifies which context to use.
-   (nil stands for the current buffer/frame).
-
-   If BINDFLAG is false, then if this symbol is supposed to become
-   local in every buffer where it is set, then we make it local.
-   If BINDFLAG is true, we don't do that.  */
+/* set_internal is in lisp.h due to being inlined.  */
+
+/* Factored out from set_internal to avoid inlining the non-hotpath.  */
 
 void
-set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
-	      bool bindflag)
+set_internal_vetted (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
+			     bool bindflag, Dyn_Bind_Env env, struct Lisp_Symbol *sym)
 {
-  bool voide = EQ (newval, Qunbound);
-  struct Lisp_Symbol *sym;
-  Lisp_Object tem1;
-
-  /* If restoring in a dead buffer, do nothing.  */
-  /* if (BUFFERP (where) && NILP (XBUFFER (where)->name))
-      return; */
-
-  CHECK_SYMBOL (symbol);
-  if (SYMBOL_CONSTANT_P (symbol))
+  if (SYM_HOOKED_P (sym))
     {
+    start:
+      switch (sym->redirect)
+	{
+	case SYMBOL_PLAINVAL:
+	  SET_SYMBOL_VAL (sym, run_varhook (sym, false, env, sym->val.value, newval));
+	  return;
+	case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
+	default:
+	  set_internal_localized_or_forwarded (symbol, newval, where, bindflag, env, sym);
+	  return;
+	}
+    }
       if (NILP (Fkeywordp (symbol))
 	  || !EQ (newval, Fsymbol_value (symbol)))
 	xsignal1 (Qsetting_constant, symbol);
       else
 	/* Allow setting keywords to their own value.  */
 	return;
-    }
+}
 
-  sym = XSYMBOL (symbol);
+/* Split from set_internal to avoid code duplication, because both set_internal and
+   set_internal_vetted must call this function.  */
 
- start:
+void
+set_internal_localized_or_forwarded (Lisp_Object symbol, Lisp_Object newval,
+				     Lisp_Object where, bool bindflag,
+				     Dyn_Bind_Env env, struct Lisp_Symbol *sym)
+{
+  bool voide;
+  Lisp_Object tem1;
   switch (sym->redirect)
     {
-    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
-    case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
     case SYMBOL_LOCALIZED:
       {
+	bool buf_local = true;
 	struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
 	if (NILP (where))
 	  {
@@ -1258,6 +1371,7 @@
 		   indicating that we're seeing the default value.
 		   Likewise if the variable has been let-bound
 		   in the current buffer.  */
+		buf_local = false;
 		if (bindflag || !blv->local_if_set
 		    || let_shadows_buffer_binding_p (sym))
 		  {
@@ -1285,6 +1399,9 @@
 	    set_blv_valcell (blv, tem1);
 	  }
 
+	MAYBE_RUN_VARHOOK (newval, sym, buf_local, env, blv_value (blv), newval);
+	voide = EQ (newval, Qunbound);
+
 	/* Store the new value in the cons cell.  */
 	set_blv_value (blv, newval);
 
@@ -1316,6 +1433,11 @@
 	      SET_PER_BUFFER_VALUE_P (buf, idx, 1);
 	  }
 
+	MAYBE_RUN_VARHOOK (newval, sym,
+			   (XFWDTYPE (innercontents)) == Lisp_Fwd_Buffer_Obj,
+			   env, do_symval_forwarding (innercontents), newval);
+	voide = EQ (newval, Qunbound);
+
 	if (voide)
 	  { /* If storing void (making the symbol void), forward only through
 	       buffer-local indicator, not through Lisp_Objfwd, etc.  */
@@ -1347,8 +1469,8 @@
  start:
   switch (sym->redirect)
     {
-    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
+    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
     case SYMBOL_LOCALIZED:
       {
 	/* If var is set up for a buffer that lacks a local value for it,
@@ -1413,6 +1535,17 @@
 for this variable.  */)
   (Lisp_Object symbol, Lisp_Object value)
 {
+  set_default_internal (symbol, value, Dyn_Global);
+  return value;
+}
+
+/* Like Fset_default, but with ENV argument. See set_internal for
+   a description of this argument. */
+
+void
+set_default_internal (Lisp_Object symbol, Lisp_Object value,
+		      Dyn_Bind_Env env)
+{
   struct Lisp_Symbol *sym;
 
   CHECK_SYMBOL (symbol);
@@ -1423,26 +1556,32 @@
 	xsignal1 (Qsetting_constant, symbol);
       else
 	/* Allow setting keywords to their own value.  */
-	return value;
+	return;
     }
   sym = XSYMBOL (symbol);
 
  start:
   switch (sym->redirect)
     {
+    case SYMBOL_PLAINVAL:
+      {
+	set_internal (symbol, value, Qnil, false, env);
+	return;
+      }
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
-    case SYMBOL_PLAINVAL: return Fset (symbol, value);
     case SYMBOL_LOCALIZED:
       {
 	struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
 
+	MAYBE_RUN_VARHOOK (value, sym, false, env, XCDR (blv->defcell), value);
+
 	/* Store new value into the DEFAULT-VALUE slot.  */
 	XSETCDR (blv->defcell, value);
 
 	/* If the default binding is now loaded, set the REALVALUE slot too.  */
 	if (blv->fwd && EQ (blv->defcell, blv->valcell))
 	  store_symval_forwarding (blv->fwd, value, NULL);
-	return value;
+	return;
       }
     case SYMBOL_FORWARDED:
       {
@@ -1456,6 +1595,8 @@
 	    int offset = XBUFFER_OBJFWD (valcontents)->offset;
 	    int idx = PER_BUFFER_IDX (offset);
 
+	    MAYBE_RUN_VARHOOK (value, sym, false, env, per_buffer_default (offset), value);
+
 	    set_per_buffer_default (offset, value);
 
 	    /* If this variable is not always local in all buffers,
@@ -1468,10 +1609,13 @@
 		  if (!PER_BUFFER_VALUE_P (b, idx))
 		    set_per_buffer_value (b, offset, value);
 	      }
-	    return value;
+	    return;
 	  }
 	else
-	  return Fset (symbol, value);
+	  {
+	    set_internal (symbol, value, Qnil, false, env);
+	    return;
+	  }
       }
     default: emacs_abort ();
     }
@@ -1599,7 +1743,7 @@
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYM_CONST_P (sym))
     error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
 
   if (!blv)
@@ -1672,7 +1816,7 @@
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYM_CONST_P (sym))
     error ("Symbol %s may not be buffer-local",
 	   SDATA (SYMBOL_NAME (variable)));
 
@@ -1861,7 +2005,7 @@
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYM_CONST_P (sym))
     error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
 
   blv = make_blv (sym, forwarded, valcontents);
@@ -3470,6 +3614,12 @@
   DEFSYM (Qad_advice_info, "ad-advice-info");
   DEFSYM (Qad_activate_internal, "ad-activate-internal");
 
+  DEFSYM (Qglobal, "global");
+  DEFSYM (Qbuf_local, "buf-local");
+  DEFSYM (Qdyn_local, "dyn-local");
+  DEFSYM (Qdyn_bind, "dyn-bind");
+  DEFSYM (Qdyn_unbind, "dyn-unbind");
+
   error_tail = pure_cons (Qerror, Qnil);
 
   /* ERROR is used as a signaler for random errors for which nothing else is
@@ -3609,8 +3759,11 @@
   defsubr (&Sindirect_function);
   defsubr (&Ssymbol_plist);
   defsubr (&Ssymbol_name);
+  defsubr (&Ssymbol_hook);
+  defsubr (&Ssymbol_unhook);
   defsubr (&Smakunbound);
   defsubr (&Sfmakunbound);
+  defsubr (&Ssymbol_hooked_p);
   defsubr (&Sboundp);
   defsubr (&Sfboundp);
   defsubr (&Sfset);
@@ -3678,10 +3831,10 @@
   DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,
 	       doc: /* The largest value that is representable in a Lisp integer.  */);
   Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM);
-  XSYMBOL (intern_c_string ("most-positive-fixnum"))->constant = 1;
+  XSYMBOL (intern_c_string ("most-positive-fixnum"))->vetted = SYM_CONST;
 
   DEFVAR_LISP ("most-negative-fixnum", Vmost_negative_fixnum,
 	       doc: /* The smallest value that is representable in a Lisp integer.  */);
   Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
-  XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1;
+  XSYMBOL (intern_c_string ("most-negative-fixnum"))->vetted = SYM_CONST;
 }
--- src/alloc.c
+++ src/alloc.c
@@ -3390,7 +3390,7 @@
   set_symbol_next (val, NULL);
   p->gcmarkbit = false;
   p->interned = SYMBOL_UNINTERNED;
-  p->constant = 0;
+  p->vetted = 0;
   p->declared_special = false;
   p->pinned = false;
   consing_since_gc += sizeof (struct Lisp_Symbol);
--- src/lread.c
+++ src/lread.c
@@ -3821,7 +3821,7 @@
   if ((SREF (string, 0) == ':')
       && EQ (obarray, initial_obarray))
     {
-      XSYMBOL (sym)->constant = 1;
+      XSYMBOL (sym)->vetted = SYM_CONST;
       XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
       SET_SYMBOL_VAL (XSYMBOL (sym), sym);
     }
@@ -4042,7 +4042,7 @@
   set_symbol_function (Qunbound, Qnil);
   set_symbol_plist (Qunbound, Qnil);
   SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
-  XSYMBOL (Qnil)->constant = 1;
+  XSYMBOL (Qnil)->vetted = SYM_CONST;
   XSYMBOL (Qnil)->declared_special = true;
   set_symbol_plist (Qnil, Qnil);
   set_symbol_function (Qnil, Qnil);
@@ -4050,7 +4050,7 @@
 
   Qt = intern_c_string ("t");
   SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
-  XSYMBOL (Qt)->constant = 1;
+  XSYMBOL (Qt)->vetted = SYM_CONST;
   XSYMBOL (Qt)->declared_special = true;
 
   /* Qt is correct even if CANNOT_DUMP.  loadup.el will set to nil at end.  */
--- src/buffer.c
+++ src/buffer.c
@@ -5753,7 +5753,7 @@
 This variable is buffer-local but you cannot set it directly;
 use the function `set-buffer-multibyte' to change a buffer's representation.
 See also Info node `(elisp)Text Representations'.  */);
-  XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1;
+  XSYMBOL (intern_c_string ("enable-multibyte-characters"))->vetted = SYM_CONST;
 
   DEFVAR_PER_BUFFER ("buffer-file-coding-system",
 		     &BVAR (current_buffer, buffer_file_coding_system), Qnil,
--- src/bytecode.c
+++ src/bytecode.c
@@ -840,7 +840,7 @@
 	    else
 	      {
 		BEFORE_POTENTIAL_GC ();
-		set_internal (sym, val, Qnil, 0);
+		set_internal (sym, val, Qnil, false, Dyn_Current);
 		AFTER_POTENTIAL_GC ();
 	      }
 	  }
--- src/font.c
+++ src/font.c
@@ -5197,19 +5197,19 @@
     [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
   Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
-  XSYMBOL (intern_c_string ("font-weight-table"))->constant = 1;
+  XSYMBOL (intern_c_string ("font-weight-table"))->vetted = SYM_CONST;
 
   DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table,
 	       doc: /*  Vector of font slant symbols vs the corresponding numeric values.
 See `font-weight-table' for the format of the vector. */);
   Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
-  XSYMBOL (intern_c_string ("font-slant-table"))->constant = 1;
+  XSYMBOL (intern_c_string ("font-slant-table"))->vetted = SYM_CONST;
 
   DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table,
 	       doc: /*  Alist of font width symbols vs the corresponding numeric values.
 See `font-weight-table' for the format of the vector. */);
   Vfont_width_table = BUILD_STYLE_TABLE (width_table);
-  XSYMBOL (intern_c_string ("font-width-table"))->constant = 1;
+  XSYMBOL (intern_c_string ("font-width-table"))->vetted = SYM_CONST;
 
   staticpro (&font_style_table);
   font_style_table = make_uninit_vector (3);
--- lisp/subr.el
+++ lisp/subr.el
@@ -2507,6 +2507,9 @@
 Note that this should end with a directory separator.
 See also `locate-user-emacs-file'.")
 \f
+(setq symbol-setter-function ; Defined in eval.c
+      (lambda (_sym _env _oldval newval) newval))
+\f
 ;;;; Misc. useful functions.
 
 (defsubst buffer-narrowed-p ()