Add lisp watchpoints

This allows calling a function whenever a symbol-value is changed.

* src/lisp.h (lisp_h_SYMBOL_TRAPPED_WRITE_P):
(SYMBOL_TRAPPED_WRITE_P): New function/macro.
(lisp_h_SYMBOL_CONSTANT_P): Check for SYMBOL_NOWRITE specifically.
(enum symbol_trapped_write): New enumeration.
(struct Lisp_Symbol): Rename field constant to trapped_write.
(make_symbol_constant): New function.

* src/data.c (Fadd_variable_watcher, Fremove_variable_watcher):
(set_symbol_trapped_write, restore_symbol_trapped_write):
(harmonize_variable_watchers, notify_variable_watchers): New functions.

* src/data.c (Fset_default): Call `notify_variable_watchers' for trapped
symbols.
(set_internal): Change bool argument BIND to 3-value enum and call
`notify_variable_watchers' for trapped symbols.

* src/data.c (syms_of_data):
* src/data.c (syms_of_data):
* src/font.c (syms_of_font):
* src/lread.c (intern_sym, init_obarray):
* src/buffer.c (syms_of_buffer): Use make_symbol_constant.

* src/alloc.c (init_symbol):
* src/bytecode.c (exec_byte_code): Use SYMBOL_TRAPPED_WRITE_P.
* src/data.c (Fmake_variable_buffer_local, Fmake_local_variable):
(Fmake_variable_frame_local):
* src/eval.c (Fdefvaralias, specbind): Refer to Lisp_Symbol's
trapped_write instead of constant.
(Ffuncall): Move subr calling code into separate function.
(funcall_subr): New function.

8 files changed, 378 insertions, 173 deletions

diff --git a/src/alloc.c b/src/alloc.c
index ae32400708a..6eced7bab18 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3567,7 +3567,7 @@ init_symbol (Lisp_Object val, Lisp_Object name)
   set_symbol_next (val, NULL);
   p->gcmarkbit = false;
   p->interned = SYMBOL_UNINTERNED;
-  p->constant = 0;
+  p->trapped_write = SYMBOL_UNTRAPPED_WRITE;
   p->declared_special = false;
   p->pinned = false;
 }
diff --git a/src/buffer.c b/src/buffer.c
index aa556b75bc6..6815aa7f7ed 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -984,40 +984,54 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
     bset_local_var_alist (b, Qnil);
   else
     {
-      Lisp_Object tmp, prop, last = Qnil;
+      Lisp_Object tmp, last = Qnil;
       for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp))
-        if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
-          {
-            /* If permanent-local, keep it.  */
-            last = tmp;
-            if (EQ (prop, Qpermanent_local_hook))
-              {
-                /* This is a partially permanent hook variable.
-                   Preserve only the elements that want to be preserved.  */
-                Lisp_Object list, newlist;
-                list = XCDR (XCAR (tmp));
-                if (!CONSP (list))
-                  newlist = list;
-                else
-                  for (newlist = Qnil; CONSP (list); list = XCDR (list))
-                    {
-                      Lisp_Object elt = XCAR (list);
-                      /* Preserve element ELT if it's t,
-                         if it is a function with a `permanent-local-hook' property,
-                         or if it's not a symbol.  */
-                      if (! SYMBOLP (elt)
-                          || EQ (elt, Qt)
-                          || !NILP (Fget (elt, Qpermanent_local_hook)))
-                        newlist = Fcons (elt, newlist);
-                    }
-                XSETCDR (XCAR (tmp), Fnreverse (newlist));
-              }
-          }
-        /* Delete this local variable.  */
-        else if (NILP (last))
-          bset_local_var_alist (b, XCDR (tmp));
-        else
-          XSETCDR (last, XCDR (tmp));
+        {
+          Lisp_Object local_var = XCAR (XCAR (tmp));
+          Lisp_Object prop = Fget (local_var, Qpermanent_local);
+
+          if (!NILP (prop))
+            {
+              /* If permanent-local, keep it.  */
+              last = tmp;
+              if (EQ (prop, Qpermanent_local_hook))
+                {
+                  /* This is a partially permanent hook variable.
+                     Preserve only the elements that want to be preserved.  */
+                  Lisp_Object list, newlist;
+                  list = XCDR (XCAR (tmp));
+                  if (!CONSP (list))
+                    newlist = list;
+                  else
+                    for (newlist = Qnil; CONSP (list); list = XCDR (list))
+                      {
+                        Lisp_Object elt = XCAR (list);
+                        /* Preserve element ELT if it's t,
+                           if it is a function with a `permanent-local-hook' property,
+                           or if it's not a symbol.  */
+                        if (! SYMBOLP (elt)
+                            || EQ (elt, Qt)
+                            || !NILP (Fget (elt, Qpermanent_local_hook)))
+                          newlist = Fcons (elt, newlist);
+                      }
+                  newlist = Fnreverse (newlist);
+                  if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE)
+                    notify_variable_watchers (local_var, newlist,
+                                              Qmakunbound, Fcurrent_buffer ());
+                  XSETCDR (XCAR (tmp), newlist);
+                  continue; /* Don't do variable write trapping twice.  */
+                }
+            }
+          /* Delete this local variable.  */
+          else if (NILP (last))
+            bset_local_var_alist (b, XCDR (tmp));
+          else
+            XSETCDR (last, XCDR (tmp));
+
+          if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE)
+            notify_variable_watchers (local_var, Qnil,
+                                      Qmakunbound, Fcurrent_buffer ());
+        }
     }
 
   for (i = 0; i < last_per_buffer_idx; ++i)
@@ -5541,7 +5555,7 @@ file I/O and the behavior of various editing commands.
 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;
+  make_symbol_constant (intern_c_string ("enable-multibyte-characters"));
 
   DEFVAR_PER_BUFFER ("buffer-file-coding-system",
                      &BVAR (current_buffer, buffer_file_coding_system), Qnil,
diff --git a/src/bytecode.c b/src/bytecode.c
index be39a81c5e9..868c0148d30 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -569,10 +569,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
             if (SYMBOLP (sym)
                 && !EQ (val, Qunbound)
                 && !XSYMBOL (sym)->redirect
-                && !SYMBOL_CONSTANT_P (sym))
+                && !SYMBOL_TRAPPED_WRITE_P (sym))
               SET_SYMBOL_VAL (XSYMBOL (sym), val);
             else
-              set_internal (sym, val, Qnil, false);
+              set_internal (sym, val, Qnil, SET_INTERNAL_SET);
           }
           NEXT;
 
diff --git a/src/data.c b/src/data.c
index 61b5da8b5b6..07730d0924f 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1225,7 +1225,7 @@ 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, SET_INTERNAL_SET);
   return newval;
 }
 
@@ -1233,13 +1233,14 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
    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.  */
+   If BINDFLAG is SET_INTERNAL_SET, then if this symbol is supposed to
+   become local in every buffer where it is set, then we make it
+   local.  If BINDFLAG is SET_INTERNAL_BIND or SET_INTERNAL_UNBIND, we
+   don't do that.  */
 
 void
 set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
-              bool bindflag)
+              enum Set_Internal_Bind bindflag)
 {
   bool voide = EQ (newval, Qunbound);
   struct Lisp_Symbol *sym;
@@ -1250,18 +1251,31 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
       return; */
 
   CHECK_SYMBOL (symbol);
-  if (SYMBOL_CONSTANT_P (symbol))
+  sym = XSYMBOL (symbol);
+  switch (sym->trapped_write)
     {
+    case SYMBOL_NOWRITE:
       if (NILP (Fkeywordp (symbol))
-          || !EQ (newval, Fsymbol_value (symbol)))
-        xsignal1 (Qsetting_constant, symbol);
+          || !EQ (newval, Fsymbol_value (symbol)))
+        xsignal1 (Qsetting_constant, symbol);
       else
-        /* Allow setting keywords to their own value.  */
-        return;
+        /* Allow setting keywords to their own value.  */
+        return;
+
+    case SYMBOL_TRAPPED_WRITE:
+      notify_variable_watchers (symbol, voide? Qnil : newval,
+                                (bindflag == SET_INTERNAL_BIND? Qlet :
+                                 bindflag == SET_INTERNAL_UNBIND? Qunlet :
+                                 voide? Qmakunbound : Qset),
+                                where);
+      /* FALLTHROUGH!  */
+    case SYMBOL_UNTRAPPED_WRITE:
+        break;
+
+    default: emacs_abort ();
     }
 
   maybe_set_redisplay (symbol);
-  sym = XSYMBOL (symbol);
 
  start:
   switch (sym->redirect)
@@ -1385,6 +1399,111 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
     }
   return;
 }
+
+static void
+set_symbol_trapped_write (Lisp_Object symbol, enum symbol_trapped_write trap)
+{
+  struct Lisp_Symbol* sym = XSYMBOL (symbol);
+  if (sym->trapped_write == SYMBOL_NOWRITE)
+    xsignal1 (Qtrapping_constant, symbol);
+  else if (sym->redirect == SYMBOL_LOCALIZED
+           && SYMBOL_BLV (sym)->frame_local)
+    xsignal1 (Qtrapping_frame_local, symbol);
+  sym->trapped_write = trap;
+}
+
+static void
+restore_symbol_trapped_write (Lisp_Object symbol)
+{
+  set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE);
+}
+
+static void
+harmonize_variable_watchers (Lisp_Object alias, Lisp_Object base_variable)
+{
+  if (!EQ (base_variable, alias)
+      && EQ (base_variable, Findirect_variable (alias)))
+    set_symbol_trapped_write
+      (alias, XSYMBOL (base_variable)->trapped_write);
+}
+
+DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher,
+       2, 2, 0,
+       doc: /* Cause WATCH-FUNCTION to be called when SYMBOL is set.
+All writes to aliases of SYMBOL will call WATCH-FUNCTION too.  */)
+  (Lisp_Object symbol, Lisp_Object watch_function)
+{
+  symbol = Findirect_variable (symbol);
+  set_symbol_trapped_write (symbol, SYMBOL_TRAPPED_WRITE);
+  map_obarray (Vobarray, harmonize_variable_watchers, symbol);
+
+  Lisp_Object watchers = Fget (symbol, Qwatchers);
+  Lisp_Object member = Fmember (watch_function, watchers);
+  if (NILP (member))
+    Fput (symbol, Qwatchers, Fcons (watch_function, watchers));
+  return Qnil;
+}
+
+DEFUN ("remove-variable-watcher", Fremove_variable_watcher, Sremove_variable_watcher,
+       2, 2, 0,
+       doc: /* Undo the effect of `add-variable-watcher'.
+Remove WATCH-FUNCTION from the list of functions to be called when
+SYMBOL (or its aliases) are set.  */)
+  (Lisp_Object symbol, Lisp_Object watch_function)
+{
+  symbol = Findirect_variable (symbol);
+  Lisp_Object watchers = Fget (symbol, Qwatchers);
+  watchers = Fdelete (watch_function, watchers);
+  if (NILP (watchers))
+    {
+      set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE);
+      map_obarray (Vobarray, harmonize_variable_watchers, symbol);
+    }
+  Fput (symbol, Qwatchers, watchers);
+  return Qnil;
+}
+
+void
+notify_variable_watchers (Lisp_Object symbol,
+                          Lisp_Object newval,
+                          Lisp_Object operation,
+                          Lisp_Object where)
+{
+  symbol = Findirect_variable (symbol);
+
+  ptrdiff_t count = SPECPDL_INDEX ();
+  record_unwind_protect (restore_symbol_trapped_write, symbol);
+  /* Avoid recursion.  */
+  set_symbol_trapped_write (symbol, SYMBOL_UNTRAPPED_WRITE);
+
+  if (NILP (where)
+      && !EQ (operation, Qset_default) && !EQ (operation, Qmakunbound)
+      && !NILP (Flocal_variable_if_set_p (symbol, Fcurrent_buffer ())))
+    {
+      XSETBUFFER (where, current_buffer);
+    }
+
+  if (EQ (operation, Qset_default))
+    operation = Qset;
+
+  for (Lisp_Object watchers = Fget (symbol, Qwatchers);
+       CONSP (watchers);
+       watchers = XCDR (watchers))
+    {
+      Lisp_Object watcher = XCAR (watchers);
+      /* Call subr directly to avoid gc.  */
+      if (SUBRP (watcher))
+        {
+          Lisp_Object args[] = { symbol, newval, operation, where };
+          funcall_subr (XSUBR (watcher), ARRAYELTS (args), args);
+        }
+      else
+        CALLN (Ffuncall, watcher, symbol, newval, operation, where);
+    }
+
+  unbind_to (count, Qnil);
+}
+
 
 /* Access or set a buffer-local symbol's default value.  */
 
@@ -1471,16 +1590,27 @@ for this variable.  */)
   struct Lisp_Symbol *sym;
 
   CHECK_SYMBOL (symbol);
-  if (SYMBOL_CONSTANT_P (symbol))
+  sym = XSYMBOL (symbol);
+  switch (sym->trapped_write)
     {
+    case SYMBOL_NOWRITE:
       if (NILP (Fkeywordp (symbol))
-          || !EQ (value, Fdefault_value (symbol)))
-        xsignal1 (Qsetting_constant, symbol);
+          || !EQ (value, Fsymbol_value (symbol)))
+        xsignal1 (Qsetting_constant, symbol);
       else
-        /* Allow setting keywords to their own value.  */
-        return value;
+        /* Allow setting keywords to their own value.  */
+        return value;
+
+    case SYMBOL_TRAPPED_WRITE:
+      /* Don't notify here if we're going to call Fset anyway.  */
+      if (sym->redirect != SYMBOL_PLAINVAL)
+        notify_variable_watchers (symbol, value, Qset_default, Qnil);
+      /* FALLTHROUGH!  */
+    case SYMBOL_UNTRAPPED_WRITE:
+        break;
+
+    default: emacs_abort ();
     }
-  sym = XSYMBOL (symbol);
 
  start:
   switch (sym->redirect)
@@ -1651,7 +1781,7 @@ The function `default-value' gets the default value and `set-default' sets it.
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYMBOL_CONSTANT_P (variable))
     error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
 
   if (!blv)
@@ -1726,7 +1856,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument.  */)
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (sym->trapped_write == SYMBOL_NOWRITE)
     error ("Symbol %s may not be buffer-local",
            SDATA (SYMBOL_NAME (variable)));
 
@@ -1838,6 +1968,9 @@ From now on the default value will apply in this buffer.  Return VARIABLE.  */)
     default: emacs_abort ();
     }
 
+  if (sym->trapped_write == SYMBOL_TRAPPED_WRITE)
+    notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ());
+
   /* Get rid of this buffer's alist element, if any.  */
   XSETSYMBOL (variable, sym);   /* Propagate variable indirection.  */
   tem = Fassq (variable, BVAR (current_buffer, local_var_alist));
@@ -1920,7 +2053,7 @@ frame-local bindings).  */)
     default: emacs_abort ();
     }
 
-  if (sym->constant)
+  if (SYMBOL_TRAPPED_WRITE_P (variable))
     error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
 
   blv = make_blv (sym, forwarded, valcontents);
@@ -3465,6 +3598,8 @@ syms_of_data (void)
   DEFSYM (Qcyclic_variable_indirection, "cyclic-variable-indirection");
   DEFSYM (Qvoid_variable, "void-variable");
   DEFSYM (Qsetting_constant, "setting-constant");
+  DEFSYM (Qtrapping_constant, "trapping-constant");
+  DEFSYM (Qtrapping_frame_local, "trapping-frame-local");
   DEFSYM (Qinvalid_read_syntax, "invalid-read-syntax");
 
   DEFSYM (Qinvalid_function, "invalid-function");
@@ -3543,6 +3678,10 @@ syms_of_data (void)
   PUT_ERROR (Qvoid_variable, error_tail, "Symbol's value as variable is void");
   PUT_ERROR (Qsetting_constant, error_tail,
              "Attempt to set a constant symbol");
+  PUT_ERROR (Qtrapping_constant, error_tail,
+             "Attempt to trap writes to a constant symbol");
+  PUT_ERROR (Qtrapping_frame_local, error_tail,
+             "Attempt to trap writes to a frame local variable");
   PUT_ERROR (Qinvalid_read_syntax, error_tail, "Invalid read syntax");
   PUT_ERROR (Qinvalid_function, error_tail, "Invalid function");
   PUT_ERROR (Qwrong_number_of_arguments, error_tail,
@@ -3721,10 +3860,18 @@ syms_of_data (void)
   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;
+  make_symbol_constant (intern_c_string ("most-positive-fixnum"));
 
   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;
+  make_symbol_constant (intern_c_string ("most-negative-fixnum"));
+
+  DEFSYM (Qwatchers, "watchers");
+  DEFSYM (Qmakunbound, "makunbound");
+  DEFSYM (Qunlet, "unlet");
+  DEFSYM (Qset, "set");
+  DEFSYM (Qset_default, "set-default");
+  defsubr (&Sadd_variable_watcher);
+  defsubr (&Sremove_variable_watcher);
 }
diff --git a/src/eval.c b/src/eval.c
index bbc1518be54..724f0018a58 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -593,12 +593,12 @@ The return value is BASE-VARIABLE.  */)
   CHECK_SYMBOL (new_alias);
   CHECK_SYMBOL (base_variable);
 
-  sym = XSYMBOL (new_alias);
-
-  if (sym->constant)
-    /* Not sure why, but why not?  */
+  if (SYMBOL_CONSTANT_P (new_alias))
+    /* Making it an alias effectively changes its value.  */
     error ("Cannot make a constant an alias");
 
+  sym = XSYMBOL (new_alias);
+
   switch (sym->redirect)
     {
     case SYMBOL_FORWARDED:
@@ -617,8 +617,8 @@ The return value is BASE-VARIABLE.  */)
      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, SET_INTERNAL_BIND);
   {
     union specbinding *p;
 
@@ -628,11 +628,14 @@ The return value is BASE-VARIABLE.  */)
         error ("Don't know how to make a let-bound variable an alias");
   }
 
+  if (sym->trapped_write == SYMBOL_TRAPPED_WRITE)
+    notify_variable_watchers (new_alias, base_variable, Qdefvaralias, Qnil);
+
   sym->declared_special = 1;
   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->trapped_write = XSYMBOL (base_variable)->trapped_write;
   LOADHIST_ATTACH (new_alias);
   /* Even if docstring is nil: remove old docstring.  */
   Fput (new_alias, Qvariable_documentation, docstring);
@@ -2645,9 +2648,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
   Lisp_Object fun, original_fun;
   Lisp_Object funcar;
   ptrdiff_t numargs = nargs - 1;
-  Lisp_Object lisp_numargs;
   Lisp_Object val;
-  Lisp_Object *internal_args;
   ptrdiff_t count;
 
   QUIT;
@@ -2680,86 +2681,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
     fun = indirect_function (fun);
 
   if (SUBRP (fun))
-    {
-      if (numargs < XSUBR (fun)->min_args
-          || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
-        {
-          XSETFASTINT (lisp_numargs, numargs);
-          xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
-        }
-
-      else if (XSUBR (fun)->max_args == UNEVALLED)
-        xsignal1 (Qinvalid_function, original_fun);
-
-      else if (XSUBR (fun)->max_args == MANY)
-        val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
-      else
-        {
-          Lisp_Object internal_argbuf[8];
-          if (XSUBR (fun)->max_args > numargs)
-            {
-              eassert (XSUBR (fun)->max_args <= ARRAYELTS (internal_argbuf));
-              internal_args = internal_argbuf;
-              memcpy (internal_args, args + 1, numargs * word_size);
-              memclear (internal_args + numargs,
-                        (XSUBR (fun)->max_args - numargs) * word_size);
-            }
-          else
-            internal_args = args + 1;
-          switch (XSUBR (fun)->max_args)
-            {
-            case 0:
-              val = (XSUBR (fun)->function.a0 ());
-              break;
-            case 1:
-              val = (XSUBR (fun)->function.a1 (internal_args[0]));
-              break;
-            case 2:
-              val = (XSUBR (fun)->function.a2
-                     (internal_args[0], internal_args[1]));
-              break;
-            case 3:
-              val = (XSUBR (fun)->function.a3
-                     (internal_args[0], internal_args[1], internal_args[2]));
-              break;
-            case 4:
-              val = (XSUBR (fun)->function.a4
-                     (internal_args[0], internal_args[1], internal_args[2],
-                     internal_args[3]));
-              break;
-            case 5:
-              val = (XSUBR (fun)->function.a5
-                     (internal_args[0], internal_args[1], internal_args[2],
-                      internal_args[3], internal_args[4]));
-              break;
-            case 6:
-              val = (XSUBR (fun)->function.a6
-                     (internal_args[0], internal_args[1], internal_args[2],
-                      internal_args[3], internal_args[4], internal_args[5]));
-              break;
-            case 7:
-              val = (XSUBR (fun)->function.a7
-                     (internal_args[0], internal_args[1], internal_args[2],
-                      internal_args[3], internal_args[4], internal_args[5],
-                      internal_args[6]));
-              break;
-
-            case 8:
-              val = (XSUBR (fun)->function.a8
-                     (internal_args[0], internal_args[1], internal_args[2],
-                      internal_args[3], internal_args[4], internal_args[5],
-                      internal_args[6], internal_args[7]));
-              break;
-
-            default:
-
-              /* If a subr takes more than 8 arguments without using MANY
-                 or UNEVALLED, we need to extend this function to support it.
-                 Until this is done, there is no way to call the function.  */
-              emacs_abort ();
-            }
-        }
-    }
+    val = funcall_subr (XSUBR (fun), numargs, args + 1);
   else if (COMPILEDP (fun))
     val = funcall_lambda (fun, numargs, args + 1);
   else
@@ -2791,6 +2713,89 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
   return val;
 }
 
+
+/* Apply a C subroutine SUBR to the NUMARGS evaluated arguments in ARG_VECTOR
+   and return the result of evaluation.  */
+
+Lisp_Object
+funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args)
+{
+  if (numargs < subr->min_args
+      || (subr->max_args >= 0 && subr->max_args < numargs))
+    {
+      Lisp_Object fun;
+      XSETSUBR (fun, subr);
+      xsignal2 (Qwrong_number_of_arguments, fun, make_number (numargs));
+    }
+
+  else if (subr->max_args == UNEVALLED)
+    {
+      Lisp_Object fun;
+      XSETSUBR (fun, subr);
+      xsignal1 (Qinvalid_function, fun);
+    }
+
+  else if (subr->max_args == MANY)
+    return (subr->function.aMANY) (numargs, args);
+  else
+    {
+      Lisp_Object internal_argbuf[8];
+      Lisp_Object *internal_args;
+      if (subr->max_args > numargs)
+        {
+          eassert (subr->max_args <= ARRAYELTS (internal_argbuf));
+          internal_args = internal_argbuf;
+          memcpy (internal_args, args, numargs * word_size);
+          memclear (internal_args + numargs,
+                    (subr->max_args - numargs) * word_size);
+        }
+      else
+        internal_args = args;
+      switch (subr->max_args)
+        {
+        case 0:
+          return (subr->function.a0 ());
+        case 1:
+          return (subr->function.a1 (internal_args[0]));
+        case 2:
+          return (subr->function.a2
+                  (internal_args[0], internal_args[1]));
+        case 3:
+          return (subr->function.a3
+                  (internal_args[0], internal_args[1], internal_args[2]));
+        case 4:
+          return (subr->function.a4
+                  (internal_args[0], internal_args[1], internal_args[2],
+                   internal_args[3]));
+        case 5:
+          return (subr->function.a5
+                  (internal_args[0], internal_args[1], internal_args[2],
+                   internal_args[3], internal_args[4]));
+        case 6:
+          return (subr->function.a6
+                  (internal_args[0], internal_args[1], internal_args[2],
+                   internal_args[3], internal_args[4], internal_args[5]));
+        case 7:
+          return (subr->function.a7
+                  (internal_args[0], internal_args[1], internal_args[2],
+                   internal_args[3], internal_args[4], internal_args[5],
+                   internal_args[6]));
+        case 8:
+          return (subr->function.a8
+                  (internal_args[0], internal_args[1], internal_args[2],
+                   internal_args[3], internal_args[4], internal_args[5],
+                   internal_args[6], internal_args[7]));
+
+        default:
+
+          /* If a subr takes more than 8 arguments without using MANY
+             or UNEVALLED, we need to extend this function to support it.
+             Until this is done, there is no way to call the function.  */
+          emacs_abort ();
+        }
+    }
+}
+
 static Lisp_Object
 apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
 {
@@ -3171,10 +3176,10 @@ specbind (Lisp_Object symbol, Lisp_Object value)
       specpdl_ptr->let.symbol = symbol;
       specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
       grow_specpdl ();
-      if (!sym->constant)
+      if (!sym->trapped_write)
         SET_SYMBOL_VAL (sym, value);
       else
-        set_internal (symbol, value, Qnil, 1);
+        set_internal (symbol, value, Qnil, SET_INTERNAL_BIND);
       break;
     case SYMBOL_LOCALIZED:
       if (SYMBOL_BLV (sym)->frame_local)
@@ -3214,7 +3219,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
           specpdl_ptr->let.kind = SPECPDL_LET;
 
         grow_specpdl ();
-        set_internal (symbol, value, Qnil, 1);
+        set_internal (symbol, value, Qnil, SET_INTERNAL_BIND);
         break;
       }
     default: emacs_abort ();
@@ -3341,14 +3346,16 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
         case SPECPDL_BACKTRACE:
           break;
         case SPECPDL_LET:
-          { /* 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 variable has a trivial value (no forwarding), and
+               isn't trapped, we can just set it.  */
             Lisp_Object sym = specpdl_symbol (specpdl_ptr);
             if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL)
               {
-                SET_SYMBOL_VAL (XSYMBOL (sym),
-                                specpdl_old_value (specpdl_ptr));
+                if (XSYMBOL (sym)->trapped_write == SYMBOL_UNTRAPPED_WRITE)
+                  SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (specpdl_ptr));
+                else
+                  set_internal (sym, specpdl_old_value (specpdl_ptr),
+                                Qnil, SET_INTERNAL_UNBIND);
                 break;
               }
             else
@@ -3371,7 +3378,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
             /* 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, SET_INTERNAL_UNBIND);
           }
           break;
         }
@@ -3596,7 +3603,7 @@ backtrace_eval_unrewind (int distance)
               {
                 set_specpdl_old_value
                   (tmp, Fbuffer_local_value (symbol, where));
-                set_internal (symbol, old_value, where, 1);
+                set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND);
               }
           }
           break;
@@ -3940,6 +3947,7 @@ alist of active lexical bindings.  */);
   defsubr (&Sset_default_toplevel_value);
   defsubr (&Sdefvar);
   defsubr (&Sdefvaralias);
+  DEFSYM (Qdefvaralias, "defvaralias");
   defsubr (&Sdefconst);
   defsubr (&Smake_var_non_special);
   defsubr (&Slet);
diff --git a/src/font.c b/src/font.c
index 9fe7c26ea9c..36e71669453 100644
--- a/src/font.c
+++ b/src/font.c
@@ -5415,19 +5415,19 @@ Each element has the form:
     [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;
+  make_symbol_constant (intern_c_string ("font-weight-table"));
 
   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;
+  make_symbol_constant (intern_c_string ("font-slant-table"));
 
   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;
+  make_symbol_constant (intern_c_string ("font-width-table"));
 
   staticpro (&font_style_table);
   font_style_table = make_uninit_vector (3);
diff --git a/src/lisp.h b/src/lisp.h
index b6c46687b28..94f1152a56e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -320,7 +320,8 @@ error !;
 #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) (XSYMBOL (sym)->trapped_write == SYMBOL_NOWRITE)
+#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->trapped_write)
 #define lisp_h_SYMBOL_VAL(sym) \
    (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
 #define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
@@ -375,6 +376,7 @@ error !;
 # define NILP(x) lisp_h_NILP (x)
 # define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v)
 # define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
+# define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
 # define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
 # define SYMBOLP(x) lisp_h_SYMBOLP (x)
 # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
@@ -600,6 +602,9 @@ extern void char_table_set (Lisp_Object, int, Lisp_Object);
 /* Defined in data.c.  */
 extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
 extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object);
+extern void notify_variable_watchers (Lisp_Object symbol, Lisp_Object newval,
+                                      Lisp_Object operation, Lisp_Object where);
+
 
 #ifdef CANNOT_DUMP
 enum { might_dump = false };
@@ -632,6 +637,13 @@ enum symbol_redirect
   SYMBOL_FORWARDED = 3
 };
 
+enum symbol_trapped_write
+{
+  SYMBOL_UNTRAPPED_WRITE = 0,
+  SYMBOL_NOWRITE = 1,
+  SYMBOL_TRAPPED_WRITE = 2
+};
+
 struct Lisp_Symbol
 {
   bool_bf gcmarkbit : 1;
@@ -643,10 +655,10 @@ struct Lisp_Symbol
      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;
+  /* 0 : normal case, just set the value
+     1 : constant, cannot set, e.g. nil, t, :keywords.
+     2 : trap the write, call watcher functions.  */
+  ENUM_BF (symbol_trapped_write) trapped_write : 2;
 
   /* Interned state of the symbol.  This is an enumerator from
      enum symbol_interned.  */
@@ -1850,9 +1862,20 @@ SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
   return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
 }
 
-/* Value is non-zero if symbol is considered a constant, i.e. its
-   value cannot be changed (there is an exception for keyword symbols,
-   whose value can be set to the keyword symbol itself).  */
+/* Value is non-zero if symbol cannot be changed through a simple set,
+   i.e. it's a constant (e.g. nil, t, :keywords), or it has some
+   watching functions.  */
+
+INLINE int
+(SYMBOL_TRAPPED_WRITE_P) (Lisp_Object sym)
+{
+  return lisp_h_SYMBOL_TRAPPED_WRITE_P (sym);
+}
+
+/* Value is non-zero if symbol cannot be changed at all, i.e. it's a
+   constant (e.g. nil, t, :keywords).  Code that actually wants to
+   write to SYM, should also check whether there are any watching
+   functions.  */
 
 INLINE int
 (SYMBOL_CONSTANT_P) (Lisp_Object sym)
@@ -3286,6 +3309,12 @@ set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
   XSYMBOL (sym)->next = next;
 }
 
+INLINE void
+make_symbol_constant (Lisp_Object sym)
+{
+  XSYMBOL (sym)->trapped_write = SYMBOL_NOWRITE;
+}
+
 /* Buffer-local (also frame-local) variable access functions.  */
 
 INLINE int
@@ -3394,7 +3423,13 @@ extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object);
 extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
                                            Lisp_Object);
 extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
-extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool);
+enum Set_Internal_Bind {
+  SET_INTERNAL_SET,
+  SET_INTERNAL_BIND,
+  SET_INTERNAL_UNBIND
+};
+extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object,
+                          enum Set_Internal_Bind);
 extern void syms_of_data (void);
 extern void swap_in_global_binding (struct Lisp_Symbol *);
 
@@ -3877,6 +3912,7 @@ extern _Noreturn void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object);
 extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object,
                                 Lisp_Object);
 extern _Noreturn void signal_error (const char *, Lisp_Object);
+extern Lisp_Object funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *arg_vector);
 extern Lisp_Object eval_sub (Lisp_Object form);
 extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
 extern Lisp_Object call0 (Lisp_Object);
diff --git a/src/lread.c b/src/lread.c
index eab9b8bea08..14f9393cc47 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3833,7 +3833,7 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
 
   if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
     {
-      XSYMBOL (sym)->constant = 1;
+      make_symbol_constant (sym);
       XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
       SET_SYMBOL_VAL (XSYMBOL (sym), sym);
     }
@@ -4120,12 +4120,12 @@ init_obarray (void)
 
   DEFSYM (Qnil, "nil");
   SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
-  XSYMBOL (Qnil)->constant = 1;
+  make_symbol_constant (Qnil);
   XSYMBOL (Qnil)->declared_special = true;
 
   DEFSYM (Qt, "t");
   SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
-  XSYMBOL (Qt)->constant = 1;
+  make_symbol_constant (Qt);
   XSYMBOL (Qt)->declared_special = true;
 
   /* Qt is correct even if CANNOT_DUMP.  loadup.el will set to nil at end.  */