mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-13 09:32:47 +00:00
Code Issues Releases Activity

Split relocated data into two separate arrays

Browse Source 
Rework the functionality of the previous commit to be more efficient.
This commit is contained in:
Andrea Corallo 2020-01-12 11:47:50 +01:00
parent 93ed2c32df
commit c1d034fc27
4 changed files with 107 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
lisp/emacs-lisp/comp.el
View File

@ -157,6 +157,13 @@ Can be used by code that wants to expand differently in this case.")
finally return h)
"Hash table lap-op -> stack adjustment."))
(cl-defstruct comp-data-container
"Data relocation container structure."
(l () :type list
:documentation "Constant objects used by functions.")
(idx (make-hash-table :test #'equal) :type hash-table
:documentation "Obj -> position into the previous field."))
(cl-defstruct comp-ctxt
"Lisp side of the compiler context."
(output nil :type string
@ -166,10 +173,11 @@ Can be used by code that wants to expand differently in this case.")
(funcs-h (make-hash-table) :type hash-table
:documentation "lisp-func-name -> comp-func.
This is to build the prev field.")
(data-relocs-l () :type list
:documentation "List of pairs (impure . obj-to-reloc).")
(data-relocs-idx (make-hash-table :test #'equal) :type hash-table
:documentation "Obj -> position into data-relocs."))
(d-base (make-comp-data-container) :type comp-data-container
:documentation "Standard data relocated in use by functions.")
(d-impure (make-comp-data-container) :type comp-data-container
:documentation "Data relocated that cannot be moved into pure space.
This is tipically for top-level forms other than defun."))
(cl-defstruct comp-args-base
(min nil :type number
@ -314,16 +322,28 @@ structure.")
"Type hint predicate for function name FUNC."
(when (member func comp-type-hints) t))
(defun comp-data-container-check (cont)
"Sanity check CONT coherency."
(cl-assert (= (length (comp-data-container-l cont))
(hash-table-count (comp-data-container-idx cont)))))
(defun comp-add-const-to-relocs-to-cont (obj cont)
"Keep track of OBJ into the CONT relocation container.
The corresponding index is returned."
(let ((h (comp-data-container-idx cont)))
(if-let ((idx (gethash obj h)))
idx
(push obj (comp-data-container-l cont))
(puthash obj (hash-table-count h) h))))
(defun comp-add-const-to-relocs (obj &optional impure)
"Keep track of OBJ into the ctxt relocations.
When IMPURE is non nil OBJ cannot be copied into pure space.
The corresponding index is returned."
(let ((data-relocs-idx (comp-ctxt-data-relocs-idx comp-ctxt))
(packed-obj (cons impure obj)))
(if-let ((idx (gethash packed-obj data-relocs-idx)))
idx
(push packed-obj (comp-ctxt-data-relocs-l comp-ctxt))
(puthash packed-obj (hash-table-count data-relocs-idx) data-relocs-idx))))
(comp-add-const-to-relocs-to-cont obj
(if impure
(comp-ctxt-d-impure comp-ctxt)
(comp-ctxt-d-base comp-ctxt))))
(defmacro comp-within-log-buff (&rest body)
"Execute BODY while at the end the log-buffer.
@ -1810,8 +1830,8 @@ These are substituted with a normal 'set' op."
(defun comp-compile-ctxt-to-file (name)
"Compile as native code the current context naming it NAME.
Prepare every function for final compilation and drive the C back-end."
(cl-assert (= (length (comp-ctxt-data-relocs-l comp-ctxt))
(hash-table-count (comp-ctxt-data-relocs-idx comp-ctxt))))
(comp-data-container-check (comp-ctxt-d-base comp-ctxt))
(comp-data-container-check (comp-ctxt-d-impure comp-ctxt))
(comp--compile-ctxt-to-file name))
(defun comp-final (_)

110
src/comp.c
View File

@ -39,9 +39,11 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#define CURRENT_THREAD_RELOC_SYM "current_thread_reloc"
#define PURE_RELOC_SYM "pure_reloc"
#define DATA_RELOC_SYM "d_reloc"
#define DATA_RELOC_IMPURE_SYM "d_reloc_imp"
#define FUNC_LINK_TABLE_SYM "freloc_link_table"
#define LINK_TABLE_HASH_SYM "freloc_hash"
#define TEXT_DATA_RELOC_SYM "text_data_reloc"
#define TEXT_DATA_RELOC_IMPURE_SYM "text_data_reloc_imp"
#define SPEED XFIXNUM (Fsymbol_value (Qcomp_speed))
#define COMP_DEBUG XFIXNUM (Fsymbol_value (Qcomp_debug))
@ -171,8 +173,12 @@ typedef struct {
Lisp_Object exported_funcs_h; /* subr_name -> gcc_jit_function *. */
Lisp_Object imported_funcs_h; /* subr_name -> gcc_jit_field *reloc_field. */
Lisp_Object emitter_dispatcher;
gcc_jit_rvalue *data_relocs; /* Synthesized struct holding data relocs. */
gcc_jit_lvalue *func_relocs; /* Synthesized struct holding func relocs. */
/* Synthesized struct holding data relocs. */
gcc_jit_rvalue *data_relocs;
/* Same as before but can't go in pure space. */
gcc_jit_rvalue *data_relocs_impure;
/* Synthesized struct holding func relocs. */
gcc_jit_lvalue *func_relocs;
} comp_t;
static comp_t comp;
@ -894,9 +900,10 @@ emit_const_lisp_obj (Lisp_Object obj, Lisp_Object impure)
comp.void_ptr_type,
NULL));
Lisp_Object d_reloc_idx = CALL1I (comp-ctxt-data-relocs-idx, Vcomp_ctxt);
Lisp_Object packed_obj = Fcons (impure, obj);
Lisp_Object reloc_idx = Fgethash (packed_obj, d_reloc_idx, Qnil);
Lisp_Object container = impure ? CALL1I (comp-ctxt-d-impure, Vcomp_ctxt)
: CALL1I (comp-ctxt-d-base, Vcomp_ctxt);
Lisp_Object reloc_idx =
Fgethash (obj, CALL1I (comp-data-container-idx, container), Qnil);
eassert (!NILP (reloc_idx));
gcc_jit_rvalue *reloc_n =
gcc_jit_context_new_rvalue_from_int (comp.ctxt,
@ -906,7 +913,8 @@ emit_const_lisp_obj (Lisp_Object obj, Lisp_Object impure)
gcc_jit_lvalue_as_rvalue (
gcc_jit_context_new_array_access (comp.ctxt,
NULL,
comp.data_relocs,
impure ? comp.data_relocs_impure
: comp.data_relocs,
reloc_n));
}
@ -1749,14 +1757,52 @@ emit_static_object (const char *name, Lisp_Object obj)
gcc_jit_block_end_with_return (block, NULL, res);
}
static gcc_jit_rvalue *
declare_imported_data_relocs (Lisp_Object container, const char *code_symbol,
const char *text_symbol)
{
/* Imported objects. */
EMACS_INT d_reloc_len =
XFIXNUM (CALL1I (hash-table-count,
CALL1I (comp-data-container-idx, container)));
Lisp_Object d_reloc = Fnreverse (CALL1I (comp-data-container-l, container));
d_reloc = Fvconcat (1, &d_reloc);
gcc_jit_rvalue *reloc_struct =
gcc_jit_lvalue_as_rvalue (
gcc_jit_context_new_global (
comp.ctxt,
NULL,
GCC_JIT_GLOBAL_EXPORTED,
gcc_jit_context_new_array_type (comp.ctxt,
NULL,
comp.lisp_obj_type,
d_reloc_len),
code_symbol));
emit_static_object (text_symbol, d_reloc);
return reloc_struct;
}
static void
declare_runtime_imported_data (void)
declare_imported_data (void)
{
/* Imported symbols by inliner functions. */
CALL1I (comp-add-const-to-relocs, Qnil);
CALL1I (comp-add-const-to-relocs, Qt);
CALL1I (comp-add-const-to-relocs, Qconsp);
CALL1I (comp-add-const-to-relocs, Qlistp);
/* Imported objects. */
comp.data_relocs =
declare_imported_data_relocs (CALL1I (comp-ctxt-d-base, Vcomp_ctxt),
DATA_RELOC_SYM,
TEXT_DATA_RELOC_SYM);
comp.data_relocs_impure =
declare_imported_data_relocs (CALL1I (comp-ctxt-d-impure, Vcomp_ctxt),
DATA_RELOC_IMPURE_SYM,
TEXT_DATA_RELOC_IMPURE_SYM);
}
/*
@ -1842,27 +1888,7 @@ emit_ctxt_code (void)
gcc_jit_type_get_pointer (comp.void_ptr_type),
PURE_RELOC_SYM));
declare_runtime_imported_data ();
/* Imported objects. */
EMACS_INT d_reloc_len =
XFIXNUM (CALL1I (hash-table-count,
CALL1I (comp-ctxt-data-relocs-idx, Vcomp_ctxt)));
Lisp_Object d_reloc = Fnreverse (CALL1I (comp-ctxt-data-relocs-l, Vcomp_ctxt));
d_reloc = Fvconcat (1, &d_reloc);
comp.data_relocs =
gcc_jit_lvalue_as_rvalue (
gcc_jit_context_new_global (
comp.ctxt,
NULL,
GCC_JIT_GLOBAL_EXPORTED,
gcc_jit_context_new_array_type (comp.ctxt,
NULL,
comp.lisp_obj_type,
d_reloc_len),
DATA_RELOC_SYM));
emit_static_object (TEXT_DATA_RELOC_SYM, d_reloc);
declare_imported_data ();
/* Functions imported from Lisp code. */
freloc_check_fill ();
@ -3263,12 +3289,14 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump)
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),
@ -3283,21 +3311,23 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump)
/* Imported data. */
if (!loading_dump)
comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM);
{
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);
}
EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec));
if (!loading_dump && !NILP (Vpurify_flag))
for (EMACS_INT i = 0; i < d_vec_len; i++)
{
Lisp_Object packed_obj = AREF (comp_u->data_vec, i);
if (NILP (XCAR (packed_obj)))
/* If is not impure can be copied into pure space. */
XSETCDR (packed_obj, Fpurecopy (XCDR (packed_obj)));
}
for (EMACS_INT i = 0; i < d_vec_len; i++)
data_relocs[i] = XCDR (AREF (comp_u->data_vec, 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);
if (!loading_dump)
{

3
src/comp.h
View File

@ -38,6 +38,9 @@ struct Lisp_Native_Comp_Unit
Lisp_Object file;
/* 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. */
Lisp_Object data_impure_vec;
dynlib_handle_ptr handle;
};

4
src/lisp.h
View File

@ -4767,8 +4767,8 @@ SUBR_NATIVE_COMPILEDP (Lisp_Object a)
INLINE struct Lisp_Native_Comp_Unit *
allocate_native_comp_unit (void)
{
return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, data_vec,
PVEC_NATIVE_COMP_UNIT);
return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit,
data_impure_vec, PVEC_NATIVE_COMP_UNIT);
}
#else
INLINE bool