diff options
Diffstat (limited to 'src/comp.c')
| -rw-r--r-- | src/comp.c | 150 |
1 files changed, 137 insertions, 13 deletions
diff --git a/src/comp.c b/src/comp.c index 704bd4b6b35..ff73245b8de 100644 --- a/src/comp.c +++ b/src/comp.c @@ -29,6 +29,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <stdio.h> #include <signal.h> #include <libgccjit.h> +#include <epaths.h> #include "puresize.h" #include "window.h" @@ -393,6 +394,8 @@ load_gccjit_if_necessary (bool mandatory) } +#define ELN_FILENAME_HASH_LEN 64 + /* C symbols emitted for the load relocation mechanism. */ #define CURRENT_THREAD_RELOC_SYM "current_thread_reloc" #define PURE_RELOC_SYM "pure_reloc" @@ -634,6 +637,16 @@ format_string (const char *format, ...) return scratch_area; } +static Lisp_Object +comp_hash_string (Lisp_Object string) +{ + Lisp_Object digest = make_uninit_string (SHA512_DIGEST_SIZE * 2); + sha512_buffer (SSDATA (string), SCHARS (string), SSDATA (digest)); + hexbuf_digest (SSDATA (digest), SDATA (digest), SHA512_DIGEST_SIZE); + + return digest; +} + /* Produce a key hashing Vcomp_subr_list. */ void @@ -641,10 +654,7 @@ hash_native_abi (void) { Lisp_Object string = Fmapconcat (intern_c_string ("subr-name"), Vcomp_subr_list, build_string (" ")); - Lisp_Object digest = make_uninit_string (SHA512_DIGEST_SIZE * 2); - - sha512_buffer (SSDATA (string), SCHARS (string), SSDATA (digest)); - hexbuf_digest (SSDATA (digest), SDATA (digest), SHA512_DIGEST_SIZE); + Lisp_Object digest = comp_hash_string (string); /* Check runs once. */ eassert (NILP (Vcomp_abi_hash)); @@ -652,8 +662,7 @@ hash_native_abi (void) /* If 10 characters are usually sufficient for git I guess 16 are fine for us here. */ Vcomp_native_path_postfix = - concat3 (make_string ("eln-", 4), - Vsystem_configuration, + concat2 (Vsystem_configuration, concat2 (make_string ("-", 1), Fsubstring_no_properties (Vcomp_abi_hash, make_fixnum (0), @@ -3852,6 +3861,71 @@ compile_function (Lisp_Object func) /* Entry points exposed to lisp. */ /**********************************/ +/* In use by Fcomp_el_to_eln_filename. */ +static Lisp_Object loadsearch_re_list; + +DEFUN ("comp-el-to-eln-filename", Fcomp_el_to_eln_filename, + Scomp_el_to_eln_filename, 1, 2, 0, + doc: /* Given a source file return the corresponding .eln true filename. +If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) + (Lisp_Object filename, Lisp_Object base_dir) +{ + CHECK_STRING (filename); + + if (suffix_p (filename, ".gz")) + filename = Fsubstring (filename, Qnil, make_fixnum (-3)); + filename = Fexpand_file_name (filename, Qnil); + + /* We create eln filenames with an hash in order to look-up these + starting from the source filename, IOW have a relation + /absolute/path/filename.el -> eln-cache/filename-hash.eln. + + As installing .eln files compiled during the build changes their + absolute path we need an hashing mechanism that is not sensitive + to that. For this we replace if match PATH_DUMPLOADSEARCH or + PATH_LOADSEARCH with '//' before generating the hash. + + Another approach would be to hash using the source file content + but this may have a measurable performance impact. */ + + if (NILP (loadsearch_re_list)) + { + Lisp_Object loadsearch_list = + Fcons (build_string (PATH_DUMPLOADSEARCH), + Fcons (build_string (PATH_LOADSEARCH), Qnil)); + FOR_EACH_TAIL (loadsearch_list) + loadsearch_re_list = + Fcons (Fregexp_quote (XCAR (loadsearch_list)), loadsearch_re_list); + } + Lisp_Object loadsearch_res = loadsearch_re_list; + FOR_EACH_TAIL (loadsearch_res) + { + Lisp_Object match_idx = + Fstring_match (XCAR (loadsearch_res), filename, Qnil); + if (EQ (match_idx, make_fixnum (0))) + { + filename = + Freplace_match (build_string ("//"), Qt, Qt, filename, Qnil); + break; + } + } + + Lisp_Object hash = Fsubstring (comp_hash_string (filename), Qnil, + make_fixnum (ELN_FILENAME_HASH_LEN)); + filename = concat2 (Ffile_name_nondirectory (Fsubstring (filename, Qnil, + make_fixnum (-3))), + build_string ("-")); + filename = concat3 (filename, hash, build_string (NATIVE_ELISP_SUFFIX)); + if (NILP (base_dir)) + base_dir = XCAR (Vcomp_eln_load_path); + + if (!file_name_absolute_p (SSDATA (base_dir))) + base_dir = Fexpand_file_name (base_dir, Vinvocation_directory); + + return Fexpand_file_name (filename, + concat2 (base_dir, Vcomp_native_path_postfix)); +} + DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt, 0, 0, 0, doc: /* Initialize the native compiler context. Return t on success. */) @@ -4039,11 +4113,12 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, Scomp__compile_ctxt_to_file, 1, 1, 0, doc: /* Compile as native code the current context to file. */) - (Lisp_Object base_name) + (Lisp_Object file_name) { load_gccjit_if_necessary (true); - CHECK_STRING (base_name); + CHECK_STRING (file_name); + Lisp_Object base_name = Fsubstring (file_name, Qnil, make_fixnum (-4)); gcc_jit_context_set_int_option (comp.ctxt, GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL, @@ -4105,19 +4180,18 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, AUTO_STRING (dot_so, NATIVE_ELISP_SUFFIX); - Lisp_Object out_file = CALLN (Fconcat, base_name, dot_so); Lisp_Object tmp_file = Fmake_temp_file_internal (base_name, Qnil, dot_so, Qnil); gcc_jit_context_compile_to_file (comp.ctxt, GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY, SSDATA (tmp_file)); - CALL2I (comp--replace-output-file, out_file, tmp_file); + CALL2I (comp--replace-output-file, file_name, tmp_file); if (!noninteractive) unbind_to (count, Qnil); - return out_file; + return file_name; } DEFUN ("comp-libgccjit-version", Fcomp_libgccjit_version, @@ -4462,7 +4536,11 @@ maybe_defer_native_compilation (Lisp_Object function_name, concat2 (CALL1I (file-name-sans-extension, Vload_true_file_name), build_pure_c_string (".el")); if (NILP (Ffile_exists_p (src))) - return; + { + src = concat2 (src, build_pure_c_string (".gz")); + if (NILP (Ffile_exists_p (src))) + return; + } /* This is to have deferred compilaiton able to compile comp dependecies breaking circularity. */ @@ -4497,6 +4575,27 @@ maybe_defer_native_compilation (Lisp_Object function_name, /* Functions used to load eln files. */ /**************************************/ +/* Fixup the system eln-cache dir. This is the last entry in + `comp-eln-load-path'. */ +void +fixup_eln_load_path (Lisp_Object directory) +{ + Lisp_Object last_cell = Qnil; + Lisp_Object tmp = Vcomp_eln_load_path; + FOR_EACH_TAIL (tmp) + if (CONSP (tmp)) + last_cell = tmp; + + Lisp_Object eln_cache_sys = + Ffile_name_directory (concat2 (Vinvocation_directory, + directory)); + /* One directory up... */ + eln_cache_sys = + Ffile_name_directory (Fsubstring (eln_cache_sys, Qnil, + make_fixnum (-1))); + Fsetcar (last_cell, eln_cache_sys); +} + typedef char *(*comp_lit_str_func) (void); /* Deserialize read and return static object. */ @@ -4869,7 +4968,13 @@ syms_of_comp (void) #ifdef HAVE_NATIVE_COMP /* Compiler control customizes. */ DEFVAR_BOOL ("comp-deferred-compilation", comp_deferred_compilation, - doc: /* If t compile asyncronously every .elc file loaded. */); + doc: /* If non-nil compile asyncronously all .elc files +being loaded. + +Once compilation happened each function definition is updated to the +native compiled one. */); + comp_deferred_compilation = true; + DEFSYM (Qcomp_speed, "comp-speed"); DEFSYM (Qcomp_debug, "comp-debug"); @@ -4971,6 +5076,7 @@ syms_of_comp (void) build_pure_c_string ("eln file inconsistent with current runtime " "configuration, please recompile")); + defsubr (&Scomp_el_to_eln_filename); defsubr (&Scomp__init_ctxt); defsubr (&Scomp__release_ctxt); defsubr (&Scomp__compile_ctxt_to_file); @@ -4989,6 +5095,8 @@ syms_of_comp (void) comp.emitter_dispatcher = Qnil; staticpro (&delayed_sources); delayed_sources = Qnil; + staticpro (&loadsearch_re_list); + loadsearch_re_list = Qnil; #ifdef WINDOWSNT staticpro (&all_loaded_comp_units_h); @@ -5015,6 +5123,22 @@ syms_of_comp (void) internal use during */); Vcomp_deferred_pending_h = CALLN (Fmake_hash_table, QCtest, Qeq); + DEFVAR_LISP ("comp-eln-to-el-h", Vcomp_eln_to_el_h, + doc: /* Hash table eln-filename -> el-filename. */); + Vcomp_eln_to_el_h = CALLN (Fmake_hash_table, QCtest, Qequal); + + DEFVAR_LISP ("comp-eln-load-path", Vcomp_eln_load_path, + doc: /* List of eln cache directories. + +If a directory is non absolute is assumed to be relative to +`invocation-directory'. +The last directory of this list is assumed to be the system one. */); + + /* Temporary value in use for boostrap. We can't do better as + `invocation-directory' is still unset, will be fixed up during + dump reload. */ + Vcomp_eln_load_path = Fcons (build_string ("../eln-cache/"), Qnil); + #endif /* #ifdef HAVE_NATIVE_COMP */ defsubr (&Snative_comp_available_p); |