Enhance struct Lisp_Subr to hold the alternative "BC_" function.scratch/accurate-warning-pos

Also fix a GC bug, where symbols with position were not being disabled.

* src/lisp.h (union Lisp_Function): New type.
(struct Lisp_Subr): Add fields normal_function, BC_function, and next.
(DEFUN): Setup all three function fields to the subr (BC_function is still a
dummy), set field next to NULL.

* src/alloc.c (Fgarbage_collect): Move the binding of
Qsymbols_with_pos_enabled to garbage_collect_1 so that it gets bound when GC
is invoked via garbage_collect.

* src/lread.c (subr_ptr, using_BC_subrs): New static variables.
(Fswitch_to_BC_subrs, Fswitch_to_normal_subrs): New defuns.
(defsubr): Chain new subr to previous using field next and variable subr_ptr.
(init_lread): Initialise subr_ptr to NULL.
(syms_of_lread): Create subrs Sswitch_to_BC_subrs and Sswitch_to_normal_subrs.

* src/pdumper.c (dump_subr): Enhance to dump struct Lisp_Subr's new fields.
Update the expected value of HASH_Lisp_Subr_xxxxxxxxxx.
(dump_vectorlike): Also dump PVEC_SYMBOL_WITH_POSes.

4 files changed, 70 insertions, 13 deletions

diff --git a/src/alloc.c b/src/alloc.c
index 035b45864d9..e14b0d577a8 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6053,12 +6053,17 @@ garbage_collect_1 (struct gcstat *gcst)
   struct timespec start;
   byte_ct tot_before = 0;
 
+  specbind (Qsymbols_with_pos_enabled, Qnil);
+
   eassert (weak_hash_tables == NULL);
 
   /* Can't GC if pure storage overflowed because we can't determine
      if something is a pure object or not.  */
   if (pure_bytes_used_before_overflow)
-    return false;
+    {
+      unbind_to (count, Qnil);
+      return false;
+    }
 
   /* Record this function, so it appears on the profiler's backtraces.  */
   record_in_backtrace (QAutomatic_GC, 0, 0);
@@ -6249,6 +6254,7 @@ garbage_collect_1 (struct gcstat *gcst)
       malloc_probe (min (swept, SIZE_MAX));
     }
 
+  unbind_to (count, Qnil);
   return true;
 }
 
@@ -6276,11 +6282,9 @@ returns nil, because real GC can't be done.
 See Info node `(elisp)Garbage Collection'.  */)
   (void)
 {
-  ptrdiff_t count = SPECPDL_INDEX ();
   struct gcstat gcst;
-  specbind (Qsymbols_with_pos_enabled, Qnil);
   if (!garbage_collect_1 (&gcst))
-    return unbind_to (count, Qnil);
+    return Qnil;
 
   Lisp_Object total[] = {
     list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)),
@@ -6315,7 +6319,7 @@ See Info node `(elisp)Garbage Collection'.  */)
 	   make_int ((mallinfo ().fordblks + 1023) >> 10)),
 #endif
   };
-  return unbind_to (count, CALLMANY (Flist, total));
+  return CALLMANY (Flist, total);
 }
 
 /* Mark Lisp objects in glyph matrix MATRIX.  Currently the
diff --git a/src/lisp.h b/src/lisp.h
index 3324dac98f6..a22043026ad 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2127,10 +2127,7 @@ CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
    It is generated by the DEFUN macro only.
    defsubr makes it into a Lisp object.  */
 
-struct Lisp_Subr
-  {
-    union vectorlike_header header;
-    union {
+union Lisp_Function {
       Lisp_Object (*a0) (void);
       Lisp_Object (*a1) (Lisp_Object);
       Lisp_Object (*a2) (Lisp_Object, Lisp_Object);
@@ -2142,10 +2139,18 @@ struct Lisp_Subr
       Lisp_Object (*a8) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
       Lisp_Object (*aUNEVALLED) (Lisp_Object args);
       Lisp_Object (*aMANY) (ptrdiff_t, Lisp_Object *);
-    } function;
+};
+
+struct Lisp_Subr
+  {
+    union vectorlike_header header;
+    union Lisp_Function function;
+    union Lisp_Function normal_function;
+    union Lisp_Function BC_function;
     short min_args, max_args;
     const char *symbol_name;
     const char *intspec;
+    union Aligned_Lisp_Subr *next;
     EMACS_INT doc;
   } GCALIGNED_STRUCT;
 union Aligned_Lisp_Subr
@@ -3162,7 +3167,11 @@ CHECK_INTEGER (Lisp_Object x)
   static union Aligned_Lisp_Subr sname =                                \
      {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },				\
        { .a ## maxargs = fnname },					\
-       minargs, maxargs, lname, intspec, 0}};				\
+       { .a ## maxargs = fnname },                                      \
+       { .a ## maxargs = /* BC_ ##  */fnname },                               \
+       minargs, maxargs, lname, intspec,                                \
+       NULL,                                                            \
+       0}};                                                             \
    Lisp_Object fnname
 
 /* defsubr (Sname);
diff --git a/src/lread.c b/src/lread.c
index fcee7d4df7e..cc9ee110aec 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4438,6 +4438,40 @@ init_obarray_once (void)
 }
 
 
+static union Aligned_Lisp_Subr *subr_ptr = NULL;
+static bool using_BC_subrs = false;
+
+DEFUN ("switch-to-BC-subrs", Fswitch_to_BC_subrs, Sswitch_to_BC_subrs, 0, 0, 0,
+       doc: /* Switch all subrs to using the byte compiler versions.  */)
+     (void)
+{
+  union Aligned_Lisp_Subr *ptr = subr_ptr;
+  if (!using_BC_subrs)
+    while (ptr)
+      {
+        ptr->s.function = ptr->s.BC_function;
+        ptr = ptr->s.next;
+      }
+  using_BC_subrs = true;
+  return Qnil;
+}
+
+DEFUN ("switch-to-normal-subrs", Fswitch_to_normal_subrs,
+       Sswitch_to_normal_subrs, 0, 0, 0,
+       doc: /* Switch all subrs to using the normal versions.  */)
+     (void)
+{
+  union Aligned_Lisp_Subr *ptr = subr_ptr;
+  if (using_BC_subrs)
+    while (ptr)
+      {
+        ptr->s.function = ptr->s.normal_function;
+        ptr = ptr->s.next;
+      }
+  using_BC_subrs = false;
+  return Qnil;
+}
+
 void
 defsubr (union Aligned_Lisp_Subr *aname)
 {
@@ -4447,6 +4481,8 @@ defsubr (union Aligned_Lisp_Subr *aname)
   XSETPVECTYPE (sname, PVEC_SUBR);
   XSETSUBR (tem, sname);
   set_symbol_function (sym, tem);
+  sname->next = subr_ptr;
+  subr_ptr = aname;
 }
 
 #ifdef NOTDEF /* Use fset in subr.el now!  */
@@ -4702,6 +4738,8 @@ init_lread (void)
   if (NILP (Vpurify_flag) && !NILP (Ffboundp (Qfile_truename)))
     Vsource_directory = call1 (Qfile_truename, Vsource_directory);
 
+  subr_ptr = NULL;
+
   /* First, set Vload_path.  */
 
   /* Ignore EMACSLOADPATH when dumping.  */
@@ -4816,6 +4854,8 @@ syms_of_lread (void)
   defsubr (&Sintern);
   defsubr (&Sintern_soft);
   defsubr (&Sunintern);
+  defsubr (&Sswitch_to_BC_subrs);
+  defsubr (&Sswitch_to_normal_subrs);
   defsubr (&Sget_load_suffixes);
   defsubr (&Sload);
   defsubr (&Seval_buffer);
diff --git a/src/pdumper.c b/src/pdumper.c
index a9b3732a2d4..59cd824142d 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2914,17 +2914,20 @@ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v)
 static dump_off
 dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
 {
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_594AB72B54)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_6AE56C1912)
 # error "Lisp_Subr changed. See CHECK_STRUCTS comment."
 #endif
   struct Lisp_Subr out;
   dump_object_start (ctx, &out, sizeof (out));
   DUMP_FIELD_COPY (&out, subr, header.size);
   dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0);
+  dump_field_emacs_ptr (ctx, &out, subr, &subr->normal_function.a0);
+  dump_field_emacs_ptr (ctx, &out, subr, &subr->BC_function.a0);
   DUMP_FIELD_COPY (&out, subr, min_args);
   DUMP_FIELD_COPY (&out, subr, max_args);
   dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name);
   dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec);
+  dump_field_emacs_ptr (ctx, &out, subr, &subr->next);
   DUMP_FIELD_COPY (&out, subr, doc);
   return dump_object_finish (ctx, &out, sizeof (out));
 }
@@ -2953,7 +2956,7 @@ dump_vectorlike (struct dump_context *ctx,
                  Lisp_Object lv,
                  dump_off offset)
 {
-#if CHECK_STRUCTS && !defined (HASH_pvec_type_549C833A54)
+#if CHECK_STRUCTS && !defined (HASH_pvec_type_3C7A719153)
 # error "pvec_type changed. See CHECK_STRUCTS comment."
 #endif
   const struct Lisp_Vector *v = XVECTOR (lv);
@@ -2974,6 +2977,7 @@ dump_vectorlike (struct dump_context *ctx,
     case PVEC_CHAR_TABLE:
     case PVEC_SUB_CHAR_TABLE:
     case PVEC_RECORD:
+    case PVEC_SYMBOL_WITH_POS:
       offset = dump_vectorlike_generic (ctx, &v->header);
       break;
     case PVEC_BOOL_VECTOR: