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)

diff --git a/src/alloc.c b/src/alloc.c
index faa8e703937a489f4f25d280eee9f33c4e2d9f8c..431238b13e6a4747bac197f1a81c4f5f35c1d69d 100644 (file)
--- 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 290fc3a9c459b1d0e5ec65456604607485ea9d01..7a1ccdcb83c9f9dd8918a711ddbd346adf4f3916 100644 (file)
--- 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 ae8fe014e0eb5e5992a88bde4761142862bc3141..8a758499a9122def3d4c4892f1024a20f8dcf6f5 100644 (file)
--- 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;