some more pdumper integration support

diff --git a/src/comp.c b/src/comp.c
index 68b1cdf7449b75cf32beab7989303ede50bc34d7..003d3d7ca4431785948cf9c8786d744aa07445f9 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -3136,6 +3136,12 @@ fill_freloc (void)
   fatal ("Overflowing function relocation table, increase F_RELOC_MAX_SIZE");
 }
 
+int
+filled_freloc (void)
+{
+  return freloc.link_table[0] ? 1 : 0;
+}
+
 /******************************************************************************/
 /* Helper functions called from the run-time.                                */
 /* These can't be statics till shared mechanism is used to solve relocations. */
@@ -3210,7 +3216,7 @@ load_static_obj (dynlib_handle_ptr handle, const char *name)
   return Fread (make_string (res->data, res->len));
 }
 
-static void
+void
 load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u)
 {
   dynlib_handle_ptr handle = comp_u->handle;
@@ -3297,15 +3303,11 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0,
   if (!freloc.link_table[0])
     xsignal2 (Qnative_lisp_load_failed, file,
              build_string ("Empty relocation table"));
-
-  dynlib_handle_ptr handle = dynlib_open (SSDATA (file));
-  load_handle_stack = Fcons (make_mint_ptr (handle), load_handle_stack);
-  if (!handle)
-    xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ()));
   struct Lisp_Native_Comp_Unit *comp_u = allocate_native_comp_unit();
+  comp_u->handle = dynlib_open (SSDATA (file));
+  if (!comp_u->handle)
+    xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ()));
   comp_u->file = file;
-  comp_u->fd = fd_out;
-  comp_u->handle = handle;
   load_comp_unit (comp_u);
 
   return Qt;

diff --git a/src/comp.h b/src/comp.h
index 36ee5d10e45aabc4c9a7a5ab1d1567192369d712..c4849ba13d1076256a147ebc12a9c309e7f5780f 100644 (file)
--- a/src/comp.h
+++ b/src/comp.h
@@ -30,8 +30,6 @@ struct Lisp_Native_Comp_Unit
   Lisp_Object file;
   /* Analogous to the constant vector but per compilation unit.  */
   Lisp_Object data_vec;
-  /* Compilation unit file descriptor and handle.  */
-  int fd;
   dynlib_handle_ptr handle;
 };
 
@@ -49,8 +47,12 @@ XNATIVE_COMP_UNIT (Lisp_Object a)
 }
 
 /* Defined in comp.c.  */
+extern void load_comp_unit (struct Lisp_Native_Comp_Unit *);
 extern void syms_of_comp (void);
+/* Fill the freloc structure. Must be called before any eln is loaded.  */
 extern void fill_freloc (void);
+/* Return 1 if freloc is filled or 0 otherwise.  */
+extern int filled_freloc (void);
 
 #endif
 #endif

diff --git a/src/pdumper.c b/src/pdumper.c
index 775f6c3e60b8125e995ea5298898a0c4196a40f6..157457d30d7bf582271a2d5c61c8ad9856ce9814 100644 (file)
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -446,6 +446,7 @@ enum cold_op
     COLD_OP_CHARSET,
     COLD_OP_BUFFER,
     COLD_OP_BIGNUM,
+    COLD_OP_NATIVE_SUBR,
   };
 
 /* This structure controls what operations we perform inside
@@ -939,7 +940,7 @@ dump_note_reachable (struct dump_context *ctx, Lisp_Object object)
 static void *
 dump_object_emacs_ptr (Lisp_Object lv)
 {
-  if (SUBRP (lv))
+  if (SUBRP (lv) && !SUBRP_NATIVE_COMPILEDP (lv))
     return XSUBR (lv);
   if (dump_builtin_symbol_p (lv))
     return XSYMBOL (lv);
@@ -2941,20 +2942,25 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr)
 #endif
   DUMP_FIELD_COPY (&out, subr, min_args);
   DUMP_FIELD_COPY (&out, subr, max_args);
-  dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name);
 #ifdef HAVE_NATIVE_COMP
   if (subr->native_comp_u)
     {
+      dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name);
+      dump_remember_cold_op (ctx,
+                             COLD_OP_NATIVE_SUBR,
+                            make_lisp_ptr ((void *) subr, Lisp_Vectorlike));
       dump_field_lv (ctx, &out, subr, &subr->native_intspec, WEIGHT_NORMAL);
       dump_field_lv (ctx, &out, subr, &subr->native_doc, WEIGHT_NORMAL);
     }
   else
     {
+      dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name);
       dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec);
       DUMP_FIELD_COPY (&out, subr, doc);
     }
   dump_field_lv (ctx, &out, subr, &subr->native_comp_u, WEIGHT_NORMAL);
 #else
+  dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name);
   dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec);
   DUMP_FIELD_COPY (&out, subr, doc);
 #endif
@@ -2968,9 +2974,10 @@ dump_native_comp_unit (struct dump_context *ctx,
 {
   START_DUMP_PVEC (ctx, &comp_u->header, struct Lisp_Native_Comp_Unit, out);
   dump_pseudovector_lisp_fields (ctx, &out->header, &comp_u->header);
-  out->fd = 0;
-  out->handle = 0;
-  return finish_dump_pvec (ctx, &out->header);
+  out->handle = NULL;
+
+  dump_off comp_u_off = finish_dump_pvec (ctx, &out->header);
+  return comp_u_off;
 }
 #endif
 
@@ -3051,6 +3058,11 @@ dump_vectorlike (struct dump_context *ctx,
     case PVEC_BIGNUM:
       offset = dump_bignum (ctx, lv);
       break;
+#ifdef HAVE_NATIVE_COMP
+    case PVEC_NATIVE_COMP_UNIT:
+      offset = dump_native_comp_unit (ctx, XNATIVE_COMP_UNIT (lv));
+      break;
+#endif
     case PVEC_WINDOW_CONFIGURATION:
       error_unsupported_dump_object (ctx, lv, "window configuration");
     case PVEC_OTHER:
@@ -3075,11 +3087,6 @@ dump_vectorlike (struct dump_context *ctx,
       error_unsupported_dump_object (ctx, lv, "condvar");
     case PVEC_MODULE_FUNCTION:
       error_unsupported_dump_object (ctx, lv, "module function");
-#ifdef HAVE_NATIVE_COMP
-    case PVEC_NATIVE_COMP_UNIT:
-      offset = dump_native_comp_unit (ctx, XNATIVE_COMP_UNIT (lv));
-      break;
-#endif
     default:
       error_unsupported_dump_object(ctx, lv, "weird pseudovector");
     }
@@ -3454,6 +3461,22 @@ dump_cold_bignum (struct dump_context *ctx, Lisp_Object object)
     }
 }
 
+static void
+dump_cold_native_subr (struct dump_context *ctx, Lisp_Object subr)
+{
+  /* Dump subr contents.  */
+  dump_off subr_offset = dump_recall_object (ctx, subr);
+  eassert (subr_offset > 0);
+  dump_remember_fixup_ptr_raw
+    (ctx,
+     subr_offset + dump_offsetof (struct Lisp_Subr, symbol_name),
+     ctx->offset);
+  const char *symbol_name = XSUBR (subr)->symbol_name;
+  ALLOW_IMPLICIT_CONVERSION;
+  dump_write (ctx, symbol_name, 1 + strlen (symbol_name));
+  DISALLOW_IMPLICIT_CONVERSION;
+}
+
 static void
 dump_drain_cold_data (struct dump_context *ctx)
 {
@@ -3497,6 +3520,9 @@ dump_drain_cold_data (struct dump_context *ctx)
         case COLD_OP_BIGNUM:
           dump_cold_bignum (ctx, data);
           break;
+       case COLD_OP_NATIVE_SUBR:
+         dump_cold_native_subr (ctx, data);
+         break;
         default:
           emacs_abort ();
         }
@@ -3916,7 +3942,7 @@ dump_do_fixup (struct dump_context *ctx,
       /* Dump wants a pointer to a Lisp object.
          If DUMP_FIXUP_LISP_OBJECT_RAW, we should stick a C pointer in
          the dump; otherwise, a Lisp_Object.  */
-      if (SUBRP (arg))
+      if (SUBRP (arg) && !SUBRP_NATIVE_COMPILEDP(arg))
         {
           dump_value = emacs_offset (XSUBR (arg));
           if (type == DUMP_FIXUP_LISP_OBJECT)