Fix load_comp_unit for non zero speeds

'dlopen' returns the same handle when trying to load two times
the same shared.

Touching 'd_reloc' etc leads to fails in case a frame with a reference
to it in a register is active. (comp-speed >= 0)

3 files changed, 89 insertions, 45 deletions

diff --git a/src/alloc.c b/src/alloc.c
index faa8e703937..431238b13e6 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -517,6 +517,14 @@ Lisp_Object const *staticvec[NSTATICS]
 
 int staticidx;
 
+/* Lisp of freed native compilation unit handles.
+
+   Because during GC Vcomp_loaded_handles can't be used (hash table) temporary
+   annotate here and update Vcomp_loaded_handles when finished.
+*/
+
+static Lisp_Object freed_cu_handles[NATIVE_COMP_FLAG];
+
 static void *pure_alloc (size_t, int);
 
 /* Return PTR rounded up to the next multiple of ALIGNMENT.  */
@@ -3030,6 +3038,10 @@ cleanup_vector (struct Lisp_Vector *vector)
         PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit);
       eassert (cu->handle);
       dynlib_close (cu->handle);
+      /* We'll update Vcomp_loaded_handles when finished.  */
+      freed_cu_handles[0] =
+        Fcons (make_mint_ptr (cu->handle), freed_cu_handles[0]);
+      set_cons_marked (XCONS (freed_cu_handles[0]));
     }
 }
 
@@ -5937,6 +5949,9 @@ garbage_collect (void)
   if (garbage_collection_messages)
     message1_nolog ("Garbage collecting...");
 
+  if (NATIVE_COMP_FLAG)
+    freed_cu_handles[0] = Qnil;
+
   block_input ();
 
   shrink_regexp_cache ();
@@ -6001,6 +6016,10 @@ garbage_collect (void)
 
   gc_in_progress = 0;
 
+  if (NATIVE_COMP_FLAG)
+    FOR_EACH_TAIL (freed_cu_handles[0])
+      Fputhash (XCAR (freed_cu_handles[0]), Qnil, Vcomp_loaded_handles);
+
   unblock_input ();
 
   consing_until_gc = gc_threshold
diff --git a/src/comp.c b/src/comp.c
index 290fc3a9c45..7a1ccdcb83c 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -3282,61 +3282,81 @@ load_static_obj (struct Lisp_Native_Comp_Unit *comp_u, const char *name)
 void
 load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump)
 {
-  freloc_check_fill ();
-
   dynlib_handle_ptr handle = comp_u->handle;
-  struct thread_state ***current_thread_reloc =
-    dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM);
-  EMACS_INT ***pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM);
-  Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM);
-  Lisp_Object *data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM);
-  void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM);
-  void (*top_level_run)(Lisp_Object) = dynlib_sym (handle, "top_level_run");
-
-  if (!(current_thread_reloc
-        && pure_reloc
-        && data_relocs
-        && data_imp_relocs
-        && freloc_link_table
-        && top_level_run)
-      || NILP (Fstring_equal (load_static_obj (comp_u, LINK_TABLE_HASH_SYM),
-                              hash_subr_list ())))
-    xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file);
+  Lisp_Object lisp_handle = make_mint_ptr (handle);
+  bool reloading_cu = !NILP (Fgethash (lisp_handle, Vcomp_loaded_handles, Qnil));
+  Lisp_Object comp_u_obj;
+  XSETNATIVE_COMP_UNIT (comp_u_obj, comp_u);
+
+  if (reloading_cu)
+    /* 'dlopen' returns the same handle when trying to load two times
+       the same shared.  In this case touching 'd_reloc' etc leads to
+       fails in case a frame with a reference to it in a live reg is
+       active (comp-speed >= 0).
+
+       We must *never* mess with static pointers in an already loaded
+       eln.  */
+    {
+      comp_u_obj = Fgethash (lisp_handle, Vcomp_loaded_handles, Qnil);
+      comp_u = XNATIVE_COMP_UNIT (comp_u_obj);
+    }
+  else
+    Fputhash (lisp_handle, comp_u_obj, Vcomp_loaded_handles);
 
-  *current_thread_reloc = &current_thread;
-  *pure_reloc = (EMACS_INT **)&pure;
+  freloc_check_fill ();
 
-  /* Imported functions.  */
-  *freloc_link_table = freloc.link_table;
+  void (*top_level_run)(Lisp_Object) = dynlib_sym (handle, "top_level_run");
 
-  /* Imported data.  */
-  if (!loading_dump)
+  if (!reloading_cu)
     {
-      comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM);
-      comp_u->data_impure_vec =
-        load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM);
+      struct thread_state ***current_thread_reloc =
+        dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM);
+      EMACS_INT ***pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM);
+      Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM);
+      Lisp_Object *data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM);
+      void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM);
+
+      if (!(current_thread_reloc
+            && pure_reloc
+            && data_relocs
+            && data_imp_relocs
+            && freloc_link_table
+            && top_level_run)
+          || NILP (Fstring_equal (load_static_obj (comp_u, LINK_TABLE_HASH_SYM),
+                                  hash_subr_list ())))
+        xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file);
+
+      *current_thread_reloc = &current_thread;
+      *pure_reloc = (EMACS_INT **)&pure;
+
+      /* Imported functions.  */
+      *freloc_link_table = freloc.link_table;
+
+      /* Imported data.  */
+      if (!loading_dump)
+        {
+          comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM);
+          comp_u->data_impure_vec =
+            load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM);
 
-      if (!NILP (Vpurify_flag))
-        /* Non impure can be copied into pure space.  */
-        comp_u->data_vec = Fpurecopy (comp_u->data_vec);
-    }
+          if (!NILP (Vpurify_flag))
+            /* Non impure can be copied into pure space.  */
+            comp_u->data_vec = Fpurecopy (comp_u->data_vec);
+        }
 
-  EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec));
-  for (EMACS_INT i = 0; i < d_vec_len; i++)
-    data_relocs[i] = AREF (comp_u->data_vec, i);
+      EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec));
+      for (EMACS_INT i = 0; i < d_vec_len; i++)
+        data_relocs[i] = AREF (comp_u->data_vec, i);
 
-  d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec));
-  for (EMACS_INT i = 0; i < d_vec_len; i++)
-    data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i);
+      d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec));
+      for (EMACS_INT i = 0; i < d_vec_len; i++)
+        data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i);
+    }
 
   if (!loading_dump)
-    {
-      Lisp_Object comp_u_obj;
-      XSETNATIVE_COMP_UNIT (comp_u_obj, comp_u);
-      /* Executing this will perform all the expected environment
-         modifications.  */
-      top_level_run (comp_u_obj);
-    }
+    /* Executing this will perform all the expected environment
+       modifications.  */
+    top_level_run (comp_u_obj);
 
   return;
 }
@@ -3518,6 +3538,10 @@ syms_of_comp (void)
                doc: /* Hash table symbol-function -> function-c-name.  For
                        internal use during  */);
   Vcomp_sym_subr_c_name_h = CALLN (Fmake_hash_table);
+  DEFVAR_LISP ("comp-loaded-handles", Vcomp_loaded_handles,
+               doc: /* Hash table keeping track of the currently
+                       loaded compilation unit: handle -> comp_u */);
+  Vcomp_loaded_handles = CALLN (Fmake_hash_table, QCtest, Qequal);
 }
 
 #endif /* HAVE_NATIVE_COMP */
diff --git a/src/pdumper.c b/src/pdumper.c
index ae8fe014e0e..8a758499a91 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -5577,6 +5577,7 @@ pdumper_load (const char *dump_filename)
     dump_hooks[i] ();
 
   dump_do_all_dump_reloc_for_phase (header, dump_base, LATE_RELOCS);
+  Vcomp_loaded_handles = CALLN (Fmake_hash_table, QCtest, Qequal);
   dump_do_all_dump_reloc_for_phase (header, dump_base, VERY_LATE_RELOCS);
   initialized = true;