From: Andrea Corallo Date: Tue, 24 Dec 2019 07:09:21 +0000 (+0100) Subject: some more pdumper integration support X-Git-Tag: emacs-28.0.90~2727^2~888 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=36ab5c6d49f8fbfb858844743223414e6f2f2564;p=emacs.git some more pdumper integration support --- diff --git a/src/comp.c b/src/comp.c index 68b1cdf7449..003d3d7ca44 100644 --- 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 36ee5d10e45..c4849ba13d1 100644 --- 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 775f6c3e60b..157457d30d7 100644 --- 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)