From 01442a9ac9c6e6a652b628cf18b90a7e30bff845 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 11 May 2019 21:12:21 +0200 Subject: Add native compiler comp.c --- src/lread.c | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 290b3d3d64e..bedb3d57cb5 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4174,13 +4174,16 @@ intern_c_string_1 (const char *str, ptrdiff_t len) { Lisp_Object obarray = check_obarray (Vobarray); Lisp_Object tem = oblookup (obarray, str, len, len); + Lisp_Object string; if (!SYMBOLP (tem)) { - /* Creating a non-pure string from a string literal not implemented yet. - We could just use make_string here and live with the extra copy. */ - eassert (!NILP (Vpurify_flag)); - tem = intern_driver (make_pure_c_string (str, len), obarray, tem); + if NILP (Vpurify_flag) + string = make_string (str, len); + else + string = make_pure_c_string (str, len); + + tem = intern_driver (string, obarray, tem); } return tem; } -- cgit v1.2.3 From 4ca1857b501875fa3695ee7d42712e681c4767f4 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 15 Jun 2019 18:07:59 +0200 Subject: fix intern_c_string_1 --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index bedb3d57cb5..ca7b29f690b 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4178,7 +4178,7 @@ intern_c_string_1 (const char *str, ptrdiff_t len) if (!SYMBOLP (tem)) { - if NILP (Vpurify_flag) + if (NILP (Vpurify_flag)) string = make_string (str, len); else string = make_pure_c_string (str, len); -- cgit v1.2.3 From 70a7c65742244403422d7c3e4b79a2046c1cefb7 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 18 Aug 2019 21:48:49 +0200 Subject: move away from modules --- src/comp.c | 87 ++++++++++++++++++++++++++++++++++++++++++++++++++---- src/emacs-module.c | 76 +++++------------------------------------------ src/lread.c | 45 +++++++++++++++++++--------- 3 files changed, 119 insertions(+), 89 deletions(-) (limited to 'src/lread.c') diff --git a/src/comp.c b/src/comp.c index 953a1dd9d0f..5233a72aa5d 100644 --- a/src/comp.c +++ b/src/comp.c @@ -31,6 +31,7 @@ along with GNU Emacs. If not, see . */ #include "bytecode.h" #include "atimer.h" #include "window.h" +#include "dynlib.h" #define DEFAULT_SPEED 2 /* See comp-speed var. */ @@ -2555,11 +2556,6 @@ DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt, define_add1_sub1 (); define_negate (); - gcc_jit_context_new_global (comp.ctxt, - NULL, - GCC_JIT_GLOBAL_EXPORTED, - comp.int_type, - "native_compiled_emacs_lisp"); return Qt; } @@ -2699,7 +2695,7 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, gcc_jit_context_dump_to_file (comp.ctxt, filename, 1); } - AUTO_STRING (dot_so, ".so"); /* FIXME use correct var */ + AUTO_STRING (dot_so, NATIVE_ELISP_SUFFIX); const char *filename = (const char *) SDATA (CALLN (Fconcat, ctxtname, dot_so)); @@ -2830,6 +2826,81 @@ helper_set_data_relocs (Lisp_Object *d_relocs_vec, char const *relocs) { } + + +/************************************/ +/* Native compiler load functions. */ +/************************************/ + +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 +load_comp_unit (dynlib_handle_ptr handle) +{ + Lisp_Object *data_relocs = dynlib_sym (handle, "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); + + 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; +} + +/* Load related routines. */ +DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0, + doc: /* Load native elisp code FILE. */) + (Lisp_Object file) +{ + dynlib_handle_ptr handle; + + CHECK_STRING (file); + handle = dynlib_open (SSDATA (file)); + if (!handle) + xsignal2 (Qcomp_unit_open_failed, file, build_string (dynlib_error ())); + + int r = load_comp_unit (handle); + + if (r != 0) + xsignal2 (Qcomp_unit_init_failed, file, INT_TO_INTEGER (r)); + + return Qt; +} + void syms_of_comp (void) @@ -2874,11 +2945,15 @@ syms_of_comp (void) DEFSYM (Qnegate, "negate"); DEFSYM (QFnumberp, "Fnumberp"); DEFSYM (QFintegerp, "Fintegerp"); + /* Returned values. */ + DEFSYM (Qcomp_unit_open_failed, "comp-unit-open-failed"); + DEFSYM (Qcomp_unit_init_failed, "comp-unit-init-failed"); defsubr (&Scomp__init_ctxt); defsubr (&Scomp__release_ctxt); defsubr (&Scomp__add_func_to_ctxt); defsubr (&Scomp__compile_ctxt_to_file); + defsubr (&Snative_elisp_load); staticpro (&comp.func_hash); comp.func_hash = Qnil; diff --git a/src/emacs-module.c b/src/emacs-module.c index e14ef89d8f9..bbb0e3dadd9 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -944,64 +944,6 @@ module_signal_or_throw (struct emacs_env_private *env) } } - -/* - 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, emacs_env *env) -{ - Lisp_Object *data_relocs = dynlib_sym (handle, "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; -} - /* Live runtime and environment objects, for assertions. */ static Lisp_Object Vmodule_runtimes; static Lisp_Object Vmodule_environments; @@ -1012,7 +954,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, { dynlib_handle_ptr handle; emacs_init_function module_init; - void *gpl_sym, *native_comp; + void *gpl_sym; CHECK_STRING (file); handle = dynlib_open (SSDATA (file)); @@ -1020,17 +962,13 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, xsignal2 (Qmodule_open_failed, file, build_string (dynlib_error ())); gpl_sym = dynlib_sym (handle, "plugin_is_GPL_compatible"); - native_comp = dynlib_sym (handle, "native_compiled_emacs_lisp"); - if (!gpl_sym && !native_comp) + if (!gpl_sym) xsignal1 (Qmodule_not_gpl_compatible, file); - if (!native_comp) - { - module_init = - (emacs_init_function) dynlib_func (handle, "emacs_module_init"); - if (!module_init) - xsignal1 (Qmissing_module_init_function, file); - } + module_init = (emacs_init_function) dynlib_func (handle, "emacs_module_init"); + if (!module_init) + xsignal1 (Qmissing_module_init_function, file); + struct emacs_runtime rt_pub; struct emacs_runtime_private rt_priv; emacs_env env_pub; @@ -1051,7 +989,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, &env_pub) : module_init (rt); + int r = module_init (rt); /* Process the quit flag first, so that quitting doesn't get overridden by other non-local exits. */ diff --git a/src/lread.c b/src/lread.c index ca7b29f690b..1a5074cb70b 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1281,6 +1281,11 @@ Return t if the file exists and loads successfully. */) bool is_module = false; #endif +#ifdef HAVE_LIBGCCJIT + bool is_native_elisp = suffix_p (found, NATIVE_ELISP_SUFFIX); +#else + bool is_native_elisp = false; +#endif /* Check if we're stuck in a recursive load cycle. 2000-09-21: It's not possible to just check for the file loaded @@ -1379,7 +1384,7 @@ Return t if the file exists and loads successfully. */) } /* !load_prefer_newer */ } } - else if (!is_module) + else if (!is_module && !is_native_elisp) { /* We are loading a source file (*.el). */ if (!NILP (Vload_source_file_function)) @@ -1406,7 +1411,7 @@ Return t if the file exists and loads successfully. */) stream = NULL; errno = EINVAL; } - else if (!is_module) + else if (!is_module && !is_native_elisp) { #ifdef WINDOWSNT emacs_close (fd); @@ -1422,7 +1427,7 @@ Return t if the file exists and loads successfully. */) might be accessed by the unbind_to call below. */ struct infile input; - if (is_module) + if (is_module || is_native_elisp) { /* `module-load' uses the file name, so we can close the stream now. */ @@ -1452,6 +1457,8 @@ Return t if the file exists and loads successfully. */) file, 1); else if (is_module) message_with_string ("Loading %s (module)...", file, 1); + else if (is_native_elisp) + message_with_string ("Loading %s (native compiled elisp)...", file, 1); else if (!compiled) message_with_string ("Loading %s (source)...", file, 1); else if (newer) @@ -1475,6 +1482,18 @@ Return t if the file exists and loads successfully. */) #else /* This cannot happen. */ emacs_abort (); +#endif + } + else if (is_native_elisp) + { +#ifdef HAVE_LIBGCCJIT + specbind (Qcurrent_load_list, Qnil); + LOADHIST_ATTACH (found); + Fnative_elisp_load (found); + build_load_history (found, true); +#else + /* This cannot happen. */ + emacs_abort (); #endif } else @@ -4866,21 +4885,19 @@ This list includes suffixes for both compiled and source Emacs Lisp files. This list should not include the empty string. `load' and related functions try to append these suffixes, in order, to the specified file name if a suffix is allowed or required. */); + Vload_suffixes = list2 (build_pure_c_string (".elc"), + build_pure_c_string (".el")); #ifdef HAVE_MODULES + Vload_suffixes = Fcons (build_pure_c_string (MODULES_SUFFIX), Vload_suffixes); #ifdef MODULES_SECONDARY_SUFFIX - Vload_suffixes = list4 (build_pure_c_string (".elc"), - build_pure_c_string (".el"), - build_pure_c_string (MODULES_SUFFIX), - build_pure_c_string (MODULES_SECONDARY_SUFFIX)); -#else - Vload_suffixes = list3 (build_pure_c_string (".elc"), - build_pure_c_string (".el"), - build_pure_c_string (MODULES_SUFFIX)); + Vload_suffixes = + Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes); #endif -#else - Vload_suffixes = list2 (build_pure_c_string (".elc"), - build_pure_c_string (".el")); #endif +#ifdef HAVE_LIBGCCJIT + Vload_suffixes = Fcons (build_pure_c_string (NATIVE_ELISP_SUFFIX), Vload_suffixes); +#endif + DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix, doc: /* Suffix of loadable module file, or nil if modules are not supported. */); #ifdef HAVE_MODULES -- cgit v1.2.3 From 90425b6d4b314f8f4c26cbf61ec24fdffec4c0f7 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 1 Sep 2019 12:40:54 +0200 Subject: better messaging when load native elisp --- src/lread.c | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 1a5074cb70b..b10743f980c 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1534,6 +1534,8 @@ Return t if the file exists and loads successfully. */) file, 1); else if (is_module) message_with_string ("Loading %s (module)...done", file, 1); + else if (is_native_elisp) + message_with_string ("Loading %s (native compiled elisp)...done", file, 1); else if (!compiled) message_with_string ("Loading %s (source)...done", file, 1); else if (newer) -- cgit v1.2.3 From 06ad74581385cd1930a073b2fda314230b254608 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 8 Sep 2019 10:11:36 +0200 Subject: rename HAVE_LIBGCCJIT -> HAVE_NATIVE_COMP --- configure.ac | 8 ++++---- src/comp.c | 4 ++-- src/emacs.c | 2 +- src/lread.c | 6 +++--- 4 files changed, 10 insertions(+), 10 deletions(-) (limited to 'src/lread.c') diff --git a/configure.ac b/configure.ac index a36a2f32428..0cfd80bb2e8 100644 --- a/configure.ac +++ b/configure.ac @@ -3672,15 +3672,15 @@ fi AC_SUBST(LIBZ) ### Emacs Lisp native compiler support -HAVE_LIBGCCJIT=no +HAVE_NATIVE_COMP=no LIBGCCJIT_LIB= COMP_OBJ= if test "${with_nativecomp}" != "no"; then - AC_CHECK_LIB(gccjit, gcc_jit_context_acquire, HAVE_LIBGCCJIT=yes, , -lgccjit) - if test "${HAVE_LIBGCCJIT}" = "yes"; then + AC_CHECK_LIB(gccjit, gcc_jit_context_acquire, HAVE_NATIVE_COMP=yes, , -lgccjit) + if test "${HAVE_NATIVE_COMP}" = "yes"; then LIBGCCJIT_LIB="-lgccjit -ldl" COMP_OBJ="dynlib.o comp.o" - AC_DEFINE(HAVE_LIBGCCJIT, 1, [Define to 1 if you have the libgccjit library (-lgccjit).]) + AC_DEFINE(HAVE_NATIVE_COMP, 1, [Define to 1 if you have the libgccjit library (-lgccjit).]) AC_DEFINE_UNQUOTED(NATIVE_ELISP_SUFFIX, ".eln", [System extension for native compiled elisp]) fi diff --git a/src/comp.c b/src/comp.c index 00e15601998..2b6f8bf0536 100644 --- a/src/comp.c +++ b/src/comp.c @@ -20,7 +20,7 @@ along with GNU Emacs. If not, see . */ #include -#ifdef HAVE_LIBGCCJIT +#ifdef HAVE_NATIVE_COMP #include #include @@ -3283,4 +3283,4 @@ syms_of_comp (void) comp_speed = DEFAULT_SPEED; } -#endif /* HAVE_LIBGCCJIT */ +#endif /* HAVE_NATIVE_COMP */ diff --git a/src/emacs.c b/src/emacs.c index c59a70988b7..90ab7ac1e8e 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1598,7 +1598,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_json (); #endif -#ifdef HAVE_LIBGCCJIT +#ifdef HAVE_NATIVE_COMP if (!initialized) syms_of_comp (); #endif diff --git a/src/lread.c b/src/lread.c index b10743f980c..f1b17edd011 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1281,7 +1281,7 @@ Return t if the file exists and loads successfully. */) bool is_module = false; #endif -#ifdef HAVE_LIBGCCJIT +#ifdef HAVE_NATIVE_COMP bool is_native_elisp = suffix_p (found, NATIVE_ELISP_SUFFIX); #else bool is_native_elisp = false; @@ -1486,7 +1486,7 @@ Return t if the file exists and loads successfully. */) } else if (is_native_elisp) { -#ifdef HAVE_LIBGCCJIT +#ifdef HAVE_NATIVE_COMP specbind (Qcurrent_load_list, Qnil); LOADHIST_ATTACH (found); Fnative_elisp_load (found); @@ -4896,7 +4896,7 @@ to the specified file name if a suffix is allowed or required. */); Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes); #endif #endif -#ifdef HAVE_LIBGCCJIT +#ifdef HAVE_NATIVE_COMP Vload_suffixes = Fcons (build_pure_c_string (NATIVE_ELISP_SUFFIX), Vload_suffixes); #endif -- cgit v1.2.3 From 9650e5a1a90768953ce9f3eef014616180bfed8e Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 24 Nov 2019 18:48:37 +0100 Subject: revert unnecessary modifications --- lisp/emacs-lisp/byte-run.el | 2 -- lisp/emacs-lisp/bytecomp.el | 1 - src/lread.c | 11 ++++------- 3 files changed, 4 insertions(+), 10 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index fedbd61ffd1..6a49c60099d 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -597,6 +597,4 @@ Otherwise, return nil. For internal use only." (make-obsolete 'macro-declaration-function 'macro-declarations-alist "24.3") -(provide 'byte-run) - ;;; byte-run.el ends here diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ebbee2a0c7c..7be43204a16 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -124,7 +124,6 @@ (require 'backquote) (require 'macroexp) (require 'cconv) -(require 'byte-run) (eval-when-compile (require 'compile)) ;; Refrain from using cl-lib at run-time here, since it otherwise prevents ;; us from emitting warnings when compiling files which use cl-lib without diff --git a/src/lread.c b/src/lread.c index f1b17edd011..bd7182c398f 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4195,16 +4195,13 @@ intern_c_string_1 (const char *str, ptrdiff_t len) { Lisp_Object obarray = check_obarray (Vobarray); Lisp_Object tem = oblookup (obarray, str, len, len); - Lisp_Object string; if (!SYMBOLP (tem)) { - if (NILP (Vpurify_flag)) - string = make_string (str, len); - else - string = make_pure_c_string (str, len); - - tem = intern_driver (string, obarray, tem); + /* Creating a non-pure string from a string literal not implemented yet. + We could just use make_string here and live with the extra copy. */ + eassert (!NILP (Vpurify_flag)); + tem = intern_driver (make_pure_c_string (str, len), obarray, tem); } return tem; } -- cgit v1.2.3 From e05253cb9bc4a35c7dedc3cbb2830e37d385a339 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 7 Dec 2019 10:24:13 +0100 Subject: let intern_c_string works creating with non-pure strings --- src/lread.c | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index bd7182c398f..f280dad97c0 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4198,10 +4198,14 @@ intern_c_string_1 (const char *str, ptrdiff_t len) if (!SYMBOLP (tem)) { - /* Creating a non-pure string from a string literal not implemented yet. - We could just use make_string here and live with the extra copy. */ - eassert (!NILP (Vpurify_flag)); - tem = intern_driver (make_pure_c_string (str, len), obarray, tem); + Lisp_Object string; + + if (NILP (Vpurify_flag)) + string = make_string (str, len); + else + string = make_pure_c_string (str, len); + + tem = intern_driver (string, obarray, tem); } return tem; } -- cgit v1.2.3 From 694ece772220346aef12520bc66ca401d08809bb Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 14 Dec 2019 09:28:12 +0100 Subject: reworking relocation mechanism to use one single table --- src/comp.c | 116 +++++++++++++++++++++++++++++++++++++----------------------- src/emacs.c | 4 +++ src/lisp.h | 3 +- src/lread.c | 3 ++ 4 files changed, 81 insertions(+), 45 deletions(-) (limited to 'src/lread.c') diff --git a/src/comp.c b/src/comp.c index 70b423aa97a..a233187ccdf 100644 --- a/src/comp.c +++ b/src/comp.c @@ -70,6 +70,16 @@ along with GNU Emacs. If not, see . */ #endif #define SETJMP_NAME SETJMP +/* Max number function importable by native compiled code. */ +#define F_RELOC_MAX_SIZE 1500 + +typedef struct { + void *link_table[F_RELOC_MAX_SIZE]; + ptrdiff_t size; +} f_reloc_t; + +static f_reloc_t freloc; + /* C side of the compiler context. */ typedef struct { @@ -157,7 +167,7 @@ typedef struct { gcc_jit_function *check_impure; Lisp_Object func_blocks_h; /* blk_name -> gcc_block. */ Lisp_Object exported_funcs_h; /* subr_name -> gcc_jit_function *. */ - Lisp_Object imported_funcs_h; /* subr_name -> reloc_field. */ + Lisp_Object imported_funcs_h; /* subr_name -> gcc_jit_field *reloc_field. */ Lisp_Object emitter_dispatcher; gcc_jit_rvalue *data_relocs; /* Synthesized struct holding data relocs. */ gcc_jit_lvalue *func_relocs; /* Synthesized struct holding func relocs. */ @@ -184,6 +194,20 @@ Lisp_Object helper_unbind_n (Lisp_Object n); void helper_save_restriction (void); bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code); +void *helper_link_table[] = + { wrong_type_argument, + helper_PSEUDOVECTOR_TYPEP_XUNTAG, + pure_write_error, + push_handler, + SETJMP_NAME, + record_unwind_protect_excursion, + helper_unbind_n, + helper_save_restriction, + record_unwind_current_buffer, + set_internal, + helper_unwind_protect, + specbind }; + static char * ATTRIBUTE_FORMAT_PRINTF (1, 2) format_string (const char *format, ...) @@ -1758,7 +1782,7 @@ declare_runtime_imported_funcs (void) #undef ADD_IMPORTED - return field_list; + return Freverse (field_list); } /* @@ -1767,7 +1791,6 @@ declare_runtime_imported_funcs (void) static void emit_ctxt_code (void) { - USE_SAFE_ALLOCA; comp.current_thread_ref = gcc_jit_lvalue_as_rvalue ( @@ -1809,56 +1832,32 @@ emit_ctxt_code (void) emit_static_object (TEXT_DATA_RELOC_SYM, d_reloc); - /* Imported functions from non Lisp code. */ - Lisp_Object f_runtime = declare_runtime_imported_funcs (); - EMACS_INT f_reloc_len = XFIXNUM (Flength (f_runtime)); - - /* Imported subrs. */ - Lisp_Object f_subr = CALL1I (comp-ctxt-func-relocs-l, Vcomp_ctxt); - f_reloc_len += XFIXNUM (Flength (f_subr)); - - gcc_jit_field **fields = SAFE_ALLOCA (f_reloc_len * sizeof (*fields)); - Lisp_Object f_reloc_list = Qnil; - int n_frelocs = 0; + /* Functions imported from Lisp code. */ + static gcc_jit_field *fields[F_RELOC_MAX_SIZE]; + ptrdiff_t n_frelocs = 0; + Lisp_Object f_runtime = declare_runtime_imported_funcs (); FOR_EACH_TAIL (f_runtime) { Lisp_Object el = XCAR (f_runtime); + eassert (n_frelocs < ARRAYELTS (fields)); fields[n_frelocs++] = xmint_pointer (XCDR (el)); - f_reloc_list = Fcons (XCAR (el), f_reloc_list); } - FOR_EACH_TAIL (f_subr) + Lisp_Object subr_l = Vsubr_list; + FOR_EACH_TAIL (subr_l) { - Lisp_Object subr_sym = XCAR (f_subr); - Lisp_Object subr = symbol_subr (subr_sym); - /* Ignore inliners. This are not real functions to be imported. */ - if (SUBRP (subr)) - { - Lisp_Object maxarg = XCDR (Fsubr_arity (subr)); - gcc_jit_field *field = - declare_imported_func (subr_sym, comp.lisp_obj_type, - FIXNUMP (maxarg) ? XFIXNUM (maxarg) : - EQ (maxarg, Qmany) ? MANY : UNEVALLED, - NULL); - fields[n_frelocs++] = field; - f_reloc_list = Fcons (subr_sym, f_reloc_list); - } + struct Lisp_Subr *subr = XSUBR (XCAR (subr_l)); + Lisp_Object subr_sym = intern_c_string (subr->symbol_name); + eassert (n_frelocs < ARRAYELTS (fields)); + fields[n_frelocs++] = declare_imported_func (subr_sym, comp.lisp_obj_type, + subr->max_args, NULL); } - Lisp_Object f_reloc_vec = make_vector (n_frelocs, Qnil); - f_reloc_list = Fnreverse (f_reloc_list); - ptrdiff_t i = 0; - FOR_EACH_TAIL (f_reloc_list) - { - ASET (f_reloc_vec, i++, XCAR (f_reloc_list)); - } - emit_static_object (TEXT_IMPORTED_FUNC_RELOC_SYM, f_reloc_vec); - gcc_jit_struct *f_reloc_struct = gcc_jit_context_new_struct_type (comp.ctxt, NULL, - "function_reloc_struct", + "freloc_link_table", n_frelocs, fields); comp.func_relocs = gcc_jit_context_new_global ( @@ -1867,8 +1866,6 @@ emit_ctxt_code (void) GCC_JIT_GLOBAL_EXPORTED, gcc_jit_struct_as_type (f_reloc_struct), IMPORTED_FUNC_RELOC_SYM); - - SAFE_FREE (); } @@ -3038,8 +3035,8 @@ DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt, comp.exported_funcs_h = CALLN (Fmake_hash_table); /* - Always reinitialize this cause old function definitions are garbage collected - by libgccjit when the ctxt is released. + Always reinitialize this cause old function definitions are garbage + collected by libgccjit when the ctxt is released. */ comp.imported_funcs_h = CALLN (Fmake_hash_table); @@ -3140,6 +3137,29 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, } +void +fill_freloc (void) +{ + if (ARRAYELTS (helper_link_table) > F_RELOC_MAX_SIZE) + goto overflow; + memcpy (freloc.link_table, helper_link_table, sizeof (freloc.link_table)); + freloc.size = ARRAYELTS (helper_link_table); + + Lisp_Object subr_l = Vsubr_list; + FOR_EACH_TAIL (subr_l) + { + if (freloc.size == F_RELOC_MAX_SIZE) + goto overflow; + struct Lisp_Subr *subr = XSUBR (XCAR (subr_l)); + freloc.link_table[freloc.size] = subr->function.a0; + freloc.size++; + } + return; + + overflow: + fatal ("Overflowing function relocation table, increase F_RELOC_MAX_SIZE"); +} + /******************************************************************************/ /* Helper functions called from the run-time. */ /* These can't be statics till shared mechanism is used to solve relocations. */ @@ -3343,6 +3363,10 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0, { CHECK_STRING (file); + if (!freloc.link_table[0]) + xsignal2 (Qnative_lisp_load_failed, file, + build_string ("Empty relocation table")); + Frequire (Qadvice, Qnil, Qnil); dynlib_handle_ptr handle = dynlib_open (SSDATA (file)); @@ -3472,6 +3496,10 @@ syms_of_comp (void) doc: /* The compiler context. */); Vcomp_ctxt = Qnil; + /* FIXME should be initialized but not here... */ + DEFVAR_LISP ("comp-subr-list", Vsubr_list, + doc: /* List of all defined subrs. */); + /* Load mechanism. */ staticpro (&Vnative_elisp_refs_hash); Vnative_elisp_refs_hash diff --git a/src/emacs.c b/src/emacs.c index 90ab7ac1e8e..0798e0702f2 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2050,6 +2050,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem moncontrol (0); #endif +#ifdef HAVE_NATIVE_COMP + fill_freloc (); +#endif + initialized = true; if (dump_mode) diff --git a/src/lisp.h b/src/lisp.h index 25319047a69..d0f7a9720c0 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4750,9 +4750,10 @@ extern bool profiler_memory_running; extern void malloc_probe (size_t); extern void syms_of_profiler (void); -/* Defined in comp.c. */ #ifdef HAVE_NATIVE_COMP +/* Defined in comp.c. */ extern void syms_of_comp (void); +extern void fill_freloc (void); #endif /* HAVE_NATIVE_COMP */ #ifdef DOS_NT diff --git a/src/lread.c b/src/lread.c index f280dad97c0..1ba04835aa1 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4465,6 +4465,9 @@ defsubr (union Aligned_Lisp_Subr *aname) XSETPVECTYPE (sname, PVEC_SUBR); XSETSUBR (tem, sname); set_symbol_function (sym, tem); +#ifdef HAVE_NATIVE_COMP + Vsubr_list = Fcons (tem, Vsubr_list); +#endif /* HAVE_NATIVE_COMP */ } #ifdef NOTDEF /* Use fset in subr.el now! */ -- cgit v1.2.3 From 2ccce1bc3954ce5f2faa0dcf7fa68ec5cae710ca Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 24 Dec 2019 16:58:44 +0100 Subject: some style fixes --- lisp/emacs-lisp/comp.el | 2 +- src/comp.c | 12 ++++++------ src/lread.c | 2 +- src/pdumper.c | 2 +- 4 files changed, 9 insertions(+), 9 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index e8a9b6c2b69..6b9965b8200 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -406,7 +406,7 @@ Put PREFIX in front of it." "Byte compile FUNCTION-NAME spilling data from the byte compiler." (let* ((f (symbol-function function-name)) (func (make-comp-func :name function-name - :c-name (comp-c-func-name function-name"F") + :c-name (comp-c-func-name function-name "F") :doc (documentation f) :int-spec (interactive-form f)))) (when (byte-code-function-p f) diff --git a/src/comp.c b/src/comp.c index 7e25bdc9256..87986abee68 100644 --- a/src/comp.c +++ b/src/comp.c @@ -1824,7 +1824,7 @@ emit_ctxt_code (void) fields[n_frelocs++] = xmint_pointer (XCDR (el)); } - Lisp_Object subr_l = Vsubr_list; + Lisp_Object subr_l = Vcomp_subr_list; FOR_EACH_TAIL (subr_l) { struct Lisp_Subr *subr = XSUBR (XCAR (subr_l)); @@ -3121,7 +3121,7 @@ fill_freloc (void) memcpy (freloc.link_table, helper_link_table, sizeof (helper_link_table)); freloc.size = ARRAYELTS (helper_link_table); - Lisp_Object subr_l = Vsubr_list; + Lisp_Object subr_l = Vcomp_subr_list; FOR_EACH_TAIL (subr_l) { if (freloc.size == F_RELOC_MAX_SIZE) @@ -3290,7 +3290,7 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, XSETSUBR (tem, &x->s); set_symbol_function (name, tem); - Fputhash (name, c_name, Vsym_subr_c_name_h); + Fputhash (name, c_name, Vcomp_sym_subr_c_name_h); LOADHIST_ATTACH (Fcons (Qdefun, name)); return Qnil; @@ -3431,12 +3431,12 @@ syms_of_comp (void) Vcomp_ctxt = Qnil; /* FIXME should be initialized but not here... */ - DEFVAR_LISP ("comp-subr-list", Vsubr_list, + DEFVAR_LISP ("comp-subr-list", Vcomp_subr_list, doc: /* List of all defined subrs. */); - DEFVAR_LISP ("comp-sym-subr-c-name-h", Vsym_subr_c_name_h, + DEFVAR_LISP ("comp-sym-subr-c-name-h", Vcomp_sym_subr_c_name_h, doc: /* Hash table symbol-function -> function-c-name. For internal use during */); - Vsym_subr_c_name_h = CALLN (Fmake_hash_table); + Vcomp_sym_subr_c_name_h = CALLN (Fmake_hash_table); } #endif /* HAVE_NATIVE_COMP */ diff --git a/src/lread.c b/src/lread.c index 1ba04835aa1..4e8a3adeb94 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4466,7 +4466,7 @@ defsubr (union Aligned_Lisp_Subr *aname) XSETSUBR (tem, sname); set_symbol_function (sym, tem); #ifdef HAVE_NATIVE_COMP - Vsubr_list = Fcons (tem, Vsubr_list); + Vcomp_subr_list = Fcons (tem, Vcomp_subr_list); #endif /* HAVE_NATIVE_COMP */ } diff --git a/src/pdumper.c b/src/pdumper.c index 5bfccb8ac90..610b94b0a32 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5323,7 +5323,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, XNATIVE_COMP_UNIT (subr->native_comp_u); if (!comp_u->handle) error ("can't relocate native subr with not loaded compilation unit"); - Lisp_Object c_name = Fgethash (name, Vsym_subr_c_name_h, Qnil); + Lisp_Object c_name = Fgethash (name, Vcomp_sym_subr_c_name_h, Qnil); if (NILP (c_name)) error ("missing label name"); void *func = dynlib_sym (comp_u->handle, SSDATA (c_name)); -- cgit v1.2.3 From ef59b67e4657fa80d1528b9d476c67f01abecc35 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 24 Dec 2019 17:41:44 +0100 Subject: mitigate ifdef proliferation --- src/alloc.c | 17 +++++------------ src/comp.c | 2 +- src/comp.h | 10 ++++++++++ src/data.c | 5 ++--- src/doc.c | 2 -- src/eval.c | 19 +++++++++++-------- src/lisp.h | 15 ++++++++++----- src/lread.c | 32 +++++++++++++++----------------- src/pdumper.c | 21 ++++++--------------- 9 files changed, 60 insertions(+), 63 deletions(-) (limited to 'src/lread.c') diff --git a/src/alloc.c b/src/alloc.c index 5e0b04b1cc7..6d6f6934bab 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3023,15 +3023,14 @@ cleanup_vector (struct Lisp_Vector *vector) if (uptr->finalizer) uptr->finalizer (uptr->p); } -#ifdef HAVE_NATIVE_COMP - else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT)) + else if (NATIVE_COMP_FLAG + && PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT)) { struct Lisp_Native_Comp_Unit *cu = PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); eassert (cu->handle); dynlib_close (cu->handle); } -#endif } /* Reclaim space used by unmarked vectors. */ @@ -6565,14 +6564,12 @@ mark_object (Lisp_Object arg) break; case PVEC_SUBR: -#ifdef HAVE_NATIVE_COMP if (SUBRP_NATIVE_COMPILEDP (obj)) { set_vector_marked (ptr); struct Lisp_Subr *subr = XSUBR (obj); - mark_object (subr->native_comp_u); + mark_object (subr->native_comp_u[0]); } -#endif break; case PVEC_FREE: @@ -6717,13 +6714,9 @@ survives_gc_p (Lisp_Object obj) break; case Lisp_Vectorlike: -#ifdef HAVE_NATIVE_COMP survives_p = (SUBRP (obj) && !SUBRP_NATIVE_COMPILEDP (obj)) || vector_marked_p (XVECTOR (obj)); -#else - survives_p = SUBRP (obj) || vector_marked_p (XVECTOR (obj)); -#endif break; case Lisp_Cons: @@ -7473,14 +7466,14 @@ N should be nonnegative. */); static union Aligned_Lisp_Subr Swatch_gc_cons_threshold = {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) }, { .a4 = watch_gc_cons_threshold }, - 4, 4, "watch_gc_cons_threshold", {0}, {0}, 0}}; + 4, 4, "watch_gc_cons_threshold", {0}, {0}}}; XSETSUBR (watcher, &Swatch_gc_cons_threshold.s); Fadd_variable_watcher (Qgc_cons_threshold, watcher); static union Aligned_Lisp_Subr Swatch_gc_cons_percentage = {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) }, { .a4 = watch_gc_cons_percentage }, - 4, 4, "watch_gc_cons_percentage", {0}, {0}, 0}}; + 4, 4, "watch_gc_cons_percentage", {0}, {0}}}; XSETSUBR (watcher, &Swatch_gc_cons_percentage.s); Fadd_variable_watcher (Qgc_cons_percentage, watcher); } diff --git a/src/comp.c b/src/comp.c index 87986abee68..6f5658191c0 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3285,7 +3285,7 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, x->s.symbol_name = xstrdup (SSDATA (Fsymbol_name (name))); x->s.native_intspec = intspec; x->s.native_doc = doc; - x->s.native_comp_u = comp_u; + x->s.native_comp_u[0] = comp_u; Lisp_Object tem; XSETSUBR (tem, &x->s); set_symbol_function (name, tem); diff --git a/src/comp.h b/src/comp.h index 90b4f40426b..f756e38d292 100644 --- a/src/comp.h +++ b/src/comp.h @@ -19,6 +19,16 @@ along with GNU Emacs. If not, see . */ #ifndef COMP_H #define COMP_H +/* To keep ifdefs under control. */ +enum { + NATIVE_COMP_FLAG = +#ifdef HAVE_NATIVE_COMP + 1 +#else + 0 +#endif +}; + #ifdef HAVE_NATIVE_COMP #include diff --git a/src/data.c b/src/data.c index 3fb0fc0a190..d20db4dc3a3 100644 --- a/src/data.c +++ b/src/data.c @@ -881,7 +881,7 @@ DEFUN ("subr-native-comp-unit", Fsubr_native_comp_unit, (Lisp_Object subr) { CHECK_SUBR (subr); - return XSUBR (subr)->native_comp_u; + return XSUBR (subr)->native_comp_u[0]; } DEFUN ("native-comp-unit-file", Fnative_comp_unit_file, @@ -919,10 +919,9 @@ Value, if non-nil, is a list (interactive SPEC). */) if (SUBRP (fun)) { -#ifdef HAVE_NATIVE_COMP if (SUBRP_NATIVE_COMPILEDP (fun) && XSUBR (fun)->native_intspec) return XSUBR (fun)->native_intspec; -#endif + const char *spec = XSUBR (fun)->intspec; if (spec) return list2 (Qinteractive, diff --git a/src/doc.c b/src/doc.c index 9e1d8392787..2c96fc15a7c 100644 --- a/src/doc.c +++ b/src/doc.c @@ -510,12 +510,10 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) XSETCAR (tem, make_fixnum (offset)); } } -#ifdef HAVE_NATIVE_COMP else if (SUBRP_NATIVE_COMPILEDP (fun)) { XSUBR (fun)->native_doc = Qnil; } -#endif /* Lisp_Subrs have a slot for it. */ else if (SUBRP (fun)) { diff --git a/src/eval.c b/src/eval.c index bf37ed9cefa..253de05a658 100644 --- a/src/eval.c +++ b/src/eval.c @@ -219,14 +219,17 @@ void init_eval_once (void) { /* Don't forget to update docs (lispref node "Local Variables"). */ -#ifndef HAVE_NATIVE_COMP - max_specpdl_size = 1600; /* 1500 is not enough for cl-generic.el. */ - max_lisp_eval_depth = 800; -#else - /* Original values increased for comp.el. */ - max_specpdl_size = 2100; - max_lisp_eval_depth = 1400; -#endif + if (!NATIVE_COMP_FLAG) + { + max_specpdl_size = 1600; /* 1500 is not enough for cl-generic.el. */ + max_lisp_eval_depth = 800; + } + else + { + /* Original values increased for comp.el. */ + max_specpdl_size = 2100; + max_lisp_eval_depth = 1400; + } Vrun_hooks = Qnil; pdumper_do_now_and_after_load (init_eval_once_for_pdumper); } diff --git a/src/lisp.h b/src/lisp.h index c7e55057ad3..a4cabc34855 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2098,9 +2098,7 @@ struct Lisp_Subr EMACS_INT doc; Lisp_Object native_doc; }; -#ifdef HAVE_NATIVE_COMP - Lisp_Object native_comp_u; -#endif + Lisp_Object native_comp_u[NATIVE_COMP_FLAG]; } GCALIGNED_STRUCT; union Aligned_Lisp_Subr { @@ -3113,7 +3111,7 @@ CHECK_INTEGER (Lisp_Object x) static union Aligned_Lisp_Subr sname = \ {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ { .a ## maxargs = fnname }, \ - minargs, maxargs, lname, {intspec}, {0}, 0}}; \ + minargs, maxargs, lname, {intspec}, {0}}}; \ Lisp_Object fnname /* defsubr (Sname); @@ -4763,7 +4761,7 @@ extern char *emacs_root_dir (void); INLINE bool SUBRP_NATIVE_COMPILEDP (Lisp_Object a) { - return SUBRP (a) && XSUBR (a)->native_comp_u; + return SUBRP (a) && XSUBR (a)->native_comp_u[0]; } INLINE struct Lisp_Native_Comp_Unit * @@ -4772,6 +4770,13 @@ allocate_native_comp_unit (void) return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, data_vec, PVEC_NATIVE_COMP_UNIT); } +#else +INLINE bool +SUBRP_NATIVE_COMPILEDP (Lisp_Object a) +{ + return false; +} + #endif /* Defined in lastfile.c. */ diff --git a/src/lread.c b/src/lread.c index 4e8a3adeb94..1c5268d0dad 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1281,11 +1281,9 @@ Return t if the file exists and loads successfully. */) bool is_module = false; #endif -#ifdef HAVE_NATIVE_COMP - bool is_native_elisp = suffix_p (found, NATIVE_ELISP_SUFFIX); -#else - bool is_native_elisp = false; -#endif + bool is_native_elisp = + NATIVE_COMP_FLAG && suffix_p (found, NATIVE_ELISP_SUFFIX) ? true : false; + /* Check if we're stuck in a recursive load cycle. 2000-09-21: It's not possible to just check for the file loaded @@ -1486,15 +1484,16 @@ Return t if the file exists and loads successfully. */) } else if (is_native_elisp) { -#ifdef HAVE_NATIVE_COMP - specbind (Qcurrent_load_list, Qnil); - LOADHIST_ATTACH (found); - Fnative_elisp_load (found); - build_load_history (found, true); -#else - /* This cannot happen. */ - emacs_abort (); -#endif + if (NATIVE_COMP_FLAG) + { + specbind (Qcurrent_load_list, Qnil); + LOADHIST_ATTACH (found); + Fnative_elisp_load (found); + build_load_history (found, true); + } + else + /* This cannot happen. */ + emacs_abort (); } else { @@ -4465,9 +4464,8 @@ defsubr (union Aligned_Lisp_Subr *aname) XSETPVECTYPE (sname, PVEC_SUBR); XSETSUBR (tem, sname); set_symbol_function (sym, tem); -#ifdef HAVE_NATIVE_COMP - Vcomp_subr_list = Fcons (tem, Vcomp_subr_list); -#endif /* HAVE_NATIVE_COMP */ + if (NATIVE_COMP_FLAG) + Vcomp_subr_list = Fcons (tem, Vcomp_subr_list); } #ifdef NOTDEF /* Use fset in subr.el now! */ diff --git a/src/pdumper.c b/src/pdumper.c index 610b94b0a32..d66c4e99642 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2948,18 +2948,13 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) struct Lisp_Subr out; dump_object_start (ctx, &out, sizeof (out)); DUMP_FIELD_COPY (&out, subr, header.size); -#ifdef HAVE_NATIVE_COMP - if (subr->native_comp_u) + if (NATIVE_COMP_FLAG && subr->native_comp_u[0]) out.function.a0 = NULL; else dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0); -#else - dump_field_emacs_ptr (ctx, &out, subr, &subr->function.a0); -#endif DUMP_FIELD_COPY (&out, subr, min_args); DUMP_FIELD_COPY (&out, subr, max_args); -#ifdef HAVE_NATIVE_COMP - if (subr->native_comp_u) + if (NATIVE_COMP_FLAG && subr->native_comp_u[0]) { dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name); dump_remember_cold_op (ctx, @@ -2974,15 +2969,11 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec); DUMP_FIELD_COPY (&out, subr, doc); } - dump_field_lv (ctx, &out, subr, &subr->native_comp_u, WEIGHT_NORMAL); -#else - dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name); - dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec); - DUMP_FIELD_COPY (&out, subr, doc); -#endif + if (NATIVE_COMP_FLAG) + dump_field_lv (ctx, &out, subr, &subr->native_comp_u[0], WEIGHT_NORMAL); dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out)); - if (ctx->flags.dump_object_contents && subr->native_comp_u) + if (ctx->flags.dump_object_contents && subr->native_comp_u[0]) /* We'll do the final addr relocation during VERY_LATE_RELOCS time after the compilation units has been loaded. */ dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS], @@ -5320,7 +5311,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset); Lisp_Object name = intern (subr->symbol_name); struct Lisp_Native_Comp_Unit *comp_u = - XNATIVE_COMP_UNIT (subr->native_comp_u); + XNATIVE_COMP_UNIT (subr->native_comp_u[0]); if (!comp_u->handle) error ("can't relocate native subr with not loaded compilation unit"); Lisp_Object c_name = Fgethash (name, Vcomp_sym_subr_c_name_h, Qnil); -- cgit v1.2.3 From 11192b29adf4ee500f5056d1b02d35908f858b53 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 1 Jan 2020 21:13:13 +0100 Subject: make standard emacs compilable again --- configure.ac | 4 ++-- lisp/Makefile.in | 6 ++++++ src/comp.h | 4 ++-- src/lread.c | 5 +++-- src/pdumper.c | 2 ++ 5 files changed, 15 insertions(+), 6 deletions(-) (limited to 'src/lread.c') diff --git a/configure.ac b/configure.ac index 8c8b57c1079..247484a8501 100644 --- a/configure.ac +++ b/configure.ac @@ -3748,8 +3748,6 @@ if test "${with_nativecomp}" != "no"; then LIBGCCJIT_LIB="-lgccjit -ldl" COMP_OBJ+=comp.o AC_DEFINE(HAVE_NATIVE_COMP, 1, [Define to 1 if you have the libgccjit library (-lgccjit).]) - AC_DEFINE_UNQUOTED(NATIVE_ELISP_SUFFIX, ".eln", - [System extension for native compiled elisp]) else AC_MSG_ERROR([elisp native compiler requested but libgccjit not found. If you are sure you want Emacs compiled without elisp native compiler, pass @@ -3757,6 +3755,8 @@ If you are sure you want Emacs compiled without elisp native compiler, pass to configure.]) fi fi +AC_DEFINE_UNQUOTED(NATIVE_ELISP_SUFFIX, ".eln", + [System extension for native compiled elisp]) AC_SUBST(HAVE_NATIVE_COMP) AC_SUBST(LIBGCCJIT_LIB) AC_SUBST(COMP_OBJ) diff --git a/lisp/Makefile.in b/lisp/Makefile.in index cfc6f494991..5793b6474dc 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -332,7 +332,13 @@ compile-first: $(COMPILE_FIRST) .PHONY: compile-targets # TARGETS is set dynamically in the recursive call from 'compile-main'. +# Do not build comp.el unless necessary not to exceed max-specpdl-size and +# max-lisp-eval-depth in normal builds. +ifneq ($(HAVE_NATIVE_COMP),yes) +compile-targets: $(filter-out ./emacs-lisp/comp.elc,$(TARGETS)) +else compile-targets: $(TARGETS) +endif # Compile all the Elisp files that need it. Beware: it approximates # 'no-byte-compile', so watch out for false-positives! diff --git a/src/comp.h b/src/comp.h index 33b73548009..86fa54f5158 100644 --- a/src/comp.h +++ b/src/comp.h @@ -29,8 +29,6 @@ enum { #endif }; -#ifdef HAVE_NATIVE_COMP - #include struct Lisp_Native_Comp_Unit @@ -43,6 +41,8 @@ struct Lisp_Native_Comp_Unit dynlib_handle_ptr handle; }; +#ifdef HAVE_NATIVE_COMP + INLINE bool NATIVE_COMP_UNITP (Lisp_Object a) { diff --git a/src/lread.c b/src/lread.c index 1c5268d0dad..d6d13861417 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4464,8 +4464,9 @@ defsubr (union Aligned_Lisp_Subr *aname) XSETPVECTYPE (sname, PVEC_SUBR); XSETSUBR (tem, sname); set_symbol_function (sym, tem); - if (NATIVE_COMP_FLAG) - Vcomp_subr_list = Fcons (tem, Vcomp_subr_list); +#ifdef HAVE_NATIVE_COMP + Vcomp_subr_list = Fcons (tem, Vcomp_subr_list); +#endif } #ifdef NOTDEF /* Use fset in subr.el now! */ diff --git a/src/pdumper.c b/src/pdumper.c index 85809c9978f..ae8fe014e0e 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5296,6 +5296,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, dump_write_word_to_dump (dump_base, reloc_offset, value); break; } +#ifdef HAVE_NATIVE_COMP case RELOC_NATIVE_COMP_UNIT: { struct Lisp_Native_Comp_Unit *comp_u = @@ -5323,6 +5324,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, subr->function.a0 = func; break; } +#endif case RELOC_BIGNUM: { struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset); -- cgit v1.2.3 From d0066e30615f135d9eebd48b98dddfcb7cf84ed0 Mon Sep 17 00:00:00 2001 From: AndreaCorallo Date: Sat, 29 Feb 2020 08:36:06 +0000 Subject: * Keep comp-subr-list into pure space Sad pure space is not effective nowdays but anyway... should go there. --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 005528782d0..8b6db92cca9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4405,7 +4405,7 @@ defsubr (union Aligned_Lisp_Subr *aname) XSETSUBR (tem, sname); set_symbol_function (sym, tem); #ifdef HAVE_NATIVE_COMP - Vcomp_subr_list = Fcons (tem, Vcomp_subr_list); + Vcomp_subr_list = Fpurecopy (Fcons (tem, Vcomp_subr_list)); #endif } -- cgit v1.2.3 From ce9e3a4ce75acc5450aa39eb4baf601c26aec3fe Mon Sep 17 00:00:00 2001 From: AndreaCorallo Date: Sat, 29 Feb 2020 08:36:27 +0000 Subject: Introduce 'effective_load_path' --- src/lread.c | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 8b6db92cca9..6d33bd3e496 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1055,6 +1055,26 @@ This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) return Fnreverse (lst); } +static Lisp_Object +effective_load_path (void) +{ + if (!NATIVE_COMP_FLAG) + return Vload_path; + + Lisp_Object lp = Vload_path; + Lisp_Object new_lp = Qnil; + FOR_EACH_TAIL (lp) + { + Lisp_Object el = XCAR (lp); + new_lp = + Fcons (concat2 (Ffile_name_as_directory (el), + Vsystem_configuration), + new_lp); + new_lp = Fcons (el, new_lp); + } + return Fnreverse (new_lp); +} + /* Return true if STRING ends with SUFFIX. */ static bool suffix_p (Lisp_Object string, const char *suffix) @@ -1199,7 +1219,9 @@ Return t if the file exists and loads successfully. */) suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes); } - fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer); + fd = + openp (effective_load_path (), file, suffixes, &found, Qnil, + load_prefer_newer); } if (fd == -1) -- cgit v1.2.3 From 43b6f05dfb46637a414520b27430fbe3b0f005fa Mon Sep 17 00:00:00 2001 From: AndreaCorallo Date: Tue, 3 Mar 2020 22:23:41 +0000 Subject: Hash eln ABI once and add it to the output compilation path --- lisp/emacs-lisp/comp.el | 2 +- src/comp.c | 29 +++++++++++++++++++++++------ src/comp.h | 4 ++++ src/emacs.c | 5 +++++ src/lread.c | 3 ++- 5 files changed, 35 insertions(+), 8 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a9db8c6ff07..342faa2879e 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2125,7 +2125,7 @@ Return the compilation unit file name." (file-name-as-directory (concat (file-name-directory exp-file) - system-configuration)) + comp-native-path-postfix)) (file-name-sans-extension (file-name-nondirectory exp-file)))))))) (comp-log "\n \n" 1) diff --git a/src/comp.c b/src/comp.c index 425784b9810..4940ae52b3d 100644 --- a/src/comp.c +++ b/src/comp.c @@ -250,8 +250,8 @@ format_string (const char *format, ...) /* Produce a key hashing Vcomp_subr_list. */ -static Lisp_Object -hash_subr_list (void) +void +hash_native_abi (void) { Lisp_Object string = Fmapconcat (intern_c_string ("subr-name"), Vcomp_subr_list, build_string (" ")); @@ -260,7 +260,17 @@ hash_subr_list (void) sha512_buffer (SSDATA (string), SCHARS (string), SSDATA (digest)); hexbuf_digest (SSDATA (digest), SDATA (digest), SHA512_DIGEST_SIZE); - return digest; + /* Check runs once. */ + eassert (Vcomp_abi_hash); + Vcomp_abi_hash = digest; + /* If 10 characters are usually sufficient for git I guess 16 are + fine for us here. */ + Vcomp_native_path_postfix = + concat3 (Vsystem_configuration, + make_string ("-", 1), + Fsubstring_no_properties (Vcomp_abi_hash, + make_fixnum (0), + make_fixnum (16))); } static void @@ -1976,8 +1986,9 @@ emit_ctxt_code (void) fields[n_frelocs++] = xmint_pointer (XCDR (el)); } - /* Compute and store function link table hash. */ - emit_static_object (LINK_TABLE_HASH_SYM, hash_subr_list ()); + /* Sign the .eln for the exposed ABI it expects at load. */ + eassert (!NILP (Vcomp_abi_hash)); + emit_static_object (LINK_TABLE_HASH_SYM, Vcomp_abi_hash); Lisp_Object subr_l = Vcomp_subr_list; FOR_EACH_TAIL (subr_l) @@ -3430,7 +3441,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump) && freloc_link_table && top_level_run) || NILP (Fstring_equal (load_static_obj (comp_u, LINK_TABLE_HASH_SYM), - hash_subr_list ()))) + Vcomp_abi_hash))) xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file); *current_thread_reloc = ¤t_thread; @@ -3657,6 +3668,12 @@ syms_of_comp (void) doc: /* Hash table symbol-function -> function-c-name. For internal use during */); Vcomp_sym_subr_c_name_h = CALLN (Fmake_hash_table); + DEFVAR_LISP ("comp-abi-hash", Vcomp_abi_hash, + doc: /* String signing the ABI exposed to .eln files. */); + Vcomp_abi_hash = Qnil; + DEFVAR_LISP ("comp-native-path-postfix", Vcomp_native_path_postfix, + doc: /* Postifix to be added to the .eln compilation path. */); + Vcomp_native_path_postfix = Qnil; } #endif /* HAVE_NATIVE_COMP */ diff --git a/src/comp.h b/src/comp.h index 3aff440ecb7..070ec4d5ca9 100644 --- a/src/comp.h +++ b/src/comp.h @@ -61,8 +61,12 @@ XNATIVE_COMP_UNIT (Lisp_Object a) } /* Defined in comp.c. */ + +extern void hash_native_abi (void); + extern void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump); extern void syms_of_comp (void); + #endif #endif diff --git a/src/emacs.c b/src/emacs.c index da08aeb9022..b16ffa4295e 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1949,6 +1949,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem keys_of_keyboard (); keys_of_keymap (); keys_of_window (); + +#ifdef HAVE_NATIVE_COMP + /* Must be after the last defsubr has run. */ + hash_native_abi (); +#endif } else { diff --git a/src/lread.c b/src/lread.c index 6d33bd3e496..acd2fea6881 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1068,7 +1068,7 @@ effective_load_path (void) Lisp_Object el = XCAR (lp); new_lp = Fcons (concat2 (Ffile_name_as_directory (el), - Vsystem_configuration), + Vcomp_native_path_postfix), new_lp); new_lp = Fcons (el, new_lp); } @@ -4427,6 +4427,7 @@ defsubr (union Aligned_Lisp_Subr *aname) XSETSUBR (tem, sname); set_symbol_function (sym, tem); #ifdef HAVE_NATIVE_COMP + eassert (NILP (Vcomp_abi_hash)); Vcomp_subr_list = Fpurecopy (Fcons (tem, Vcomp_subr_list)); #endif } -- cgit v1.2.3 From dc89f3a0df1013c7c5fcb3cff6da27fa0263f007 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 4 Mar 2020 21:52:38 +0000 Subject: * Fix build for stock configuration Vcomp_native_path_postfix is declared only in native configuration. --- src/lread.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index acd2fea6881..32c83bfae8b 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1058,9 +1058,9 @@ This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) static Lisp_Object effective_load_path (void) { - if (!NATIVE_COMP_FLAG) - return Vload_path; - +#ifndef HAVE_NATIVE_COMP + return Vload_path; +#else Lisp_Object lp = Vload_path; Lisp_Object new_lp = Qnil; FOR_EACH_TAIL (lp) @@ -1073,6 +1073,7 @@ effective_load_path (void) new_lp = Fcons (el, new_lp); } return Fnreverse (new_lp); +#endif } /* Return true if STRING ends with SUFFIX. */ -- cgit v1.2.3 From 159f61baa9e374cfd17acf1a45c0d553b57b7ac9 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 15 Mar 2020 21:44:05 +0000 Subject: Trigger native compilation when loading bytecode Introduce a first mechanism to trigger compilation when lex elc files are loaded. This is off by default and has to be better tested. --- lisp/emacs-lisp/comp.el | 5 +++++ src/comp.c | 38 +++++++++++++++++++++++++++++++++++++- src/comp.h | 10 ++++++++++ src/data.c | 2 ++ src/lisp.h | 1 + src/lread.c | 2 +- 6 files changed, 56 insertions(+), 2 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index c00a68307b0..0728c4f0a81 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -40,6 +40,11 @@ "Emacs Lisp native compiler." :group 'lisp) +(defcustom comp-deferred-compilation nil + "If t compile asyncronously all lexically bound .elc files being loaded." + :type 'boolean + :group 'comp) + (defcustom comp-speed 2 "Compiler optimization level. From 0 to 3. - 0 no optimizations are performed, compile time is favored. diff --git a/src/comp.c b/src/comp.c index b9ecef07f32..74b74a83b77 100644 --- a/src/comp.c +++ b/src/comp.c @@ -492,7 +492,7 @@ declare_imported_func (Lisp_Object subr_sym, gcc_jit_type *ret_type, /* String containing the function ptr name. */ Lisp_Object f_ptr_name = - CALLN (Ffuncall, intern_c_string (STR (comp-c-func-name)), + CALLN (Ffuncall, intern_c_string ("comp-c-func-name"), subr_sym, make_string ("R", 1)); gcc_jit_type *f_ptr_type = @@ -3359,6 +3359,40 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code) code); } + +/***********************************/ +/* Deferred compilation mechanism. */ +/***********************************/ + +void +maybe_defer_native_compilation (Lisp_Object function_name, + Lisp_Object definition) +{ + Lisp_Object src = Qnil; + Lisp_Object load_list = Vcurrent_load_list; + + FOR_EACH_TAIL (load_list) + { + src = XCAR (load_list); + if (!CONSP (src)) + break; + } + + if (!comp_deferred_compilation + || noninteractive + || !NILP (Vpurify_flag) + || !COMPILEDP (definition) + || !FIXNUMP (AREF (definition, COMPILED_ARGLIST)) + || !STRINGP (src) + || !suffix_p (src, ".elc")) + return; + + src = concat2 (CALL1I (file-name-sans-extension, src), + build_pure_c_string (".el")); + if (!NILP (Ffile_exists_p (src))) + CALLN (Ffuncall, intern_c_string ("native-compile-async"), src, Qnil); +} + /**************************************/ /* Functions used to load eln files. */ @@ -3552,6 +3586,8 @@ void syms_of_comp (void) { /* Compiler control customizes. */ + DEFVAR_BOOL ("comp-deferred-compilation", comp_deferred_compilation, + doc: /* If t compile asyncronously every .elc file loaded. */); DEFSYM (Qcomp_speed, "comp-speed"); DEFSYM (Qcomp_debug, "comp-debug"); diff --git a/src/comp.h b/src/comp.h index 070ec4d5ca9..f3bcd4c09bc 100644 --- a/src/comp.h +++ b/src/comp.h @@ -68,5 +68,15 @@ extern void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump); extern void syms_of_comp (void); +extern void maybe_defer_native_compilation (Lisp_Object function_name, + Lisp_Object definition); +#else + +static inline void +maybe_defer_native_compilation (Lisp_Object function_name, + Lisp_Object definition) +{} + #endif + #endif diff --git a/src/data.c b/src/data.c index 8a0546ce09b..173b92c5bf4 100644 --- a/src/data.c +++ b/src/data.c @@ -814,6 +814,8 @@ The return value is undefined. */) Ffset (symbol, definition); } + maybe_defer_native_compilation (symbol, definition); + if (!NILP (docstring)) Fput (symbol, Qfunction_documentation, docstring); /* We used to return `definition', but now that `defun' and `defmacro' expand diff --git a/src/lisp.h b/src/lisp.h index cd543f5047d..96959764879 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4102,6 +4102,7 @@ LOADHIST_ATTACH (Lisp_Object x) if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); } +extern bool suffix_p (Lisp_Object, const char *); extern Lisp_Object save_match_data_load (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, diff --git a/src/lread.c b/src/lread.c index 32c83bfae8b..2d90bccdc07 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1077,7 +1077,7 @@ effective_load_path (void) } /* Return true if STRING ends with SUFFIX. */ -static bool +bool suffix_p (Lisp_Object string, const char *suffix) { ptrdiff_t suffix_len = strlen (suffix); -- cgit v1.2.3 From b53fc68535211a59fde7200713340d911b48ecec Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 18 Mar 2020 19:48:50 +0000 Subject: Extend low level code for late load --- src/comp.c | 36 ++++++++++++++++-------------------- src/comp.h | 4 ++-- src/lread.c | 2 +- src/pdumper.c | 2 +- 4 files changed, 20 insertions(+), 24 deletions(-) (limited to 'src/lread.c') diff --git a/src/comp.c b/src/comp.c index 74b74a83b77..3f2b45c85fd 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3368,27 +3368,18 @@ void maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object definition) { - Lisp_Object src = Qnil; - Lisp_Object load_list = Vcurrent_load_list; - - FOR_EACH_TAIL (load_list) - { - src = XCAR (load_list); - if (!CONSP (src)) - break; - } - if (!comp_deferred_compilation || noninteractive || !NILP (Vpurify_flag) || !COMPILEDP (definition) || !FIXNUMP (AREF (definition, COMPILED_ARGLIST)) - || !STRINGP (src) - || !suffix_p (src, ".elc")) + || !STRINGP (Vload_file_name) + || !suffix_p (Vload_file_name, ".elc")) return; - src = concat2 (CALL1I (file-name-sans-extension, src), - build_pure_c_string (".el")); + Lisp_Object src = + concat2 (CALL1I (file-name-sans-extension, Vload_file_name), + build_pure_c_string (".el")); if (!NILP (Ffile_exists_p (src))) CALLN (Ffuncall, intern_c_string ("native-compile-async"), src, Qnil); } @@ -3413,7 +3404,8 @@ load_static_obj (struct Lisp_Native_Comp_Unit *comp_u, const char *name) } void -load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump) +load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, + bool late_load) { dynlib_handle_ptr handle = comp_u->handle; Lisp_Object comp_u_lisp_obj; @@ -3447,7 +3439,9 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump) freloc_check_fill (); - void (*top_level_run)(Lisp_Object) = dynlib_sym (handle, "top_level_run"); + void (*top_level_run)(Lisp_Object) + = dynlib_sym (handle, + late_load ? "late_top_level_run" : "top_level_run"); if (!reloading_cu) { @@ -3564,9 +3558,11 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, } /* Load related routines. */ -DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0, - doc: /* Load native elisp code FILE. */) - (Lisp_Object file) +DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, + doc: /* Load native elisp code FILE. + LATE_LOAD has to be non nil when loading for deferred + compilation. */) + (Lisp_Object file, Lisp_Object late_load) { CHECK_STRING (file); @@ -3576,7 +3572,7 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0, xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ())); comp_u->file = file; comp_u->data_vec = Qnil; - load_comp_unit (comp_u, false); + load_comp_unit (comp_u, false, !NILP (late_load)); return Qt; } diff --git a/src/comp.h b/src/comp.h index f3bcd4c09bc..f5baa88853e 100644 --- a/src/comp.h +++ b/src/comp.h @@ -64,8 +64,8 @@ XNATIVE_COMP_UNIT (Lisp_Object a) extern void hash_native_abi (void); -extern void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, - bool loading_dump); +void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, + bool late_load); extern void syms_of_comp (void); extern void maybe_defer_native_compilation (Lisp_Object function_name, diff --git a/src/lread.c b/src/lread.c index 2d90bccdc07..b2f437130ce 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1483,7 +1483,7 @@ Return t if the file exists and loads successfully. */) { specbind (Qcurrent_load_list, Qnil); LOADHIST_ATTACH (found); - Fnative_elisp_load (found); + Fnative_elisp_load (found, Qnil); build_load_history (found, true); } else diff --git a/src/pdumper.c b/src/pdumper.c index 2e2220a9b29..55f95fd0e75 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5303,7 +5303,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, comp_u->handle = dynlib_open (SSDATA (comp_u->file)); if (!comp_u->handle) error ("%s", dynlib_error ()); - load_comp_unit (comp_u, true); + load_comp_unit (comp_u, true, false); break; } case RELOC_NATIVE_SUBR: -- cgit v1.2.3 From 6e09597e27fd769e734ddacca8824abd6769257d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 12 Apr 2020 21:15:52 +0100 Subject: Introduce load-true-file-name * src/comp.c (maybe_defer_native_compilation): Use `load-true-file-name' instead of `load-file-name'. * src/lread.c (Fload, end_of_file_error, read1, read_list) (init_lread, syms_of_lread): Add new `load-true-file-name' and fake `load-file-name' value when loading .eln files. --- src/comp.c | 10 +++++----- src/lread.c | 35 ++++++++++++++++++++++++++++------- 2 files changed, 33 insertions(+), 12 deletions(-) (limited to 'src/lread.c') diff --git a/src/comp.c b/src/comp.c index 32fc7f23c4e..4bd271402c2 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3467,7 +3467,7 @@ maybe_defer_native_compilation (Lisp_Object function_name, #include #include if (!NILP (function_name) && - STRINGP (Vload_file_name)) + STRINGP (Vload_true_file_name)) { static FILE *f; if (!f) @@ -3480,7 +3480,7 @@ maybe_defer_native_compilation (Lisp_Object function_name, exit (1); fprintf (f, "function %s file %s\n", SSDATA (Fsymbol_name (function_name)), - SSDATA (Vload_file_name)); + SSDATA (Vload_true_file_name)); fflush (f); } #endif @@ -3489,12 +3489,12 @@ maybe_defer_native_compilation (Lisp_Object function_name, || !NILP (Vpurify_flag) || !COMPILEDP (definition) || !FIXNUMP (AREF (definition, COMPILED_ARGLIST)) - || !STRINGP (Vload_file_name) - || !suffix_p (Vload_file_name, ".elc")) + || !STRINGP (Vload_true_file_name) + || !suffix_p (Vload_true_file_name, ".elc")) return; Lisp_Object src = - concat2 (CALL1I (file-name-sans-extension, Vload_file_name), + concat2 (CALL1I (file-name-sans-extension, Vload_true_file_name), build_pure_c_string (".el")); if (NILP (Ffile_exists_p (src))) return; diff --git a/src/lread.c b/src/lread.c index 2b1ac93aa91..937b4566851 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1467,7 +1467,20 @@ Return t if the file exists and loads successfully. */) message_with_string ("Loading %s...", file, 1); } - specbind (Qload_file_name, found); + if (is_native_elisp) + { + Lisp_Object dir = Ffile_name_directory (found); + Lisp_Object parent_dir = + Ffile_name_directory (Fsubstring (dir, + make_fixnum (0), + Fsub1 (Flength (dir)))); + specbind (Qload_file_name, + concat2 (parent_dir, + Ffile_name_nondirectory (found))); + } + else + specbind (Qload_file_name, found); + specbind (Qload_true_file_name, found); specbind (Qinhibit_file_name_operation, Qnil); specbind (Qload_in_progress, Qt); @@ -1928,8 +1941,8 @@ readevalloop_1 (int old) static AVOID end_of_file_error (void) { - if (STRINGP (Vload_file_name)) - xsignal1 (Qend_of_file, Vload_file_name); + if (STRINGP (Vload_true_file_name)) + xsignal1 (Qend_of_file, Vload_true_file_name); xsignal0 (Qend_of_file); } @@ -3161,7 +3174,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) goto retry; } if (c == '$') - return Vload_file_name; + return Vload_true_file_name; if (c == '\'') return list2 (Qfunction, read0 (readcharfun)); /* #:foo is the uninterned symbol named foo. */ @@ -3960,7 +3973,7 @@ read_list (bool flag, Lisp_Object readcharfun) first_in_list = 0; /* While building, if the list starts with #$, treat it specially. */ - if (EQ (elt, Vload_file_name) + if (EQ (elt, Vload_true_file_name) && ! NILP (elt) && !NILP (Vpurify_flag)) { @@ -3981,7 +3994,7 @@ read_list (bool flag, Lisp_Object readcharfun) elt = concat2 (dot_dot_lisp, Ffile_name_nondirectory (elt)); } } - else if (EQ (elt, Vload_file_name) + else if (EQ (elt, Vload_true_file_name) && ! NILP (elt) && load_force_doc_strings) doc_reference = 2; @@ -4737,6 +4750,7 @@ init_lread (void) load_in_progress = 0; Vload_file_name = Qnil; + Vload_true_file_name = Qnil; Vstandard_input = Qt; Vloads_in_progress = Qnil; } @@ -4938,9 +4952,15 @@ directory. These file names are converted to absolute at startup. */); Vload_history = Qnil; DEFVAR_LISP ("load-file-name", Vload_file_name, - doc: /* Full name of file being loaded by `load'. */); + doc: /* Full name of file being loaded by `load'. +In case a .eln file is being loaded this is unreliable and `load-true-file-name' +should be used instead. */); Vload_file_name = Qnil; + DEFVAR_LISP ("load-true-file-name", Vload_true_file_name, + doc: /* Full name of file being loaded by `load'. */); + Vload_true_file_name = Qnil; + DEFVAR_LISP ("user-init-file", Vuser_init_file, doc: /* File name, including directory, of user's initialization file. If the file loaded had extension `.elc', and the corresponding source file @@ -5082,6 +5102,7 @@ that are loaded before your customizations are read! */); DEFSYM (Qfunction, "function"); DEFSYM (Qload, "load"); DEFSYM (Qload_file_name, "load-file-name"); + DEFSYM (Qload_true_file_name, "load-true-file-name"); DEFSYM (Qeval_buffer_list, "eval-buffer-list"); DEFSYM (Qdir_ok, "dir-ok"); DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation"); -- cgit v1.2.3 From 1c5548f1c51b44b78d05deb11a31b8678df7b4e7 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 13 Apr 2020 11:07:11 +0100 Subject: * src/lread.c (Fload): Add comment. --- src/lread.c | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 937b4566851..18a56d0969c 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1469,6 +1469,11 @@ Return t if the file exists and loads successfully. */) if (is_native_elisp) { + /* Many packages use `load-file-name' as a way to obtain the + package location (see bug#40099). .eln files are not in the + same folder of their respective sources therfore not to break + packages we fake `load-file-name' here. The non faked + version of it is `load-true-file-name'. */ Lisp_Object dir = Ffile_name_directory (found); Lisp_Object parent_dir = Ffile_name_directory (Fsubstring (dir, -- cgit v1.2.3 From 05adf0353faf0bff3da60230a691b381de297843 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 13 Apr 2020 16:54:03 +0100 Subject: Fix function find mechanism for installed instance. * src/lread.c (parent_directory): New function. (Fload): Make use of 'parent_directory' and fix load-history build-up with relative paths. --- src/lread.c | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 18a56d0969c..9bd60b9b386 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1102,6 +1102,14 @@ close_infile_unwind (void *arg) infile = prev_infile; } +static Lisp_Object +parent_directory (Lisp_Object directory) +{ + return Ffile_name_directory (Fsubstring (directory, + make_fixnum (0), + Fsub1 (Flength (directory)))); +} + DEFUN ("load", Fload, Sload, 1, 5, 0, doc: /* Execute a file of Lisp code named FILE. First try FILE with `.elc' appended, then try with `.el', then try @@ -1474,13 +1482,8 @@ Return t if the file exists and loads successfully. */) same folder of their respective sources therfore not to break packages we fake `load-file-name' here. The non faked version of it is `load-true-file-name'. */ - Lisp_Object dir = Ffile_name_directory (found); - Lisp_Object parent_dir = - Ffile_name_directory (Fsubstring (dir, - make_fixnum (0), - Fsub1 (Flength (dir)))); specbind (Qload_file_name, - concat2 (parent_dir, + concat2 (parent_directory (Ffile_name_directory (found)), Ffile_name_nondirectory (found))); } else @@ -1506,9 +1509,15 @@ Return t if the file exists and loads successfully. */) if (NATIVE_COMP_FLAG) { specbind (Qcurrent_load_list, Qnil); - LOADHIST_ATTACH (found); + if (!NILP (Vpurify_flag)) + { + Lisp_Object base = parent_directory (Ffile_name_directory (found)); + Lisp_Object offset = Flength (base); + hist_file_name = Fsubstring (found, offset, Qnil); + } + LOADHIST_ATTACH (hist_file_name); Fnative_elisp_load (found, Qnil); - build_load_history (found, true); + build_load_history (hist_file_name, true); } else /* This cannot happen. */ -- cgit v1.2.3 From 97873235523dd6fc236b3ebc7bf34a53fb5a528a Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 13 Apr 2020 16:57:27 +0100 Subject: * src/lread.c (Fload): Clean-up unnecessary sanity check. 'is_native_elisp' can't be non zero if NATIVE_COMP_FLAG is not set. --- src/lread.c | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 9bd60b9b386..1e05ac69320 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1506,22 +1506,16 @@ Return t if the file exists and loads successfully. */) } else if (is_native_elisp) { - if (NATIVE_COMP_FLAG) + specbind (Qcurrent_load_list, Qnil); + if (!NILP (Vpurify_flag)) { - specbind (Qcurrent_load_list, Qnil); - if (!NILP (Vpurify_flag)) - { - Lisp_Object base = parent_directory (Ffile_name_directory (found)); - Lisp_Object offset = Flength (base); - hist_file_name = Fsubstring (found, offset, Qnil); - } - LOADHIST_ATTACH (hist_file_name); - Fnative_elisp_load (found, Qnil); - build_load_history (hist_file_name, true); + Lisp_Object base = parent_directory (Ffile_name_directory (found)); + Lisp_Object offset = Flength (base); + hist_file_name = Fsubstring (found, offset, Qnil); } - else - /* This cannot happen. */ - emacs_abort (); + LOADHIST_ATTACH (hist_file_name); + Fnative_elisp_load (found, Qnil); + build_load_history (hist_file_name, true); } else { -- cgit v1.2.3 From 385d9e69740e4f6293fe4c7b4206e3a4aca6ca21 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 6 Jun 2020 13:00:45 +0100 Subject: Some fixes for --without-nativecomp config * src/pdumper.c (dump_subr): Do not add RELOC_NATIVE_SUBR for VERY_LATE_RELOCS in --without-nativecomp. (dump_do_dump_relocation): Add a sanity check that no RELOC_NATIVE_SUBR exists in --without-nativecomp. * src/lread.c (Fload): As Fnative_elisp_load is not defined in --without-nativecomp so ifdef this block. --- src/lread.c | 6 ++++++ src/pdumper.c | 8 +++++++- 2 files changed, 13 insertions(+), 1 deletion(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 026f3b6d98f..192c7ba773a 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1507,6 +1507,7 @@ Return t if the file exists and loads successfully. */) } else if (is_native_elisp) { +#ifdef HAVE_NATIVE_COMP specbind (Qcurrent_load_list, Qnil); if (!NILP (Vpurify_flag)) { @@ -1517,6 +1518,11 @@ Return t if the file exists and loads successfully. */) LOADHIST_ATTACH (hist_file_name); Fnative_elisp_load (found, Qnil); build_load_history (hist_file_name, true); +#else + /* This cannot happen. */ + emacs_abort (); +#endif + } else { diff --git a/src/pdumper.c b/src/pdumper.c index ffe59fbb306..92ac96a8faa 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2967,7 +2967,9 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) dump_field_lv (ctx, &out, subr, &subr->native_comp_u[0], WEIGHT_NORMAL); dump_off subr_off = dump_object_finish (ctx, &out, sizeof (out)); - if (ctx->flags.dump_object_contents && !NILP (subr->native_comp_u[0])) + if (NATIVE_COMP_FLAG + && ctx->flags.dump_object_contents + && !NILP (subr->native_comp_u[0])) /* We'll do the final addr relocation during VERY_LATE_RELOCS time after the compilation units has been loaded. */ dump_push (&ctx->dump_relocs[VERY_LATE_RELOCS], @@ -5331,6 +5333,10 @@ dump_do_dump_relocation (const uintptr_t dump_base, } case RELOC_NATIVE_SUBR: { + if (!NATIVE_COMP_FLAG) + /* This cannot happen. */ + emacs_abort (); + /* When resurrecting from a dump given non all the original native compiled subrs may be still around we can't rely on a 'top_level_run' mechanism, we revive them one-by-one -- cgit v1.2.3 From e38678b268c2a3f77d1fa32a55706fb9e077405c Mon Sep 17 00:00:00 2001 From: Nicolás Bértolo Date: Mon, 25 May 2020 18:05:23 -0300 Subject: Reduce the number of files probed when finding a lisp file. * src/lread.c (get-load-suffixes): Do not add any suffix to files that need to be loaded by the dynamic linker. (effective_load_path): Remove function. (load): Don't add any suffix if file ends in a suffix already. (effective_load_path): Remove function. (openp_add_middle_dir_to_suffixes): Add helper function to create pairs of middle directories and suffixes. (openp_max_middledir_and_suffix_len): Add helper function to count the number of bytes needed to store the middle directory and suffix. (openp_fill_filename_buffer): Add helper function to copy middle directory, basename and suffix to the filename buffer. --- src/lread.c | 203 +++++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 154 insertions(+), 49 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 192c7ba773a..a3e8d07c563 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1056,31 +1056,27 @@ This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) { Lisp_Object exts = Vload_file_rep_suffixes; Lisp_Object suffix = XCAR (suffixes); - FOR_EACH_TAIL (exts) - lst = Fcons (concat2 (suffix, XCAR (exts)), lst); - } - return Fnreverse (lst); -} + bool native_code_suffix = + NATIVE_COMP_FLAG + && strcmp (NATIVE_ELISP_SUFFIX, SSDATA (suffix)) == 0; -static Lisp_Object -effective_load_path (void) -{ -#ifndef HAVE_NATIVE_COMP - return Vload_path; -#else - Lisp_Object lp = Vload_path; - Lisp_Object new_lp = Qnil; - FOR_EACH_TAIL (lp) - { - Lisp_Object el = XCAR (lp); - new_lp = - Fcons (concat2 (Ffile_name_as_directory (el), - Vcomp_native_path_postfix), - new_lp); - new_lp = Fcons (el, new_lp); - } - return Fnreverse (new_lp); +#ifdef HAVE_MODULES + native_code_suffix = + native_code_suffix || strcmp (MODULES_SUFFIX, SSDATA (suffix)) == 0; +#ifdef MODULES_SECONDARY_SUFFIX + native_code_suffix = + native_code_suffix + || strcmp (MODULES_SECONDARY_SUFFIX, SSDATA (suffix)) == 0; #endif +#endif + + if (native_code_suffix) + lst = Fcons (suffix, lst); + else + FOR_EACH_TAIL (exts) + lst = Fcons (concat2 (suffix, XCAR (exts)), lst); + } + return Fnreverse (lst); } /* Return true if STRING ends with SUFFIX. */ @@ -1218,7 +1214,7 @@ Return t if the file exists and loads successfully. */) || suffix_p (file, MODULES_SECONDARY_SUFFIX) #endif #endif - ) + || (NATIVE_COMP_FLAG && suffix_p (file, NATIVE_ELISP_SUFFIX))) must_suffix = Qnil; /* Don't insist on adding a suffix if the argument includes a directory name. */ @@ -1236,8 +1232,7 @@ Return t if the file exists and loads successfully. */) } fd = - openp (effective_load_path (), file, suffixes, &found, Qnil, - load_prefer_newer); + openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer); } if (fd == -1) @@ -1612,6 +1607,114 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) return file; } +/* This function turns a list of suffixes into a list of middle dirs + and suffixes. If the suffix is not NATIVE_ELISP_SUFFIX then its + suffix is nil and it is added to the list as is. Instead, if it + suffix is NATIVE_ELISP_SUFFIX then two elements are added to the + list. The first one has middledir equal to nil and the second uses + comp-native-path-postfix as middledir. This is because we'd like + to search for dir/foo.eln before dir/middledir/foo.eln. + +For example, it turns this: + +(".eln" ".elc" ".elc.gz" ".el" ".el.gz") + + into this: + +((nil . ".eln") + (comp-native-path-postfix . ".eln") + (nil . ".elc") + (nil . ".elc.gz") + (nil . ".el") + (nil . ".el.gz")) +*/ +static Lisp_Object +openp_add_middle_dir_to_suffixes (Lisp_Object suffixes) +{ + Lisp_Object tail = suffixes; + Lisp_Object extended_suf = Qnil; + FOR_EACH_TAIL_SAFE (tail) + { +#ifdef HAVE_NATIVE_COMP + CHECK_STRING_CAR (tail); + char * suf = SSDATA (XCAR (tail)); + if (strcmp (NATIVE_ELISP_SUFFIX, suf) == 0) + { + CHECK_STRING (Vcomp_native_path_postfix); + /* Here we add them in the opposite order so that nreverse + corrects it. */ + extended_suf = Fcons (Fcons (Qnil, XCAR (tail)), extended_suf); + extended_suf = Fcons (Fcons (Vcomp_native_path_postfix, XCAR (tail)), + extended_suf); + } + else +#endif + extended_suf = Fcons (Fcons (Qnil, XCAR (tail)), extended_suf); + } + + suffixes = Fnreverse (extended_suf); + return suffixes; +} + +/* This function takes a list of middledirs and suffixes and returns + the maximum buffer space that this part of the filename will + need. */ +static ptrdiff_t +openp_max_middledir_and_suffix_len (Lisp_Object middledir_and_suffixes) +{ + ptrdiff_t max_extra_len = 0; + Lisp_Object tail = middledir_and_suffixes; + FOR_EACH_TAIL_SAFE (tail) + { + Lisp_Object middledir_and_suffix = XCAR (tail); + Lisp_Object middledir = XCAR (middledir_and_suffix); + Lisp_Object suffix = XCDR (middledir_and_suffix); + ptrdiff_t len = SBYTES (suffix); + if (!NILP (middledir)) + len += 2 + SBYTES (middledir); /* Add two slashes. */ + max_extra_len = max (max_extra_len, len); + } + return max_extra_len; +} + +/* This function completes the FN buffer with the middledir, + basenameme, and suffix. It takes the directory length in DIRNAME, + but it requires that it has been copied already to the start of + the buffer. + + After this function the FN buffer will be (depending on middledir) + dirname/middledir/basename.suffix + or + dirname/basename.suffix +*/ +static ptrdiff_t +openp_fill_filename_buffer (char *fn, ptrdiff_t dirnamelen, + Lisp_Object basenamewext, + Lisp_Object middledir_and_suffix) +{ + Lisp_Object middledir = XCAR (middledir_and_suffix); + Lisp_Object suffix = XCDR (middledir_and_suffix); + ptrdiff_t basenamewext_len = SBYTES (basenamewext); + ptrdiff_t fnlen, lsuffix = SBYTES (suffix); + ptrdiff_t lmiddledir = 0; + if (!NILP (middledir)) + { + /* Add 1 for the slash. */ + lmiddledir = SBYTES (middledir) + 1; + memcpy (fn + dirnamelen, SDATA (middledir), + lmiddledir - 1); + fn[dirnamelen + (lmiddledir - 1)] = '/'; + } + + memcpy (fn + dirnamelen + lmiddledir, SDATA (basenamewext), + basenamewext_len); + /* Make complete filename by appending SUFFIX. */ + memcpy (fn + dirnamelen + lmiddledir + basenamewext_len, + SDATA (suffix), lsuffix + 1); + fnlen = dirnamelen + lmiddledir + basenamewext_len + lsuffix; + return fnlen; +} + /* Search for a file whose name is STR, looking in directories in the Lisp list PATH, and trying suffixes from SUFFIX. On success, return a file descriptor (or 1 or -2 as described below). @@ -1649,7 +1752,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, ptrdiff_t want_length; Lisp_Object filename; Lisp_Object string, tail, encoded_fn, save_string; - ptrdiff_t max_suffix_len = 0; + Lisp_Object middledir_and_suffixes; + ptrdiff_t max_extra_len = 0; int last_errno = ENOENT; int save_fd = -1; USE_SAFE_ALLOCA; @@ -1660,13 +1764,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, CHECK_STRING (str); - tail = suffixes; - FOR_EACH_TAIL_SAFE (tail) - { - CHECK_STRING_CAR (tail); - max_suffix_len = max (max_suffix_len, - SBYTES (XCAR (tail))); - } + middledir_and_suffixes = openp_add_middle_dir_to_suffixes (suffixes); + + max_extra_len = openp_max_middledir_and_suffix_len (middledir_and_suffixes); string = filename = encoded_fn = save_string = Qnil; @@ -1683,7 +1783,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, executable. */ FOR_EACH_TAIL_SAFE (path) { - ptrdiff_t baselen, prefixlen; + ptrdiff_t dirnamelen, prefixlen; if (EQ (path, just_use_str)) filename = str; @@ -1700,35 +1800,40 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, continue; } + /* Calculate maximum length of any filename made from this path element/specified file name and any possible suffix. */ - want_length = max_suffix_len + SBYTES (filename); + want_length = max_extra_len + SBYTES (filename); if (fn_size <= want_length) { fn_size = 100 + want_length; fn = SAFE_ALLOCA (fn_size); } + Lisp_Object dirnamewslash = Ffile_name_directory (filename); + Lisp_Object basenamewext = Ffile_name_nondirectory (filename); + /* Copy FILENAME's data to FN but remove starting /: if any. */ - prefixlen = ((SCHARS (filename) > 2 - && SREF (filename, 0) == '/' - && SREF (filename, 1) == ':') + prefixlen = ((SCHARS (dirnamewslash) > 2 + && SREF (dirnamewslash, 0) == '/' + && SREF (dirnamewslash, 1) == ':') ? 2 : 0); - baselen = SBYTES (filename) - prefixlen; - memcpy (fn, SDATA (filename) + prefixlen, baselen); + dirnamelen = SBYTES (dirnamewslash) - prefixlen; + memcpy (fn, SDATA (dirnamewslash) + prefixlen, dirnamelen); - /* Loop over suffixes. */ - AUTO_LIST1 (empty_string_only, empty_unibyte_string); - tail = NILP (suffixes) ? empty_string_only : suffixes; + /* Loop over middledir_and_suffixes. */ + AUTO_LIST1 (empty_string_only, Fcons (Qnil, empty_unibyte_string)); + tail = NILP (middledir_and_suffixes) ? empty_string_only + : middledir_and_suffixes; FOR_EACH_TAIL_SAFE (tail) { - Lisp_Object suffix = XCAR (tail); - ptrdiff_t fnlen, lsuffix = SBYTES (suffix); + Lisp_Object middledir_and_suffix = XCAR (tail); + Lisp_Object suffix = XCDR (middledir_and_suffix); Lisp_Object handler; - /* Make complete filename by appending SUFFIX. */ - memcpy (fn + baselen, SDATA (suffix), lsuffix + 1); - fnlen = baselen + lsuffix; + ptrdiff_t fnlen = openp_fill_filename_buffer (fn, dirnamelen, + basenamewext, + middledir_and_suffix); /* Check that the file exists and is not a directory. */ /* We used to only check for handlers on non-absolute file names: -- cgit v1.2.3 From 10933f235fa2f1d7a3936da173cdd6e807bff57f Mon Sep 17 00:00:00 2001 From: Nicolás Bértolo Date: Mon, 8 Jun 2020 22:01:25 -0300 Subject: Copy suffixes passed to 'openp' to avoid GC crashes. Fixes bug#41755 In openp_add_middle_dir_to_suffixes we build a heap-based list from the passed suffixes. It is crucial that we don't create a heap-based cons that points to a stack-based list. * src/lread.c (openp_add_middle_dir_to_suffixes): Copy suffixes when building a list of middle-dirs and suffixes. --- src/lread.c | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index a3e8d07c563..0530848c2b7 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1635,21 +1635,27 @@ openp_add_middle_dir_to_suffixes (Lisp_Object suffixes) Lisp_Object extended_suf = Qnil; FOR_EACH_TAIL_SAFE (tail) { -#ifdef HAVE_NATIVE_COMP + /* suffixes may be a stack-based cons pointing to stack-based + strings. We must copy the suffix if we are putting it into + a heap-based cons to avoid a dangling reference. This would + lead to crashes during the GC. */ CHECK_STRING_CAR (tail); char * suf = SSDATA (XCAR (tail)); + Lisp_Object copied_suffix = build_string (suf); +#ifdef HAVE_NATIVE_COMP if (strcmp (NATIVE_ELISP_SUFFIX, suf) == 0) { CHECK_STRING (Vcomp_native_path_postfix); /* Here we add them in the opposite order so that nreverse corrects it. */ - extended_suf = Fcons (Fcons (Qnil, XCAR (tail)), extended_suf); - extended_suf = Fcons (Fcons (Vcomp_native_path_postfix, XCAR (tail)), + extended_suf = Fcons (Fcons (Qnil, copied_suffix), extended_suf); + extended_suf = Fcons (Fcons (Vcomp_native_path_postfix, + copied_suffix), extended_suf); } else #endif - extended_suf = Fcons (Fcons (Qnil, XCAR (tail)), extended_suf); + extended_suf = Fcons (Fcons (Qnil, copied_suffix), extended_suf); } suffixes = Fnreverse (extended_suf); -- cgit v1.2.3 From f0e9fdd1f9a9989b457cbc382e0cf12c161a8e6c Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 21 Jun 2020 20:52:52 +0200 Subject: Two `load-history' eln related fixes. * src/lread.c (Fload): Fix `load-history' filling for elns non in root lisp-dir. * lisp/startup.el (command-line): Fix `load-history' fixup algorith for eln files. --- lisp/startup.el | 7 ++++++- src/lread.c | 3 ++- 2 files changed, 8 insertions(+), 2 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/startup.el b/lisp/startup.el index bff10003f84..e58f27e7ebc 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1061,7 +1061,12 @@ please check its value") (unless (file-readable-p lispdir) (princ (format "Lisp directory %s not readable?" lispdir)) (terpri))) - (setq lisp-dir (file-truename (file-name-directory simple-file-name))) + (setq lisp-dir + (file-truename + (if (string-match "\\.eln\\'" simple-file-name) + (expand-file-name + (concat (file-name-directory simple-file-name) "../")) + (file-name-directory simple-file-name)))) (setq load-history (mapcar (lambda (elt) (if (and (stringp (car elt)) diff --git a/src/lread.c b/src/lread.c index 0530848c2b7..f5a7d44a1e0 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1506,7 +1506,8 @@ Return t if the file exists and loads successfully. */) specbind (Qcurrent_load_list, Qnil); if (!NILP (Vpurify_flag)) { - Lisp_Object base = parent_directory (Ffile_name_directory (found)); + Lisp_Object base = concat2 (parent_directory (Vinvocation_directory), + build_string ("lisp/")); Lisp_Object offset = Flength (base); hist_file_name = Fsubstring (found, offset, Qnil); } -- cgit v1.2.3 From f2e6168ece69d635b4f9d9a138100c6772903d0b Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 15 Aug 2020 20:22:10 +0200 Subject: * Remove a warning for conventional build * src/lread.c (parent_directory): Add ATTRIBUTE_UNUSED. --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index f5a7d44a1e0..f10a20ded86 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1099,7 +1099,7 @@ close_infile_unwind (void *arg) infile = prev_infile; } -static Lisp_Object +static ATTRIBUTE_UNUSED Lisp_Object parent_directory (Lisp_Object directory) { return Ffile_name_directory (Fsubstring (directory, -- cgit v1.2.3 From 3224a443060a5f21bb910064fc06fe4432810355 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 19 Jul 2020 10:46:24 +0200 Subject: Move eln files into dedicated cache directories When loading a elc file search for a corresponding eln one into `comp-eln-load-path' directories and load it if available. `comp-eln-load-path' contains by default two directory (user and system one). * src/pdumper.c (dump_do_dump_relocation): While resurrecting from load set eln cache sys dir in `Vcomp_eln_load_path'. * src/lread.c (maybe_swap_for_eln): New function. (Fload): Clean-up some now unnecessary code going back to the master one. (Fload): Make use of Vcomp_eln_to_el_h for the reverse file look-up. (openp_add_middle_dir_to_suffixes) (openp_max_middledir_and_suffix_len, openp_fill_filename_buffer): Remove functions. (openp): As for Fload revert code modifications. (openp): When a .elc file is being loaded check if a corresponding eln can be loaded in place. * src/comp.c (ELN_FILENAME_HASH_LEN): New macro. (comp_hash_string): New function. (hash_native_abi): Make use of 'comp_hash_string'. (hash_native_abi): Change `comp-native-path-postfix' format. (Fcomp_el_to_eln_filename): New function. (Fcomp__compile_ctxt_to_file): Have file_name as a input. (Vcomp_eln_to_el_h, Vcomp_eln_load_path): New global varaibles. * lisp/startup.el (normal-top-level): Add user eln cache directory in `comp-eln-load-path'. * lisp/help-fns.el (find-lisp-object-file-name): Reverse look-up files using `comp-eln-to-el-h'. * lisp/files.el (locate-file): Likewise. * lisp/emacs-lisp/find-func.el (find-library-name): Likewise. * lisp/emacs-lisp/comp.el (comp-output-directory) (comp-output-base-filename, comp-output-filename): Remove function. (comp-compile-ctxt-to-file): Create parent directories if necessary. (comp-run-async-workers, native-compile, native-compile-async): Make use `comp-el-to-eln-filename'. --- lisp/emacs-lisp/comp.el | 38 +++----- lisp/emacs-lisp/find-func.el | 6 +- lisp/files.el | 5 +- lisp/help-fns.el | 6 +- lisp/startup.el | 3 + src/comp.c | 71 ++++++++++++--- src/lread.c | 206 ++++++++++++++----------------------------- src/pdumper.c | 17 +++- 8 files changed, 163 insertions(+), 189 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a92392f63ac..30cedf298e2 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -569,28 +569,6 @@ VERBOSITY is a number between 0 and 3." -(defun comp-output-directory (src) - "Return the compilation direcotry for source SRC." - (let* ((src (if (symbolp src) (symbol-name src) src)) - (expanded-filename (expand-file-name src))) - (file-name-as-directory - (concat (file-name-directory expanded-filename) - comp-native-path-postfix)))) - -(defun comp-output-base-filename (src) - "Output filename sans extention for SRC file being native compiled." - (let* ((src (if (symbolp src) (symbol-name src) src)) - (expanded-filename (expand-file-name src)) - (output-dir (comp-output-directory src)) - (output-filename - (file-name-sans-extension - (file-name-nondirectory expanded-filename)))) - (expand-file-name output-filename output-dir))) - -(defun comp-output-filename (src) - "Output filename for SRC file being native compiled." - (concat (comp-output-base-filename src) ".eln")) - (defmacro comp-loop-insn-in-block (basic-block &rest body) "Loop over all insns in BASIC-BLOCK executning BODY. Inside BODY `insn' can be used to read or set the current @@ -2486,7 +2464,7 @@ Prepare every function for final compilation and drive the C back-end." (unless (file-exists-p dir) ;; In case it's created in the meanwhile. (ignore-error 'file-already-exists - (make-directory dir))) + (make-directory dir t))) (unless comp-dry-run (comp--compile-ctxt-to-file name)))) @@ -2597,7 +2575,7 @@ display a message." source-file) when (or comp-always-compile (file-newer-than-file-p source-file - (comp-output-filename source-file))) + (comp-el-to-eln-filename source-file))) do (let* ((expr `(progn (require 'comp) (setf comp-speed ,comp-speed @@ -2636,7 +2614,7 @@ display a message." (when (and load1 (zerop (process-exit-status process))) (native-elisp-load - (comp-output-filename source-file1) + (comp-el-to-eln-filename source-file1) (eq load1 'late))) (comp-run-async-workers))))) (puthash source-file process comp-async-compilations)) @@ -2676,7 +2654,11 @@ Return the compilation unit file name." (byte-compile-debug t) (comp-ctxt (make-comp-ctxt - :output (comp-output-base-filename function-or-file) + :output (comp-el-to-eln-filename (if (symbolp function-or-file) + (symbol-name function-or-file) + function-or-file) + (when byte-native-for-bootstrap + (car (last comp-eln-load-path)))) :with-late-load with-late-load))) (comp-log "\n \n" 1) (condition-case err @@ -2770,8 +2752,8 @@ queued with LOAD %" (and (eq load 'late) (cl-some (lambda (re) (string-match re file)) comp-deferred-compilation-black-list))) - (let ((out-dir (comp-output-directory file)) - (out-filename (comp-output-filename file))) + (let* ((out-filename (comp-el-to-eln-filename file)) + (out-dir (file-name-directory out-filename))) (if (or (file-writable-p out-filename) (and (not (file-exists-p out-dir)) (file-writable-p (substring out-dir 0 -1)))) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index efbcfb3a722..2db976f8c5c 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -188,11 +188,7 @@ LIBRARY should be a string (the name of the library)." ((string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library) (setq library (replace-match "" t t library))) ((string-match "\\.eln\\'" library) - ;; From help-fns.el. - (setq library (expand-file-name (concat (file-name-base library) - ".el") - (concat (file-name-directory library) - ".."))))) + (setq library (gethash (file-name-nondirectory library) comp-eln-to-el-h)))) (or (locate-file library (or find-function-source-path load-path) diff --git a/lisp/files.el b/lisp/files.el index 9270f334afa..2aeae0a9bef 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -926,7 +926,10 @@ one or more of those symbols." (logior (if (memq 'executable predicate) 1 0) (if (memq 'writable predicate) 2 0) (if (memq 'readable predicate) 4 0)))) - (locate-file-internal filename path suffixes predicate)) + (let ((file (locate-file-internal filename path suffixes predicate))) + (if (and file (string-match "\\.eln\\'" file)) + (gethash (file-name-nondirectory file) comp-eln-to-el-h) + file))) (defun locate-file-completion-table (dirs suffixes string pred action) "Do completion for file names passed to `locate-file'." diff --git a/lisp/help-fns.el b/lisp/help-fns.el index afca2cd932e..49cdb4ed5e4 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -333,10 +333,8 @@ suitable file is found, return nil." object (or (if (symbolp type) type) 'defun)))) (file-name (if (and true-name (string-match "[.]eln\\'" true-name)) - (expand-file-name (concat (file-name-base true-name) - ".el") - (concat (file-name-directory true-name) - "..")) + (gethash (file-name-nondirectory true-name) + comp-eln-to-el-h) true-name))) (cond (autoloaded diff --git a/lisp/startup.el b/lisp/startup.el index e58f27e7ebc..e469b90bd68 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -537,6 +537,9 @@ It is the default value of the variable `top-level'." (setq user-emacs-directory (startup--xdg-or-homedot startup--xdg-config-home-emacs nil)) + (when (boundp 'comp-eln-load-path) + (setq comp-eln-load-path (cons (concat user-emacs-directory "eln-cache/") + comp-eln-load-path))) ;; Look in each dir in load-path for a subdirs.el file. If we ;; find one, load it, which will add the appropriate subdirs of ;; that dir into load-path. This needs to be done before setting diff --git a/src/comp.c b/src/comp.c index 704bd4b6b35..9582506f91b 100644 --- a/src/comp.c +++ b/src/comp.c @@ -393,6 +393,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 +636,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 +653,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 +661,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 +3860,30 @@ compile_function (Lisp_Object func) /* Entry points exposed to lisp. */ /**********************************/ +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 file_name, Lisp_Object base_dir) +{ + CHECK_STRING (file_name); + file_name = Fexpand_file_name (file_name, Qnil); + Lisp_Object hashed = Fsubstring (comp_hash_string (file_name), Qnil, + make_fixnum (ELN_FILENAME_HASH_LEN)); + file_name = concat2 (Ffile_name_nondirectory (Fsubstring (file_name, Qnil, + make_fixnum (-3))), + build_string ("-")); + file_name = concat3 (file_name, hashed, 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 (file_name, + 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 +4071,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 +4138,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, @@ -4971,6 +5003,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); @@ -5015,6 +5048,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); diff --git a/src/lread.c b/src/lread.c index f10a20ded86..c5bec0633df 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1231,8 +1231,7 @@ Return t if the file exists and loads successfully. */) suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes); } - fd = - openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer); + fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer); } if (fd == -1) @@ -1478,9 +1477,8 @@ Return t if the file exists and loads successfully. */) same folder of their respective sources therfore not to break packages we fake `load-file-name' here. The non faked version of it is `load-true-file-name'. */ - specbind (Qload_file_name, - concat2 (parent_directory (Ffile_name_directory (found)), - Ffile_name_nondirectory (found))); + specbind (Qload_file_name, Fgethash (Ffile_name_nondirectory (found), + Vcomp_eln_to_el_h, Qnil)); } else specbind (Qload_file_name, found); @@ -1608,118 +1606,51 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) return file; } -/* This function turns a list of suffixes into a list of middle dirs - and suffixes. If the suffix is not NATIVE_ELISP_SUFFIX then its - suffix is nil and it is added to the list as is. Instead, if it - suffix is NATIVE_ELISP_SUFFIX then two elements are added to the - list. The first one has middledir equal to nil and the second uses - comp-native-path-postfix as middledir. This is because we'd like - to search for dir/foo.eln before dir/middledir/foo.eln. +/* Look for a suitable .eln file to be loaded in place of FILENAME. + If found replace the content of FILENAME and FD. */ -For example, it turns this: - -(".eln" ".elc" ".elc.gz" ".el" ".el.gz") - - into this: - -((nil . ".eln") - (comp-native-path-postfix . ".eln") - (nil . ".elc") - (nil . ".elc.gz") - (nil . ".el") - (nil . ".el.gz")) -*/ -static Lisp_Object -openp_add_middle_dir_to_suffixes (Lisp_Object suffixes) +static void +maybe_swap_for_eln (Lisp_Object *filename, int *fd, struct timespec mtime) { - Lisp_Object tail = suffixes; - Lisp_Object extended_suf = Qnil; - FOR_EACH_TAIL_SAFE (tail) - { - /* suffixes may be a stack-based cons pointing to stack-based - strings. We must copy the suffix if we are putting it into - a heap-based cons to avoid a dangling reference. This would - lead to crashes during the GC. */ - CHECK_STRING_CAR (tail); - char * suf = SSDATA (XCAR (tail)); - Lisp_Object copied_suffix = build_string (suf); #ifdef HAVE_NATIVE_COMP - if (strcmp (NATIVE_ELISP_SUFFIX, suf) == 0) - { - CHECK_STRING (Vcomp_native_path_postfix); - /* Here we add them in the opposite order so that nreverse - corrects it. */ - extended_suf = Fcons (Fcons (Qnil, copied_suffix), extended_suf); - extended_suf = Fcons (Fcons (Vcomp_native_path_postfix, - copied_suffix), - extended_suf); - } - else -#endif - extended_suf = Fcons (Fcons (Qnil, copied_suffix), extended_suf); - } + struct stat eln_st; - suffixes = Fnreverse (extended_suf); - return suffixes; -} + if (!suffix_p (*filename, ".elc")) + return; -/* This function takes a list of middledirs and suffixes and returns - the maximum buffer space that this part of the filename will - need. */ -static ptrdiff_t -openp_max_middledir_and_suffix_len (Lisp_Object middledir_and_suffixes) -{ - ptrdiff_t max_extra_len = 0; - Lisp_Object tail = middledir_and_suffixes; - FOR_EACH_TAIL_SAFE (tail) + /* Search eln in the eln-cache directories. */ + Lisp_Object eln_path_tail = Vcomp_eln_load_path; + FOR_EACH_TAIL_SAFE (eln_path_tail) { - Lisp_Object middledir_and_suffix = XCAR (tail); - Lisp_Object middledir = XCAR (middledir_and_suffix); - Lisp_Object suffix = XCDR (middledir_and_suffix); - ptrdiff_t len = SBYTES (suffix); - if (!NILP (middledir)) - len += 2 + SBYTES (middledir); /* Add two slashes. */ - max_extra_len = max (max_extra_len, len); - } - return max_extra_len; -} + Lisp_Object el_name = + Fsubstring (*filename, Qnil, make_fixnum (-1)); + Lisp_Object eln_name = + Fcomp_el_to_eln_filename (el_name, XCAR (eln_path_tail)); + int eln_fd = emacs_open (SSDATA (ENCODE_FILE (eln_name)), O_RDONLY, 0); -/* This function completes the FN buffer with the middledir, - basenameme, and suffix. It takes the directory length in DIRNAME, - but it requires that it has been copied already to the start of - the buffer. - - After this function the FN buffer will be (depending on middledir) - dirname/middledir/basename.suffix - or - dirname/basename.suffix -*/ -static ptrdiff_t -openp_fill_filename_buffer (char *fn, ptrdiff_t dirnamelen, - Lisp_Object basenamewext, - Lisp_Object middledir_and_suffix) -{ - Lisp_Object middledir = XCAR (middledir_and_suffix); - Lisp_Object suffix = XCDR (middledir_and_suffix); - ptrdiff_t basenamewext_len = SBYTES (basenamewext); - ptrdiff_t fnlen, lsuffix = SBYTES (suffix); - ptrdiff_t lmiddledir = 0; - if (!NILP (middledir)) - { - /* Add 1 for the slash. */ - lmiddledir = SBYTES (middledir) + 1; - memcpy (fn + dirnamelen, SDATA (middledir), - lmiddledir - 1); - fn[dirnamelen + (lmiddledir - 1)] = '/'; + if (eln_fd > 0) + { + if (fstat (eln_fd, &eln_st) || S_ISDIR (eln_st.st_mode)) + emacs_close (eln_fd); + else + { + struct timespec eln_mtime = get_stat_mtime (&eln_st); + if (timespec_cmp (eln_mtime, mtime) > 0) + { + *filename = eln_name; + emacs_close (*fd); + *fd = eln_fd; + /* Store the eln -> el relation. */ + Fputhash (Ffile_name_nondirectory (eln_name), + el_name, Vcomp_eln_to_el_h); + return; + } + else + emacs_close (eln_fd); + } + } } - - memcpy (fn + dirnamelen + lmiddledir, SDATA (basenamewext), - basenamewext_len); - /* Make complete filename by appending SUFFIX. */ - memcpy (fn + dirnamelen + lmiddledir + basenamewext_len, - SDATA (suffix), lsuffix + 1); - fnlen = dirnamelen + lmiddledir + basenamewext_len + lsuffix; - return fnlen; +#endif } /* Search for a file whose name is STR, looking in directories @@ -1759,21 +1690,23 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, ptrdiff_t want_length; Lisp_Object filename; Lisp_Object string, tail, encoded_fn, save_string; - Lisp_Object middledir_and_suffixes; - ptrdiff_t max_extra_len = 0; + ptrdiff_t max_suffix_len = 0; int last_errno = ENOENT; int save_fd = -1; USE_SAFE_ALLOCA; - /* The last-modified time of the newest matching file found. Initialize it to something less than all valid timestamps. */ struct timespec save_mtime = make_timespec (TYPE_MINIMUM (time_t), -1); CHECK_STRING (str); - middledir_and_suffixes = openp_add_middle_dir_to_suffixes (suffixes); - - max_extra_len = openp_max_middledir_and_suffix_len (middledir_and_suffixes); + tail = suffixes; + FOR_EACH_TAIL_SAFE (tail) + { + CHECK_STRING_CAR (tail); + max_suffix_len = max (max_suffix_len, + SBYTES (XCAR (tail))); + } string = filename = encoded_fn = save_string = Qnil; @@ -1790,7 +1723,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, executable. */ FOR_EACH_TAIL_SAFE (path) { - ptrdiff_t dirnamelen, prefixlen; + ptrdiff_t baselen, prefixlen; if (EQ (path, just_use_str)) filename = str; @@ -1807,40 +1740,35 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, continue; } - /* Calculate maximum length of any filename made from this path element/specified file name and any possible suffix. */ - want_length = max_extra_len + SBYTES (filename); + want_length = max_suffix_len + SBYTES (filename); if (fn_size <= want_length) { fn_size = 100 + want_length; fn = SAFE_ALLOCA (fn_size); } - Lisp_Object dirnamewslash = Ffile_name_directory (filename); - Lisp_Object basenamewext = Ffile_name_nondirectory (filename); - /* Copy FILENAME's data to FN but remove starting /: if any. */ - prefixlen = ((SCHARS (dirnamewslash) > 2 - && SREF (dirnamewslash, 0) == '/' - && SREF (dirnamewslash, 1) == ':') + prefixlen = ((SCHARS (filename) > 2 + && SREF (filename, 0) == '/' + && SREF (filename, 1) == ':') ? 2 : 0); - dirnamelen = SBYTES (dirnamewslash) - prefixlen; - memcpy (fn, SDATA (dirnamewslash) + prefixlen, dirnamelen); + baselen = SBYTES (filename) - prefixlen; + memcpy (fn, SDATA (filename) + prefixlen, baselen); - /* Loop over middledir_and_suffixes. */ - AUTO_LIST1 (empty_string_only, Fcons (Qnil, empty_unibyte_string)); - tail = NILP (middledir_and_suffixes) ? empty_string_only - : middledir_and_suffixes; + /* Loop over suffixes. */ + AUTO_LIST1 (empty_string_only, empty_unibyte_string); + tail = NILP (suffixes) ? empty_string_only : suffixes; FOR_EACH_TAIL_SAFE (tail) { - Lisp_Object middledir_and_suffix = XCAR (tail); - Lisp_Object suffix = XCDR (middledir_and_suffix); + Lisp_Object suffix = XCAR (tail); + ptrdiff_t fnlen, lsuffix = SBYTES (suffix); Lisp_Object handler; - ptrdiff_t fnlen = openp_fill_filename_buffer (fn, dirnamelen, - basenamewext, - middledir_and_suffix); + /* Make complete filename by appending SUFFIX. */ + memcpy (fn + baselen, SDATA (suffix), lsuffix + 1); + fnlen = baselen + lsuffix; /* Check that the file exists and is not a directory. */ /* We used to only check for handlers on non-absolute file names: @@ -1962,9 +1890,11 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, } else { + maybe_swap_for_eln (&string, &fd, get_stat_mtime (&st)); /* We succeeded; return this descriptor and filename. */ if (storeptr) *storeptr = string; + SAFE_FREE (); return fd; } @@ -1973,6 +1903,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, /* No more suffixes. Return the newest. */ if (0 <= save_fd && ! CONSP (XCDR (tail))) { + maybe_swap_for_eln (&save_string, &save_fd, save_mtime); if (storeptr) *storeptr = save_string; SAFE_FREE (); @@ -5030,11 +4961,8 @@ to the specified file name if a suffix is allowed or required. */); Vload_suffixes = Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes); #endif -#endif -#ifdef HAVE_NATIVE_COMP - Vload_suffixes = Fcons (build_pure_c_string (NATIVE_ELISP_SUFFIX), Vload_suffixes); -#endif +#endif DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix, doc: /* Suffix of loadable module file, or nil if modules are not supported. */); #ifdef HAVE_MODULES diff --git a/src/pdumper.c b/src/pdumper.c index 629d0969346..ca055a1327c 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5249,9 +5249,24 @@ dump_do_dump_relocation (const uintptr_t dump_base, { fclose (file); installation_state = INSTALLED; + /* FIXME Vcomp_eln_load_path = ?? */ } else - installation_state = LOCAL_BUILD; + { + installation_state = LOCAL_BUILD; + /* Fixup `comp-eln-load-path' so emacs can be invoked + position independently. */ + Lisp_Object eln_cache_sys = + Ffile_name_directory (concat2 (Vinvocation_directory, + XCDR (comp_u->file))); + /* One directory up... */ + eln_cache_sys = + Ffile_name_directory (Fsubstring (eln_cache_sys, Qnil, + make_fixnum (-1))); + /* FIXME for subsequent dumps we should fixup only the + last entry. */ + Vcomp_eln_load_path = Fcons (eln_cache_sys, Qnil); + } } comp_u->file = -- cgit v1.2.3 From 142cfe942f9263efd6adab5f51f2feab4740735f Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 16 Aug 2020 20:40:44 +0200 Subject: * Introduce `load-no-native' Given load loads automatically a .eln in place of a .elc we need a way to force the .elc load in the case we really want it. * src/lread.c (syms_of_lread): Define `load-no-native'. (maybe_swap_for_eln): Make use of. --- src/lread.c | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index c5bec0633df..521da4e1d81 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1615,7 +1615,8 @@ maybe_swap_for_eln (Lisp_Object *filename, int *fd, struct timespec mtime) #ifdef HAVE_NATIVE_COMP struct stat eln_st; - if (!suffix_p (*filename, ".elc")) + if (load_no_native + || !suffix_p (*filename, ".elc")) return; /* Search eln in the eln-cache directories. */ @@ -5156,6 +5157,11 @@ Note that if you customize this, obviously it will not affect files that are loaded before your customizations are read! */); load_prefer_newer = 0; + DEFVAR_BOOL ("load-no-native", load_no_native, + doc: /* Do not try to load the a .eln file in place of + a .elc one. */); + load_no_native = false; + /* Vsource_directory was initialized in init_lread. */ DEFSYM (Qcurrent_load_list, "current-load-list"); -- cgit v1.2.3 From 8a931a97b8dd19a38d6f719f810280a07ba76438 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 19 Aug 2020 15:26:42 +0200 Subject: Fix native code uneffective loads after recompilation 'dlopen' can return the same handle if two shared with the same filename are loaded in two different times (even if the first was deleted!). To prevent this scenario the last modification time of the source file is included in the hashing algorithm. * src/comp.c (Fcomp_el_to_eln_filename): Update hashing algo to include the source last modification date. * src/lread.c (maybe_swap_for_eln): Do not check for eln newer then elc as this is now unnecessary. --- src/comp.c | 19 +++++++++++++++++-- src/lread.c | 20 +++++++------------- 2 files changed, 24 insertions(+), 15 deletions(-) (limited to 'src/lread.c') diff --git a/src/comp.c b/src/comp.c index ff73245b8de..a00088bb7f8 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3872,13 +3872,26 @@ If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) { CHECK_STRING (filename); + if (NILP (Ffile_exists_p (filename))) + xsignal1 (Qfile_missing, filename); + + Lisp_Object last_mod_time = + Fnth (make_fixnum (5), Ffile_attributes (filename, Qnil)); + 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. + + /absolute/path/filename.el + last_mod_time -> + eln-cache/filename-hash.eln. + + 'dlopen' can return the same handle if two shared with the same + filename are loaded in two different times (even if the first was + deleted!). To prevent this scenario the last modification time + of the source file is included in the hashing algorithm. As installing .eln files compiled during the build changes their absolute path we need an hashing mechanism that is not sensitive @@ -3910,7 +3923,9 @@ If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) } } - Lisp_Object hash = Fsubstring (comp_hash_string (filename), Qnil, + Lisp_Object hash_input = + concat2 (filename, Fprin1_to_string (last_mod_time, Qnil)); + Lisp_Object hash = Fsubstring (comp_hash_string (hash_input), Qnil, make_fixnum (ELN_FILENAME_HASH_LEN)); filename = concat2 (Ffile_name_nondirectory (Fsubstring (filename, Qnil, make_fixnum (-3))), diff --git a/src/lread.c b/src/lread.c index 521da4e1d81..6b585fcaccc 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1635,19 +1635,13 @@ maybe_swap_for_eln (Lisp_Object *filename, int *fd, struct timespec mtime) emacs_close (eln_fd); else { - struct timespec eln_mtime = get_stat_mtime (&eln_st); - if (timespec_cmp (eln_mtime, mtime) > 0) - { - *filename = eln_name; - emacs_close (*fd); - *fd = eln_fd; - /* Store the eln -> el relation. */ - Fputhash (Ffile_name_nondirectory (eln_name), - el_name, Vcomp_eln_to_el_h); - return; - } - else - emacs_close (eln_fd); + *filename = eln_name; + emacs_close (*fd); + *fd = eln_fd; + /* Store the eln -> el relation. */ + Fputhash (Ffile_name_nondirectory (eln_name), + el_name, Vcomp_eln_to_el_h); + return; } } } -- cgit v1.2.3 From c818c29771d3cb51875643b2f6c894073e429dd2 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 20 Aug 2020 12:36:39 +0200 Subject: Revert "Fix native code uneffective loads after recompilation" (bug#42944) This reverts commit 8a931a97b8dd19a38d6f719f810280a07ba76438. This introduced bug#42944. --- src/comp.c | 19 ++----------------- src/lread.c | 20 +++++++++++++------- 2 files changed, 15 insertions(+), 24 deletions(-) (limited to 'src/lread.c') diff --git a/src/comp.c b/src/comp.c index a00088bb7f8..ff73245b8de 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3872,26 +3872,13 @@ If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) { CHECK_STRING (filename); - if (NILP (Ffile_exists_p (filename))) - xsignal1 (Qfile_missing, filename); - - Lisp_Object last_mod_time = - Fnth (make_fixnum (5), Ffile_attributes (filename, Qnil)); - 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 + last_mod_time -> - eln-cache/filename-hash.eln. - - 'dlopen' can return the same handle if two shared with the same - filename are loaded in two different times (even if the first was - deleted!). To prevent this scenario the last modification time - of the source file is included in the hashing algorithm. + /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 @@ -3923,9 +3910,7 @@ If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) } } - Lisp_Object hash_input = - concat2 (filename, Fprin1_to_string (last_mod_time, Qnil)); - Lisp_Object hash = Fsubstring (comp_hash_string (hash_input), Qnil, + 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))), diff --git a/src/lread.c b/src/lread.c index 6b585fcaccc..521da4e1d81 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1635,13 +1635,19 @@ maybe_swap_for_eln (Lisp_Object *filename, int *fd, struct timespec mtime) emacs_close (eln_fd); else { - *filename = eln_name; - emacs_close (*fd); - *fd = eln_fd; - /* Store the eln -> el relation. */ - Fputhash (Ffile_name_nondirectory (eln_name), - el_name, Vcomp_eln_to_el_h); - return; + struct timespec eln_mtime = get_stat_mtime (&eln_st); + if (timespec_cmp (eln_mtime, mtime) > 0) + { + *filename = eln_name; + emacs_close (*fd); + *fd = eln_fd; + /* Store the eln -> el relation. */ + Fputhash (Ffile_name_nondirectory (eln_name), + el_name, Vcomp_eln_to_el_h); + return; + } + else + emacs_close (eln_fd); } } } -- cgit v1.2.3 From 5f5d664c734414597c1c7d9981b1ceb9ff69c5b1 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 22 Aug 2020 11:11:21 +0200 Subject: Rework eln hash filename strategy Generate eln filename hashing also the source file content in the form: /absolute/path/filename.el + content -> eln-cache/filename-path_hash-content_hash.eln * src/lread.c (maybe_swap_for_eln): Always call Fcomp_el_to_eln_filename on an existing source file. * src/comp.c (md5.h, sysstdio.h, zlib.h): New include. (comp_hash_string): Use md5 instead of sha512. (MD5_BLOCKSIZE): New macro. (accumulate_and_process_md5, final_process_md5, md5_gz_stream) (comp_hash_source_file): New functions. (Fcomp_el_to_eln_filename): Rework for hasing using also source file content. * src/lread.c (maybe_swap_for_eln): Rename el_name -> src_name as this can be also a have .el.gz extention. --- configure.ac | 9 ++-- lib/Makefile.in | 6 +++ src/comp.c | 161 ++++++++++++++++++++++++++++++++++++++++++++++++++------ src/lread.c | 13 +++-- 4 files changed, 167 insertions(+), 22 deletions(-) (limited to 'src/lread.c') diff --git a/configure.ac b/configure.ac index 0582b2f61c5..cdc18eab19e 100644 --- a/configure.ac +++ b/configure.ac @@ -3787,6 +3787,12 @@ Here instructions on how to compile and install libgccjit from source: HAVE_NATIVE_COMP=no LIBGCCJIT_LIB= if test "${with_nativecomp}" != "no"; then + if test "${HAVE_PDUMPER}" = no; then + AC_MSG_ERROR(['--with-nativecomp' requires '--with-dumping=pdumper']) + fi + if test "${HAVE_ZLIB}" = no; then + AC_MSG_ERROR(['--with-nativecomp' requires zlib]) + fi emacs_save_LIBS=$LIBS LIBS="-lgccjit" AC_RUN_IFELSE([libgccjit_smoke_test], [], [libgccjit_broken], @@ -3800,9 +3806,6 @@ if test "${with_nativecomp}" != "no"; then NEED_DYNLIB=yes AC_DEFINE(HAVE_NATIVE_COMP, 1, [Define to 1 if you have the libgccjit library (-lgccjit).]) fi -if test "${HAVE_NATIVE_COMP}" = yes && test "${HAVE_PDUMPER}" = no; then - AC_MSG_ERROR(['--with-nativecomp' requires '--with-dumping=pdumper']) -fi AC_DEFINE_UNQUOTED(NATIVE_ELISP_SUFFIX, ".eln", [System extension for native compiled elisp]) AC_SUBST(HAVE_NATIVE_COMP) diff --git a/lib/Makefile.in b/lib/Makefile.in index 06d8e56421b..8d97d3bcfbb 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -50,12 +50,18 @@ am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) am__v_at_0 = @ am__v_at_1 = +HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@ + ALL_CFLAGS= \ $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) $(DEPFLAGS) \ $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS) $(PROFILING_CFLAGS) $(CFLAGS) \ -I. -I../src -I$(srcdir) -I$(srcdir)/../src \ $(if $(patsubst e-%,,$(notdir $<)),,-Demacs) +ifeq ($(HAVE_NATIVE_COMP),yes) +ALL_CFLAGS += -DGL_COMPILE_CRYPTO_STREAM +endif + SYSTEM_TYPE = @SYSTEM_TYPE@ ifeq ($(SYSTEM_TYPE),windows-nt) include $(srcdir)/../nt/gnulib-cfg.mk diff --git a/src/comp.c b/src/comp.c index ff73245b8de..5f1257f6be1 100644 --- a/src/comp.c +++ b/src/comp.c @@ -36,7 +36,9 @@ along with GNU Emacs. If not, see . */ #include "dynlib.h" #include "buffer.h" #include "blockinput.h" -#include "sha512.h" +#include "md5.h" +#include "sysstdio.h" +#include "zlib.h" /********************************/ @@ -394,8 +396,6 @@ 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" @@ -640,9 +640,123 @@ format_string (const char *format, ...) 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); + Lisp_Object digest = make_uninit_string (MD5_DIGEST_SIZE * 2); + md5_buffer (SSDATA (string), SCHARS (string), SSDATA (digest)); + hexbuf_digest (SSDATA (digest), SDATA (digest), MD5_DIGEST_SIZE); + + return digest; +} + +#define MD5_BLOCKSIZE 32768 /* From md5.c */ + +static char acc_buff[2 * MD5_BLOCKSIZE]; +static size_t acc_size; + +static void +accumulate_and_process_md5 (void *data, size_t len, struct md5_ctx *ctxt) +{ + eassert (len <= MD5_BLOCKSIZE); + /* We may optimize this saving some of these memcpy/move using + directly the outer buffers but so far I'll not bother. */ + memcpy (acc_buff + acc_size, data, len); + acc_size += len; + if (acc_size >= MD5_BLOCKSIZE) + { + acc_size -= MD5_BLOCKSIZE; + md5_process_block (acc_buff, MD5_BLOCKSIZE, ctxt); + memmove (acc_buff, acc_buff + MD5_BLOCKSIZE, acc_size); + } +} + +static void +final_process_md5 (struct md5_ctx *ctxt) +{ + if (acc_size) + { + md5_process_bytes (acc_buff, acc_size, ctxt); + acc_size = 0; + } +} + +static int +md5_gz_stream (FILE *source, void *resblock) +{ + z_stream stream; + unsigned char in[MD5_BLOCKSIZE]; + unsigned char out[MD5_BLOCKSIZE]; + + eassert (!acc_size); + + struct md5_ctx ctx; + md5_init_ctx (&ctx); + + /* allocate inflate state */ + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + stream.avail_in = 0; + stream.next_in = Z_NULL; + int res = inflateInit2 (&stream, MAX_WBITS + 32); + if (res != Z_OK) + return -1; + + do { + stream.avail_in = fread (in, 1, MD5_BLOCKSIZE, source); + if (ferror (source)) { + inflateEnd (&stream); + return -1; + } + if (stream.avail_in == 0) + break; + stream.next_in = in; + + do { + stream.avail_out = MD5_BLOCKSIZE; + stream.next_out = out; + res = inflate (&stream, Z_NO_FLUSH); + + if (res != Z_OK && res != Z_STREAM_END) + return -1; + + accumulate_and_process_md5 (out, MD5_BLOCKSIZE - stream.avail_out, &ctx); + } while (!stream.avail_out); + + } while (res != Z_STREAM_END); + + final_process_md5 (&ctx); + inflateEnd (&stream); + + if (res != Z_STREAM_END) + return -1; + + md5_finish_ctx (&ctx, resblock); + + return 0; +} +#undef MD5_BLOCKSIZE + +static Lisp_Object +comp_hash_source_file (Lisp_Object filename) +{ + /* Can't use Finsert_file_contents + Fbuffer_hash as this is called + by Fcomp_el_to_eln_filename too early during bootstrap. */ + bool is_gz = suffix_p (filename, ".gz"); + FILE *f = emacs_fopen (SSDATA (filename), is_gz ? "rb" : "r"); + + if (!f) + report_file_error ("Opening source file", filename); + + Lisp_Object digest = make_uninit_string (MD5_DIGEST_SIZE * 2); + + int res = is_gz + ? md5_gz_stream (f, SSDATA (digest)) + : md5_stream (f, SSDATA (digest)); + fclose (f); + + if (res) + xsignal2 (Qfile_notify_error, build_string ("hashing failed"), filename); + + hexbuf_digest (SSDATA (digest), SSDATA (digest), MD5_DIGEST_SIZE); return digest; } @@ -3872,21 +3986,36 @@ If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) { CHECK_STRING (filename); + filename = Fexpand_file_name (filename, Qnil); + + if (NILP (Ffile_exists_p (filename))) + xsignal1 (Qfile_missing, filename); + + Lisp_Object content_hash = comp_hash_source_file (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. + + /absolute/path/filename.el + content -> + eln-cache/filename-path_hash-content_hash.eln. + + 'dlopen' can return the same handle if two shared with the same + filename are loaded in two different times (even if the first was + deleted!). To prevent this scenario the source file content is + included in the hashing algorithm. + + As at any point in time no more then one file can exist with the + same filename, should be possibile to clean up all + filename-path_hash-* except the most recent one (or the new one + being recompiled). 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. */ + PATH_LOADSEARCH with '//' before generating the hash. */ if (NILP (loadsearch_re_list)) { @@ -3909,12 +4038,12 @@ If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) break; } } - - Lisp_Object hash = Fsubstring (comp_hash_string (filename), Qnil, - make_fixnum (ELN_FILENAME_HASH_LEN)); + Lisp_Object separator = build_string ("-"); + Lisp_Object path_hash = comp_hash_string (filename); filename = concat2 (Ffile_name_nondirectory (Fsubstring (filename, Qnil, make_fixnum (-3))), - build_string ("-")); + separator); + Lisp_Object hash = concat3 (path_hash, separator, content_hash); filename = concat3 (filename, hash, build_string (NATIVE_ELISP_SUFFIX)); if (NILP (base_dir)) base_dir = XCAR (Vcomp_eln_load_path); diff --git a/src/lread.c b/src/lread.c index 521da4e1d81..3d0de495605 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1623,10 +1623,17 @@ maybe_swap_for_eln (Lisp_Object *filename, int *fd, struct timespec mtime) Lisp_Object eln_path_tail = Vcomp_eln_load_path; FOR_EACH_TAIL_SAFE (eln_path_tail) { - Lisp_Object el_name = + Lisp_Object src_name = Fsubstring (*filename, Qnil, make_fixnum (-1)); + if (NILP (Ffile_exists_p (src_name))) + { + src_name = concat2 (src_name, build_string (".gz")); + if (NILP (Ffile_exists_p (src_name))) + /* Can't find the corresponding source file. */ + return; + } Lisp_Object eln_name = - Fcomp_el_to_eln_filename (el_name, XCAR (eln_path_tail)); + Fcomp_el_to_eln_filename (src_name, XCAR (eln_path_tail)); int eln_fd = emacs_open (SSDATA (ENCODE_FILE (eln_name)), O_RDONLY, 0); if (eln_fd > 0) @@ -1643,7 +1650,7 @@ maybe_swap_for_eln (Lisp_Object *filename, int *fd, struct timespec mtime) *fd = eln_fd; /* Store the eln -> el relation. */ Fputhash (Ffile_name_nondirectory (eln_name), - el_name, Vcomp_eln_to_el_h); + src_name, Vcomp_eln_to_el_h); return; } else -- cgit v1.2.3 From 696ab2eb17cf8850a65814f428287848b7d23d64 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 28 Aug 2020 18:37:44 +0200 Subject: * src/lread.c (Fload): Bind load-file-name to the .elc filename. --- src/lread.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 3d0de495605..5b77868a63b 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1477,8 +1477,10 @@ Return t if the file exists and loads successfully. */) same folder of their respective sources therfore not to break packages we fake `load-file-name' here. The non faked version of it is `load-true-file-name'. */ - specbind (Qload_file_name, Fgethash (Ffile_name_nondirectory (found), - Vcomp_eln_to_el_h, Qnil)); + Lisp_Object el_name = Fgethash (Ffile_name_nondirectory (found), + Vcomp_eln_to_el_h, Qnil); + specbind (Qload_file_name, + NILP (el_name) ? Qnil : concat2 (el_name, build_string ("c"))); } else specbind (Qload_file_name, found); -- cgit v1.2.3 From 38b0ead7c1a8475bef7f811b07beed2c23cbc593 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 29 Aug 2020 10:15:55 +0200 Subject: * Back using `load-file-name' when reading '#$' (bug#42961) * src/lread.c (read1, read_list): Use again load-file-name when reading '#$'. (syms_of_lread): Update `load-file-name' doc. --- src/lread.c | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 5b77868a63b..326af307f9c 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3261,7 +3261,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) goto retry; } if (c == '$') - return Vload_true_file_name; + return Vload_file_name; if (c == '\'') return list2 (Qfunction, read0 (readcharfun)); /* #:foo is the uninterned symbol named foo. */ @@ -4062,7 +4062,7 @@ read_list (bool flag, Lisp_Object readcharfun) first_in_list = 0; /* While building, if the list starts with #$, treat it specially. */ - if (EQ (elt, Vload_true_file_name) + if (EQ (elt, Vload_file_name) && ! NILP (elt) && !NILP (Vpurify_flag)) { @@ -4083,7 +4083,7 @@ read_list (bool flag, Lisp_Object readcharfun) elt = concat2 (dot_dot_lisp, Ffile_name_nondirectory (elt)); } } - else if (EQ (elt, Vload_true_file_name) + else if (EQ (elt, Vload_file_name) && ! NILP (elt) && load_force_doc_strings) doc_reference = 2; @@ -5039,8 +5039,10 @@ directory. These file names are converted to absolute at startup. */); DEFVAR_LISP ("load-file-name", Vload_file_name, doc: /* Full name of file being loaded by `load'. -In case a .eln file is being loaded this is unreliable and `load-true-file-name' -should be used instead. */); + +In case of native code being loaded this is indicating the +corresponding bytecode filename. Use `load-true-file-name' to obtain +the .eln filename. */); Vload_file_name = Qnil; DEFVAR_LISP ("load-true-file-name", Vload_true_file_name, -- cgit v1.2.3 From 87b9c3e71840f480c2ce05eb51d71156790a5434 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 29 Aug 2020 11:29:01 +0200 Subject: Have .elc files in `load-history' when loading native code (bug#43089) * src/lread.c (Fload): Add the corresponding .elc file to `load-history' when loading native code. * lisp/subr.el (eval-after-load): Use `load-file-name' instead of `load-true-file-name'. --- lisp/subr.el | 4 ++-- src/lread.c | 24 +++++++++++++++--------- 2 files changed, 17 insertions(+), 11 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/subr.el b/lisp/subr.el index 6e866015509..b020d09280a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4613,10 +4613,10 @@ This function makes or adds to an entry on `after-load-alist'." ;; So add an indirection to make sure that `func' is really run ;; "after-load" in case the provide call happens early. (lambda () - (if (not load-true-file-name) + (if (not load-file-name) ;; Not being provided from a file, run func right now. (funcall func) - (let ((lfn load-true-file-name) + (let ((lfn load-file-name) ;; Don't use letrec, because equal (in ;; add/remove-hook) would get trapped in a cycle. (fun (make-symbol "eval-after-load-helper"))) diff --git a/src/lread.c b/src/lread.c index 326af307f9c..ac5b2838eef 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1322,10 +1322,23 @@ Return t if the file exists and loads successfully. */) specbind (Qlexical_binding, Qnil); /* Get the name for load-history. */ + Lisp_Object found_for_hist; + if (is_native_elisp) + { + /* Reconstruct the .elc filename. */ + Lisp_Object src_name = Fgethash (Ffile_name_nondirectory (found), + Vcomp_eln_to_el_h, Qnil); + if (suffix_p (src_name, "el.gz")) + src_name = Fsubstring (src_name, make_fixnum (0), make_fixnum (-3)); + found_for_hist = concat2 (src_name, build_string ("c")); + } + else + found_for_hist = found; + hist_file_name = (! NILP (Vpurify_flag) ? concat2 (Ffile_name_directory (file), - Ffile_name_nondirectory (found)) - : found) ; + Ffile_name_nondirectory (found_for_hist)) + : found_for_hist); version = -1; @@ -1504,13 +1517,6 @@ Return t if the file exists and loads successfully. */) { #ifdef HAVE_NATIVE_COMP specbind (Qcurrent_load_list, Qnil); - if (!NILP (Vpurify_flag)) - { - Lisp_Object base = concat2 (parent_directory (Vinvocation_directory), - build_string ("lisp/")); - Lisp_Object offset = Flength (base); - hist_file_name = Fsubstring (found, offset, Qnil); - } LOADHIST_ATTACH (hist_file_name); Fnative_elisp_load (found, Qnil); build_load_history (hist_file_name, true); -- cgit v1.2.3 From ba0a61d10a5aedaf4b7bb61aa3626f385d6aba12 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 31 Aug 2020 22:21:22 +0200 Subject: * src/lread.c (Fload): Fix for manual eln load. --- src/lread.c | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index ac5b2838eef..80d36f571c2 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1328,9 +1328,15 @@ Return t if the file exists and loads successfully. */) /* Reconstruct the .elc filename. */ Lisp_Object src_name = Fgethash (Ffile_name_nondirectory (found), Vcomp_eln_to_el_h, Qnil); - if (suffix_p (src_name, "el.gz")) - src_name = Fsubstring (src_name, make_fixnum (0), make_fixnum (-3)); - found_for_hist = concat2 (src_name, build_string ("c")); + if (NILP (src_name)) + /* Manual eln load. */ + found_for_hist = found; + else + { + if (suffix_p (src_name, "el.gz")) + src_name = Fsubstring (src_name, make_fixnum (0), make_fixnum (-3)); + found_for_hist = concat2 (src_name, build_string ("c")); + } } else found_for_hist = found; -- cgit v1.2.3 From 3023eb569213a3dd5183640f6e322acd00ea536a Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 1 Sep 2020 20:04:00 +0200 Subject: * Fix `load-filename' for installed instance (bug#43089) * src/lread.c (parent_directory): Remove function as now unnecessary. (compute_found_effective): New function. (Fload): Make use of 'compute_found_effective' and fix `load-filename' computation. --- src/lread.c | 62 ++++++++++++++++++++++--------------------------------------- 1 file changed, 22 insertions(+), 40 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 80d36f571c2..3c226e0b50c 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1099,12 +1099,22 @@ close_infile_unwind (void *arg) infile = prev_infile; } -static ATTRIBUTE_UNUSED Lisp_Object -parent_directory (Lisp_Object directory) +/* Compute the filename we want in `load-history' and `load-file-name'. */ + +static Lisp_Object +compute_found_effective (Lisp_Object found) { - return Ffile_name_directory (Fsubstring (directory, - make_fixnum (0), - Fsub1 (Flength (directory)))); + /* Reconstruct the .elc filename. */ + Lisp_Object src_name = + Fgethash (Ffile_name_nondirectory (found), Vcomp_eln_to_el_h, Qnil); + + if (NILP (src_name)) + /* Manual eln load. */ + return found; + + if (suffix_p (src_name, "el.gz")) + src_name = Fsubstring (src_name, make_fixnum (0), make_fixnum (-3)); + return concat2 (src_name, build_string ("c")); } DEFUN ("load", Fload, Sload, 1, 5, 0, @@ -1321,30 +1331,15 @@ Return t if the file exists and loads successfully. */) Vload_source_file_function. */ specbind (Qlexical_binding, Qnil); - /* Get the name for load-history. */ - Lisp_Object found_for_hist; - if (is_native_elisp) - { - /* Reconstruct the .elc filename. */ - Lisp_Object src_name = Fgethash (Ffile_name_nondirectory (found), - Vcomp_eln_to_el_h, Qnil); - if (NILP (src_name)) - /* Manual eln load. */ - found_for_hist = found; - else - { - if (suffix_p (src_name, "el.gz")) - src_name = Fsubstring (src_name, make_fixnum (0), make_fixnum (-3)); - found_for_hist = concat2 (src_name, build_string ("c")); - } - } - else - found_for_hist = found; + Lisp_Object found_eff = + is_native_elisp + ? compute_found_effective (found) + : found; hist_file_name = (! NILP (Vpurify_flag) ? concat2 (Ffile_name_directory (file), - Ffile_name_nondirectory (found_for_hist)) - : found_for_hist); + Ffile_name_nondirectory (found_eff)) + : found_eff); version = -1; @@ -1489,20 +1484,7 @@ Return t if the file exists and loads successfully. */) message_with_string ("Loading %s...", file, 1); } - if (is_native_elisp) - { - /* Many packages use `load-file-name' as a way to obtain the - package location (see bug#40099). .eln files are not in the - same folder of their respective sources therfore not to break - packages we fake `load-file-name' here. The non faked - version of it is `load-true-file-name'. */ - Lisp_Object el_name = Fgethash (Ffile_name_nondirectory (found), - Vcomp_eln_to_el_h, Qnil); - specbind (Qload_file_name, - NILP (el_name) ? Qnil : concat2 (el_name, build_string ("c"))); - } - else - specbind (Qload_file_name, found); + specbind (Qload_file_name, found_eff); specbind (Qload_true_file_name, found); specbind (Qinhibit_file_name_operation, Qnil); specbind (Qload_in_progress, Qt); -- cgit v1.2.3 From a06fe08e8e8177ae3ccd6e2677b40237cd86ae9d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 28 Sep 2020 17:20:55 +0200 Subject: Clean-up some now unnecessary diff against master * lisp/emacs-lisp/autoload.el (update-directory-autoloads): .eln files have been moved so remove the '.eln' match. * lisp/emacs-lisp/bytecomp.el (byte-compile-refresh-preloaded): Likewise. * lisp/emacs-lisp/find-func.el (find-library-suffixes): Clean-up as '.eln' is no more in `load-suffixes'. * lisp/help-fns.el (find-lisp-object-file-name): Clean-up as `symbol-file' will return the '.elc' file. * src/lread.c (Fget_load_suffixes): Remove logic as '.eln' is not anymore in load-suffixes. (openp): Two spaces. --- lisp/emacs-lisp/autoload.el | 2 +- lisp/emacs-lisp/bytecomp.el | 3 +-- lisp/emacs-lisp/find-func.el | 3 +-- lisp/help-fns.el | 11 +++-------- src/lread.c | 23 +++-------------------- 5 files changed, 9 insertions(+), 33 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 4bdbc95081f..5ee0a14273f 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -1047,7 +1047,7 @@ write its autoloads into the specified file instead." ;; we don't want to depend on whether Emacs was ;; built with or without modules support, nor ;; what is the suffix for the underlying OS. - (unless (string-match "\\.\\(elc\\|eln\\|so\\|dll\\)" suf) + (unless (string-match "\\.\\(elc\\|so\\|dll\\)" suf) (push suf tmp))) (concat "\\`[^=.].*" (regexp-opt tmp t) "\\'"))) (files (apply #'nconc diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4a2a8c62cbc..b0e3158df32 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -5180,8 +5180,7 @@ Use with caution." (message "Can't find %s to refresh preloaded Lisp files" argv0) (dolist (f (reverse load-history)) (setq f (car f)) - (when (string-match "el[cn]\\'" f) - (setq f (substring f 0 -1))) + (if (string-match "elc\\'" f) (setq f (substring f 0 -1))) (when (and (file-readable-p f) (file-newer-than-file-p f emacs-file) ;; Don't reload the source version of the files below diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index a4577a53164..9e4d8cf1aa8 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -167,8 +167,7 @@ See the functions `find-function' and `find-variable'." (defun find-library-suffixes () (let ((suffixes nil)) (dolist (suffix (get-load-suffixes) (nreverse suffixes)) - (unless (string-match "el[cn]" suffix) - (push suffix suffixes))))) + (unless (string-match "elc" suffix) (push suffix suffixes))))) (defun find-library--load-name (library) (let ((name library)) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 88984ec453e..9fee156f18f 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -323,17 +323,12 @@ found via `load-path'. The return value can also be `C-source', which means that OBJECT is a function or variable defined in C. If no suitable file is found, return nil." (let* ((autoloaded (autoloadp type)) - (true-name (or (and autoloaded (nth 1 type)) + (file-name (or (and autoloaded (nth 1 type)) (symbol-file ;; FIXME: Why do we have this weird "If TYPE is the ;; value returned by `symbol-function' for a function ;; symbol" exception? - object (or (if (symbolp type) type) 'defun)))) - (file-name (if (and true-name - (string-match "[.]eln\\'" true-name)) - (gethash (file-name-nondirectory true-name) - comp-eln-to-el-h) - true-name))) + object (or (if (symbolp type) type) 'defun))))) (cond (autoloaded ;; An autoloaded function: Locate the file since `symbol-function' @@ -392,7 +387,7 @@ suitable file is found, return nil." ((let ((lib-name (if (string-match "[.]elc\\'" file-name) (substring-no-properties file-name 0 -1) - file-name))) + file-name))) (or (and (file-readable-p lib-name) lib-name) ;; The library might be compressed. (and (file-readable-p (concat lib-name ".gz")) lib-name)))) diff --git a/src/lread.c b/src/lread.c index d32f5755e98..ea31131b755 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1056,25 +1056,8 @@ This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) { Lisp_Object exts = Vload_file_rep_suffixes; Lisp_Object suffix = XCAR (suffixes); - bool native_code_suffix = - NATIVE_COMP_FLAG - && strcmp (NATIVE_ELISP_SUFFIX, SSDATA (suffix)) == 0; - -#ifdef HAVE_MODULES - native_code_suffix = - native_code_suffix || strcmp (MODULES_SUFFIX, SSDATA (suffix)) == 0; -#ifdef MODULES_SECONDARY_SUFFIX - native_code_suffix = - native_code_suffix - || strcmp (MODULES_SECONDARY_SUFFIX, SSDATA (suffix)) == 0; -#endif -#endif - - if (native_code_suffix) - lst = Fcons (suffix, lst); - else - FOR_EACH_TAIL (exts) - lst = Fcons (concat2 (suffix, XCAR (exts)), lst); + FOR_EACH_TAIL (exts) + lst = Fcons (concat2 (suffix, XCAR (exts)), lst); } return Fnreverse (lst); } @@ -1698,6 +1681,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, int last_errno = ENOENT; int save_fd = -1; USE_SAFE_ALLOCA; + /* The last-modified time of the newest matching file found. Initialize it to something less than all valid timestamps. */ struct timespec save_mtime = make_timespec (TYPE_MINIMUM (time_t), -1); @@ -1898,7 +1882,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, /* We succeeded; return this descriptor and filename. */ if (storeptr) *storeptr = string; - SAFE_FREE (); return fd; } -- cgit v1.2.3 From 03dfa83dc35738c9228b66b3d3f72753b344f939 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Oct 2020 12:32:58 +0200 Subject: * Do not check eln timestamp as superseded by source hashing (bug#43532) * src/lread.c (maybe_swap_for_eln): Remove eln file timestamp check given is now unnecessary. (openp): Update for new 'maybe_swap_for_eln' signature. --- src/lread.c | 26 ++++++++++---------------- 1 file changed, 10 insertions(+), 16 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index ea31131b755..6aab470eb2f 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1589,7 +1589,7 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) If found replace the content of FILENAME and FD. */ static void -maybe_swap_for_eln (Lisp_Object *filename, int *fd, struct timespec mtime) +maybe_swap_for_eln (Lisp_Object *filename, int *fd) { #ifdef HAVE_NATIVE_COMP struct stat eln_st; @@ -1621,19 +1621,13 @@ maybe_swap_for_eln (Lisp_Object *filename, int *fd, struct timespec mtime) emacs_close (eln_fd); else { - struct timespec eln_mtime = get_stat_mtime (&eln_st); - if (timespec_cmp (eln_mtime, mtime) > 0) - { - *filename = eln_name; - emacs_close (*fd); - *fd = eln_fd; - /* Store the eln -> el relation. */ - Fputhash (Ffile_name_nondirectory (eln_name), - src_name, Vcomp_eln_to_el_h); - return; - } - else - emacs_close (eln_fd); + *filename = eln_name; + emacs_close (*fd); + *fd = eln_fd; + /* Store the eln -> el relation. */ + Fputhash (Ffile_name_nondirectory (eln_name), + src_name, Vcomp_eln_to_el_h); + return; } } } @@ -1878,7 +1872,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, } else { - maybe_swap_for_eln (&string, &fd, get_stat_mtime (&st)); + maybe_swap_for_eln (&string, &fd); /* We succeeded; return this descriptor and filename. */ if (storeptr) *storeptr = string; @@ -1890,7 +1884,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, /* No more suffixes. Return the newest. */ if (0 <= save_fd && ! CONSP (XCDR (tail))) { - maybe_swap_for_eln (&save_string, &save_fd, save_mtime); + maybe_swap_for_eln (&save_string, &save_fd); if (storeptr) *storeptr = save_string; SAFE_FREE (); -- cgit v1.2.3 From 627a02467508140d213a68c9eed6cb78a5e94860 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 9 Feb 2021 16:28:30 +0100 Subject: Note that the `values' variable is now obsolete * src/lread.c (syms_of_lread): Note that it's obsolete in the doc string (because we can't mark it as obsolete "properly" yet, because that leads to compilation warnings when somebody (let (values) ... values). --- etc/NEWS | 2 ++ src/lread.c | 3 ++- 2 files changed, 4 insertions(+), 1 deletion(-) (limited to 'src/lread.c') diff --git a/etc/NEWS b/etc/NEWS index ec574543d11..7f02f6106d6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2217,6 +2217,8 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', * Lisp Changes in Emacs 28.1 +** The 'values' variable is now obsolete. + --- ** New variable 'indent-line-ignored-functions'. This allows modes to cycle through a set of indentation functions diff --git a/src/lread.c b/src/lread.c index 010194c34ea..dea1b232fff 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4833,7 +4833,8 @@ to find all the symbols in an obarray, use `mapatoms'. */); DEFVAR_LISP ("values", Vvalues, doc: /* List of values of all expressions which were read, evaluated and printed. -Order is reverse chronological. */); +Order is reverse chronological. +This variable is obsolete as of Emacs 28.1 and should not be used. */); XSYMBOL (intern ("values"))->u.s.declared_special = false; DEFVAR_LISP ("standard-input", Vstandard_input, -- cgit v1.2.3 From b456b19ec4e517cca53e4c6865059443300ae820 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 4 Mar 2021 20:36:43 +0200 Subject: Fix typos and doc strings in native-compilation files * lisp/emacs-lisp/comp.el (comp-speed, comp-debug, comp-verbose) (comp-always-compile, comp-deferred-compilation-deny-list) (comp-bootstrap-deny-list, comp-never-optimize-functions) (comp-async-jobs-number, comp-async-cu-done-hook) (comp-async-all-done-hook, comp-async-env-modifier-form) (comp-pass, comp-native-compiling, comp-post-pass-hooks) (comp-known-predicate-p, comp-pred-to-cstr) (comp-symbol-values-optimizable, comp-limple-assignments) (comp-limple-calls, comp-limple-branches, comp-block) (comp-vec--verify-idx, comp-vec-aref, comp-vec-append) (comp-vec-prepend, comp-block-preds) (comp-ensure-native-compiler, comp-log, comp-log-func) (comp-loop-insn-in-block, comp-byte-frame-size) (comp-add-func-to-ctxt, comp-spill-lap-function, comp-spill-lap) (comp-lap-fall-through-p, comp-new-frame, comp-emit-set-call) (comp-copy-slot, comp-latch-make-fill, comp-emit-cond-jump) (comp-body-eff, comp-op-case, comp-prepare-args-for-top-level) (comp-limplify-top-level, comp-negate-arithm-cmp-fun) (comp-emit-assume, comp-cond-cstrs-target-mvar) (comp-function-foldable-p, comp-function-call-maybe-fold) (comp-form-tco-call-seq, comp-clean-up-stale-eln) (comp-delete-or-replace-file, comp--native-compile) (native--compile-async, native-compile) (batch-byte-native-compile-for-bootstrap): Fix typos, wording, and punctuation in doc strings. * lisp/loadup.el: Fix typos. * src/lread.c (syms_of_lread): Doc fix. --- lisp/emacs-lisp/comp.el | 207 ++++++++++++++++++++++++------------------------ lisp/loadup.el | 13 +-- src/lread.c | 3 +- 3 files changed, 112 insertions(+), 111 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index af14afd42bb..4a418c1aade 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -45,56 +45,57 @@ :group 'lisp) (defcustom comp-speed 2 - "Compiler optimization level. From -1 to 3. -- -1 functions are kept in bytecode form and no native compilation is performed. -- 0 native compilation is performed with no optimizations. -- 1 lite optimizations. -- 2 max optimization level fully adherent to the language semantic. -- 3 max optimization level, to be used only when necessary. - Warning: the compiler is free to perform dangerous optimizations." + "Optimization level for native compilation, a number between -1 and 3. + -1 functions are kept in bytecode form and no native compilation is performed. + 0 native compilation is performed with no optimizations. + 1 light optimizations. + 2 max optimization level fully adherent to the language semantic. + 3 max optimization level, to be used only when necessary. + Warning: with 3, the compiler is free to perform dangerous optimizations." :type 'integer :safe #'integerp :version "28.1") (defcustom comp-debug 0 - "Compiler debug level. From 0 to 3. -This intended for debugging the compiler itself. -- 0 no debug facility. + "Debug level for native compilation, a number between 0 and 3. +This is intended for debugging the compiler itself. + 0 no debugging output. This is the recommended value unless you are debugging the compiler itself. -- 1 emit debug symbols and dump pseudo C code. -- 2 dump gcc passes and libgccjit log file. -- 3 dump libgccjit reproducers." + 1 emit debug symbols and dump pseudo C code. + 2 dump gcc passes and libgccjit log file. + 3 dump libgccjit reproducers." :type 'integer :safe #'natnump :version "28.1") (defcustom comp-verbose 0 - "Compiler verbosity. From 0 to 3. -This intended for debugging the compiler itself. -- 0 no logging. -- 1 final limple is logged. -- 2 LAP and final limple and some pass info are logged. -- 3 max verbosity." + "Compiler verbosity for native compilation, a number between 0 and 3. +This is intended for debugging the compiler itself. + 0 no logging. + 1 final LIMPLE is logged. + 2 LAP, final LIMPLE, and some pass info are logged. + 3 max verbosity." :type 'integer :risky t :version "28.1") (defcustom comp-always-compile nil - "Unconditionally (re-)compile all files." + "Non-nil means unconditionally (re-)compile all files." :type 'boolean :version "28.1") (defcustom comp-deferred-compilation-deny-list '() - "List of regexps to exclude files from deferred native compilation. -Skip if any is matching." + "List of regexps to exclude matching files from deferred native compilation. +Files whose names match any regexp is excluded from native compilation." :type 'list :version "28.1") (defcustom comp-bootstrap-deny-list '() "List of regexps to exclude files from native compilation during bootstrap. -Skip if any is matching." +Files whose names match any regexp is excluded from native compilation +during bootstrap." :type 'list :version "28.1") @@ -103,13 +104,14 @@ Skip if any is matching." ;; correctly (see comment in `advice--add-function'). DO NOT ;; REMOVE. macroexpand rename-buffer) - "Primitive functions for which we do not perform trampoline optimization." + "Primitive functions to exclude from trampoline optimization." :type 'list :version "28.1") (defcustom comp-async-jobs-number 0 - "Default number of processes used for async compilation. -When zero use half of the CPUs or at least one." + "Default number of subprocesses used for async native compilation. +Value of zero means to use half the number of the CPU's execution units, +or one if there's just one execution unit." :type 'integer :risky t :version "28.1") @@ -118,19 +120,18 @@ When zero use half of the CPUs or at least one." ;; like `comp-async-cu-done-function'. (defcustom comp-async-cu-done-hook nil "Hook run after asynchronously compiling a single compilation unit. -The argument FILE passed to the function is the filename used as -compilation input." +Called with one argument FILE, the filename used as input to compilation." :type 'hook :version "28.1") (defcustom comp-async-all-done-hook nil - "Hook run after asynchronously compiling all input files." + "Hook run after completing asynchronous compilation of all input files." :type 'hook :version "28.1") (defcustom comp-async-env-modifier-form nil - "Form evaluated before compilation by each asynchronous compilation worker. -Usable to modify the compiler environment." + "Form evaluated before compilation by each asynchronous compilation subprocess. +Used to modify the compiler environment." :type 'list :risky t :version "28.1") @@ -195,11 +196,12 @@ the .eln output directory." "Name of the async compilation buffer log.") (defvar comp-native-compiling nil - "This gets bound to t while native compilation. -Can be used by code that wants to expand differently in this case.") + "This gets bound to t during native compilation. +Intended to be used by code that needs to work differently when +native compilation runs.") (defvar comp-pass nil - "Every pass has the right to bind what it likes here.") + "Every native-compilation pass can bind this to whatever it likes.") (defvar comp-curr-allocation-class 'd-default "Current allocation class. @@ -223,7 +225,7 @@ Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'. See `comp-ctxt'.") For internal use only by the testsuite.") (defvar comp-post-pass-hooks '() - "Alist PASS FUNCTIONS. + "Alist whose elements are of the form (PASS FUNCTIONS...). Each function in FUNCTIONS is run after PASS. Useful to hook into pass checkers.") @@ -583,16 +585,16 @@ Useful to hook into pass checkers.") "Hash table function -> `comp-constraint'") (defun comp-known-predicate-p (predicate) - "Predicate matching if PREDICATE is known." + "Return t if PREDICATE is known." (when (gethash predicate comp-known-predicates-h) t)) (defun comp-pred-to-cstr (predicate) - "Given PREDICATE return the correspondig constraint." + "Given PREDICATE, return the correspondig constraint." (gethash predicate comp-known-predicates-h)) (defconst comp-symbol-values-optimizable '(most-positive-fixnum most-negative-fixnum) - "Symbol values we can resolve in the compile-time.") + "Symbol values we can resolve at compile-time.") (defconst comp-type-hints '(comp-hint-fixnum comp-hint-cons) @@ -608,16 +610,16 @@ Useful to hook into pass checkers.") (defconst comp-limple-assignments `(assume fetch-handler ,@comp-limple-sets) - "Limple operators that clobbers the first m-var argument.") + "Limple operators that clobber the first m-var argument.") (defconst comp-limple-calls '(call callref direct-call direct-callref) - "Limple operators use to call subrs.") + "Limple operators used to call subrs.") (defconst comp-limple-branches '(jump cond-jump) - "Limple operators use for conditional and unconditional branches.") + "Limple operators used for conditional and unconditional branches.") (defconst comp-limple-ops `(,@comp-limple-calls ,@comp-limple-assignments @@ -629,7 +631,7 @@ Useful to hook into pass checkers.") "Bound to the current function by most passes.") (defvar comp-block nil - "Bound to the current basic block by some pass.") + "Bound to the current basic block by some passes.") (define-error 'native-compiler-error-dyn-func "can't native compile a non-lexically-scoped function" @@ -657,12 +659,12 @@ Useful to hook into pass checkers.") (- (comp-vec-end vec) (comp-vec-beg vec))) (defsubst comp-vec--verify-idx (vec idx) - "Check idx is in bounds for VEC." + "Check whether idx is in bounds for VEC." (cl-assert (and (< idx (comp-vec-end vec)) (>= idx (comp-vec-beg vec))))) (defsubst comp-vec-aref (vec idx) - "Return the element of VEC at index IDX." + "Return the element of VEC whose index is IDX." (declare (gv-setter (lambda (val) `(comp-vec--verify-idx ,vec ,idx) `(puthash ,idx ,val (comp-vec-data ,vec))))) @@ -671,14 +673,14 @@ Useful to hook into pass checkers.") (defsubst comp-vec-append (vec elt) "Append ELT into VEC. -ELT is returned." +Returns ELT." (puthash (comp-vec-end vec) elt (comp-vec-data vec)) (cl-incf (comp-vec-end vec)) elt) (defsubst comp-vec-prepend (vec elt) "Prepend ELT into VEC. -ELT is returned." +Returns ELT." (puthash (1- (comp-vec-beg vec)) elt (comp-vec-data vec)) (cl-decf (comp-vec-beg vec)) elt) @@ -818,7 +820,7 @@ non local exit (ends with an `unreachable' insn).")) (comp-func-edges-h comp-func)))) (defun comp-block-preds (basic-block) - "Given BASIC-BLOCK return the list of its predecessors." + "Return the list of predecessors of BASIC-BLOCK." (mapcar #'comp-edge-src (comp-block-in-edges basic-block))) (defun comp-gen-counter () @@ -895,14 +897,14 @@ In use by the backend." (defun comp-ensure-native-compiler () - "Make sure Emacs has native compiler support and libgccjit is loadable. + "Make sure Emacs has native compiler support and libgccjit can be loaded. Signal an error otherwise. To be used by all entry points." (cond ((null (featurep 'nativecomp)) - (error "Emacs not compiled with native compiler support (--with-nativecomp)")) + (error "Emacs was not compiled with native compiler support (--with-native-compilation)")) ((null (native-comp-available-p)) - (error "Cannot find libgccjit")))) + (error "Cannot find libgccjit library")))) (defun comp-equality-fun-p (function) "Equality functions predicate for FUNCTION." @@ -997,9 +999,9 @@ Assume allocation class 'd-default as default." (cl-defun comp-log (data &optional (level 1) quoted) "Log DATA at LEVEL. -LEVEL is a number from 1-3; if it is less than `comp-verbose', do -nothing. If `noninteractive', log with `message'. Otherwise, -log with `comp-log-to-buffer'." +LEVEL is a number from 1-3, and defaults to 1; if it is less +than `comp-verbose', do nothing. If `noninteractive', log +with `message'. Otherwise, log with `comp-log-to-buffer'." (when (>= comp-verbose level) (if noninteractive (cl-typecase data @@ -1050,7 +1052,7 @@ log with `comp-log-to-buffer'." (cons (concat "(" (mapconcat #'comp-prettyformat-insn insn " ") ")")))) (defun comp-log-func (func verbosity) - "Log function FUNC. + "Log function FUNC at VERBOSITY. VERBOSITY is a number between 0 and 3." (when (>= comp-verbose verbosity) (comp-log (format "\nFunction: %s\n" (comp-func-name func)) verbosity) @@ -1080,7 +1082,7 @@ VERBOSITY is a number between 0 and 3." (defmacro comp-loop-insn-in-block (basic-block &rest body) "Loop over all insns in BASIC-BLOCK executing BODY. -Inside BODY `insn' and `insn-cell'can be used to read or set the +Inside BODY, `insn' and `insn-cell'can be used to read or set the current instruction or its cell." (declare (debug (form body)) (indent defun)) @@ -1157,11 +1159,11 @@ clashes." :rest rest)))) (defsubst comp-byte-frame-size (byte-compiled-func) - "Given BYTE-COMPILED-FUNC return the frame size to be allocated." + "Return the frame size to be allocated for BYTE-COMPILED-FUNC." (aref byte-compiled-func 3)) (defun comp-add-func-to-ctxt (func) - "Add FUNC to the current compiler contex." + "Add FUNC to the current compiler context." (let ((name (comp-func-name func)) (c-name (comp-func-c-name func))) (puthash name c-name (comp-ctxt-sym-to-c-name-h comp-ctxt)) @@ -1171,7 +1173,7 @@ clashes." "Byte-compile INPUT and spill lap for further stages.") (cl-defmethod comp-spill-lap-function ((function-name symbol)) - "Byte-compile FUNCTION-NAME spilling data from the byte compiler." + "Byte-compile FUNCTION-NAME, spilling data from the byte compiler." (unless (comp-ctxt-output comp-ctxt) (setf (comp-ctxt-output comp-ctxt) (make-temp-file (comp-c-func-name function-name "freefn-") @@ -1208,10 +1210,10 @@ clashes." (comp-add-func-to-ctxt func)))) (cl-defmethod comp-spill-lap-function ((form list)) - "Byte-compile FORM spilling data from the byte compiler." + "Byte-compile FORM, spilling data from the byte compiler." (unless (eq (car-safe form) 'lambda) (signal 'native-compiler-error - "Cannot native compile, form is not a lambda")) + "Cannot native-compile, form is not a lambda")) (unless (comp-ctxt-output comp-ctxt) (setf (comp-ctxt-output comp-ctxt) (make-temp-file "comp-lambda-" nil ".eln"))) @@ -1283,7 +1285,7 @@ clashes." (comp-log lap 1 t)))) (cl-defmethod comp-spill-lap-function ((filename string)) - "Byte-compile FILENAME spilling data from the byte compiler." + "Byte-compile FILENAME, spilling data from the byte compiler." (byte-compile-file filename) (unless byte-to-native-top-level-forms (signal 'native-compiler-error-empty-byte filename)) @@ -1316,8 +1318,8 @@ clashes." (defun comp-spill-lap (input) "Byte-compile and spill the LAP representation for INPUT. -If INPUT is a symbol this is the function-name to be compiled. -If INPUT is a string this is the filename to be compiled." +If INPUT is a symbol, it is the function-name to be compiled. +If INPUT is a string, it is the filename to be compiled." (let ((byte-native-compiling t) (byte-to-native-lambdas-h (make-hash-table :test #'eq)) (byte-to-native-top-level-forms ()) @@ -1355,7 +1357,7 @@ Points to the next slot to be filled.") t)) (defun comp-lap-fall-through-p (inst) - "Return t if INST fall through, nil otherwise." + "Return t if INST falls through, nil otherwise." (when (not (memq (car inst) '(byte-goto byte-return))) t)) @@ -1442,7 +1444,7 @@ STACK-OFF is the index of the first slot frame involved." (defun comp-new-frame (size vsize &optional ssa) "Return a clean frame of meta variables of size SIZE and VSIZE. -If SSA non-nil populate it of m-var in ssa form." +If SSA is non-nil, populate it with m-var in ssa form." (cl-loop with v = (make-comp-vec :beg (- vsize) :end size) for i from (- vsize) below size for mvar = (if ssa @@ -1459,13 +1461,13 @@ If SSA non-nil populate it of m-var in ssa form." (defun comp-emit-set-call (call) "Emit CALL assigning the result the the current slot frame. -If the callee function is known to have a return type propagate it." +If the callee function is known to have a return type, propagate it." (cl-assert call) (comp-emit (list 'set (comp-slot) call))) (defun comp-copy-slot (src-n &optional dst-n) "Set slot number DST-N to slot number SRC-N as source. -If DST-N is specified use it otherwise assume it to be the current slot." +If DST-N is specified, use it; otherwise assume it to be the current slot." (comp-with-sp (or dst-n (comp-sp)) (let ((src-slot (comp-slot-n src-n))) (cl-assert src-slot) @@ -1496,7 +1498,7 @@ Add block to the current function and return it." (defun comp-latch-make-fill (target) "Create a latch pointing to TARGET and fill it. -Return the created latch" +Return the created latch." (let ((latch (make-comp-latch :name (comp-new-block-sym "latch"))) (curr-bb (comp-limplify-curr-block comp-pass))) ;; See `comp-make-curr-block'. @@ -1530,8 +1532,8 @@ Return the created latch" "Emit a conditional jump to LAP-LABEL when A and B satisfy EQ. TARGET-OFFSET is the positive offset on the SP when branching to the target block. -If NEGATED non null negate the tested condition. -Return value is the fall through block name." +If NEGATED is non null, negate the tested condition. +Return value is the fall-through block name." (cl-destructuring-bind (label-num . label-sp) lap-label (let* ((bb (comp-block-name (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass)) @@ -1682,8 +1684,8 @@ SP-DELTA is the stack adjustment." (intern (replace-regexp-in-string "byte-" "" x))) (defun comp-body-eff (body op-name sp-delta) - "Given the original body BODY compute the effective one. -When BODY is auto guess function name form the LAP byte-code + "Given the original BODY, compute the effective one. +When BODY is `auto', guess function name from the LAP byte-code name. Otherwise expect lname fnname." (pcase (car body) ('auto @@ -1694,8 +1696,8 @@ name. Otherwise expect lname fnname." (defmacro comp-op-case (&rest cases) "Expand CASES into the corresponding `pcase' expansion. -This is responsible for generating the proper stack adjustment when known and -the annotation emission." +This is responsible for generating the proper stack adjustment, when known, +and the annotation emission." (declare (debug (body)) (indent defun)) `(pcase op @@ -1963,7 +1965,7 @@ the annotation emission." func) (cl-defgeneric comp-prepare-args-for-top-level (function) - "Given FUNCTION, return the two args arguments for comp--register-...") + "Given FUNCTION, return the two arguments for comp--register-...") (cl-defmethod comp-prepare-args-for-top-level ((function comp-func-l)) "Lexically-scoped FUNCTION." @@ -1974,7 +1976,7 @@ the annotation emission." 'many))))) (cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d)) - "Dynamic scoped FUNCTION." + "Dynamically scoped FUNCTION." (cons (make-comp-mvar :constant (func-arity (comp-func-byte-func function))) (let ((comp-curr-allocation-class 'd-default)) ;; Lambda-lists must stay in the same relocation class of @@ -2060,15 +2062,15 @@ These are stored in the reloc data array." (defun comp-limplify-top-level (for-late-load) "Create a limple function to modify the global environment at load. -When FOR-LATE-LOAD is non-nil the emitted function modifies only +When FOR-LATE-LOAD is non-nil, the emitted function modifies only function definition. -Synthesize a function called 'top_level_run' that gets one single -parameter (the compilation unit it-self). To define native -functions 'top_level_run' will call back `comp--register-subr' +Synthesize a function called `top_level_run' that gets one single +parameter (the compilation unit itself). To define native +functions, `top_level_run' will call back `comp--register-subr' into the C code forwarding the compilation unit." ;; Once an .eln is loaded and Emacs is dumped 'top_level_run' has no - ;; reasons to be execute ever again. Therefore all objects can be + ;; reasons to be executed ever again. Therefore all objects can be ;; just ephemeral. (let* ((comp-curr-allocation-class 'd-ephemeral) (func (make-comp-func-l :name (if for-late-load @@ -2240,8 +2242,7 @@ into the C code forwarding the compilation unit." (defun comp-negate-arithm-cmp-fun (function) "Negate FUNCTION. -Return nil if we don't want to emit constraints for its -negation." +Return nil if we don't want to emit constraints for its negation." (cl-ecase function (= nil) (> '<=) @@ -2261,7 +2262,7 @@ negation." (defun comp-emit-assume (kind lhs rhs bb negated) "Emit an assume of kind KIND for mvar LHS being RHS. -When NEGATED is non-nil the assumption is negated. +When NEGATED is non-nil, the assumption is negated. The assume is emitted at the beginning of the block BB." (let ((lhs-slot (comp-mvar-slot lhs))) (cl-assert lhs-slot) @@ -2335,7 +2336,7 @@ Return OP otherwise." ;; Cheap substitute to a copy propagation pass... (defun comp-cond-cstrs-target-mvar (mvar exit-insn bb) - "Given MVAR search in BB the original mvar MVAR got assigned from. + "Given MVAR, search in BB the original mvar MVAR got assigned from. Keep on searching till EXIT-INSN is encountered." (cl-flet ((targetp (x) ;; Ret t if x is an mvar and target the correct slot number. @@ -3029,12 +3030,12 @@ Forward propagate immediate involed in assignments." (comp-mvar-neg lval) (comp-mvar-neg rval))) (defun comp-function-foldable-p (f args) - "Given function F called with ARGS return non-nil when optimizable." + "Given function F called with ARGS, return non-nil when optimizable." (and (comp-function-pure-p f) (cl-every #'comp-cstr-imm-vld-p args))) (defun comp-function-call-maybe-fold (insn f args) - "Given INSN when F is pure if all ARGS are known remove the function call. + "Given INSN, when F is pure if all ARGS are known, remove the function call. Return non-nil if the function is folded successfully." (cl-flet ((rewrite-insn-as-setimm (insn value) ;; See `comp-emit-setimm'. @@ -3372,7 +3373,7 @@ Return the list of m-var ids nuked." ;;; Tail Call Optimization pass specific code. (defun comp-form-tco-call-seq (args) - "Generate a tco sequence for ARGS." + "Generate a TCO sequence for ARGS." `(,@(cl-loop for arg in args for i from 0 collect `(set ,(make-comp-mvar :slot i) ,arg)) @@ -3747,7 +3748,7 @@ Return the trampoline if found or nil otherwise." ;;;###autoload (defun comp-clean-up-stale-eln (file) - "Given FILE remove all the .eln files in `comp-eln-load-path' + "Given FILE remove all its *.eln files in `comp-eln-load-path' sharing the original source filename (including FILE)." (when (string-match (rx "-" (group-n 1 (1+ hex)) "-" (1+ hex) ".eln" eos) file) @@ -3765,7 +3766,7 @@ sharing the original source filename (including FILE)." "Replace OLDFILE with NEWFILE. When NEWFILE is nil just delete OLDFILE. Takes the necessary steps when dealing with OLDFILE being a -shared libraries that may be currently loaded by a running Emacs +shared library that might be currently loaded into a running Emacs session." (cond ((eq 'windows-nt system-type) (ignore-errors (delete-file oldfile)) @@ -3929,8 +3930,8 @@ display a message." (defun comp--native-compile (function-or-file &optional with-late-load output) "Compile FUNCTION-OR-FILE into native code. This serves as internal implementation of `native-compile'. -When WITH-LATE-LOAD non-nil mark the compilation unit for late -load once finished compiling." +When WITH-LATE-LOAD is non-nil, mark the compilation unit for late +load once it finishes compiling." (comp-ensure-native-compiler) (unless (or (functionp function-or-file) (stringp function-or-file)) @@ -3975,7 +3976,7 @@ load once finished compiling." (native-elisp-load data)))) (defun native-compile-async-skip-p (file load selector) - "Return non-nil when FILE compilation should be skipped. + "Return non-nil if FILE's compilation should be skipped. LOAD and SELECTOR work as described in `native--compile-async'." ;; Make sure we are not already compiling `file' (bug#40838). @@ -4014,13 +4015,13 @@ of (commands) to run simultaneously. LOAD can also be the symbol `late'. This is used internally if the byte code has already been loaded when this function is -called. It means that we requests the special kind of load, +called. It means that we request the special kind of load necessary in that situation, called \"late\" loading. -During a \"late\" load instead of executing all top level forms +During a \"late\" load, instead of executing all top-level forms of the original files, only function definitions are loaded (paying attention to have these effective only if the -bytecode definition was not changed in the meanwhile)." +bytecode definition was not changed in the meantime)." (comp-ensure-native-compiler) (unless (member load '(nil t late)) (error "LOAD must be nil, t or 'late")) @@ -4068,13 +4069,13 @@ bytecode definition was not changed in the meanwhile)." "Compile FUNCTION-OR-FILE into native code. This is the synchronous entry-point for the Emacs Lisp native compiler. -FUNCTION-OR-FILE is a function symbol, a form or the filename of +FUNCTION-OR-FILE is a function symbol, a form, or the filename of an Emacs Lisp source file. -When OUTPUT is non-nil use it as filename for the compiled +If OUTPUT is non-nil, use it as the filename for the compiled object. -If FUNCTION-OR-FILE is a filename return the filename of the +If FUNCTION-OR-FILE is a filename, return the filename of the compiled object. If FUNCTION-OR-FILE is a function symbol or a -form return the compiled function." +form, return the compiled function." (comp--native-compile function-or-file nil output)) ;;;###autoload @@ -4092,9 +4093,9 @@ Ultra cheap impersonation of `batch-byte-compile'." ;;;###autoload (defun batch-byte-native-compile-for-bootstrap () - "As `batch-byte-compile' but used for booststrap. -Generate .elc files in addition to the .eln one. If the -environment variable 'NATIVE_DISABLED' is set byte compile only." + "Like `batch-native-compile', but used for booststrap. +Generate *.elc files in addition to the *.eln files. If the +environment variable 'NATIVE_DISABLED' is set, only byte compile." (comp-ensure-native-compiler) (if (equal (getenv "NATIVE_DISABLED") "1") (batch-byte-compile) diff --git a/lisp/loadup.el b/lisp/loadup.el index 526f7c33281..98d4e4fe673 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -450,8 +450,9 @@ lost after dumping"))) (when (featurep 'nativecomp) ;; Fix the compilation unit filename to have it working when - ;; when installed or if the source directory got moved. This is set to be - ;; a pair in the form: (rel-path-from-install-bin . rel-path-from-local-bin). + ;; installed or if the source directory got moved. This is set to be + ;; a cons cell of the form: + ;; (rel-filename-from-install-bin . rel-filename-from-local-bin). (let ((h (make-hash-table :test #'eq)) (bin-dest-dir (cadr (member "--bin-dest" command-line-args))) (eln-dest-dir (cadr (member "--eln-dest" command-line-args)))) @@ -466,12 +467,12 @@ lost after dumping"))) (native-comp-unit-set-file cu (cons - ;; Relative path from the installed binary. + ;; Relative filename from the installed binary. (file-relative-name (concat eln-dest-dir (file-name-nondirectory (native-comp-unit-file cu))) bin-dest-dir) - ;; Relative path from the built uninstalled binary. + ;; Relative filename from the built uninstalled binary. (file-relative-name (native-comp-unit-file cu) invocation-directory)))) h)))) @@ -536,8 +537,8 @@ lost after dumping"))) (t (error "unrecognized dump mode %s" dump-mode))))) (when (and (featurep 'nativecomp) (equal dump-mode "pdump")) - ;; Don't enable this before bootstrap is completed the as the - ;; compiler infrastructure may not be usable. + ;; Don't enable this before bootstrap is completed, as the + ;; compiler infrastructure may not be usable yet. (setq comp-enable-subr-trampolines t)) (message "Dumping under the name %s" output) (condition-case () diff --git a/src/lread.c b/src/lread.c index d947c4e519a..989b55c88f9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -5200,8 +5200,7 @@ that are loaded before your customizations are read! */); load_prefer_newer = 0; DEFVAR_BOOL ("load-no-native", load_no_native, - doc: /* Do not try to load the a .eln file in place of - a .elc one. */); + doc: /* Non-nil means not to load a .eln file when a .elc was requested. */); load_no_native = false; /* Vsource_directory was initialized in init_lread. */ -- cgit v1.2.3 From b3ad62f8a35617366886be2a86e8641282824adf Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 19 Mar 2021 10:23:41 +0100 Subject: Do not load native code when `load' is explicitly called on a .elc file * src/lread.c (Fload): Do not load native code when `load' is explicitly called on a .elc file. (Flocate_file_internal): Update 'openp' call sites. (maybe_swap_for_eln): Add new 'no_native' parameter. (openp): Likewise + update 'maybe_swap_for_eln' and 'openp' call sites. * src/lisp.h: Update 'openp' signature. * src/w32proc.c (sys_spawnve): Update 'openp' call sites. * src/w32.c (check_windows_init_file): Likewise. * src/sound.c (Fplay_sound_internal): Likewise. * src/process.c (Fmake_process): Likewise. * src/image.c (image_create_bitmap_from_file) (image_find_image_fd): Likewise. * src/emacs.c (set_invocation_vars): Likewise. * src/charset.c (load_charset_map_from_file): Likewise. * src/callproc.c (call_process): Likewise. --- src/callproc.c | 2 +- src/charset.c | 2 +- src/emacs.c | 5 +++-- src/image.c | 4 ++-- src/lisp.h | 2 +- src/lread.c | 24 ++++++++++++++++-------- src/process.c | 2 +- src/sound.c | 5 +++-- src/w32.c | 3 ++- src/w32proc.c | 3 ++- 10 files changed, 32 insertions(+), 20 deletions(-) (limited to 'src/lread.c') diff --git a/src/callproc.c b/src/callproc.c index cd0f67fe29b..5aa2cbafb4c 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -457,7 +457,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, int ok; ok = openp (Vexec_path, args[0], Vexec_suffixes, &path, - make_fixnum (X_OK), false); + make_fixnum (X_OK), false, false); if (ok < 0) report_file_error ("Searching for program", args[0]); } diff --git a/src/charset.c b/src/charset.c index eb388d1868b..7cd0fa78f04 100644 --- a/src/charset.c +++ b/src/charset.c @@ -486,7 +486,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, ptrdiff_t count = SPECPDL_INDEX (); record_unwind_protect_nothing (); specbind (Qfile_name_handler_alist, Qnil); - fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil, false); + fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil, false, false); fp = fd < 0 ? 0 : fdopen (fd, "r"); if (!fp) { diff --git a/src/emacs.c b/src/emacs.c index ec62c19e388..d353679b0f0 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -468,8 +468,9 @@ set_invocation_vars (char *argv0, char const *original_pwd) if (NILP (Vinvocation_directory)) { Lisp_Object found; - int yes = openp (Vexec_path, Vinvocation_name, - Vexec_suffixes, &found, make_fixnum (X_OK), false); + int yes = + openp (Vexec_path, Vinvocation_name, Vexec_suffixes, &found, + make_fixnum (X_OK), false, false); if (yes == 1) { /* Add /: to the front of the name diff --git a/src/image.c b/src/image.c index 6d493f6cdd4..2f85e3035e8 100644 --- a/src/image.c +++ b/src/image.c @@ -519,7 +519,7 @@ image_create_bitmap_from_file (struct frame *f, Lisp_Object file) /* Search bitmap-file-path for the file, if appropriate. */ if (openp (Vx_bitmap_file_path, file, Qnil, &found, - make_fixnum (R_OK), false) + make_fixnum (R_OK), false, false) < 0) return -1; @@ -3128,7 +3128,7 @@ image_find_image_fd (Lisp_Object file, int *pfd) /* Try to find FILE in data-directory/images, then x-bitmap-file-path. */ fd = openp (search_path, file, Qnil, &file_found, - pfd ? Qt : make_fixnum (R_OK), false); + pfd ? Qt : make_fixnum (R_OK), false, false); if (fd >= 0 || fd == -2) { file_found = ENCODE_FILE (file_found); diff --git a/src/lisp.h b/src/lisp.h index fcdf8e27181..4004b535cdf 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4087,7 +4087,7 @@ extern bool suffix_p (Lisp_Object, const char *); extern Lisp_Object save_match_data_load (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern int openp (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object *, Lisp_Object, bool); + Lisp_Object *, Lisp_Object, bool, bool); enum { S2N_IGNORE_TRAILING = 1 }; extern Lisp_Object string_to_number (char const *, int, ptrdiff_t *); extern void map_obarray (Lisp_Object, void (*) (Lisp_Object, Lisp_Object), diff --git a/src/lread.c b/src/lread.c index 989b55c88f9..3bf31500065 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1240,6 +1240,8 @@ Return t if the file exists and loads successfully. */) else file = Fsubstitute_in_file_name (file); + bool no_native = suffix_p (file, ".elc"); + /* Avoid weird lossage with null string as arg, since it would try to load a directory as a Lisp file. */ if (SCHARS (file) == 0) @@ -1280,7 +1282,9 @@ Return t if the file exists and loads successfully. */) suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes); } - fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer); + fd = + openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer, + no_native); } if (fd == -1) @@ -1635,7 +1639,7 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate) { Lisp_Object file; - int fd = openp (path, filename, suffixes, &file, predicate, false); + int fd = openp (path, filename, suffixes, &file, predicate, false, false); if (NILP (predicate) && fd >= 0) emacs_close (fd); return file; @@ -1645,12 +1649,13 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) If found replace the content of FILENAME and FD. */ static void -maybe_swap_for_eln (Lisp_Object *filename, int *fd) +maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd) { #ifdef HAVE_NATIVE_COMP struct stat eln_st; - if (load_no_native + if (no_native + || load_no_native || !suffix_p (*filename, ".elc")) return; @@ -1714,11 +1719,14 @@ maybe_swap_for_eln (Lisp_Object *filename, int *fd) If NEWER is true, try all SUFFIXes and return the result for the newest file that exists. Does not apply to remote files, - or if a non-nil and non-t PREDICATE is specified. */ + or if a non-nil and non-t PREDICATE is specified. + + if NO_NATIVE is true do not try to load native code. */ int openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, - Lisp_Object *storeptr, Lisp_Object predicate, bool newer) + Lisp_Object *storeptr, Lisp_Object predicate, bool newer, + bool no_native) { ptrdiff_t fn_size = 100; char buf[100]; @@ -1928,7 +1936,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, } else { - maybe_swap_for_eln (&string, &fd); + maybe_swap_for_eln (no_native, &string, &fd); /* We succeeded; return this descriptor and filename. */ if (storeptr) *storeptr = string; @@ -1940,7 +1948,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, /* No more suffixes. Return the newest. */ if (0 <= save_fd && ! CONSP (XCDR (tail))) { - maybe_swap_for_eln (&save_string, &save_fd); + maybe_swap_for_eln (no_native, &save_string, &save_fd); if (storeptr) *storeptr = save_string; SAFE_FREE (); diff --git a/src/process.c b/src/process.c index b98bc297a3f..84e301a87a5 100644 --- a/src/process.c +++ b/src/process.c @@ -1936,7 +1936,7 @@ usage: (make-process &rest ARGS) */) { tem = Qnil; openp (Vexec_path, program, Vexec_suffixes, &tem, - make_fixnum (X_OK), false); + make_fixnum (X_OK), false, false); if (NILP (tem)) report_file_error ("Searching for program", program); tem = Fexpand_file_name (tem, Qnil); diff --git a/src/sound.c b/src/sound.c index e5f66f8f529..9041076bdc0 100644 --- a/src/sound.c +++ b/src/sound.c @@ -1370,8 +1370,9 @@ Internal use only, use `play-sound' instead. */) if (STRINGP (attrs[SOUND_FILE])) { /* Open the sound file. */ - current_sound->fd = openp (list1 (Vdata_directory), - attrs[SOUND_FILE], Qnil, &file, Qnil, false); + current_sound->fd = + openp (list1 (Vdata_directory), attrs[SOUND_FILE], Qnil, &file, Qnil, + false, false); if (current_sound->fd < 0) sound_perror ("Could not open sound file"); diff --git a/src/w32.c b/src/w32.c index 14b8b11da00..467e6cb4271 100644 --- a/src/w32.c +++ b/src/w32.c @@ -10255,7 +10255,8 @@ check_windows_init_file (void) need to ENCODE_FILE here, but we do need to convert the file names from UTF-8 to ANSI. */ init_file = build_string ("term/w32-win"); - fd = openp (Vload_path, init_file, Fget_load_suffixes (), NULL, Qnil, 0); + fd = + openp (Vload_path, init_file, Fget_load_suffixes (), NULL, Qnil, 0, 0); if (fd < 0) { Lisp_Object load_path_print = Fprin1_to_string (Vload_path, Qnil); diff --git a/src/w32proc.c b/src/w32proc.c index a50c87777fa..ffa56e135d0 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1918,7 +1918,8 @@ sys_spawnve (int mode, char *cmdname, char **argv, char **envp) { program = build_string (cmdname); full = Qnil; - openp (Vexec_path, program, Vexec_suffixes, &full, make_fixnum (X_OK), 0); + openp (Vexec_path, program, Vexec_suffixes, &full, make_fixnum (X_OK), + 0, 0); if (NILP (full)) { errno = EINVAL; -- cgit v1.2.3 From 5aa42f686c635e3b3f6cea8270e3c6fc2e4270f9 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 21 Mar 2021 20:40:45 +0100 Subject: Prevent unnecessary multiple .el hashing in 'maybe_swap_for_eln' * src/comp.c (Fcomp_el_to_eln_rel_filename): New function. (Fcomp_el_to_eln_filename): Make use of. (syms_of_comp): Register 'Scomp_el_to_eln_rel_filename'. * src/lread.c (maybe_swap_for_eln): Make use of 'Fcomp_el_to_eln_rel_filename' to hash prevent unnecessary multiple hashing. --- src/comp.c | 21 +++++++++++++++------ src/lread.c | 22 ++++++++++++---------- 2 files changed, 27 insertions(+), 16 deletions(-) (limited to 'src/lread.c') diff --git a/src/comp.c b/src/comp.c index 29b16c78ac0..4e2b941b670 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4001,11 +4001,10 @@ make_directory_wrapper_1 (Lisp_Object ignore) return Qt; } -DEFUN ("comp-el-to-eln-filename", Fcomp_el_to_eln_filename, - Scomp_el_to_eln_filename, 1, 2, 0, - doc: /* Return the corresponding .eln filename for source FILENAME. -If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) - (Lisp_Object filename, Lisp_Object base_dir) +DEFUN ("comp-el-to-eln-rel-filename", Fcomp_el_to_eln_rel_filename, + Scomp_el_to_eln_rel_filename, 1, 1, 0, + doc: /* Return the corresponding .eln relative filename. */) + (Lisp_Object filename) { CHECK_STRING (filename); @@ -4082,7 +4081,16 @@ If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) make_fixnum (-3))), separator); Lisp_Object hash = concat3 (path_hash, separator, content_hash); - filename = concat3 (filename, hash, build_string (NATIVE_ELISP_SUFFIX)); + return concat3 (filename, hash, build_string (NATIVE_ELISP_SUFFIX)); +} + +DEFUN ("comp-el-to-eln-filename", Fcomp_el_to_eln_filename, + Scomp_el_to_eln_filename, 1, 2, 0, + doc: /* Return the corresponding .eln filename for source FILENAME. +If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) + (Lisp_Object filename, Lisp_Object base_dir) +{ + filename = Fcomp_el_to_eln_rel_filename (filename); /* If base_dir was not specified search inside Vcomp_eln_load_path for the first directory where we have write access. */ @@ -5287,6 +5295,7 @@ compiled one. */); "configuration, please recompile")); defsubr (&Scomp__subr_signature); + defsubr (&Scomp_el_to_eln_rel_filename); defsubr (&Scomp_el_to_eln_filename); defsubr (&Scomp_native_driver_options_effective_p); defsubr (&Scomp__install_trampoline); diff --git a/src/lread.c b/src/lread.c index 3bf31500065..5fd52feb376 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1661,19 +1661,21 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd) /* Search eln in the eln-cache directories. */ Lisp_Object eln_path_tail = Vcomp_eln_load_path; - FOR_EACH_TAIL_SAFE (eln_path_tail) + Lisp_Object src_name = + Fsubstring (*filename, Qnil, make_fixnum (-1)); + if (NILP (Ffile_exists_p (src_name))) { - Lisp_Object src_name = - Fsubstring (*filename, Qnil, make_fixnum (-1)); + src_name = concat2 (src_name, build_string (".gz")); if (NILP (Ffile_exists_p (src_name))) - { - src_name = concat2 (src_name, build_string (".gz")); - if (NILP (Ffile_exists_p (src_name))) - /* Can't find the corresponding source file. */ - return; - } + /* Can't find the corresponding source file. */ + return; + } + Lisp_Object eln_rel_name = Fcomp_el_to_eln_rel_filename (src_name); + + FOR_EACH_TAIL_SAFE (eln_path_tail) + { Lisp_Object eln_name = - Fcomp_el_to_eln_filename (src_name, XCAR (eln_path_tail)); + Fexpand_file_name (eln_rel_name, XCAR (eln_path_tail)); int eln_fd = emacs_open (SSDATA (ENCODE_FILE (eln_name)), O_RDONLY, 0); if (eln_fd > 0) -- cgit v1.2.3 From 4a3b43f55cfa96f5dd42e360eb4577750e97dbf0 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 24 Mar 2021 11:23:00 +0100 Subject: * src/lread.c (maybe_swap_for_eln): Fix eln filename (bug#bug#47337). --- src/lread.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 5fd52feb376..56717dba810 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1675,7 +1675,9 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd) FOR_EACH_TAIL_SAFE (eln_path_tail) { Lisp_Object eln_name = - Fexpand_file_name (eln_rel_name, XCAR (eln_path_tail)); + Fexpand_file_name (eln_rel_name, + Fexpand_file_name (Vcomp_native_version_dir, + XCAR (eln_path_tail))); int eln_fd = emacs_open (SSDATA (ENCODE_FILE (eln_name)), O_RDONLY, 0); if (eln_fd > 0) -- cgit v1.2.3 From 79b8b6ca45ad707d86244882430e275efd95cdb9 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 26 Mar 2021 08:06:09 +0100 Subject: * Prevent stale eln loading checking file timestamp before load (bug#46617) * src/lread.c (maybe_swap_for_eln): Add file timestamp check. (openp): Update 'maybe_swap_for_eln' call sites. --- src/lread.c | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 56717dba810..e8c257a13cc 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1649,7 +1649,8 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) If found replace the content of FILENAME and FD. */ static void -maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd) +maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, + struct timespec mtime) { #ifdef HAVE_NATIVE_COMP struct stat eln_st; @@ -1686,13 +1687,19 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd) emacs_close (eln_fd); else { - *filename = eln_name; - emacs_close (*fd); - *fd = eln_fd; - /* Store the eln -> el relation. */ - Fputhash (Ffile_name_nondirectory (eln_name), - src_name, Vcomp_eln_to_el_h); - return; + struct timespec eln_mtime = get_stat_mtime (&eln_st); + if (timespec_cmp (eln_mtime, mtime) >= 0) + { + *filename = eln_name; + emacs_close (*fd); + *fd = eln_fd; + /* Store the eln -> el relation. */ + Fputhash (Ffile_name_nondirectory (eln_name), + src_name, Vcomp_eln_to_el_h); + return; + } + else + emacs_close (eln_fd); } } } @@ -1940,7 +1947,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, } else { - maybe_swap_for_eln (no_native, &string, &fd); + maybe_swap_for_eln (no_native, &string, &fd, + get_stat_mtime (&st)); /* We succeeded; return this descriptor and filename. */ if (storeptr) *storeptr = string; @@ -1952,7 +1960,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, /* No more suffixes. Return the newest. */ if (0 <= save_fd && ! CONSP (XCDR (tail))) { - maybe_swap_for_eln (no_native, &save_string, &save_fd); + maybe_swap_for_eln (no_native, &save_string, &save_fd, + save_mtime); if (storeptr) *storeptr = save_string; SAFE_FREE (); -- cgit v1.2.3 From 613caa9527ef56fb9b810d2b9478cbe9784baca0 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 31 Mar 2021 14:49:36 +0200 Subject: Do not defer compilation when bytecode is explicitly requested (bug#46617) * src/comp.c (maybe_defer_native_compilation): Check if the file is registered in 'V_comp_no_native_file_h'. (syms_of_comp): 'V_comp_no_native_file_h' new global. * src/lread.c (maybe_swap_for_eln): Register files in 'V_comp_no_native_file_h'. * lisp/faces.el (tty-run-terminal-initialization): Do not explicitly load .elc file to not exclude .eln being loaded in place. --- lisp/faces.el | 3 ++- src/comp.c | 10 +++++++++- src/lread.c | 6 ++++++ 3 files changed, 17 insertions(+), 2 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/faces.el b/lisp/faces.el index 42f4cddfb1b..68bfbbae384 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2244,7 +2244,8 @@ If you set `term-file-prefix' to nil, this function does nothing." (let ((file (locate-library (concat term-file-prefix type)))) (and file (or (assoc file load-history) - (load file t t))))) + (load (file-name-sans-extension file) + t t))))) type) ;; Next, try to find a matching initialization function, and call it. (tty-find-type #'(lambda (type) diff --git a/src/comp.c b/src/comp.c index 857f798a8d8..b286f6077f3 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4689,7 +4689,8 @@ maybe_defer_native_compilation (Lisp_Object function_name, || !NILP (Vpurify_flag) || !COMPILEDP (definition) || !STRINGP (Vload_true_file_name) - || !suffix_p (Vload_true_file_name, ".elc")) + || !suffix_p (Vload_true_file_name, ".elc") + || !NILP (Fgethash (Vload_true_file_name, V_comp_no_native_file_h, Qnil))) return; Lisp_Object src = @@ -5373,6 +5374,13 @@ This is used to prevent double trampoline instantiation but also to protect the trampolines against GC. */); Vcomp_installed_trampolines_h = CALLN (Fmake_hash_table); + DEFVAR_LISP ("comp-no-native-file-h", V_comp_no_native_file_h, + doc: /* Files for which no deferred compilation has to +be performed because the bytecode version was explicitly requested by +the user during load. +For internal use. */); + V_comp_no_native_file_h = CALLN (Fmake_hash_table, QCtest, Qequal); + Fprovide (intern_c_string ("nativecomp"), Qnil); #endif /* #ifdef HAVE_NATIVE_COMP */ diff --git a/src/lread.c b/src/lread.c index e8c257a13cc..ec6f09238ba 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1655,6 +1655,12 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, #ifdef HAVE_NATIVE_COMP struct stat eln_st; + if (no_native + || load_no_native) + Fputhash (*filename, Qt, V_comp_no_native_file_h); + else + Fremhash (*filename, V_comp_no_native_file_h); + if (no_native || load_no_native || !suffix_p (*filename, ".elc")) -- cgit v1.2.3 From dc393517ca1cfef7770bffdfe2b7fd3c2c5e7bbf Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 1 Apr 2021 14:27:12 +0200 Subject: Issue a warning when eln look-up fails due to missing .el source file. * lisp/emacs-lisp/comp.el (comp-warning-on-missing-source): New customize. * src/lread.c (maybe_swap_for_eln): Issue a warning when eln look-up fails due to missing .el source file. * src/comp.c (syms_of_comp): Define 'Qcomp_warning_on_missing_source'. --- lisp/emacs-lisp/comp.el | 7 +++++++ src/comp.c | 3 ++- src/lread.c | 12 ++++++++++-- 3 files changed, 19 insertions(+), 3 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 213eb7b4126..7f41a97f6b9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -180,6 +180,13 @@ the .eln output directory." :type 'boolean :version "28.1") +(defcustom comp-warning-on-missing-source t + "Emit a warning if a byte-code file being loaded has no corresponding source. +The source file is necessary for native code file look-up and deferred +compilation mechanism." + :type 'boolean + :version "28.1") + (defvar no-native-compile nil "Non-nil to prevent native-compiling of Emacs Lisp code. Note that when `no-byte-compile' is set to non-nil it overrides the value of diff --git a/src/comp.c b/src/comp.c index eb734d5833d..67c8e39315b 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5254,7 +5254,8 @@ compiled one. */); DEFSYM (Qlate, "late"); DEFSYM (Qlambda_fixup, "lambda-fixup"); DEFSYM (Qgccjit, "gccjit"); - DEFSYM (Qcomp_subr_trampoline_install, "comp-subr-trampoline-install") + DEFSYM (Qcomp_subr_trampoline_install, "comp-subr-trampoline-install"); + DEFSYM (Qcomp_warning_on_missing_source, "comp-warning-on-missing-source"); /* To be signaled by the compiler. */ DEFSYM (Qnative_compiler_error, "native-compiler-error"); diff --git a/src/lread.c b/src/lread.c index ec6f09238ba..156df73de82 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1674,8 +1674,16 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, { src_name = concat2 (src_name, build_string (".gz")); if (NILP (Ffile_exists_p (src_name))) - /* Can't find the corresponding source file. */ - return; + { + if (!NILP (find_symbol_value (Qcomp_warning_on_missing_source))) + call2 (intern_c_string ("display-warning"), + Qcomp, + CALLN (Fformat, + build_string ("Cannot look-up eln file as no source " + "file was found for %s"), + *filename)); + return; + } } Lisp_Object eln_rel_name = Fcomp_el_to_eln_rel_filename (src_name); -- cgit v1.2.3 From 6f8ec1449197f1fcd730df91dddf6f7750284593 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 4 Apr 2021 17:10:08 +0200 Subject: Output native compiled preloaded files into the 'preloaded' subfolder * src/comp.c (fixup_eln_load_path): Account the fact that the file can be dumped in the 'preloaded' subfolder. * lisp/loadup.el: Likewise. * src/lread.c (maybe_swap_for_eln1): New function. (maybe_swap_for_eln): Handle 'preloaded' subfolder. * src/Makefile.in (LISP_PRELOADED): Export preloaded files. --- lisp/loadup.el | 30 +++++++++++++++--------- src/Makefile.in | 1 + src/comp.c | 29 +++++++++++++++++------ src/lread.c | 73 +++++++++++++++++++++++++++++++++++++-------------------- 4 files changed, 89 insertions(+), 44 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/loadup.el b/lisp/loadup.el index 57058ac4aa1..c3948e465f2 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -465,17 +465,25 @@ lost after dumping"))) (when (subr-native-elisp-p f) (puthash (subr-native-comp-unit f) nil h))))) (maphash (lambda (cu _) - (native-comp-unit-set-file - cu - (cons - ;; Relative filename from the installed binary. - (file-relative-name (concat eln-dest-dir - (file-name-nondirectory - (native-comp-unit-file cu))) - bin-dest-dir) - ;; Relative filename from the built uninstalled binary. - (file-relative-name (native-comp-unit-file cu) - invocation-directory)))) + (let* ((file (native-comp-unit-file cu)) + (preloaded (equal (substring (file-name-directory file) + -10 -1) + "preloaded")) + (eln-dest-dir-eff (if preloaded + (expand-file-name "preloaded" + eln-dest-dir) + eln-dest-dir))) + (native-comp-unit-set-file + cu + (cons + ;; Relative filename from the installed binary. + (file-relative-name (expand-file-name + (file-name-nondirectory + file) + eln-dest-dir-eff) + bin-dest-dir) + ;; Relative filename from the built uninstalled binary. + (file-relative-name file invocation-directory))))) h)))) (when (hash-table-p purify-flag) diff --git a/src/Makefile.in b/src/Makefile.in index c6b1f556440..b8bad73b006 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -500,6 +500,7 @@ shortlisp := $(filter-out ${shortlisp_filter},${shortlisp}) ## the critical path (relevant in parallel compilations). ## We don't really need to sort, but may as well use it to remove duplicates. shortlisp := loaddefs.el loadup.el $(sort ${shortlisp}) +export LISP_PRELOADED = ${shortlisp} lisp = $(addprefix ${lispsource}/,${shortlisp}) ## Construct full set of libraries to be linked. diff --git a/src/comp.c b/src/comp.c index 67c8e39315b..9bad9b9667f 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4091,6 +4091,7 @@ for new compilations. If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) (Lisp_Object filename, Lisp_Object base_dir) { + Lisp_Object source_filename = filename; filename = Fcomp_el_to_eln_rel_filename (filename); /* If base_dir was not specified search inside Vcomp_eln_load_path @@ -4129,9 +4130,18 @@ If BASE-DIR is nil use the first entry in `comp-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, - Fexpand_file_name (Vcomp_native_version_dir, - base_dir)); + /* In case the file being compiled is found in 'LISP_PRELOADED' + target for output the 'preloaded' subfolder. */ + Lisp_Object lisp_preloaded = + Fgetenv_internal (build_string ("LISP_PRELOADED"), Qnil); + base_dir = Fexpand_file_name (Vcomp_native_version_dir, base_dir); + if (!NILP (lisp_preloaded) + && !NILP (Fmember (CALL1I (file-name-base, source_filename), + Fmapcar (intern_c_string ("file-name-base"), + CALL1I (split-string, lisp_preloaded))))) + base_dir = Fexpand_file_name (build_string ("preloaded"), base_dir); + + return Fexpand_file_name (filename, base_dir); } DEFUN ("comp--install-trampoline", Fcomp__install_trampoline, @@ -4750,10 +4760,15 @@ fixup_eln_load_path (Lisp_Object directory) 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))); + bool preloaded = + !NILP (Fequal (Fsubstring (eln_cache_sys, make_fixnum (-10), + make_fixnum (-1)), + build_string ("preloaded"))); + /* One or two directories up... */ + for (int i = 0; i < (preloaded ? 2 : 1); i++) + eln_cache_sys = + Ffile_name_directory (Fsubstring (eln_cache_sys, Qnil, + make_fixnum (-1))); Fsetcar (last_cell, eln_cache_sys); } diff --git a/src/lread.c b/src/lread.c index 156df73de82..e53e1f65ab9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1645,6 +1645,40 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) return file; } +#ifdef HAVE_NATIVE_COMP +static bool +maybe_swap_for_eln1 (Lisp_Object src_name, Lisp_Object eln_name, + Lisp_Object *filename, int *fd, struct timespec mtime) +{ + struct stat eln_st; + int eln_fd = emacs_open (SSDATA (ENCODE_FILE (eln_name)), O_RDONLY, 0); + + if (eln_fd > 0) + { + if (fstat (eln_fd, &eln_st) || S_ISDIR (eln_st.st_mode)) + emacs_close (eln_fd); + else + { + struct timespec eln_mtime = get_stat_mtime (&eln_st); + if (timespec_cmp (eln_mtime, mtime) >= 0) + { + emacs_close (*fd); + *fd = eln_fd; + *filename = eln_name; + /* Store the eln -> el relation. */ + Fputhash (Ffile_name_nondirectory (eln_name), + src_name, Vcomp_eln_to_el_h); + return true; + } + else + emacs_close (eln_fd); + } + } + + return false; +} +#endif + /* Look for a suitable .eln file to be loaded in place of FILENAME. If found replace the content of FILENAME and FD. */ @@ -1653,7 +1687,6 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, struct timespec mtime) { #ifdef HAVE_NATIVE_COMP - struct stat eln_st; if (no_native || load_no_native) @@ -1687,36 +1720,24 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, } Lisp_Object eln_rel_name = Fcomp_el_to_eln_rel_filename (src_name); + Lisp_Object dir = Qnil; FOR_EACH_TAIL_SAFE (eln_path_tail) { + dir = XCAR (eln_path_tail); Lisp_Object eln_name = Fexpand_file_name (eln_rel_name, - Fexpand_file_name (Vcomp_native_version_dir, - XCAR (eln_path_tail))); - int eln_fd = emacs_open (SSDATA (ENCODE_FILE (eln_name)), O_RDONLY, 0); - - if (eln_fd > 0) - { - if (fstat (eln_fd, &eln_st) || S_ISDIR (eln_st.st_mode)) - emacs_close (eln_fd); - else - { - struct timespec eln_mtime = get_stat_mtime (&eln_st); - if (timespec_cmp (eln_mtime, mtime) >= 0) - { - *filename = eln_name; - emacs_close (*fd); - *fd = eln_fd; - /* Store the eln -> el relation. */ - Fputhash (Ffile_name_nondirectory (eln_name), - src_name, Vcomp_eln_to_el_h); - return; - } - else - emacs_close (eln_fd); - } - } + Fexpand_file_name (Vcomp_native_version_dir, dir)); + if (maybe_swap_for_eln1 (src_name, eln_name, filename, fd, mtime)) + return; } + + /* Look also in preloaded subfolder of the last entry in + `comp-eln-load-path'. */ + dir = Fexpand_file_name (build_string ("preloaded"), + Fexpand_file_name (Vcomp_native_version_dir, + dir)); + maybe_swap_for_eln1 (src_name, Fexpand_file_name (eln_rel_name, dir), + filename, fd, mtime); #endif } -- cgit v1.2.3 From 901ce566037b27233b907a51a9cbd330c77830ba Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 6 May 2021 15:00:00 +0200 Subject: Rename comp-warning-on-missing-source MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/lread.c (maybe_swap_for_eln): Rename comp-warning-on-missing-source → native-comp-warning-on-missing-source. * src/comp.c (syms_of_comp): Likewise. * lisp/emacs-lisp/comp.el (native-comp-warning-on-missing-source): Likewise. --- lisp/emacs-lisp/comp.el | 2 +- src/comp.c | 3 ++- src/lread.c | 3 ++- 3 files changed, 5 insertions(+), 3 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2b00faa069d..434e0fb4165 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -178,7 +178,7 @@ the .eln output directory." :type 'boolean :version "28.1") -(defcustom comp-warning-on-missing-source t +(defcustom native-comp-warning-on-missing-source t "Emit a warning if a byte-code file being loaded has no corresponding source. The source file is necessary for native code file look-up and deferred compilation mechanism." diff --git a/src/comp.c b/src/comp.c index 9173dde2202..5cf94762a92 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5272,7 +5272,8 @@ compiled one. */); DEFSYM (Qlambda_fixup, "lambda-fixup"); DEFSYM (Qgccjit, "gccjit"); DEFSYM (Qcomp_subr_trampoline_install, "comp-subr-trampoline-install"); - DEFSYM (Qcomp_warning_on_missing_source, "comp-warning-on-missing-source"); + DEFSYM (Qnative_comp_warning_on_missing_source, + "native-comp-warning-on-missing-source"); /* To be signaled by the compiler. */ DEFSYM (Qnative_compiler_error, "native-compiler-error"); diff --git a/src/lread.c b/src/lread.c index e53e1f65ab9..12e4ca66cdc 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1708,7 +1708,8 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, src_name = concat2 (src_name, build_string (".gz")); if (NILP (Ffile_exists_p (src_name))) { - if (!NILP (find_symbol_value (Qcomp_warning_on_missing_source))) + if (!NILP (find_symbol_value ( + Qnative_comp_warning_on_missing_source))) call2 (intern_c_string ("display-warning"), Qcomp, CALLN (Fformat, -- cgit v1.2.3 From fbbcbed10ee89e0865bbddc6683ff626ec488ee9 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 6 May 2021 16:28:43 +0200 Subject: Rename comp-eln-load-path → native-comp-eln-load-path MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/comp.c (Fcomp_el_to_eln_filename): Rename comp-eln-load-path → native-comp-eln-load-path. * src/lread.c (maybe_swap_for_eln): Likewise. * lisp/startup.el (native-comp-eln-load-path) (normal-top-level): Likewise. * lisp/emacs-lisp/comp.el (comp-spill-lap-function, comp-final) (comp-eln-load-path-eff, comp-trampoline-compile) (comp-clean-up-stale-eln, comp-run-async-workers) (comp-lookup-eln, batch-byte-native-compile-for-bootstrap): Likewise. --- lisp/emacs-lisp/comp.el | 20 ++++++++++---------- lisp/startup.el | 16 ++++++++-------- src/comp.c | 14 +++++++------- src/lread.c | 2 +- 4 files changed, 26 insertions(+), 26 deletions(-) (limited to 'src/lread.c') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 434e0fb4165..684b814292f 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1333,7 +1333,7 @@ clashes." (setf (comp-ctxt-output comp-ctxt) (comp-el-to-eln-filename filename (when byte-native-for-bootstrap - (car (last comp-eln-load-path)))))) + (car (last native-comp-eln-load-path)))))) (setf (comp-ctxt-speed comp-ctxt) (alist-get 'native-comp-speed byte-native-qualities) (comp-ctxt-debug comp-ctxt) (alist-get 'native-comp-debug @@ -3653,7 +3653,7 @@ Prepare every function for final compilation and drive the C back-end." (setf native-comp-verbose ,native-comp-verbose comp-libgccjit-reproducer ,comp-libgccjit-reproducer comp-ctxt ,comp-ctxt - comp-eln-load-path ',comp-eln-load-path + native-comp-eln-load-path ',native-comp-eln-load-path native-comp-driver-options ',native-comp-driver-options load-path ',load-path) @@ -3703,12 +3703,12 @@ Prepare every function for final compilation and drive the C back-end." (defun comp-eln-load-path-eff () "Return a list of effective eln load directories. -Account for `comp-eln-load-path' and `comp-native-version-dir'." +Account for `native-comp-eln-load-path' and `comp-native-version-dir'." (mapcar (lambda (dir) (expand-file-name comp-native-version-dir (file-name-as-directory (expand-file-name dir invocation-directory)))) - comp-eln-load-path)) + native-comp-eln-load-path)) (defun comp-trampoline-filename (subr-name) "Given SUBR-NAME return the filename containing the trampoline." @@ -3772,14 +3772,14 @@ Return the trampoline if found or nil otherwise." when (file-writable-p f) do (cl-return f) finally (error "Cannot find suitable directory for output in \ -`comp-eln-load-path'"))))) +`native-comp-eln-load-path'"))))) ;; Some entry point support code. ;;;###autoload (defun comp-clean-up-stale-eln (file) - "Given FILE remove all its *.eln files in `comp-eln-load-path' + "Given FILE remove all its *.eln files in `native-comp-eln-load-path' sharing the original source filename (including FILE)." (when (string-match (rx "-" (group-n 1 (1+ hex)) "-" (1+ hex) ".eln" eos) file) @@ -3910,7 +3910,7 @@ display a message." native-comp-verbose ,native-comp-verbose comp-libgccjit-reproducer ,comp-libgccjit-reproducer comp-async-compilation t - comp-eln-load-path ',comp-eln-load-path + native-comp-eln-load-path ',native-comp-eln-load-path native-comp-driver-options ',native-comp-driver-options load-path ',load-path @@ -4123,10 +4123,10 @@ bytecode definition was not changed in the meantime)." ;;;###autoload (defun comp-lookup-eln (filename) "Given a Lisp source FILENAME return the corresponding .eln file if found. -Search happens in `comp-eln-load-path'." +Search happens in `native-comp-eln-load-path'." (cl-loop with eln-filename = (comp-el-to-eln-rel-filename filename) - for dir in comp-eln-load-path + for dir in native-comp-eln-load-path for f = (expand-file-name eln-filename (expand-file-name comp-native-version-dir (expand-file-name @@ -4169,7 +4169,7 @@ Native compilation equivalent to `batch-byte-compile'." "Like `batch-native-compile', but used for bootstrap. Generate .elc files in addition to the .eln files. Force the produced .eln to be outputted in the eln system -directory (the last entry in `comp-eln-load-path'). +directory (the last entry in `native-comp-eln-load-path'). If the environment variable 'NATIVE_DISABLED' is set, only byte compile." (comp-ensure-native-compiler) diff --git a/lisp/startup.el b/lisp/startup.el index 6bab9e364c2..bb25c1b7b0b 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -519,7 +519,7 @@ DIRS are relative." xdg-dir) (t emacs-d-dir)))) -(defvar comp-eln-load-path) +(defvar native-comp-eln-load-path) (defun normal-top-level () "Emacs calls this function when it first starts up. It sets `command-line-processed', processes the command-line, @@ -538,21 +538,21 @@ It is the default value of the variable `top-level'." (startup--xdg-or-homedot startup--xdg-config-home-emacs nil)) (when (featurep 'native-compile) - ;; Form `comp-eln-load-path'. + ;; Form `native-comp-eln-load-path'. (let ((path-env (getenv "EMACSNATIVELOADPATH"))) (when path-env (dolist (path (split-string path-env path-separator)) (unless (string= "" path) - (push path comp-eln-load-path))))) + (push path native-comp-eln-load-path))))) (push (expand-file-name "eln-cache/" user-emacs-directory) - comp-eln-load-path) + native-comp-eln-load-path) ;; When $HOME is set to '/nonexistent' means we are running the ;; testsuite, add a temporary folder in front to produce there ;; new compilations. (when (equal (getenv "HOME") "/nonexistent") (let ((tmp-dir (make-temp-file "emacs-testsuite-" t))) (add-hook 'kill-emacs-hook (lambda () (delete-directory tmp-dir t))) - (push tmp-dir comp-eln-load-path)))) + (push tmp-dir native-comp-eln-load-path)))) ;; Look in each dir in load-path for a subdirs.el file. If we ;; find one, load it, which will add the appropriate subdirs of ;; that dir into load-path. This needs to be done before setting @@ -640,12 +640,12 @@ It is the default value of the variable `top-level'." (decode-coding-string dir coding t)) path))))) (when (featurep 'native-compile) - (let ((npath (symbol-value 'comp-eln-load-path))) - (set 'comp-eln-load-path + (let ((npath (symbol-value 'native-comp-eln-load-path))) + (set 'native-comp-eln-load-path (mapcar (lambda (dir) ;; Call expand-file-name to remove all the ;; pesky ".." from the directyory names in - ;; comp-eln-load-path. + ;; native-comp-eln-load-path. (expand-file-name (decode-coding-string dir coding t))) npath)))) diff --git a/src/comp.c b/src/comp.c index 5cf94762a92..5128755bf18 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4095,11 +4095,11 @@ directory in `comp-eln-load-path' otherwise. */) Lisp_Object source_filename = filename; filename = Fcomp_el_to_eln_rel_filename (filename); - /* If base_dir was not specified search inside Vcomp_eln_load_path + /* If base_dir was not specified search inside Vnative_comp_eln_load_path for the first directory where we have write access. */ if (NILP (base_dir)) { - Lisp_Object eln_load_paths = Vcomp_eln_load_path; + Lisp_Object eln_load_paths = Vnative_comp_eln_load_path; FOR_EACH_TAIL (eln_load_paths) { Lisp_Object dir = XCAR (eln_load_paths); @@ -4630,7 +4630,7 @@ void eln_load_path_final_clean_up (void) { #ifdef WINDOWSNT - Lisp_Object dir_tail = Vcomp_eln_load_path; + Lisp_Object dir_tail = Vnative_comp_eln_load_path; FOR_EACH_TAIL (dir_tail) { Lisp_Object files_in_dir = @@ -4755,7 +4755,7 @@ void fixup_eln_load_path (Lisp_Object eln_filename) { Lisp_Object last_cell = Qnil; - Lisp_Object tem = Vcomp_eln_load_path; + Lisp_Object tem = Vnative_comp_eln_load_path; FOR_EACH_TAIL (tem) if (CONSP (tem)) last_cell = tem; @@ -5127,7 +5127,7 @@ static bool file_in_eln_sys_dir (Lisp_Object filename) { Lisp_Object eln_sys_dir = Qnil; - Lisp_Object tmp = Vcomp_eln_load_path; + Lisp_Object tmp = Vnative_comp_eln_load_path; FOR_EACH_TAIL (tmp) eln_sys_dir = XCAR (tmp); return !NILP (Fstring_match (Fregexp_quote (Fexpand_file_name (eln_sys_dir, @@ -5369,7 +5369,7 @@ For internal use. */); 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, + DEFVAR_LISP ("native-comp-eln-load-path", Vnative_comp_eln_load_path, doc: /* List of eln cache directories. If a directory is non absolute is assumed to be relative to @@ -5381,7 +5381,7 @@ The last directory of this list is assumed to be the system one. */); /* Temporary value in use for bootstrap. 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 ("../native-lisp/"), Qnil); + Vnative_comp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil); DEFVAR_BOOL ("comp-enable-subr-trampolines", comp_enable_subr_trampolines, doc: /* If non-nil enable primitive trampoline synthesis. diff --git a/src/lread.c b/src/lread.c index 12e4ca66cdc..d2e6323cb14 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1700,7 +1700,7 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, return; /* Search eln in the eln-cache directories. */ - Lisp_Object eln_path_tail = Vcomp_eln_load_path; + Lisp_Object eln_path_tail = Vnative_comp_eln_load_path; Lisp_Object src_name = Fsubstring (*filename, Qnil, make_fixnum (-1)); if (NILP (Ffile_exists_p (src_name))) -- cgit v1.2.3 From 0e69c85d7d6d46ab9c0d10051066a365e76a901f Mon Sep 17 00:00:00 2001 From: Nicolás Bértolo Date: Thu, 13 May 2021 13:30:29 +0200 Subject: Make searching for files faster under Windows * src/lread.c (openp): Use faccessat to check that a file exists before opening it on Windows (bug#41646). This speeds up searching for files. --- src/lread.c | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index d2e6323cb14..bca53a9a37a 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1945,7 +1945,17 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, } else { - fd = emacs_open (pfn, O_RDONLY, 0); + /* In some systems (like Windows) finding out if a + file exists is cheaper to do than actually opening + it. Only open the file when we are sure that it + exists. */ +#ifdef WINDOWSNT + if (faccessat (AT_FDCWD, pfn, R_OK, AT_EACCESS)) + fd = -1; + else +#endif + fd = emacs_open (pfn, O_RDONLY, 0); + if (fd < 0) { if (! (errno == ENOENT || errno == ENOTDIR)) -- cgit v1.2.3 From de45864cf787ce244b0d97e7cf523a6e03743f10 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 20 May 2021 18:26:15 +0200 Subject: Fix lexing of numbers with trailing decimal point and exponent Numbers with a trailing dot and an exponent were incorrectly read as integers (with the exponent ignored) instead of the floats they should be. For example, 1.e6 was read as the integer 1, not 1000000.0 as every sane person would agree was meant. (Bug#48678) Numbers with a trailing dot but no exponent are still read as integers. * src/lread.c (string_to_number): Fix float lexing. * test/src/lread-tests.el (lread-float): Add test. * doc/lispref/numbers.texi (Float Basics): Clarify syntax. --- doc/lispref/numbers.texi | 3 ++- src/lread.c | 10 ++++---- test/src/lread-tests.el | 67 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 74 insertions(+), 6 deletions(-) (limited to 'src/lread.c') diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 4c5f72126ed..d28e15869aa 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -237,7 +237,8 @@ precede the number and its exponent. For example, @samp{1500.0}, @samp{+15e2}, @samp{15.0e+2}, @samp{+1500000e-3}, and @samp{.15e4} are five ways of writing a floating-point number whose value is 1500. They are all equivalent. Like Common Lisp, Emacs Lisp requires at -least one digit after any decimal point in a floating-point number; +least one digit after a decimal point in a floating-point number that +does not have an exponent; @samp{1500.} is an integer, not a floating-point number. Emacs Lisp treats @code{-0.0} as numerically equal to ordinary zero diff --git a/src/lread.c b/src/lread.c index bca53a9a37a..0b33fd0f254 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3938,8 +3938,7 @@ string_to_number (char const *string, int base, ptrdiff_t *plen) bool signedp = negative | positive; cp += signedp; - enum { INTOVERFLOW = 1, LEAD_INT = 2, DOT_CHAR = 4, TRAIL_INT = 8, - E_EXP = 16 }; + enum { INTOVERFLOW = 1, LEAD_INT = 2, TRAIL_INT = 4, E_EXP = 16 }; int state = 0; int leading_digit = digit_to_number (*cp, base); uintmax_t n = leading_digit; @@ -3959,7 +3958,6 @@ string_to_number (char const *string, int base, ptrdiff_t *plen) char const *after_digits = cp; if (*cp == '.') { - state |= DOT_CHAR; cp++; } @@ -4008,8 +4006,10 @@ string_to_number (char const *string, int base, ptrdiff_t *plen) cp = ecp; } - float_syntax = ((state & (DOT_CHAR|TRAIL_INT)) == (DOT_CHAR|TRAIL_INT) - || (state & ~INTOVERFLOW) == (LEAD_INT|E_EXP)); + /* A float has digits after the dot or an exponent. + This excludes numbers like "1." which are lexed as integers. */ + float_syntax = ((state & TRAIL_INT) + || ((state & LEAD_INT) && (state & E_EXP))); } if (plen) diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index f2a60bcf327..dac8f95bc4d 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -196,4 +196,71 @@ literals (Bug#20852)." (should-error (read-event "foo: ")) (should-error (read-char-exclusive "foo: ")))) +(ert-deftest lread-float () + (should (equal (read "13") 13)) + (should (equal (read "+13") 13)) + (should (equal (read "-13") -13)) + (should (equal (read "13.") 13)) + (should (equal (read "+13.") 13)) + (should (equal (read "-13.") -13)) + (should (equal (read "13.25") 13.25)) + (should (equal (read "+13.25") 13.25)) + (should (equal (read "-13.25") -13.25)) + (should (equal (read ".25") 0.25)) + (should (equal (read "+.25") 0.25)) + (should (equal (read "-.25") -0.25)) + (should (equal (read "13e4") 130000.0)) + (should (equal (read "+13e4") 130000.0)) + (should (equal (read "-13e4") -130000.0)) + (should (equal (read "13e+4") 130000.0)) + (should (equal (read "+13e+4") 130000.0)) + (should (equal (read "-13e+4") -130000.0)) + (should (equal (read "625e-4") 0.0625)) + (should (equal (read "+625e-4") 0.0625)) + (should (equal (read "-625e-4") -0.0625)) + (should (equal (read "1.25e2") 125.0)) + (should (equal (read "+1.25e2") 125.0)) + (should (equal (read "-1.25e2") -125.0)) + (should (equal (read "1.25e+2") 125.0)) + (should (equal (read "+1.25e+2") 125.0)) + (should (equal (read "-1.25e+2") -125.0)) + (should (equal (read "1.25e-1") 0.125)) + (should (equal (read "+1.25e-1") 0.125)) + (should (equal (read "-1.25e-1") -0.125)) + (should (equal (read "4.e3") 4000.0)) + (should (equal (read "+4.e3") 4000.0)) + (should (equal (read "-4.e3") -4000.0)) + (should (equal (read "4.e+3") 4000.0)) + (should (equal (read "+4.e+3") 4000.0)) + (should (equal (read "-4.e+3") -4000.0)) + (should (equal (read "5.e-1") 0.5)) + (should (equal (read "+5.e-1") 0.5)) + (should (equal (read "-5.e-1") -0.5)) + (should (equal (read "0") 0)) + (should (equal (read "+0") 0)) + (should (equal (read "-0") 0)) + (should (equal (read "0.") 0)) + (should (equal (read "+0.") 0)) + (should (equal (read "-0.") 0)) + (should (equal (read "0.0") 0.0)) + (should (equal (read "+0.0") 0.0)) + (should (equal (read "-0.0") -0.0)) + (should (equal (read "0e5") 0.0)) + (should (equal (read "+0e5") 0.0)) + (should (equal (read "-0e5") -0.0)) + (should (equal (read "0e-5") 0.0)) + (should (equal (read "+0e-5") 0.0)) + (should (equal (read "-0e-5") -0.0)) + (should (equal (read ".0e-5") 0.0)) + (should (equal (read "+.0e-5") 0.0)) + (should (equal (read "-.0e-5") -0.0)) + (should (equal (read "0.0e-5") 0.0)) + (should (equal (read "+0.0e-5") 0.0)) + (should (equal (read "-0.0e-5") -0.0)) + (should (equal (read "0.e-5") 0.0)) + (should (equal (read "+0.e-5") 0.0)) + (should (equal (read "-0.e-5") -0.0)) + ) + + ;;; lread-tests.el ends here -- cgit v1.2.3 From 5dd2d50f3d5e65b85c87da86e2e8a6d087fe5767 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Wed, 16 Jun 2021 21:28:10 +0100 Subject: Fix NS native compilation builds * Makefile.in (ns_applibexecdir): (ns_applibdir): (ns_appdir): New variables. (.PHONY): Include new rule. (epaths-force-ns-self-contained): Remove the app bundle directory from all paths. * configure.ac (NS_SELF_CONTAINED): Set the default site-lisp directory instead of hard-coding it in the ObjC code, and use the new epaths generating make rule. * src/callproc.c (init_callproc_1): (init_callproc): Remove all the NS specific code as the special cases are now handled by decode_env_path. * src/emacs.c (load_pdump): (decode_env_path): Use ns_relocate to find the correct directory after relocation. * src/lread.c (load_path_default): Remove all the NS specific code as the special cases are now handled by decode_env_path. * src/nsterm.h: Update function definitions. * src/nsterm.m (ns_etc_directory): (ns_exec_path): (ns_load_path): Remove functions that are no longer needed. (ns_relocate): New function to calculate paths within the NS app bundle. * nextstep/Makefile.in (ns_applibexecdir): New variable, and update anything relying on the libexec location. --- Makefile.in | 18 +++++++- configure.ac | 19 +++++--- nextstep/Makefile.in | 12 ++--- src/Makefile.in | 2 +- src/callproc.c | 36 ++------------- src/emacs.c | 16 ++++++- src/lread.c | 7 +-- src/nsterm.h | 4 +- src/nsterm.m | 125 +++++++++------------------------------------------ 9 files changed, 80 insertions(+), 159 deletions(-) (limited to 'src/lread.c') diff --git a/Makefile.in b/Makefile.in index b7502880230..420cb544a4d 100644 --- a/Makefile.in +++ b/Makefile.in @@ -106,8 +106,11 @@ USE_STARTUP_NOTIFICATION = @USE_STARTUP_NOTIFICATION@ # Location to install Emacs.app under GNUstep / macOS. # Later values may use these. +ns_appdir=@ns_appdir@ ns_appbindir=@ns_appbindir@ +ns_applibexecdir=@ns_applibexecdir@ ns_appresdir=@ns_appresdir@ +ns_applibdir=@ns_applibdir@ # Either yes or no depending on whether this is a relocatable Emacs.app. ns_self_contained=@ns_self_contained@ @@ -330,12 +333,12 @@ BIN_DESTDIR='$(DESTDIR)${bindir}/' ELN_DESTDIR = $(DESTDIR)${libdir}/emacs/${version}/ else BIN_DESTDIR='${ns_appbindir}/' -ELN_DESTDIR = ${ns_appresdir}/ +ELN_DESTDIR = ${ns_applibdir}/emacs/${version}/ endif all: ${SUBDIR} info -.PHONY: all ${SUBDIR} blessmail epaths-force epaths-force-w32 etc-emacsver +.PHONY: all ${SUBDIR} blessmail epaths-force epaths-force-w32 epaths-force-ns-self-contained etc-emacsver # If configure were to just generate emacsver.tex from emacsver.tex.in # in the normal way, the timestamp of emacsver.tex would always be @@ -404,6 +407,17 @@ epaths-force-w32: -e "/^.*#/s|@SRC@|$${w32srcdir}|g") && \ ${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h +# A NextStep style app bundle is relocatable, so instead of +# hard-coding paths try to generate them at run-time. +# +# The paths are mostly the same, and the bundle paths are different +# between macOS and GNUstep, so just replace any references to the app +# bundle root itself with the relative path. +epaths-force-ns-self-contained: epaths-force + @(sed < ${srcdir}/src/epaths.h > epaths.h.$$$$ \ + -e 's;${ns_appdir}/;;') && \ + ${srcdir}/build-aux/move-if-change epaths.h.$$$$ src/epaths.h + lib-src src: $(NTDIR) lib src: lib-src diff --git a/configure.ac b/configure.ac index 830f33844b6..92527056b95 100644 --- a/configure.ac +++ b/configure.ac @@ -1891,10 +1891,11 @@ if test "${with_ns}" != no; then # so avoid NS_IMPL_COCOA if macuvs.h is absent. # Even a headless Emacs can build macuvs.h, so this should let you bootstrap. if test "${opsys}" = darwin && test -f "$srcdir/src/macuvs.h"; then - lispdirrel=Contents/Resources/lisp NS_IMPL_COCOA=yes ns_appdir=`pwd`/nextstep/Emacs.app ns_appbindir=${ns_appdir}/Contents/MacOS + ns_applibexecdir=${ns_appdir}/Contents/MacOS/libexec + ns_applibdir=${ns_appdir}/Contents/MacOS/lib ns_appresdir=${ns_appdir}/Contents/Resources ns_appsrc=Cocoa/Emacs.base ns_fontfile=macfont.o @@ -1952,6 +1953,8 @@ fail; if test $NS_IMPL_GNUSTEP = yes; then ns_appdir=`pwd`/nextstep/Emacs.app ns_appbindir=${ns_appdir} + ns_applibexecdir=${ns_appdir}/libexec + ns_applibdir=${ns_appdir}/lib ns_appresdir=${ns_appdir}/Resources ns_appsrc=GNUstep/Emacs.base ns_fontfile=nsfont.o @@ -2008,12 +2011,13 @@ if test "${HAVE_NS}" = yes; then window_system=nextstep # set up packaging dirs if test "${EN_NS_SELF_CONTAINED}" = yes; then + AC_DEFINE(NS_SELF_CONTAINED, 1, [Build an NS bundled app]) ns_self_contained=yes prefix=${ns_appresdir} exec_prefix=${ns_appbindir} dnl This one isn't really used, only archlibdir is. - libexecdir="\${ns_appbindir}/libexec" - archlibdir="\${ns_appbindir}/libexec" + libexecdir="\${ns_applibexecdir}" + archlibdir="\${ns_applibexecdir}" etcdocdir="\${ns_appresdir}/etc" etcdir="\${ns_appresdir}/etc" dnl FIXME maybe set datarootdir instead. @@ -2021,7 +2025,7 @@ if test "${HAVE_NS}" = yes; then infodir="\${ns_appresdir}/info" mandir="\${ns_appresdir}/man" lispdir="\${ns_appresdir}/lisp" - test "$locallisppathset" = no && locallisppath="" + test "$locallisppathset" = no && locallisppath="\${ns_appresdir}/site-lisp" INSTALL_ARCH_INDEP_EXTRA= fi @@ -5414,6 +5418,8 @@ AC_SUBST(CFLAGS) AC_SUBST(X_TOOLKIT_TYPE) AC_SUBST(ns_appdir) AC_SUBST(ns_appbindir) +AC_SUBST(ns_applibexecdir) +AC_SUBST(ns_applibdir) AC_SUBST(ns_appresdir) AC_SUBST(ns_appsrc) AC_SUBST(GNU_OBJC_CFLAGS) @@ -6014,10 +6020,13 @@ dnl the use of force in the 'epaths-force' rule in Makefile.in. AC_CONFIG_COMMANDS([src/epaths.h], [ if test "${opsys}" = "mingw32"; then ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force-w32 +elif test "$EN_NS_SELF_CONTAINED" = "yes"; then + ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force-ns-self-contained else ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force fi || AC_MSG_ERROR(['src/epaths.h' could not be made.]) -], [GCC="$GCC" CPPFLAGS="$CPPFLAGS" opsys="$opsys"]) +], [GCC="$GCC" CPPFLAGS="$CPPFLAGS" opsys="$opsys" + EN_NS_SELF_CONTAINED="$EN_NS_SELF_CONTAINED"]) dnl NB we have to cheat and use the ac_... version because abs_top_srcdir dnl is not yet set, sigh. Or we could use ../$srcdir/src/.gdbinit, diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in index 3168fee76c0..42b2ab2715d 100644 --- a/nextstep/Makefile.in +++ b/nextstep/Makefile.in @@ -36,6 +36,7 @@ MKDIR_P = @MKDIR_P@ ns_appdir = @ns_appdir@ ## GNUstep: ns_appdir; macOS: ns_appdir/Contents/MacOS ns_appbindir = @ns_appbindir@ +ns_applibexecdir = @ns_applibexecdir@ ## GNUstep/Emacs.base or Cocoa/Emacs.base. ns_appsrc = @ns_appsrc@ ## GNUstep: GNUstep/Emacs.base/Resources/Info-gnustep.plist @@ -44,7 +45,7 @@ ns_check_file = @ns_appdir@/@ns_check_file@ .PHONY: all -all: ${ns_appdir} ${ns_appbindir}/Emacs ${ns_appbindir}/Emacs.pdmp +all: ${ns_appdir} ${ns_appbindir}/Emacs ${ns_applibexecdir}/Emacs.pdmp ${ns_check_file} ${ns_appdir}: ${srcdir}/${ns_appsrc} ${ns_appsrc} rm -rf ${ns_appdir} @@ -63,8 +64,10 @@ ${ns_appbindir}/Emacs: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT} ${MKDIR_P} ${ns_appbindir} cp -f ../src/emacs${EXEEXT} $@ -${ns_appbindir}/Emacs.pdmp: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT}.pdmp - ${MKDIR_P} ${ns_appbindir} +# FIXME: Don't install the dump file into the app bundle when +# self-contained install is disabled. +${ns_applibexecdir}/Emacs.pdmp: ${ns_appdir} ${ns_check_file} ../src/emacs${EXEEXT}.pdmp + ${MKDIR_P} ${ns_applibexecdir} cp -f ../src/emacs${EXEEXT}.pdmp $@ .PHONY: FORCE @@ -85,9 +88,8 @@ links: ../src/emacs${EXEEXT} ln -s $(top_srcdir_abs)/info ${ns_appdir}/Contents/Resources ${MKDIR_P} ${ns_appbindir} ln -s $(abs_top_builddir)/src/emacs${EXEEXT} ${ns_appbindir}/Emacs - ln -s $(abs_top_builddir)/src/emacs${EXEEXT}.pdmp ${ns_appbindir}/Emacs.pdmp ln -s $(abs_top_builddir)/lib-src ${ns_appbindir}/bin - ln -s $(abs_top_builddir)/lib-src ${ns_appbindir}/libexec + ln -s $(abs_top_builddir)/lib-src ${ns_applibexecdir} ${MKDIR_P} ${ns_appdir}/Contents/Resources/etc for f in $(shell cd $(top_srcdir_abs)/etc; ls); do ln -s $(top_srcdir_abs)/etc/$$f ${ns_appdir}/Contents/Resources/etc; done ln -s $(abs_top_builddir)/etc/DOC ${ns_appdir}/Contents/Resources/etc diff --git a/src/Makefile.in b/src/Makefile.in index 79cddb35b55..22c7aeed5c6 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -55,7 +55,7 @@ lwlibdir = ../lwlib # Configuration files for .o files to depend on. config_h = config.h $(srcdir)/conf_post.h -## ns-app if HAVE_NS, else empty. +## ns-app if NS self contained app, else empty. OTHER_FILES = @OTHER_FILES@ ## Flags to pass for profiling builds diff --git a/src/callproc.c b/src/callproc.c index e44e243680d..aabc39313b8 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -1661,32 +1661,15 @@ make_environment_block (Lisp_Object current_dir) void init_callproc_1 (void) { -#ifdef HAVE_NS - const char *etc_dir = ns_etc_directory (); - const char *path_exec = ns_exec_path (); -#endif - - Vdata_directory = decode_env_path ("EMACSDATA", -#ifdef HAVE_NS - etc_dir ? etc_dir : -#endif - PATH_DATA, 0); + Vdata_directory = decode_env_path ("EMACSDATA", PATH_DATA, 0); Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory)); - Vdoc_directory = decode_env_path ("EMACSDOC", -#ifdef HAVE_NS - etc_dir ? etc_dir : -#endif - PATH_DOC, 0); + Vdoc_directory = decode_env_path ("EMACSDOC", PATH_DOC, 0); Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory)); /* Check the EMACSPATH environment variable, defaulting to the PATH_EXEC path from epaths.h. */ - Vexec_path = decode_env_path ("EMACSPATH", -#ifdef HAVE_NS - path_exec ? path_exec : -#endif - PATH_EXEC, 0); + Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC, 0); Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path)); /* FIXME? For ns, path_exec should go at the front? */ Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path); @@ -1701,10 +1684,6 @@ init_callproc (void) char *sh; Lisp_Object tempdir; -#ifdef HAVE_NS - if (data_dir == 0) - data_dir = ns_etc_directory () != 0; -#endif if (!NILP (Vinstallation_directory)) { @@ -1716,15 +1695,8 @@ init_callproc (void) /* MSDOS uses wrapped binaries, so don't do this. */ if (NILP (Fmember (tem, Vexec_path))) { -#ifdef HAVE_NS - const char *path_exec = ns_exec_path (); -#endif /* Running uninstalled, so default to tem rather than PATH_EXEC. */ - Vexec_path = decode_env_path ("EMACSPATH", -#ifdef HAVE_NS - path_exec ? path_exec : -#endif - SSDATA (tem), 0); + Vexec_path = decode_env_path ("EMACSPATH", SSDATA (tem), 0); Vexec_path = nconc2 (decode_env_path ("PATH", "", 0), Vexec_path); } diff --git a/src/emacs.c b/src/emacs.c index 60a57a693ce..b7982ece646 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -835,7 +835,13 @@ load_pdump (int argc, char **argv) NULL #endif ; - const char *argv0_base = "emacs"; + const char *argv0_base = +#ifdef NS_SELF_CONTAINED + "Emacs" +#else + "emacs" +#endif + ; /* TODO: maybe more thoroughly scrub process environment in order to make this use case (loading a dump file in an unexeced emacs) @@ -912,6 +918,8 @@ load_pdump (int argc, char **argv) /* On MS-Windows, PATH_EXEC normally starts with a literal "%emacs_dir%", so it will never work without some tweaking. */ path_exec = w32_relocate (path_exec); +#elif defined (HAVE_NS) + path_exec = ns_relocate (path_exec); #endif /* Look for "emacs.pdmp" in PATH_EXEC. We hardcode "emacs" in @@ -929,6 +937,7 @@ load_pdump (int argc, char **argv) } sprintf (dump_file, "%s%c%s%s", path_exec, DIRECTORY_SEP, argv0_base, suffix); +#if !defined (NS_SELF_CONTAINED) /* Assume the Emacs binary lives in a sibling directory as set up by the default installation configuration. */ const char *go_up = "../../../../bin/"; @@ -943,6 +952,7 @@ load_pdump (int argc, char **argv) sprintf (emacs_executable, "%s%c%s%s%s", path_exec, DIRECTORY_SEP, go_up, argv0_base, strip_suffix ? strip_suffix : ""); +#endif result = pdumper_load (dump_file, emacs_executable); if (result == PDUMPER_LOAD_FILE_NOT_FOUND) @@ -2960,7 +2970,11 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) path = 0; if (!path) { +#ifdef NS_SELF_CONTAINED + path = ns_relocate (defalt); +#else path = defalt; +#endif #ifdef WINDOWSNT defaulted = 1; #endif diff --git a/src/lread.c b/src/lread.c index 0b33fd0f254..4617ffd6265 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4769,14 +4769,9 @@ load_path_default (void) return decode_env_path (0, PATH_DUMPLOADSEARCH, 0); Lisp_Object lpath = Qnil; - const char *normal = PATH_LOADSEARCH; const char *loadpath = NULL; -#ifdef HAVE_NS - loadpath = ns_load_path (); -#endif - - lpath = decode_env_path (0, loadpath ? loadpath : normal, 0); + lpath = decode_env_path (0, PATH_LOADSEARCH, 0); if (!NILP (Vinstallation_directory)) { diff --git a/src/nsterm.h b/src/nsterm.h index f64354b8a7b..b29e76cc63f 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1190,9 +1190,7 @@ extern void ns_run_ascript (void); #define NSAPP_DATA2_RUNFILEDIALOG 11 extern void ns_run_file_dialog (void); -extern const char *ns_etc_directory (void); -extern const char *ns_exec_path (void); -extern const char *ns_load_path (void); +extern const char *ns_relocate (const char *epath); extern void syms_of_nsterm (void); extern void syms_of_nsfns (void); extern void syms_of_nsmenu (void); diff --git a/src/nsterm.m b/src/nsterm.m index e81a4cbc0dc..8497138039c 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -499,118 +499,35 @@ append2 (Lisp_Object list, Lisp_Object item) const char * -ns_etc_directory (void) -/* If running as a self-contained app bundle, return as a string the - filename of the etc directory, if present; else nil. */ -{ - NSBundle *bundle = [NSBundle mainBundle]; - NSString *resourceDir = [bundle resourcePath]; - NSString *resourcePath; - NSFileManager *fileManager = [NSFileManager defaultManager]; - BOOL isDir; +ns_relocate (const char *epath) +/* If we're running in a self-contained app bundle some hard-coded + paths are relative to the root of the bundle, so work out the full + path. - resourcePath = [resourceDir stringByAppendingPathComponent: @"etc"]; - if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir]) - { - if (isDir) return [resourcePath UTF8String]; - } - return NULL; -} - - -const char * -ns_exec_path (void) -/* If running as a self-contained app bundle, return as a path string - the filenames of the libexec and bin directories, ie libexec:bin. - Otherwise, return nil. - Normally, Emacs does not add its own bin/ directory to the PATH. - However, a self-contained NS build has a different layout, with - bin/ and libexec/ subdirectories in the directory that contains - Emacs.app itself. - We put libexec first, because init_callproc_1 uses the first - element to initialize exec-directory. An alternative would be - for init_callproc to check for invocation-directory/libexec. -*/ + FIXME: I think this should be able to handle cases where multiple + directories are separated by colons. */ { +#ifdef NS_SELF_CONTAINED NSBundle *bundle = [NSBundle mainBundle]; - NSString *resourceDir = [bundle resourcePath]; - NSString *binDir = [bundle bundlePath]; - NSString *resourcePath, *resourcePaths; - NSRange range; - NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR]; + NSString *root = [bundle bundlePath]; + NSString *original = [NSString stringWithUTF8String:epath]; + NSString *fixedPath = [NSString pathWithComponents:@[root, original]]; NSFileManager *fileManager = [NSFileManager defaultManager]; - NSArray *paths; - NSEnumerator *pathEnum; - BOOL isDir; - range = [resourceDir rangeOfString: @"Contents"]; - if (range.location != NSNotFound) - { - binDir = [binDir stringByAppendingPathComponent: @"Contents"]; -#ifdef NS_IMPL_COCOA - binDir = [binDir stringByAppendingPathComponent: @"MacOS"]; -#endif - } + if (![original isAbsolutePath] + && [fileManager fileExistsAtPath:fixedPath isDirectory:NULL]) + return [fixedPath UTF8String]; - paths = [binDir stringsByAppendingPaths: - [NSArray arrayWithObjects: @"libexec", @"bin", nil]]; - pathEnum = [paths objectEnumerator]; - resourcePaths = @""; + /* If we reach here either the path is absolute and therefore we + don't need to complete it, or we're unable to relocate the + file/directory. If it's the latter it may be because the user is + trying to use a bundled app as though it's a Unix style install + and we have no way to guess what was intended, so return the + original string unaltered. */ - while ((resourcePath = [pathEnum nextObject])) - { - if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir]) - if (isDir) - { - if ([resourcePaths length] > 0) - resourcePaths - = [resourcePaths stringByAppendingString: pathSeparator]; - resourcePaths - = [resourcePaths stringByAppendingString: resourcePath]; - } - } - if ([resourcePaths length] > 0) return [resourcePaths UTF8String]; - - return NULL; -} - - -const char * -ns_load_path (void) -/* If running as a self-contained app bundle, return as a path string - the filenames of the site-lisp and lisp directories. - Ie, site-lisp:lisp. Otherwise, return nil. */ -{ - NSBundle *bundle = [NSBundle mainBundle]; - NSString *resourceDir = [bundle resourcePath]; - NSString *resourcePath, *resourcePaths; - NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR]; - NSFileManager *fileManager = [NSFileManager defaultManager]; - BOOL isDir; - NSArray *paths = [resourceDir stringsByAppendingPaths: - [NSArray arrayWithObjects: - @"site-lisp", @"lisp", nil]]; - NSEnumerator *pathEnum = [paths objectEnumerator]; - resourcePaths = @""; - - /* Hack to skip site-lisp. */ - if (no_site_lisp) resourcePath = [pathEnum nextObject]; - - while ((resourcePath = [pathEnum nextObject])) - { - if ([fileManager fileExistsAtPath: resourcePath isDirectory: &isDir]) - if (isDir) - { - if ([resourcePaths length] > 0) - resourcePaths - = [resourcePaths stringByAppendingString: pathSeparator]; - resourcePaths - = [resourcePaths stringByAppendingString: resourcePath]; - } - } - if ([resourcePaths length] > 0) return [resourcePaths UTF8String]; +#endif - return NULL; + return epath; } -- cgit v1.2.3 From a0f060939456f3680823e34f430e482fcde2f5dd Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 26 Jun 2021 12:46:39 +0300 Subject: ; * src/lread.c (load_path_default): Remove unused variable. --- src/lread.c | 1 - 1 file changed, 1 deletion(-) (limited to 'src/lread.c') diff --git a/src/lread.c b/src/lread.c index 4617ffd6265..a6c2db5d994 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4769,7 +4769,6 @@ load_path_default (void) return decode_env_path (0, PATH_DUMPLOADSEARCH, 0); Lisp_Object lpath = Qnil; - const char *loadpath = NULL; lpath = decode_env_path (0, PATH_LOADSEARCH, 0); -- cgit v1.2.3