From 9413488ab4e8752a2fe88ce9f42ca83ffbe5f1a8 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 31 Aug 2019 17:06:45 +0200 Subject: [PATCH] reloc emission mechanism seems ok --- src/comp.c | 236 ++++++++++++++++++++++++++++++++++------------------- 1 file changed, 151 insertions(+), 85 deletions(-) diff --git a/src/comp.c b/src/comp.c index 1a2984bb72e..d7e82845454 100644 --- a/src/comp.c +++ b/src/comp.c @@ -149,8 +149,8 @@ typedef struct { Lisp_Object func_blocks; /* blk_name -> gcc_block. */ 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; + gcc_jit_rvalue *data_relocs; /* Synthesized struct holding data relocs. */ + gcc_jit_lvalue *func_relocs; /* Synthesized struct holding func relocs. */ } comp_t; static comp_t comp; @@ -270,53 +270,72 @@ emit_comment (const char *str) str); } -static void -fill_declaration_types (gcc_jit_type **type, gcc_jit_rvalue **args, - unsigned nargs) -{ - /* If args are passed types are extracted from that otherwise assume params */ - /* are all lisp objs. */ - if (args) - for (unsigned i = 0; i < nargs; i++) - type[i] = gcc_jit_rvalue_get_type (args[i]); - else - for (unsigned i = 0; i < nargs; i++) - type[i] = comp.lisp_obj_type; -} - +/* + Declare an imported function. + When nargs is MANY (ptrdiff_t nargs, Lisp_Object *args) signature is assumed. + When types is NULL types is assumed to be all Lisp_Objects. +*/ static gcc_jit_field * declare_imported_func (Lisp_Object subr_sym, gcc_jit_type *ret_type, - unsigned nargs, gcc_jit_rvalue **args) + int nargs, gcc_jit_type **types) { /* Don't want to declare the same function two times. */ eassert (NILP (Fgethash (subr_sym, comp.func_hash, Qnil))); - gcc_jit_type *type[nargs]; - fill_declaration_types (type, args, nargs); + if (nargs == MANY) + { + nargs = 2; + types = alloca (nargs * sizeof (* types)); + types[0] = comp.ptrdiff_type; + types[1] = comp.lisp_obj_type; + } + else if (!types) + { + types = alloca (nargs * sizeof (* types)); + for (unsigned i = 0; i < nargs; i++) + types[i] = comp.lisp_obj_type; + } + + eassert (types); /* String containing the function ptr name. */ - Lisp_Object f_ptr_name - = CALLN (Ffuncall, intern_c_string (STR (comp-c-func-name)), - subr_sym, make_string("R", 1)); - - gcc_jit_type *f_ptr_type - = gcc_jit_context_new_function_ptr_type (comp.ctxt, - NULL, - ret_type, - nargs, - type, - 0); - gcc_jit_field *field - = gcc_jit_context_new_field (comp.ctxt, - NULL, - f_ptr_type, - SSDATA (f_ptr_name)); + Lisp_Object f_ptr_name = + CALLN (Ffuncall, intern_c_string (STR (comp-c-func-name)), + subr_sym, make_string("R", 1)); + + gcc_jit_type *f_ptr_type = + gcc_jit_context_new_function_ptr_type (comp.ctxt, + NULL, + ret_type, + nargs, + types, + 0); + 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 void +fill_declaration_types (gcc_jit_type **type, gcc_jit_rvalue **args, + unsigned nargs) +{ + /* If args are passed types are extracted from that otherwise assume params */ + /* are all lisp objs. */ + if (args) + for (unsigned i = 0; i < nargs; i++) + type[i] = gcc_jit_rvalue_get_type (args[i]); + else + for (unsigned i = 0; i < nargs; i++) + type[i] = comp.lisp_obj_type; +} + static gcc_jit_function * declare_exported_func (const char *f_name, gcc_jit_type *ret_type, unsigned nargs, gcc_jit_rvalue **args) @@ -351,6 +370,9 @@ emit_call (Lisp_Object subr_sym, gcc_jit_type *ret_type, unsigned nargs, gcc_jit_lvalue_access_field (comp.func_relocs, NULL, (gcc_jit_field *) xmint_pointer (XCAR (value))); + if (!f_ptr) + error ("Undeclared function relocation."); + emit_comment (format_string ("calling subr: %s", SSDATA (SYMBOL_NAME (subr_sym)))); return gcc_jit_context_new_call_through_ptr(comp.ctxt, @@ -1523,6 +1545,38 @@ emit_litteral_string_func (const char *str_name, const char *str) gcc_jit_block_end_with_return (block, NULL, res); } +/* + Declare as imported all the functions that are requested from the runtime. + These are either subrs or not. +*/ +static Lisp_Object +declare_runtime_imported (void) +{ + /* For subr imported by the runtime we rely on the standard mechanism in place + for functions imported by lisp code. */ + FUNCALL1 (comp-add-subr-to-relocs, intern_c_string ("1+")); + FUNCALL1 (comp-add-subr-to-relocs, intern_c_string ("1-")); + FUNCALL1 (comp-add-subr-to-relocs, intern_c_string ("+")); + FUNCALL1 (comp-add-subr-to-relocs, intern_c_string ("-")); + + Lisp_Object field_list = Qnil; +#define ADD_IMPORTED(f_name, ret_type, nargs, args) \ + { \ + Lisp_Object name = intern_c_string (f_name); \ + Lisp_Object field = \ + make_mint_ptr (declare_imported_func (name, ret_type, nargs, args)); \ + field_list = Fcons (field, field_list); \ + } while (0) + + ADD_IMPORTED ("wrong_type_argument", comp.void_type, 2, NULL); + gcc_jit_type *args[] = {comp.lisp_obj_type, comp.int_type}; + ADD_IMPORTED ("helper_PSEUDOVECTOR_TYPEP_XUNTAG", comp.bool_type, 2, args); + ADD_IMPORTED ("pure_write_error", comp.void_type, 1, NULL); +#undef ADD_IMPORTED + + return field_list; +} + /* This emit the code needed by every compilation unit to be loaded. */ @@ -1536,49 +1590,61 @@ emit_ctxt_code (void) XFIXNUM (FUNCALL1 (hash-table-count, FUNCALL1 (comp-ctxt-data-relocs-idx, Vcomp_ctxt))); - 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_relocs")); + 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_relocs")); 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)); + /* Imported functions from non Lisp code. */ + Lisp_Object f_runtime = declare_runtime_imported (); + EMACS_UINT f_reloc_len = XFIXNUM (Flength (f_runtime)); + + /* Imported subrs. */ + Lisp_Object f_subr = FUNCALL1 (comp-ctxt-func-relocs-l, Vcomp_ctxt); + f_reloc_len += XFIXNUM (Flength (f_subr)); + gcc_jit_field *fields[f_reloc_len]; int i = 0; - FOR_EACH_TAIL (f_reloc) + + FOR_EACH_TAIL (f_runtime) { - Lisp_Object subr_sym = XCAR (f_reloc); + fields[i++] = xmint_pointer( XCAR (f_runtime)); + } + + FOR_EACH_TAIL (f_subr) + { + Lisp_Object subr_sym = XCAR (f_subr); 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); + Lisp_Object maxarg = XCDR (Fsubr_arity (subr)); + gcc_jit_field *field = + declare_imported_func (subr_sym, comp.lisp_obj_type, + FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY, 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"); + 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)); @@ -2332,18 +2398,18 @@ define_PSEUDOVECTORP (void) comp.bool_type, false)); - gcc_jit_rvalue *args[2] = + gcc_jit_rvalue *args[] = { gcc_jit_param_as_rvalue (param[0]), gcc_jit_param_as_rvalue (param[1]) }; comp.block = call_pseudovector_typep_b; /* FIXME use XUNTAG now that's available. */ - gcc_jit_block_end_with_return (call_pseudovector_typep_b - , - NULL, - emit_call (intern_c_string ("helper_PSEUDOVECTOR_TYPEP_XUNTAG"), - comp.bool_type, - 2, - args)); + gcc_jit_block_end_with_return ( + call_pseudovector_typep_b, + NULL, + emit_call (intern_c_string ("helper_PSEUDOVECTOR_TYPEP_XUNTAG"), + comp.bool_type, + 2, + args)); } static void @@ -2731,18 +2797,18 @@ 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 (); */ + /* 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. */ + relocation structs has to be already defined. */ struct Lisp_Hash_Table *func_h = XHASH_TABLE (FUNCALL1 (comp-ctxt-funcs-h, Vcomp_ctxt)); for (ptrdiff_t i = 0; i < func_h->count; i++) -- 2.39.5