mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 12:21:25 -08:00
Code Issues Projects Releases Wiki Activity

Add anonymous lambdas reload mechanism

Browse source 
* src/pdumper.c (dump_do_dump_relocation): Initialize
	'lambda_gc_guard' while resurrecting.
	(dump_do_dump_relocation): Revive lambdas and fixup them.

	* src/comp.h (struct Lisp_Native_Comp_Unit): Define new
	'lambda_gc_guard' 'lambda_c_name_idx_h' 'data_imp_relocs'
	'loaded_once' fields.

	* src/comp.c (load_comp_unit): Use compilaiton unit 'loaded_once'
	field.
	(make_subr, Fcomp__register_lambda): New functions.
	(Fcomp__register_subr): Make use of 'make_subr'.
	(Fnative_elisp_load): Indent.
	(Fnative_elisp_load): Initialize 'lambda_gc_guard'
	'lambda_c_name_idx_h' fields.
	(syms_of_comp): Add Scomp__register_lambda.

	* lisp/emacs-lisp/comp.el (comp-ctxt): Change
	'byte-func-to-func-h' hash key test.
	(comp-ctxt): Add 'lambda-fixups-h' slot.
	(comp-emit-lambda-for-top-level): New function.
	(comp-finalize-relocs): Never emit lambdas in pure space.
	(comp-finalize-relocs): Fixup relocation indexes.
This commit is contained in:
Andrea Corallo 2020-05-02 17:29:11 +01:00
parent 49f0331f53
commit 44b0ce6e38
4 changed files with 150 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

55
lisp/emacs-lisp/comp.el
View file

@ -230,9 +230,11 @@ Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'. See `comp-ctxt'.")
(sym-to-c-name-h (make-hash-table :test #'eq) :type hash-table
:documentation "symbol-function -> c-name.
This is only for optimizing intra CU calls at speed 3.")
(byte-func-to-func-h (make-hash-table :test #'eq) :type hash-table
(byte-func-to-func-h (make-hash-table :test #'equal) :type hash-table
:documentation "byte-function -> comp-func.
Needed to replace immediate byte-compiled lambdas with the compiled reference.")
(lambda-fixups-h (make-hash-table :test #'equal) :type hash-table
:documentation "Hash table byte-func -> mvar to fixup.")
(function-docs (make-hash-table :test #'eql) :type (or hash-table vector)
:documentation "Documentation index -> documentation")
(d-default (make-comp-data-container) :type comp-data-container
@ -1276,6 +1278,36 @@ the annotation emission."
(make-comp-mvar :constant form))
(make-comp-mvar :constant t))))))
(defun comp-emit-lambda-for-top-level (func)
"Emit the creation of subrs for lambda FUNC.
These are stored in the reloc data array."
(let ((args (comp-func-args func)))
(let ((comp-curr-allocation-class 'd-impure))
(comp-add-const-to-relocs (comp-func-byte-func func)))
(comp-emit
(comp-call 'comp--register-lambda
;; mvar to be fixed-up when containers are
;; finalized.
(or (gethash (comp-func-byte-func func)
(comp-ctxt-lambda-fixups-h comp-ctxt))
(puthash (comp-func-byte-func func)
(make-comp-mvar :constant nil)
(comp-ctxt-lambda-fixups-h comp-ctxt)))
(make-comp-mvar :constant (comp-args-base-min args))
(make-comp-mvar :constant (if (comp-args-p args)
(comp-args-max args)
'many))
(make-comp-mvar :constant (comp-func-c-name func))
(make-comp-mvar
:constant (let* ((h (comp-ctxt-function-docs comp-ctxt))
(i (hash-table-count h)))
(puthash i (comp-func-doc func) h)
i))
(make-comp-mvar :constant (comp-func-int-spec func))
;; This is the compilation unit it-self passed as
;; parameter.
(make-comp-mvar :slot 0)))))
(defun comp-limplify-top-level (for-late-load)
"Create a limple function to modify the global environment at load.
When FOR-LATE-LOAD is non nil the emitted function modifies only
@ -2143,6 +2175,12 @@ Update all insn accordingly."
(d-impure-idx (comp-data-container-idx d-impure))
(d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt))
(d-ephemeral-idx (comp-data-container-idx d-ephemeral)))
;; We never want compiled lambdas ending up in pure space. A copy must
;; be already present in impure (see `comp-emit-lambda-for-top-level').
(cl-loop for obj being each hash-keys of d-default-idx
when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt))
do (cl-assert (gethash obj d-impure-idx))
(remhash obj d-default-idx))
;; Remove entries in d-impure already present in d-default.
(cl-loop for obj being each hash-keys of d-impure-idx
when (gethash obj d-default-idx)
@ -2162,7 +2200,20 @@ Update all insn accordingly."
for doc = (gethash idx h)
do (setf (aref v idx) doc)
finally
do (setf (comp-ctxt-function-docs comp-ctxt) v))))
do (setf (comp-ctxt-function-docs comp-ctxt) v))
;; And now we conclude with the following: We need to pass to
;; `comp--register-lambda' the index in the impure relocation
;; array to store revived lambdas, but given we know it only now
;; we fix it up as last.
(cl-loop for f being each hash-keys of (comp-ctxt-lambda-fixups-h comp-ctxt)
using (hash-value mvar)
with reverse-h = (make-hash-table) ;; Make sure idx is unique.
for idx = (gethash f d-impure-idx)
do
(cl-assert (null (gethash idx reverse-h)))
(cl-assert (fixnump idx))
(setf (comp-mvar-constant mvar) idx)
(puthash idx t reverse-h))))
(defun comp-compile-ctxt-to-file (name)
"Compile as native code the current context naming it NAME.

88
src/comp.c
View file

@ -3583,15 +3583,15 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
Lisp_Object *saved_cu = dynlib_sym (handle, COMP_UNIT_SYM);
if (!saved_cu)
xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file);
bool reloading_cu = !NILP (*saved_cu);
comp_u->loaded_once = !NILP (*saved_cu);
Lisp_Object *data_eph_relocs =
dynlib_sym (handle, DATA_RELOC_EPHEMERAL_SYM);
/* While resurrecting from an image dump loading more than once the
same compilation unit does not make any sense. */
eassert (!(loading_dump && reloading_cu));
eassert (!(loading_dump && comp_u->loaded_once));
if (reloading_cu)
if (comp_u->loaded_once)
/* '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
@ -3612,13 +3612,17 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
= dynlib_sym (handle,
late_load ? "late_top_level_run" : "top_level_run");
if (!reloading_cu)
/* Always set data_imp_relocs pointer in the compilation unit (in can be
used in 'dump_do_dump_relocation'). */
comp_u->data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM);
if (!comp_u->loaded_once)
{
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);
Lisp_Object *data_imp_relocs = comp_u->data_imp_relocs;
void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM);
if (!(current_thread_reloc
@ -3704,15 +3708,13 @@ native_function_doc (Lisp_Object function)
return AREF (cu->data_fdoc_v, XSUBR (function)->doc);
}
DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr,
7, 7, 0,
doc: /* This gets called by top_level_run during load phase to register
each exported subr. */)
(Lisp_Object name, Lisp_Object minarg, Lisp_Object maxarg,
Lisp_Object c_name, Lisp_Object doc_idx, Lisp_Object intspec,
Lisp_Object comp_u)
static Lisp_Object
make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg,
Lisp_Object c_name, Lisp_Object doc_idx, Lisp_Object intspec,
Lisp_Object comp_u)
{
dynlib_handle_ptr handle = XNATIVE_COMP_UNIT (comp_u)->handle;
struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u);
dynlib_handle_ptr handle = cu->handle;
if (!handle)
xsignal0 (Qwrong_register_subr_call);
@ -3727,18 +3729,63 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr,
x->s.function.a0 = func;
x->s.min_args = XFIXNUM (minarg);
x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY;
x->s.symbol_name = xstrdup (SSDATA (Fsymbol_name (name)));
x->s.symbol_name = xstrdup (SSDATA (symbol_name));
x->s.native_intspec = intspec;
x->s.doc = XFIXNUM (doc_idx);
x->s.native_comp_u[0] = comp_u;
Lisp_Object tem;
XSETSUBR (tem, &x->s);
return tem;
}
DEFUN ("comp--register-lambda", Fcomp__register_lambda, Scomp__register_lambda,
7, 7, 0,
doc: /* This gets called by top_level_run during load phase to register
anonymous lambdas. */)
(Lisp_Object reloc_idx, Lisp_Object minarg, Lisp_Object maxarg,
Lisp_Object c_name, Lisp_Object doc_idx, Lisp_Object intspec,
Lisp_Object comp_u)
{
struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u);
if (cu->loaded_once)
return Qnil;
Lisp_Object tem =
make_subr (c_name, minarg, maxarg, c_name, doc_idx, intspec, comp_u);
/* We must protect it against GC because the function is not
reachable through symbols. */
Fputhash (tem, Qt, cu->lambda_gc_guard);
/* This is for fixing up the value in d_reloc while resurrecting
from dump. See 'dump_do_dump_relocation'. */
Fputhash (c_name, reloc_idx, cu->lambda_c_name_idx_h);
/* The key is not really important as long is the same as
symbol_name so use c_name. */
Fputhash (Fintern (c_name, Qnil), c_name, Vcomp_sym_subr_c_name_h);
/* Do the real relocation fixup. */
cu->data_imp_relocs[XFIXNUM (reloc_idx)] = tem;
return tem;
}
DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr,
7, 7, 0,
doc: /* This gets called by top_level_run during load phase to register
each exported subr. */)
(Lisp_Object name, Lisp_Object minarg, Lisp_Object maxarg,
Lisp_Object c_name, Lisp_Object doc_idx, Lisp_Object intspec,
Lisp_Object comp_u)
{
Lisp_Object tem =
make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, doc_idx, intspec,
comp_u);
set_symbol_function (name, tem);
Fputhash (name, c_name, Vcomp_sym_subr_c_name_h);
LOADHIST_ATTACH (Fcons (Qdefun, name));
Fputhash (name, c_name, Vcomp_sym_subr_c_name_h);
return Qnil;
return tem;
}
DEFUN ("comp--late-register-subr", Fcomp__late_register_subr,
@ -3759,8 +3806,8 @@ DEFUN ("comp--late-register-subr", Fcomp__late_register_subr,
/* Load related routines. */
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. */)
LATE_LOAD has to be non nil when loading for deferred
compilation. */)
(Lisp_Object file, Lisp_Object late_load)
{
CHECK_STRING (file);
@ -3773,6 +3820,8 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0,
xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ()));
comp_u->file = file;
comp_u->data_vec = Qnil;
comp_u->lambda_gc_guard = CALLN (Fmake_hash_table, QCtest, Qeq);
comp_u->lambda_c_name_idx_h = CALLN (Fmake_hash_table, QCtest, Qequal);
load_comp_unit (comp_u, false, !NILP (late_load));
return Qt;
@ -3886,6 +3935,7 @@ syms_of_comp (void)
defsubr (&Scomp__init_ctxt);
defsubr (&Scomp__release_ctxt);
defsubr (&Scomp__compile_ctxt_to_file);
defsubr (&Scomp__register_lambda);
defsubr (&Scomp__register_subr);
defsubr (&Scomp__late_register_subr);
defsubr (&Snative_elisp_load);

14
src/comp.h
View file

@ -37,13 +37,21 @@ struct Lisp_Native_Comp_Unit
/* Original eln file loaded. */
Lisp_Object file;
Lisp_Object optimize_qualities;
/* Hash doc-idx -> function documentaiton. */
/* Guard anonymous lambdas against Garbage Collection and make them
dumpable. */
Lisp_Object lambda_gc_guard;
/* Hash c_name -> d_reloc_imp index. */
Lisp_Object lambda_c_name_idx_h;
/* Hash doc-idx -> function documentaiton. */
Lisp_Object data_fdoc_v;
/* Analogous to the constant vector but per compilation unit. */
Lisp_Object data_vec;
/* Same but for data that cannot be moved to pure space.
Must be the last lisp object here. */
/* 'data_impure_vec' must be last (see allocate_native_comp_unit).
Same as data_vec but for data that cannot be moved to pure space. */
Lisp_Object data_impure_vec;
/* STUFFS WE DO NOT DUMP!! */
Lisp_Object *data_imp_relocs;
bool loaded_once;
dynlib_handle_ptr handle;
};

18
src/pdumper.c
View file

@ -5297,7 +5297,7 @@ dump_do_dump_relocation (const uintptr_t dump_base,
static enum { UNKNOWN, LOCAL_BUILD, INSTALLED } installation_state;
struct Lisp_Native_Comp_Unit *comp_u =
dump_ptr (dump_base, reloc_offset);
comp_u->lambda_gc_guard = CALLN (Fmake_hash_table, QCtest, Qeq);
if (!CONSP (comp_u->file))
error ("Trying to load incoherent dumped .eln");
@ -5320,6 +5320,10 @@ dump_do_dump_relocation (const uintptr_t dump_base,
}
case RELOC_NATIVE_SUBR:
{
/* When resurrecting from a dump given non all the original
native compiled subrs may be still around we can't rely on
a 'top_level_run' mechanism, we revive them one-by-one
here. */
struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset);
Lisp_Object name = intern (subr->symbol_name);
struct Lisp_Native_Comp_Unit *comp_u =
@ -5333,6 +5337,18 @@ dump_do_dump_relocation (const uintptr_t dump_base,
if (!func)
error ("can't find function in compilation unit");
subr->function.a0 = func;
Lisp_Object lambda_data_idx =
Fgethash (c_name, comp_u->lambda_c_name_idx_h, Qnil);
if (!NILP (lambda_data_idx))
{
/* This is an anonymous lambda.
We must fixup data_vec so the lambda can be referenced
by code. */
Lisp_Object tem;
XSETSUBR (tem, subr);
comp_u->data_imp_relocs[XFIXNUM (lambda_data_idx)] = tem;
Fputhash (tem, Qnil, comp_u->lambda_gc_guard);
}
break;
}
#endif