procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

basic reload almost working

Browse source
This commit is contained in:
Andrea Corallo 2019-08-18 18:43:33 +02:00 • committed by Andrea Corallo
parent 6f6362207f
commit c8a0b81f8f
3 changed files with 90 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

19
lisp/emacs-lisp/comp.el
View file

@ -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))
@ -833,17 +833,24 @@ the annotation emission."
(setf (comp-ctxt-data-relocs 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."
(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)
(comp-ctxt-funcs-h comp-ctxt))
(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))

46
src/comp.c
View file

@ -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;

52
src/emacs-module.c
View file

@ -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. */