From b53fc68535211a59fde7200713340d911b48ecec Mon Sep 17 00:00:00 2001
From: Andrea Corallo <akrl@sdf.org>
Date: Wed, 18 Mar 2020 19:48:50 +0000
Subject: [PATCH] Extend low level code for late load

---
 src/comp.c    | 36 ++++++++++++++++--------------------
 src/comp.h    |  4 ++--
 src/lread.c   |  2 +-
 src/pdumper.c |  2 +-
 4 files changed, 20 insertions(+), 24 deletions(-)

diff --git a/src/comp.c b/src/comp.c
index 74b74a83b77..3f2b45c85fd 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -3368,27 +3368,18 @@ void
 maybe_defer_native_compilation (Lisp_Object function_name,
 				Lisp_Object definition)
 {
-  Lisp_Object src = Qnil;
-  Lisp_Object load_list = Vcurrent_load_list;
-
-  FOR_EACH_TAIL (load_list)
-    {
-      src = XCAR (load_list);
-      if (!CONSP (src))
-	break;
-    }
-
   if (!comp_deferred_compilation
       || noninteractive
       || !NILP (Vpurify_flag)
       || !COMPILEDP (definition)
       || !FIXNUMP (AREF (definition, COMPILED_ARGLIST))
-      || !STRINGP (src)
-      || !suffix_p (src, ".elc"))
+      || !STRINGP (Vload_file_name)
+      || !suffix_p (Vload_file_name, ".elc"))
     return;
 
-  src = concat2 (CALL1I (file-name-sans-extension, src),
-		 build_pure_c_string (".el"));
+  Lisp_Object src =
+    concat2 (CALL1I (file-name-sans-extension, Vload_file_name),
+	     build_pure_c_string (".el"));
   if (!NILP (Ffile_exists_p (src)))
     CALLN (Ffuncall, intern_c_string ("native-compile-async"), src, Qnil);
 }
@@ -3413,7 +3404,8 @@ 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)
+load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
+		bool late_load)
 {
   dynlib_handle_ptr handle = comp_u->handle;
   Lisp_Object comp_u_lisp_obj;
@@ -3447,7 +3439,9 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump)
 
   freloc_check_fill ();
 
-  void (*top_level_run)(Lisp_Object) = dynlib_sym (handle, "top_level_run");
+  void (*top_level_run)(Lisp_Object)
+    = dynlib_sym (handle,
+		  late_load ? "late_top_level_run" : "top_level_run");
 
   if (!reloading_cu)
     {
@@ -3564,9 +3558,11 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr,
 }
 
 /* Load related routines.  */
-DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0,
-       doc: /* Load native elisp code FILE.  */)
-  (Lisp_Object file)
+DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0,
+       doc: /* Load native elisp code FILE.
+	     LATE_LOAD has to be non nil when loading for deferred
+	     compilation.  */)
+  (Lisp_Object file, Lisp_Object late_load)
 {
   CHECK_STRING (file);
 
@@ -3576,7 +3572,7 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0,
     xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ()));
   comp_u->file = file;
   comp_u->data_vec = Qnil;
-  load_comp_unit (comp_u, false);
+  load_comp_unit (comp_u, false, !NILP (late_load));
 
   return Qt;
 }
diff --git a/src/comp.h b/src/comp.h
index f3bcd4c09bc..f5baa88853e 100644
--- a/src/comp.h
+++ b/src/comp.h
@@ -64,8 +64,8 @@ XNATIVE_COMP_UNIT (Lisp_Object a)
 
 extern void hash_native_abi (void);
 
-extern void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u,
-			    bool loading_dump);
+void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
+		     bool late_load);
 extern void syms_of_comp (void);
 
 extern void maybe_defer_native_compilation (Lisp_Object function_name,
diff --git a/src/lread.c b/src/lread.c
index 2d90bccdc07..b2f437130ce 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1483,7 +1483,7 @@ Return t if the file exists and loads successfully.  */)
 	{
 	  specbind (Qcurrent_load_list, Qnil);
 	  LOADHIST_ATTACH (found);
-	  Fnative_elisp_load (found);
+	  Fnative_elisp_load (found, Qnil);
 	  build_load_history (found, true);
 	}
       else
diff --git a/src/pdumper.c b/src/pdumper.c
index 2e2220a9b29..55f95fd0e75 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -5303,7 +5303,7 @@ dump_do_dump_relocation (const uintptr_t dump_base,
 	comp_u->handle = dynlib_open (SSDATA (comp_u->file));
 	if (!comp_u->handle)
 	  error ("%s", dynlib_error ());
-	load_comp_unit (comp_u, true);
+	load_comp_unit (comp_u, true, false);
 	break;
       }
     case RELOC_NATIVE_SUBR:
-- 
2.39.5