From c1d034fc27e3aef2370cf0153e7b54dac7eba91b Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 12 Jan 2020 11:47:50 +0100 Subject: [PATCH] Split relocated data into two separate arrays Rework the functionality of the previous commit to be more efficient. --- lisp/emacs-lisp/comp.el | 44 +++++++++++----- src/comp.c | 108 +++++++++++++++++++++++++--------------- src/comp.h | 3 ++ src/lisp.h | 4 +- 4 files changed, 106 insertions(+), 53 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 0f71746407a..69141f657a6 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -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 (_) diff --git a/src/comp.c b/src/comp.c index 0d1f83eb8ff..290fc3a9c45 100644 --- a/src/comp.c +++ b/src/comp.c @@ -39,9 +39,11 @@ along with GNU Emacs. If not, see . */ #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); - EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); + if (!NILP (Vpurify_flag)) + /* Non impure can be copied into pure space. */ + comp_u->data_vec = Fpurecopy (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))); - } + EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); + for (EMACS_INT i = 0; i < d_vec_len; 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_relocs[i] = XCDR (AREF (comp_u->data_vec, i)); + data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i); if (!loading_dump) { diff --git a/src/comp.h b/src/comp.h index 86fa54f5158..ddebbbcccf0 100644 --- a/src/comp.h +++ b/src/comp.h @@ -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; }; diff --git a/src/lisp.h b/src/lisp.h index 2d083dc4582..04489959ed8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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 -- 2.39.5