From: Andrea Corallo Date: Thu, 22 Aug 2019 14:00:43 +0000 (+0200) Subject: emit function relocation into structure X-Git-Tag: emacs-28.0.90~2727^2~1247 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ad5488cad62b04ff1ae28cbbe2a0dcb2af817f27;p=emacs.git emit function relocation into structure --- diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 972c1185871..a14438e250c 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -80,8 +80,7 @@ "This structure is to serve al relocation creation for the current compiler context." (funcs () :type list - :documentation "Alist lisp-func-name -> c-func-name. -This is build before entering into `comp--compile-ctxt-to-file name'.") + :documentation "Exported functions list.") (funcs-h (make-hash-table) :type hash-table :documentation "lisp-func-name -> comp-func. This is to build the prev field.") @@ -180,6 +179,14 @@ The corresponding index is returned." (push obj (comp-ctxt-data-relocs-l comp-ctxt)) (puthash obj (hash-table-count data-relocs-idx) data-relocs-idx)))) +(defun comp-add-subr-to-relocs (subr-name) + "Keep track of SUBR-NAME into the ctxt relocations. +The corresponding index is returned." + (let ((func-relocs-idx (comp-ctxt-func-relocs-idx comp-ctxt))) + (unless (gethash subr-name func-relocs-idx) + (push subr-name (comp-ctxt-func-relocs-l comp-ctxt)) + (puthash subr-name (hash-table-count func-relocs-idx) func-relocs-idx)))) + (defmacro comp-within-log-buff (&rest body) "Execute BODY while at the end the log-buffer. BODY is evaluate only if `comp-debug' is non nil." @@ -276,10 +283,12 @@ Put PREFIX in front of it." (defun comp-call (func &rest args) "Emit a call for function FUNC with ARGS." + (comp-add-subr-to-relocs func) `(call ,func ,@args)) (defun comp-callref (func &rest args) "Emit a call usign narg abi for FUNC with ARGS." + (comp-add-subr-to-relocs func) `(callref ,func ,@args)) (defun comp-new-frame (size) diff --git a/src/comp.c b/src/comp.c index 5c8106a78e4..1a2984bb72e 100644 --- a/src/comp.c +++ b/src/comp.c @@ -150,6 +150,7 @@ typedef struct { Lisp_Object func_hash; /* c_f_name -> (gcc_func . subr_name). */ Lisp_Object emitter_dispatcher; gcc_jit_rvalue *data_relocs; + gcc_jit_lvalue *func_relocs; } comp_t; static comp_t comp; @@ -283,7 +284,7 @@ fill_declaration_types (gcc_jit_type **type, gcc_jit_rvalue **args, type[i] = comp.lisp_obj_type; } -static void +static gcc_jit_field * declare_imported_func (Lisp_Object subr_sym, gcc_jit_type *ret_type, unsigned nargs, gcc_jit_rvalue **args) { @@ -305,14 +306,15 @@ declare_imported_func (Lisp_Object subr_sym, gcc_jit_type *ret_type, nargs, type, 0); - gcc_jit_lvalue *f_ptr - = gcc_jit_context_new_global (comp.ctxt, - NULL, - GCC_JIT_GLOBAL_EXPORTED, - f_ptr_type, - SSDATA (f_ptr_name)); - Lisp_Object value = Fcons (make_mint_ptr (f_ptr), subr_sym); + gcc_jit_field *field + = gcc_jit_context_new_field (comp.ctxt, + NULL, + f_ptr_type, + SSDATA (f_ptr_name)); + + Lisp_Object value = Fcons (make_mint_ptr (field), subr_sym); Fputhash (subr_sym, value, comp.func_hash); + return field; } static gcc_jit_function * @@ -343,14 +345,12 @@ emit_call (Lisp_Object subr_sym, gcc_jit_type *ret_type, unsigned nargs, gcc_jit_rvalue **args) { Lisp_Object value = Fgethash (subr_sym, comp.func_hash, Qnil); + eassert (!NILP (value)); - if (NILP (value)) - { - declare_imported_func (subr_sym, ret_type, nargs, args); - value = Fgethash (subr_sym, comp.func_hash, Qnil); - eassert (!NILP (value)); - } - gcc_jit_lvalue *f_ptr = (gcc_jit_lvalue *) xmint_pointer (XCAR (value)); + gcc_jit_lvalue *f_ptr = + gcc_jit_lvalue_access_field (comp.func_relocs, + NULL, + (gcc_jit_field *) xmint_pointer (XCAR (value))); emit_comment (format_string ("calling subr: %s", SSDATA (SYMBOL_NAME (subr_sym)))); return gcc_jit_context_new_call_through_ptr(comp.ctxt, @@ -1529,6 +1529,8 @@ This emit the code needed by every compilation unit to be loaded. static void emit_ctxt_code (void) { + /* Imported objects. */ + const char *d_reloc = SSDATA (FUNCALL1 (comp-ctxt-data-relocs, Vcomp_ctxt)); EMACS_UINT d_reloc_len = XFIXNUM (FUNCALL1 (hash-table-count, @@ -1548,6 +1550,37 @@ emit_ctxt_code (void) emit_litteral_string_func ("text_data_relocs", d_reloc); + /* Imported functions. */ + Lisp_Object f_reloc = FUNCALL1 (comp-ctxt-func-relocs-l, Vcomp_ctxt); + EMACS_UINT f_reloc_len = XFIXNUM (Flength (f_reloc)); + gcc_jit_field *fields[f_reloc_len]; + int i = 0; + FOR_EACH_TAIL (f_reloc) + { + Lisp_Object subr_sym = XCAR (f_reloc); + Lisp_Object subr = Fsymbol_function (subr_sym); + gcc_jit_field *field + = declare_imported_func (subr_sym, comp.lisp_obj_type, + XFIXNUM (XCDR (Fsubr_arity (subr))), NULL); + fields [i++] = field; + } + eassert (f_reloc_len == i); + + gcc_jit_struct *f_reloc_struct + = gcc_jit_context_new_struct_type (comp.ctxt, + NULL, + "function_reloc_struct", + f_reloc_len, + fields); + comp.func_relocs + = gcc_jit_context_new_global ( + comp.ctxt, + NULL, + GCC_JIT_GLOBAL_EXPORTED, + gcc_jit_struct_as_type (f_reloc_struct), + "f_reloc"); + + /* Exported functions info. */ const char *func_list = SSDATA (FUNCALL1 (comp-ctxt-funcs, Vcomp_ctxt)); emit_litteral_string_func ("text_exported_funcs", func_list); } @@ -2658,17 +2691,6 @@ DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt, comp.void_ptr_type, pure); - /* Define inline functions. */ - - define_CAR_CDR(); - define_PSEUDOVECTORP (); - define_CHECK_TYPE (); - define_CHECK_IMPURE (); - define_bool_to_lisp_obj (); - define_setcar_setcdr (); - define_add1_sub1 (); - define_negate (); - return Qt; } @@ -2709,6 +2731,16 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, emit_ctxt_code (); + /* /\* Define inline functions. *\/ */ + /* define_CAR_CDR(); */ + /* define_PSEUDOVECTORP (); */ + /* define_CHECK_TYPE (); */ + /* define_CHECK_IMPURE (); */ + /* define_bool_to_lisp_obj (); */ + /* define_setcar_setcdr (); */ + /* define_add1_sub1 (); */ + /* define_negate (); */ + /* Compile all functions. Can't be done before because the relocation vectore has to be already compiled. */ struct Lisp_Hash_Table *func_h