From: Andrea Corallo Date: Sun, 18 Aug 2019 16:43:33 +0000 (+0200) Subject: basic reload almost working X-Git-Tag: emacs-28.0.90~2727^2~1259 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c8a0b81f8ffe093910dd3ad2852dd47a15587d9e;p=emacs.git basic reload almost working --- diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 486a7068be5..a453acc329c 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -253,7 +253,7 @@ BODY is evaluate only if `comp-debug' is non nil." (let ((lambda-list (aref (comp-func-byte-func func) 0))) (if (fixnump lambda-list) (setf (comp-func-args func) - (comp-decrypt-lambda-list (aref (comp-func-byte-func func) 0))) + (comp-decrypt-lambda-list lambda-list)) (error "Can't native compile a non lexical scoped function"))) (setf (comp-func-lap func) byte-compile-lap-output) (setf (comp-func-frame-size func) (aref (comp-func-byte-func func) 3)) @@ -831,19 +831,26 @@ the annotation emission." (cl-assert (= (length (comp-ctxt-data-relocs-l comp-ctxt)) (hash-table-count (comp-ctxt-data-relocs-idx comp-ctxt)))) (setf (comp-ctxt-data-relocs comp-ctxt) - (prin1-to-string (vconcat (reverse (comp-ctxt-data-relocs-l comp-ctxt))))) + (prin1-to-string (vconcat (reverse (comp-ctxt-data-relocs-l comp-ctxt))))) (setf (comp-ctxt-funcs comp-ctxt) - (cl-loop with h = (comp-ctxt-funcs-h comp-ctxt) - for f being each hash-keys of h - using (hash-value c-f) - collect (cons (symbol-name f) c-f))) + (prin1-to-string (cl-loop with h = (comp-ctxt-funcs-h comp-ctxt) + for f being each hash-value of h + collect f))) (comp--compile-ctxt-to-file name)) (defun comp-add-func-to-ctxt (func) "Add FUNC to the current compiler contex." - (puthash (comp-func-symbol-name func) - (comp-func-c-func-name func) - (comp-ctxt-funcs-h comp-ctxt)) + (let ((args (comp-func-args func)) + (doc (aref (comp-func-byte-func func) 4))) + (puthash (comp-func-symbol-name func) + (vector (comp-func-symbol-name func) + (comp-func-c-func-name func) + (cons (comp-args-base-min args) + (if (comp-args-p args) + (comp-args-max args) + 'many)) + doc) + (comp-ctxt-funcs-h comp-ctxt))) (comp--add-func-to-ctxt func)) diff --git a/src/comp.c b/src/comp.c index 65bca050b0e..953a1dd9d0f 100644 --- a/src/comp.c +++ b/src/comp.c @@ -1473,6 +1473,30 @@ emit_integerp (Lisp_Object insn) &res); } +/* + Is not possibile to initilize static data in libgccjit therfore will create + the following: + + char *str_name (void) + { + return "payload here"; + } +*/ + +static void +emit_litteral_string_func (const char *str_name, const char *str) +{ + gcc_jit_function *f = + gcc_jit_context_new_function (comp.ctxt, NULL, + GCC_JIT_FUNCTION_EXPORTED, + comp.char_ptr_type, + str_name, + 0, NULL, 0); + DECL_BLOCK (block, f); + gcc_jit_rvalue *res = gcc_jit_context_new_string_literal (comp.ctxt, str); + gcc_jit_block_end_with_return (block, NULL, res); +} + /* This emit the code needed by every compilation unit to be loaded. */ @@ -1493,24 +1517,11 @@ emit_ctxt_code (void) comp.lisp_obj_type, d_reloc_len), "data_relocs"); - /* - Is not possibile to initilize static data in libgccjit therfore will create - the following: - char *text_data_relocs (void) - { - return "[a b c... etc]"; - } - */ - gcc_jit_function *f = - gcc_jit_context_new_function (comp.ctxt, NULL, - GCC_JIT_FUNCTION_EXPORTED, - comp.char_ptr_type, - "text_data_relocs", - 0, NULL, 0); - DECL_BLOCK (block, f); - gcc_jit_rvalue *res = gcc_jit_context_new_string_literal (comp.ctxt, d_reloc); - gcc_jit_block_end_with_return (block, NULL, res); + emit_litteral_string_func ("text_data_relocs", d_reloc); + + const char *func_list = SSDATA (FUNCALL1 (comp-ctxt-funcs, Vcomp_ctxt)); + emit_litteral_string_func ("text_funcs", func_list); } @@ -2868,7 +2879,6 @@ syms_of_comp (void) defsubr (&Scomp__release_ctxt); defsubr (&Scomp__add_func_to_ctxt); defsubr (&Scomp__compile_ctxt_to_file); - defsubr (&Scomp_compile_and_load_ctxt); staticpro (&comp.func_hash); comp.func_hash = Qnil; diff --git a/src/emacs-module.c b/src/emacs-module.c index 7b9a5d843d0..e14ef89d8f9 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -944,21 +944,61 @@ module_signal_or_throw (struct emacs_env_private *env) } } -typedef char *(*f_comp_data_relocs) (void); + +/* + Native compiler load functions. + FIXME: Move away from here. +*/ + +typedef char *(*comp_litt_str_func) (void); + +static Lisp_Object +comp_retrive_obj (dynlib_handle_ptr handle, const char *str_name) +{ + comp_litt_str_func f = dynlib_sym (handle, str_name); + char *res = f(); + return Fread (build_string (res)); +} static int -comp_load_unit (dynlib_handle_ptr handle, struct emacs_runtime *rt) +comp_load_unit (dynlib_handle_ptr handle, emacs_env *env) { Lisp_Object *data_relocs = dynlib_sym (handle, "data_relocs"); - f_comp_data_relocs f = dynlib_sym (handle, "text_data_relocs"); - char *text_data_relocs = f(); - Lisp_Object d_vec = Fread (build_string (text_data_relocs)); + Lisp_Object d_vec = comp_retrive_obj (handle, "text_data_relocs"); EMACS_UINT d_vec_len = XFIXNUM (Flength (d_vec)); for (EMACS_UINT i = 0; i < d_vec_len; i++) data_relocs[i] = AREF (d_vec, i); + Lisp_Object func_list = comp_retrive_obj (handle, "text_funcs"); + + while (func_list) + { + Lisp_Object el = XCAR (func_list); + Lisp_Object Qsym = AREF (el, 0); + char *c_func_name = SSDATA (AREF (el, 1)); + Lisp_Object args = AREF (el, 2); + ptrdiff_t minargs = XFIXNUM (XCAR (args)); + ptrdiff_t maxargs = FIXNUMP (XCDR (args)) ? XFIXNUM (XCDR (args)) : MANY; + /* char *doc = SSDATA (AREF (el, 3)); */ + void *func = dynlib_sym (handle, c_func_name); + eassert (func); + /* Ffset (Qsym, */ + /* value_to_lisp (module_make_function (env, minargs, maxargs, func, */ + /* doc, NULL))); */ + + union Aligned_Lisp_Subr *x = xmalloc (sizeof (union Aligned_Lisp_Subr)); + x->s.header.size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS; + x->s.function.a0 = func; + x->s.min_args = minargs; + x->s.max_args = maxargs; + x->s.symbol_name = SSDATA (Fsymbol_name (Qsym)); + defsubr(x); + + func_list = XCDR (func_list); + } + return 0; } @@ -1011,7 +1051,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, ptrdiff_t count = SPECPDL_INDEX (); record_unwind_protect_ptr (finalize_runtime_unwind, rt); - int r = native_comp ? comp_load_unit (handle, rt) : module_init (rt); + int r = native_comp ? comp_load_unit (handle, &env_pub) : module_init (rt); /* Process the quit flag first, so that quitting doesn't get overridden by other non-local exits. */