From 4496a3f5ba899c89e45cd478a22b25ddf77869ec Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Fri, 20 Dec 2019 05:22:09 +0100 Subject: initial compilation unit as object add --- src/comp.h | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 src/comp.h (limited to 'src/comp.h') diff --git a/src/comp.h b/src/comp.h new file mode 100644 index 00000000000..457b678699c --- /dev/null +++ b/src/comp.h @@ -0,0 +1,52 @@ +/* Elisp native compiler definitions +Copyright (C) 2012-2019 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see . */ + +#ifndef COMP_H +#define COMP_H + +#ifdef HAVE_NATIVE_COMP + +#include + +struct Lisp_Native_Compilation_Unit +{ + union vectorlike_header header; + /* Compilation unit file descriptor and handle. */ + int fd; + dynlib_handle_ptr handle; +}; + +INLINE bool +COMPILATIONP_UNITP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_NATIVE_COMP_UNIT); +} + +INLINE struct Lisp_Native_Compilation_Unit * +XCOMPILATION_UNIT (Lisp_Object a) +{ + eassert (COMPILATIONP_UNITP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Native_Compilation_Unit); +} + +/* Defined in comp.c. */ +extern void syms_of_comp (void); +extern void fill_freloc (void); + +#endif +#endif -- cgit v1.2.3 From c5bb62f99db4b1c70e68e7c7a30ede8227f199a3 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 21 Dec 2019 18:57:56 +0100 Subject: initial gc support --- src/alloc.c | 12 ++++++++++-- src/comp.c | 27 +++++++++++++++------------ src/comp.h | 1 + src/lisp.h | 34 +++++++++++++++++++++++++--------- src/print.c | 2 +- 5 files changed, 52 insertions(+), 24 deletions(-) (limited to 'src/comp.h') diff --git a/src/alloc.c b/src/alloc.c index dba2c2df881..547990c7a9e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6567,10 +6567,18 @@ mark_object (Lisp_Object arg) case PVEC_SUBR: #ifdef HAVE_NATIVE_COMP if (SUBRP_NATIVE_COMPILEDP (obj)) - set_vector_marked (ptr); + { + set_vector_marked (ptr); + struct Lisp_Subr *subr = XSUBR (obj); + mark_object (subr->native_comp_u); + } + break; + case PVEC_NATIVE_COMP_UNIT: + set_vector_marked (ptr); + /* FIXME see comp.h. */ + mark_object (XCOMPILATION_UNIT (obj)->data_vec); #endif break; - case PVEC_FREE: emacs_abort (); diff --git a/src/comp.c b/src/comp.c index ea5d3238d2c..71d4d79f9e7 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3225,8 +3225,10 @@ load_static_obj (dynlib_handle_ptr handle, const char *name) } static void -load_comp_unit (dynlib_handle_ptr handle, Lisp_Object file) +load_comp_unit (Lisp_Object comp_u_obj, Lisp_Object file) { + struct Lisp_Native_Compilation_Unit *comp_u = XCOMPILATION_UNIT (comp_u_obj); + dynlib_handle_ptr handle = comp_u->handle; struct thread_state ***current_thread_reloc = dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); EMACS_INT ***pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM); @@ -3249,11 +3251,9 @@ load_comp_unit (dynlib_handle_ptr handle, Lisp_Object file) EMACS_INT d_vec_len = XFIXNUM (Flength (d_vec)); for (EMACS_INT i = 0; i < d_vec_len; i++) - { data_relocs[i] = AREF (d_vec, i); - prevent_gc (data_relocs[i]); - } + comp_u->data_vec = d_vec; /* Imported functions. */ *freloc_link_table = freloc.link_table; @@ -3270,24 +3270,26 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, (Lisp_Object name, Lisp_Object minarg, Lisp_Object maxarg, Lisp_Object c_name, Lisp_Object doc, Lisp_Object intspec) { - dynlib_handle_ptr handle = xmint_pointer (XCAR (load_handle_stack)); + Lisp_Object comp_u = XCAR (load_handle_stack); + dynlib_handle_ptr handle = XCOMPILATION_UNIT (comp_u)->handle; if (!handle) xsignal0 (Qwrong_register_subr_call); void *func = dynlib_sym (handle, SSDATA (c_name)); eassert (func); - /* FIXME add gc support, now just leaking. */ - union Aligned_Lisp_Subr *x = xmalloc (sizeof (*x)); - - x->s.header.size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS; + union Aligned_Lisp_Subr *x = + (union Aligned_Lisp_Subr *) allocate_pseudovector ( + VECSIZE (union Aligned_Lisp_Subr), + 0, VECSIZE (union Aligned_Lisp_Subr), + PVEC_SUBR); x->s.function.a0 = func; x->s.min_args = XFIXNUM (minarg); x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; x->s.symbol_name = xstrdup (SSDATA (Fsymbol_name (name))); x->s.native_intspec = intspec; x->s.native_doc = doc; - XSETPVECTYPE (&x->s, PVEC_SUBR); + x->s.native_comp_u = comp_u; Lisp_Object tem; XSETSUBR (tem, &x->s); set_symbol_function (name, tem); @@ -3324,11 +3326,12 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0, copy_file_fd (fd_out, fd_in, &st, Qnil, file); dynlib_handle_ptr handle = dynlib_open (format_string ("/proc/%d/fd/%d", getpid (), fd_out)); - load_handle_stack = Fcons (make_mint_ptr (handle), load_handle_stack); + Lisp_Object comp_u = make_native_comp_u (fd_in, handle); + load_handle_stack = Fcons (comp_u, load_handle_stack); if (!handle) xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ())); - load_comp_unit (handle, file); + load_comp_unit (comp_u, file); load_handle_stack = XCDR (load_handle_stack); diff --git a/src/comp.h b/src/comp.h index 457b678699c..876615e8dd4 100644 --- a/src/comp.h +++ b/src/comp.h @@ -29,6 +29,7 @@ struct Lisp_Native_Compilation_Unit /* Compilation unit file descriptor and handle. */ int fd; dynlib_handle_ptr handle; + Lisp_Object data_vec; /* FIXME this should be in the normal lisp slot. */ }; INLINE bool diff --git a/src/lisp.h b/src/lisp.h index 7a4b3517574..3d467a84d18 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1342,6 +1342,7 @@ dead_object (void) #define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD)) #define XSETMUTEX(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_MUTEX)) #define XSETCONDVAR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR)) +#define XSETNATIVE_COMP_UNIT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_NATIVE_COMP_UNIT)) /* Efficiently convert a pointer to a Lisp object and back. The pointer is represented as a fixnum, so the garbage collector @@ -2100,7 +2101,7 @@ struct Lisp_Subr Lisp_Object native_doc; }; #ifdef HAVE_NATIVE_COMP - Lisp_Object native_comp_u;; + Lisp_Object native_comp_u; #endif } GCALIGNED_STRUCT; union Aligned_Lisp_Subr @@ -2138,14 +2139,6 @@ enum char_table_specials = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table, contents) - 1 }; -#ifdef HAVE_NATIVE_COMP -INLINE bool -SUBRP_NATIVE_COMPILEDP (Lisp_Object a) -{ - return SUBRP (a) && XSUBR (a)->native_comp_u; -} -#endif - /* Sanity-check pseudovector layout. */ verify (offsetof (struct Lisp_Char_Table, defalt) == header_size); verify (offsetof (struct Lisp_Char_Table, extras) @@ -4769,6 +4762,29 @@ extern void syms_of_profiler (void); extern char *emacs_root_dir (void); #endif /* DOS_NT */ +#ifdef HAVE_NATIVE_COMP +INLINE bool +SUBRP_NATIVE_COMPILEDP (Lisp_Object a) +{ + return SUBRP (a) && XSUBR (a)->native_comp_u; +} + +INLINE Lisp_Object +make_native_comp_u (int fd, dynlib_handle_ptr handle) +{ + struct Lisp_Native_Compilation_Unit *x = + (struct Lisp_Native_Compilation_Unit *) allocate_pseudovector ( + VECSIZE (struct Lisp_Native_Compilation_Unit), + 0, VECSIZE (struct Lisp_Native_Compilation_Unit), + PVEC_NATIVE_COMP_UNIT); + x->fd = fd; + x->handle = handle; + Lisp_Object cu; + XSETNATIVE_COMP_UNIT (cu, x); + return cu; +} +#endif + /* Defined in lastfile.c. */ extern char my_edata[]; extern char my_endbss[]; diff --git a/src/print.c b/src/print.c index 2e2c863ece8..e7ddafbbbbd 100644 --- a/src/print.c +++ b/src/print.c @@ -1828,7 +1828,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, #ifdef HAVE_NATIVE_COMP case PVEC_NATIVE_COMP_UNIT: { - print_c_string ("#", printcharfun); + print_c_string ("#fd); strout (buf, len, len, printcharfun); printchar ('>', printcharfun); -- cgit v1.2.3 From 4c8b46514d87856e5e2044bce804ad0156097d04 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 22 Dec 2019 08:12:27 +0100 Subject: some rename on compilation unit struct --- src/alloc.c | 6 +++--- src/comp.c | 6 +++--- src/comp.h | 12 ++++++------ src/lisp.h | 10 +++++----- src/print.c | 2 +- 5 files changed, 18 insertions(+), 18 deletions(-) (limited to 'src/comp.h') diff --git a/src/alloc.c b/src/alloc.c index 547990c7a9e..d47f9c8a574 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3026,8 +3026,8 @@ cleanup_vector (struct Lisp_Vector *vector) #ifdef HAVE_NATIVE_COMP else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_NATIVE_COMP_UNIT)) { - struct Lisp_Native_Compilation_Unit *cu = - PSEUDOVEC_STRUCT (vector, Lisp_Native_Compilation_Unit); + struct Lisp_Native_Comp_Unit *cu = + PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); eassert (cu->handle); dynlib_close (cu->handle); } @@ -6576,7 +6576,7 @@ mark_object (Lisp_Object arg) case PVEC_NATIVE_COMP_UNIT: set_vector_marked (ptr); /* FIXME see comp.h. */ - mark_object (XCOMPILATION_UNIT (obj)->data_vec); + mark_object (XNATIVE_COMP_UNIT (obj)->data_vec); #endif break; case PVEC_FREE: diff --git a/src/comp.c b/src/comp.c index 71d4d79f9e7..c74e5cf2e6c 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3227,7 +3227,7 @@ load_static_obj (dynlib_handle_ptr handle, const char *name) static void load_comp_unit (Lisp_Object comp_u_obj, Lisp_Object file) { - struct Lisp_Native_Compilation_Unit *comp_u = XCOMPILATION_UNIT (comp_u_obj); + struct Lisp_Native_Comp_Unit *comp_u = XNATIVE_COMP_UNIT (comp_u_obj); dynlib_handle_ptr handle = comp_u->handle; struct thread_state ***current_thread_reloc = dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); @@ -3271,7 +3271,7 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, Lisp_Object c_name, Lisp_Object doc, Lisp_Object intspec) { Lisp_Object comp_u = XCAR (load_handle_stack); - dynlib_handle_ptr handle = XCOMPILATION_UNIT (comp_u)->handle; + dynlib_handle_ptr handle = XNATIVE_COMP_UNIT (comp_u)->handle; if (!handle) xsignal0 (Qwrong_register_subr_call); @@ -3313,7 +3313,7 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0, /* FIXME non portable. */ /* We copy the content of the file to be loaded in a memory mapped file. We then keep track of this in the struct - Lisp_Native_Compilation_Unit. In case this will be overwritten + Lisp_Native_Comp_Unit. In case this will be overwritten or delete we'll dump the right data. */ int fd_in = emacs_open (SSDATA (file), O_RDONLY, 0); int fd_out = memfd_create (SSDATA (file), 0); diff --git a/src/comp.h b/src/comp.h index 876615e8dd4..04c57278667 100644 --- a/src/comp.h +++ b/src/comp.h @@ -23,7 +23,7 @@ along with GNU Emacs. If not, see . */ #include -struct Lisp_Native_Compilation_Unit +struct Lisp_Native_Comp_Unit { union vectorlike_header header; /* Compilation unit file descriptor and handle. */ @@ -33,16 +33,16 @@ struct Lisp_Native_Compilation_Unit }; INLINE bool -COMPILATIONP_UNITP (Lisp_Object a) +NATIVE_COMP_UNITP (Lisp_Object a) { return PSEUDOVECTORP (a, PVEC_NATIVE_COMP_UNIT); } -INLINE struct Lisp_Native_Compilation_Unit * -XCOMPILATION_UNIT (Lisp_Object a) +INLINE struct Lisp_Native_Comp_Unit * +XNATIVE_COMP_UNIT (Lisp_Object a) { - eassert (COMPILATIONP_UNITP (a)); - return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Native_Compilation_Unit); + eassert (NATIVE_COMP_UNITP (a)); + return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Native_Comp_Unit); } /* Defined in comp.c. */ diff --git a/src/lisp.h b/src/lisp.h index 3d467a84d18..2e4a6c89846 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4772,11 +4772,11 @@ SUBRP_NATIVE_COMPILEDP (Lisp_Object a) INLINE Lisp_Object make_native_comp_u (int fd, dynlib_handle_ptr handle) { - struct Lisp_Native_Compilation_Unit *x = - (struct Lisp_Native_Compilation_Unit *) allocate_pseudovector ( - VECSIZE (struct Lisp_Native_Compilation_Unit), - 0, VECSIZE (struct Lisp_Native_Compilation_Unit), - PVEC_NATIVE_COMP_UNIT); + struct Lisp_Native_Comp_Unit *x = + (struct Lisp_Native_Comp_Unit *) allocate_pseudovector ( + VECSIZE (struct Lisp_Native_Comp_Unit), + 0, VECSIZE (struct Lisp_Native_Comp_Unit), + PVEC_NATIVE_COMP_UNIT); x->fd = fd; x->handle = handle; Lisp_Object cu; diff --git a/src/print.c b/src/print.c index e7ddafbbbbd..4d7932a81d7 100644 --- a/src/print.c +++ b/src/print.c @@ -1829,7 +1829,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, case PVEC_NATIVE_COMP_UNIT: { print_c_string ("#fd); + int len = sprintf (buf, "%d", XNATIVE_COMP_UNIT (obj)->fd); strout (buf, len, len, printcharfun); printchar ('>', printcharfun); } -- cgit v1.2.3 From a88e5f0f199ad018d57d07016dce20e5462dbbca Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 22 Dec 2019 08:31:02 +0100 Subject: better compilation unit definition --- src/alloc.c | 6 +----- src/comp.h | 3 ++- src/lisp.h | 6 ++---- 3 files changed, 5 insertions(+), 10 deletions(-) (limited to 'src/comp.h') diff --git a/src/alloc.c b/src/alloc.c index d47f9c8a574..5e0b04b1cc7 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6572,13 +6572,9 @@ mark_object (Lisp_Object arg) struct Lisp_Subr *subr = XSUBR (obj); mark_object (subr->native_comp_u); } - break; - case PVEC_NATIVE_COMP_UNIT: - set_vector_marked (ptr); - /* FIXME see comp.h. */ - mark_object (XNATIVE_COMP_UNIT (obj)->data_vec); #endif break; + case PVEC_FREE: emacs_abort (); diff --git a/src/comp.h b/src/comp.h index 04c57278667..8b83911f53c 100644 --- a/src/comp.h +++ b/src/comp.h @@ -26,10 +26,11 @@ along with GNU Emacs. If not, see . */ struct Lisp_Native_Comp_Unit { union vectorlike_header header; + /* Analogous to the constant vector but per compilation unit. */ + Lisp_Object data_vec; /* Compilation unit file descriptor and handle. */ int fd; dynlib_handle_ptr handle; - Lisp_Object data_vec; /* FIXME this should be in the normal lisp slot. */ }; INLINE bool diff --git a/src/lisp.h b/src/lisp.h index 2e4a6c89846..81ccae5683f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4773,10 +4773,8 @@ INLINE Lisp_Object make_native_comp_u (int fd, dynlib_handle_ptr handle) { struct Lisp_Native_Comp_Unit *x = - (struct Lisp_Native_Comp_Unit *) allocate_pseudovector ( - VECSIZE (struct Lisp_Native_Comp_Unit), - 0, VECSIZE (struct Lisp_Native_Comp_Unit), - PVEC_NATIVE_COMP_UNIT); + ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, data_vec, + PVEC_NATIVE_COMP_UNIT); x->fd = fd; x->handle = handle; Lisp_Object cu; -- cgit v1.2.3 From b275ddd63a24b15dd8f90ea0c4f27341a8dfa977 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 22 Dec 2019 09:28:39 +0100 Subject: rationalize load functions --- src/comp.c | 16 ++++++++++------ src/comp.h | 2 ++ src/lisp.h | 16 +++++----------- 3 files changed, 17 insertions(+), 17 deletions(-) (limited to 'src/comp.h') diff --git a/src/comp.c b/src/comp.c index 9f8c24f3cf0..6d496e89bf7 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3218,9 +3218,8 @@ load_static_obj (dynlib_handle_ptr handle, const char *name) } static void -load_comp_unit (Lisp_Object comp_u_obj, Lisp_Object file) +load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u) { - struct Lisp_Native_Comp_Unit *comp_u = XNATIVE_COMP_UNIT (comp_u_obj); dynlib_handle_ptr handle = comp_u->handle; struct thread_state ***current_thread_reloc = dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); @@ -3234,7 +3233,7 @@ load_comp_unit (Lisp_Object comp_u_obj, Lisp_Object file) && data_relocs && freloc_link_table && top_level_run)) - xsignal1 (Qnative_lisp_file_inconsistent, file); + xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file); *current_thread_reloc = ¤t_thread; *pure_reloc = (EMACS_INT **)&pure; @@ -3250,6 +3249,9 @@ load_comp_unit (Lisp_Object comp_u_obj, Lisp_Object file) /* Imported functions. */ *freloc_link_table = freloc.link_table; + Lisp_Object comp_u_obj; + XSETNATIVE_COMP_UNIT (comp_u_obj, comp_u); + /* Executing this will perform all the expected environment modification. */ top_level_run (comp_u_obj); @@ -3319,11 +3321,13 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0, copy_file_fd (fd_out, fd_in, &st, Qnil, file); dynlib_handle_ptr handle = dynlib_open (format_string ("/proc/%d/fd/%d", getpid (), fd_out)); - Lisp_Object comp_u = make_native_comp_u (fd_in, handle); if (!handle) xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ())); - - load_comp_unit (comp_u, file); + struct Lisp_Native_Comp_Unit *comp_u = allocate_native_comp_unit(); + comp_u->file = file; + comp_u->fd = fd_out; + comp_u->handle = handle; + load_comp_unit (comp_u); return Qt; } diff --git a/src/comp.h b/src/comp.h index 8b83911f53c..677ffdc4d7f 100644 --- a/src/comp.h +++ b/src/comp.h @@ -26,6 +26,8 @@ along with GNU Emacs. If not, see . */ struct Lisp_Native_Comp_Unit { union vectorlike_header header; + /* Original eln file loaded (just for debug purpose). */ + Lisp_Object file; /* Analogous to the constant vector but per compilation unit. */ Lisp_Object data_vec; /* Compilation unit file descriptor and handle. */ diff --git a/src/lisp.h b/src/lisp.h index 81ccae5683f..3c3a9e22cf3 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4769,17 +4769,11 @@ SUBRP_NATIVE_COMPILEDP (Lisp_Object a) return SUBRP (a) && XSUBR (a)->native_comp_u; } -INLINE Lisp_Object -make_native_comp_u (int fd, dynlib_handle_ptr handle) -{ - struct Lisp_Native_Comp_Unit *x = - ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, data_vec, - PVEC_NATIVE_COMP_UNIT); - x->fd = fd; - x->handle = handle; - Lisp_Object cu; - XSETNATIVE_COMP_UNIT (cu, x); - return cu; +INLINE struct Lisp_Native_Comp_Unit * +allocate_native_comp_unit (void) +{ + return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, data_vec, + PVEC_NATIVE_COMP_UNIT); } #endif -- cgit v1.2.3 From 12639610f78f9006b70933bfc6898c1312f95290 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 23 Dec 2019 09:24:51 +0100 Subject: better printing for native compilation unit --- src/comp.h | 2 +- src/print.c | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) (limited to 'src/comp.h') diff --git a/src/comp.h b/src/comp.h index 677ffdc4d7f..36ee5d10e45 100644 --- a/src/comp.h +++ b/src/comp.h @@ -26,7 +26,7 @@ along with GNU Emacs. If not, see . */ struct Lisp_Native_Comp_Unit { union vectorlike_header header; - /* Original eln file loaded (just for debug purpose). */ + /* Original eln file loaded. */ Lisp_Object file; /* Analogous to the constant vector but per compilation unit. */ Lisp_Object data_vec; diff --git a/src/print.c b/src/print.c index 4d7932a81d7..9013ccc8ccd 100644 --- a/src/print.c +++ b/src/print.c @@ -1829,8 +1829,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, case PVEC_NATIVE_COMP_UNIT: { print_c_string ("#fd); - strout (buf, len, len, printcharfun); + print_string (XNATIVE_COMP_UNIT (obj)->file, printcharfun); printchar ('>', printcharfun); } break; -- cgit v1.2.3 From 36ab5c6d49f8fbfb858844743223414e6f2f2564 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 24 Dec 2019 08:09:21 +0100 Subject: some more pdumper integration support --- src/comp.c | 18 ++++++++++-------- src/comp.h | 6 ++++-- src/pdumper.c | 48 +++++++++++++++++++++++++++++++++++++----------- 3 files changed, 51 insertions(+), 21 deletions(-) (limited to 'src/comp.h') diff --git a/src/comp.c b/src/comp.c index 68b1cdf7449..003d3d7ca44 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3136,6 +3136,12 @@ fill_freloc (void) fatal ("Overflowing function relocation table, increase F_RELOC_MAX_SIZE"); } +int +filled_freloc (void) +{ + return freloc.link_table[0] ? 1 : 0; +} + /******************************************************************************/ /* Helper functions called from the run-time. */ /* These can't be statics till shared mechanism is used to solve relocations. */ @@ -3210,7 +3216,7 @@ load_static_obj (dynlib_handle_ptr handle, const char *name) return Fread (make_string (res->data, res->len)); } -static void +void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u) { dynlib_handle_ptr handle = comp_u->handle; @@ -3297,15 +3303,11 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0, if (!freloc.link_table[0]) xsignal2 (Qnative_lisp_load_failed, file, build_string ("Empty relocation table")); - - dynlib_handle_ptr handle = dynlib_open (SSDATA (file)); - load_handle_stack = Fcons (make_mint_ptr (handle), load_handle_stack); - if (!handle) - xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ())); struct Lisp_Native_Comp_Unit *comp_u = allocate_native_comp_unit(); + comp_u->handle = dynlib_open (SSDATA (file)); + if (!comp_u->handle) + xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ())); comp_u->file = file; - comp_u->fd = fd_out; - comp_u->handle = handle; load_comp_unit (comp_u); return Qt; diff --git a/src/comp.h b/src/comp.h index 36ee5d10e45..c4849ba13d1 100644 --- a/src/comp.h +++ b/src/comp.h @@ -30,8 +30,6 @@ struct Lisp_Native_Comp_Unit Lisp_Object file; /* Analogous to the constant vector but per compilation unit. */ Lisp_Object data_vec; - /* Compilation unit file descriptor and handle. */ - int fd; dynlib_handle_ptr handle; }; @@ -49,8 +47,12 @@ XNATIVE_COMP_UNIT (Lisp_Object a) } /* Defined in comp.c. */ +extern void load_comp_unit (struct Lisp_Native_Comp_Unit *); extern void syms_of_comp (void); +/* Fill the freloc structure. Must be called before any eln is loaded. */ extern void fill_freloc (void); +/* Return 1 if freloc is filled or 0 otherwise. */ +extern int filled_freloc (void); #endif #endif diff --git a/src/pdumper.c b/src/pdumper.c index 775f6c3e60b..157457d30d7 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -446,6 +446,7 @@ enum cold_op COLD_OP_CHARSET, COLD_OP_BUFFER, COLD_OP_BIGNUM, + COLD_OP_NATIVE_SUBR, }; /* This structure controls what operations we perform inside @@ -939,7 +940,7 @@ dump_note_reachable (struct dump_context *ctx, Lisp_Object object) static void * dump_object_emacs_ptr (Lisp_Object lv) { - if (SUBRP (lv)) + if (SUBRP (lv) && !SUBRP_NATIVE_COMPILEDP (lv)) return XSUBR (lv); if (dump_builtin_symbol_p (lv)) return XSYMBOL (lv); @@ -2941,20 +2942,25 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) #endif DUMP_FIELD_COPY (&out, subr, min_args); DUMP_FIELD_COPY (&out, subr, max_args); - dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name); #ifdef HAVE_NATIVE_COMP if (subr->native_comp_u) { + dump_field_fixup_later (ctx, &out, subr, &subr->symbol_name); + dump_remember_cold_op (ctx, + COLD_OP_NATIVE_SUBR, + make_lisp_ptr ((void *) subr, Lisp_Vectorlike)); dump_field_lv (ctx, &out, subr, &subr->native_intspec, WEIGHT_NORMAL); dump_field_lv (ctx, &out, subr, &subr->native_doc, 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); } 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 @@ -2968,9 +2974,10 @@ dump_native_comp_unit (struct dump_context *ctx, { START_DUMP_PVEC (ctx, &comp_u->header, struct Lisp_Native_Comp_Unit, out); dump_pseudovector_lisp_fields (ctx, &out->header, &comp_u->header); - out->fd = 0; - out->handle = 0; - return finish_dump_pvec (ctx, &out->header); + out->handle = NULL; + + dump_off comp_u_off = finish_dump_pvec (ctx, &out->header); + return comp_u_off; } #endif @@ -3051,6 +3058,11 @@ dump_vectorlike (struct dump_context *ctx, case PVEC_BIGNUM: offset = dump_bignum (ctx, lv); break; +#ifdef HAVE_NATIVE_COMP + case PVEC_NATIVE_COMP_UNIT: + offset = dump_native_comp_unit (ctx, XNATIVE_COMP_UNIT (lv)); + break; +#endif case PVEC_WINDOW_CONFIGURATION: error_unsupported_dump_object (ctx, lv, "window configuration"); case PVEC_OTHER: @@ -3075,11 +3087,6 @@ dump_vectorlike (struct dump_context *ctx, error_unsupported_dump_object (ctx, lv, "condvar"); case PVEC_MODULE_FUNCTION: error_unsupported_dump_object (ctx, lv, "module function"); -#ifdef HAVE_NATIVE_COMP - case PVEC_NATIVE_COMP_UNIT: - offset = dump_native_comp_unit (ctx, XNATIVE_COMP_UNIT (lv)); - break; -#endif default: error_unsupported_dump_object(ctx, lv, "weird pseudovector"); } @@ -3454,6 +3461,22 @@ dump_cold_bignum (struct dump_context *ctx, Lisp_Object object) } } +static void +dump_cold_native_subr (struct dump_context *ctx, Lisp_Object subr) +{ + /* Dump subr contents. */ + dump_off subr_offset = dump_recall_object (ctx, subr); + eassert (subr_offset > 0); + dump_remember_fixup_ptr_raw + (ctx, + subr_offset + dump_offsetof (struct Lisp_Subr, symbol_name), + ctx->offset); + const char *symbol_name = XSUBR (subr)->symbol_name; + ALLOW_IMPLICIT_CONVERSION; + dump_write (ctx, symbol_name, 1 + strlen (symbol_name)); + DISALLOW_IMPLICIT_CONVERSION; +} + static void dump_drain_cold_data (struct dump_context *ctx) { @@ -3497,6 +3520,9 @@ dump_drain_cold_data (struct dump_context *ctx) case COLD_OP_BIGNUM: dump_cold_bignum (ctx, data); break; + case COLD_OP_NATIVE_SUBR: + dump_cold_native_subr (ctx, data); + break; default: emacs_abort (); } @@ -3916,7 +3942,7 @@ dump_do_fixup (struct dump_context *ctx, /* Dump wants a pointer to a Lisp object. If DUMP_FIXUP_LISP_OBJECT_RAW, we should stick a C pointer in the dump; otherwise, a Lisp_Object. */ - if (SUBRP (arg)) + if (SUBRP (arg) && !SUBRP_NATIVE_COMPILEDP(arg)) { dump_value = emacs_offset (XSUBR (arg)); if (type == DUMP_FIXUP_LISP_OBJECT) -- cgit v1.2.3 From b6d6e7feb75b792c74fe3e1d036b9edf540d771e Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 24 Dec 2019 14:51:18 +0100 Subject: add native compilation unit pdumper support --- src/comp.c | 33 +++++++++++++++++++-------------- src/comp.h | 3 ++- src/pdumper.c | 16 ++++++++++++++++ 3 files changed, 37 insertions(+), 15 deletions(-) (limited to 'src/comp.h') diff --git a/src/comp.c b/src/comp.c index 003d3d7ca44..43b22a86805 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3217,7 +3217,7 @@ load_static_obj (dynlib_handle_ptr handle, const char *name) } void -load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u) +load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump) { dynlib_handle_ptr handle = comp_u->handle; struct thread_state ***current_thread_reloc = @@ -3237,22 +3237,26 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u) *current_thread_reloc = ¤t_thread; *pure_reloc = (EMACS_INT **)&pure; - /* Imported data. */ - Lisp_Object d_vec = load_static_obj (handle, TEXT_DATA_RELOC_SYM); - EMACS_INT d_vec_len = XFIXNUM (Flength (d_vec)); - - for (EMACS_INT i = 0; i < d_vec_len; i++) - data_relocs[i] = AREF (d_vec, i); - - comp_u->data_vec = d_vec; /* Imported functions. */ *freloc_link_table = freloc.link_table; - Lisp_Object comp_u_obj; - XSETNATIVE_COMP_UNIT (comp_u_obj, comp_u); + /* Imported data. */ + if (!loading_dump) + comp_u->data_vec = load_static_obj (handle, TEXT_DATA_RELOC_SYM); + + EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); + + for (EMACS_INT i = 0; i < d_vec_len; i++) + data_relocs[i] = AREF (comp_u->data_vec, i); - /* Executing this will perform all the expected environment modification. */ - top_level_run (comp_u_obj); + if (!loading_dump) + { + Lisp_Object comp_u_obj; + XSETNATIVE_COMP_UNIT (comp_u_obj, comp_u); + /* Executing this will perform all the expected environment + modification. */ + top_level_run (comp_u_obj); + } return; } @@ -3308,7 +3312,8 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0, if (!comp_u->handle) xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ())); comp_u->file = file; - load_comp_unit (comp_u); + comp_u->data_vec = Qnil; + load_comp_unit (comp_u, false); return Qt; } diff --git a/src/comp.h b/src/comp.h index c4849ba13d1..90b4f40426b 100644 --- a/src/comp.h +++ b/src/comp.h @@ -47,7 +47,8 @@ XNATIVE_COMP_UNIT (Lisp_Object a) } /* Defined in comp.c. */ -extern void load_comp_unit (struct Lisp_Native_Comp_Unit *); +extern void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, + bool loading_dump); extern void syms_of_comp (void); /* Fill the freloc structure. Must be called before any eln is loaded. */ extern void fill_freloc (void); diff --git a/src/pdumper.c b/src/pdumper.c index 4e770f79af5..2dbe6c73fb4 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -197,6 +197,7 @@ enum dump_reloc_type /* dump_ptr = dump_ptr + dump_base */ RELOC_DUMP_TO_DUMP_PTR_RAW, /* dump_mpz = [rebuild bignum] */ + RELOC_NATIVE_COMP_UNIT, RELOC_BIGNUM, /* dump_lv = make_lisp_ptr (dump_lv + dump_base, type - RELOC_DUMP_TO_DUMP_LV) @@ -2991,6 +2992,11 @@ dump_native_comp_unit (struct dump_context *ctx, out->handle = NULL; dump_off comp_u_off = finish_dump_pvec (ctx, &out->header); + if (ctx->flags.dump_object_contents) + /* We'll do the real elf load during the LATE_RELOCS_1 relocation time. */ + dump_push (&ctx->dump_relocs[LATE_RELOCS_1], + list2 (make_fixnum (RELOC_NATIVE_COMP_UNIT), + dump_off_to_lisp (comp_u_off))); return comp_u_off; } #endif @@ -5290,6 +5296,16 @@ dump_do_dump_relocation (const uintptr_t dump_base, dump_write_word_to_dump (dump_base, reloc_offset, value); break; } + case RELOC_NATIVE_COMP_UNIT: + { + struct Lisp_Native_Comp_Unit *comp_u = + dump_ptr (dump_base, reloc_offset); + comp_u->handle = dynlib_open (SSDATA (comp_u->file)); + if (!comp_u->handle) + error ("%s", dynlib_error ()); + load_comp_unit (comp_u, true); + } + break; case RELOC_BIGNUM: { struct Lisp_Bignum *bignum = dump_ptr (dump_base, reloc_offset); -- 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/comp.h') 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 44db9b912f1d8165383b5b30732fa9caa3d3a185 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Wed, 25 Dec 2019 16:02:46 +0100 Subject: never load a compilation unit without filling the func link table --- src/comp.c | 23 +++++++++++------------ src/comp.h | 5 ----- src/emacs.c | 4 ---- 3 files changed, 11 insertions(+), 21 deletions(-) (limited to 'src/comp.h') diff --git a/src/comp.c b/src/comp.c index 6f5658191c0..9baa990061b 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3113,14 +3113,19 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, } -void -fill_freloc (void) +static void +freloc_check_fill (void) { + if (freloc.size) + return; + if (ARRAYELTS (helper_link_table) > F_RELOC_MAX_SIZE) goto overflow; memcpy (freloc.link_table, helper_link_table, sizeof (helper_link_table)); freloc.size = ARRAYELTS (helper_link_table); + eassert (!NILP (Vcomp_subr_list)); + Lisp_Object subr_l = Vcomp_subr_list; FOR_EACH_TAIL (subr_l) { @@ -3136,12 +3141,6 @@ fill_freloc (void) fatal ("Overflowing function relocation table, increase F_RELOC_MAX_SIZE"); } -int -filled_freloc (void) -{ - return freloc.link_table[0] ? 1 : 0; -} - /******************************************************************************/ /* Helper functions called from the run-time. */ /* These can't be statics till shared mechanism is used to solve relocations. */ @@ -3217,6 +3216,8 @@ load_static_obj (dynlib_handle_ptr handle, const char *name) void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump) { + freloc_check_fill (); + dynlib_handle_ptr handle = comp_u->handle; struct thread_state ***current_thread_reloc = dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); @@ -3303,9 +3304,6 @@ 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")); struct Lisp_Native_Comp_Unit *comp_u = allocate_native_comp_unit(); comp_u->handle = dynlib_open (SSDATA (file)); if (!comp_u->handle) @@ -3430,7 +3428,8 @@ syms_of_comp (void) doc: /* The compiler context. */); Vcomp_ctxt = Qnil; - /* FIXME should be initialized but not here... */ + /* FIXME should be initialized but not here... Plus this don't have + to be necessarily exposed to lisp but can easy debug for now. */ DEFVAR_LISP ("comp-subr-list", Vcomp_subr_list, doc: /* List of all defined subrs. */); DEFVAR_LISP ("comp-sym-subr-c-name-h", Vcomp_sym_subr_c_name_h, diff --git a/src/comp.h b/src/comp.h index f756e38d292..33b73548009 100644 --- a/src/comp.h +++ b/src/comp.h @@ -60,10 +60,5 @@ XNATIVE_COMP_UNIT (Lisp_Object a) extern void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump); extern void syms_of_comp (void); -/* Fill the freloc structure. Must be called before any eln is loaded. */ -extern void fill_freloc (void); -/* Return 1 if freloc is filled or 0 otherwise. */ -extern int filled_freloc (void); - #endif #endif diff --git a/src/emacs.c b/src/emacs.c index 0798e0702f2..90ab7ac1e8e 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2050,10 +2050,6 @@ 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) -- 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/comp.h') 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 c1d034fc27e3aef2370cf0153e7b54dac7eba91b Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 12 Jan 2020 11:47:50 +0100 Subject: Split relocated data into two separate arrays Rework the functionality of the previous commit to be more efficient. --- lisp/emacs-lisp/comp.el | 44 ++++++++++++++------ src/comp.c | 108 +++++++++++++++++++++++++++++++----------------- src/comp.h | 3 ++ src/lisp.h | 4 +- 4 files changed, 106 insertions(+), 53 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 0f71746407a..69141f657a6 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -157,6 +157,13 @@ Can be used by code that wants to expand differently in this case.") finally return h) "Hash table lap-op -> stack adjustment.")) +(cl-defstruct comp-data-container + "Data relocation container structure." + (l () :type list + :documentation "Constant objects used by functions.") + (idx (make-hash-table :test #'equal) :type hash-table + :documentation "Obj -> position into the previous field.")) + (cl-defstruct comp-ctxt "Lisp side of the compiler context." (output nil :type string @@ -166,10 +173,11 @@ Can be used by code that wants to expand differently in this case.") (funcs-h (make-hash-table) :type hash-table :documentation "lisp-func-name -> comp-func. This is to build the prev field.") - (data-relocs-l () :type list - :documentation "List of pairs (impure . obj-to-reloc).") - (data-relocs-idx (make-hash-table :test #'equal) :type hash-table - :documentation "Obj -> position into data-relocs.")) + (d-base (make-comp-data-container) :type comp-data-container + :documentation "Standard data relocated in use by functions.") + (d-impure (make-comp-data-container) :type comp-data-container + :documentation "Data relocated that cannot be moved into pure space. +This is tipically for top-level forms other than defun.")) (cl-defstruct comp-args-base (min nil :type number @@ -314,16 +322,28 @@ structure.") "Type hint predicate for function name FUNC." (when (member func comp-type-hints) t)) +(defun comp-data-container-check (cont) + "Sanity check CONT coherency." + (cl-assert (= (length (comp-data-container-l cont)) + (hash-table-count (comp-data-container-idx cont))))) + +(defun comp-add-const-to-relocs-to-cont (obj cont) + "Keep track of OBJ into the CONT relocation container. +The corresponding index is returned." + (let ((h (comp-data-container-idx cont))) + (if-let ((idx (gethash obj h))) + idx + (push obj (comp-data-container-l cont)) + (puthash obj (hash-table-count h) h)))) + (defun comp-add-const-to-relocs (obj &optional impure) "Keep track of OBJ into the ctxt relocations. When IMPURE is non nil OBJ cannot be copied into pure space. The corresponding index is returned." - (let ((data-relocs-idx (comp-ctxt-data-relocs-idx comp-ctxt)) - (packed-obj (cons impure obj))) - (if-let ((idx (gethash packed-obj data-relocs-idx))) - idx - (push packed-obj (comp-ctxt-data-relocs-l comp-ctxt)) - (puthash packed-obj (hash-table-count data-relocs-idx) data-relocs-idx)))) + (comp-add-const-to-relocs-to-cont obj + (if impure + (comp-ctxt-d-impure comp-ctxt) + (comp-ctxt-d-base comp-ctxt)))) (defmacro comp-within-log-buff (&rest body) "Execute BODY while at the end the log-buffer. @@ -1810,8 +1830,8 @@ These are substituted with a normal 'set' op." (defun comp-compile-ctxt-to-file (name) "Compile as native code the current context naming it NAME. Prepare every function for final compilation and drive the C back-end." - (cl-assert (= (length (comp-ctxt-data-relocs-l comp-ctxt)) - (hash-table-count (comp-ctxt-data-relocs-idx comp-ctxt)))) + (comp-data-container-check (comp-ctxt-d-base comp-ctxt)) + (comp-data-container-check (comp-ctxt-d-impure comp-ctxt)) (comp--compile-ctxt-to-file name)) (defun comp-final (_) diff --git a/src/comp.c b/src/comp.c index 0d1f83eb8ff..290fc3a9c45 100644 --- a/src/comp.c +++ b/src/comp.c @@ -39,9 +39,11 @@ along with GNU Emacs. If not, see . */ #define CURRENT_THREAD_RELOC_SYM "current_thread_reloc" #define PURE_RELOC_SYM "pure_reloc" #define DATA_RELOC_SYM "d_reloc" +#define DATA_RELOC_IMPURE_SYM "d_reloc_imp" #define FUNC_LINK_TABLE_SYM "freloc_link_table" #define LINK_TABLE_HASH_SYM "freloc_hash" #define TEXT_DATA_RELOC_SYM "text_data_reloc" +#define TEXT_DATA_RELOC_IMPURE_SYM "text_data_reloc_imp" #define SPEED XFIXNUM (Fsymbol_value (Qcomp_speed)) #define COMP_DEBUG XFIXNUM (Fsymbol_value (Qcomp_debug)) @@ -171,8 +173,12 @@ typedef struct { Lisp_Object exported_funcs_h; /* subr_name -> gcc_jit_function *. */ 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. */ + /* Synthesized struct holding data relocs. */ + gcc_jit_rvalue *data_relocs; + /* Same as before but can't go in pure space. */ + gcc_jit_rvalue *data_relocs_impure; + /* Synthesized struct holding func relocs. */ + gcc_jit_lvalue *func_relocs; } comp_t; static comp_t comp; @@ -894,9 +900,10 @@ emit_const_lisp_obj (Lisp_Object obj, Lisp_Object impure) comp.void_ptr_type, NULL)); - Lisp_Object d_reloc_idx = CALL1I (comp-ctxt-data-relocs-idx, Vcomp_ctxt); - Lisp_Object packed_obj = Fcons (impure, obj); - Lisp_Object reloc_idx = Fgethash (packed_obj, d_reloc_idx, Qnil); + Lisp_Object container = impure ? CALL1I (comp-ctxt-d-impure, Vcomp_ctxt) + : CALL1I (comp-ctxt-d-base, Vcomp_ctxt); + Lisp_Object reloc_idx = + Fgethash (obj, CALL1I (comp-data-container-idx, container), Qnil); eassert (!NILP (reloc_idx)); gcc_jit_rvalue *reloc_n = gcc_jit_context_new_rvalue_from_int (comp.ctxt, @@ -906,7 +913,8 @@ emit_const_lisp_obj (Lisp_Object obj, Lisp_Object impure) gcc_jit_lvalue_as_rvalue ( gcc_jit_context_new_array_access (comp.ctxt, NULL, - comp.data_relocs, + impure ? comp.data_relocs_impure + : comp.data_relocs, reloc_n)); } @@ -1749,14 +1757,52 @@ emit_static_object (const char *name, Lisp_Object obj) gcc_jit_block_end_with_return (block, NULL, res); } +static gcc_jit_rvalue * +declare_imported_data_relocs (Lisp_Object container, const char *code_symbol, + const char *text_symbol) +{ + /* Imported objects. */ + EMACS_INT d_reloc_len = + XFIXNUM (CALL1I (hash-table-count, + CALL1I (comp-data-container-idx, container))); + Lisp_Object d_reloc = Fnreverse (CALL1I (comp-data-container-l, container)); + d_reloc = Fvconcat (1, &d_reloc); + + gcc_jit_rvalue *reloc_struct = + gcc_jit_lvalue_as_rvalue ( + gcc_jit_context_new_global ( + comp.ctxt, + NULL, + GCC_JIT_GLOBAL_EXPORTED, + gcc_jit_context_new_array_type (comp.ctxt, + NULL, + comp.lisp_obj_type, + d_reloc_len), + code_symbol)); + + emit_static_object (text_symbol, d_reloc); + + return reloc_struct; +} + static void -declare_runtime_imported_data (void) +declare_imported_data (void) { /* Imported symbols by inliner functions. */ CALL1I (comp-add-const-to-relocs, Qnil); CALL1I (comp-add-const-to-relocs, Qt); CALL1I (comp-add-const-to-relocs, Qconsp); CALL1I (comp-add-const-to-relocs, Qlistp); + + /* Imported objects. */ + comp.data_relocs = + declare_imported_data_relocs (CALL1I (comp-ctxt-d-base, Vcomp_ctxt), + DATA_RELOC_SYM, + TEXT_DATA_RELOC_SYM); + comp.data_relocs_impure = + declare_imported_data_relocs (CALL1I (comp-ctxt-d-impure, Vcomp_ctxt), + DATA_RELOC_IMPURE_SYM, + TEXT_DATA_RELOC_IMPURE_SYM); } /* @@ -1842,27 +1888,7 @@ emit_ctxt_code (void) gcc_jit_type_get_pointer (comp.void_ptr_type), PURE_RELOC_SYM)); - declare_runtime_imported_data (); - /* Imported objects. */ - EMACS_INT d_reloc_len = - XFIXNUM (CALL1I (hash-table-count, - CALL1I (comp-ctxt-data-relocs-idx, Vcomp_ctxt))); - Lisp_Object d_reloc = Fnreverse (CALL1I (comp-ctxt-data-relocs-l, Vcomp_ctxt)); - d_reloc = Fvconcat (1, &d_reloc); - - comp.data_relocs = - gcc_jit_lvalue_as_rvalue ( - gcc_jit_context_new_global ( - comp.ctxt, - NULL, - GCC_JIT_GLOBAL_EXPORTED, - gcc_jit_context_new_array_type (comp.ctxt, - NULL, - comp.lisp_obj_type, - d_reloc_len), - DATA_RELOC_SYM)); - - emit_static_object (TEXT_DATA_RELOC_SYM, d_reloc); + declare_imported_data (); /* Functions imported from Lisp code. */ freloc_check_fill (); @@ -3263,12 +3289,14 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump) dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); EMACS_INT ***pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM); Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); + Lisp_Object *data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM); void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM); void (*top_level_run)(Lisp_Object) = dynlib_sym (handle, "top_level_run"); if (!(current_thread_reloc && pure_reloc && data_relocs + && data_imp_relocs && freloc_link_table && top_level_run) || NILP (Fstring_equal (load_static_obj (comp_u, LINK_TABLE_HASH_SYM), @@ -3283,21 +3311,23 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump) /* Imported data. */ if (!loading_dump) - comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM); + { + comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM); + comp_u->data_impure_vec = + load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM); - EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); + if (!NILP (Vpurify_flag)) + /* Non impure can be copied into pure space. */ + comp_u->data_vec = Fpurecopy (comp_u->data_vec); + } - if (!loading_dump && !NILP (Vpurify_flag)) - for (EMACS_INT i = 0; i < d_vec_len; i++) - { - Lisp_Object packed_obj = AREF (comp_u->data_vec, i); - if (NILP (XCAR (packed_obj))) - /* If is not impure can be copied into pure space. */ - XSETCDR (packed_obj, Fpurecopy (XCDR (packed_obj))); - } + EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); + for (EMACS_INT i = 0; i < d_vec_len; i++) + data_relocs[i] = AREF (comp_u->data_vec, i); + d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec)); for (EMACS_INT i = 0; i < d_vec_len; i++) - data_relocs[i] = XCDR (AREF (comp_u->data_vec, i)); + data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i); if (!loading_dump) { diff --git a/src/comp.h b/src/comp.h index 86fa54f5158..ddebbbcccf0 100644 --- a/src/comp.h +++ b/src/comp.h @@ -38,6 +38,9 @@ struct Lisp_Native_Comp_Unit Lisp_Object file; /* Analogous to the constant vector but per compilation unit. */ Lisp_Object data_vec; + /* Same but for data that cannot be moved to pure space. + Must be the last lisp object here. */ + Lisp_Object data_impure_vec; dynlib_handle_ptr handle; }; diff --git a/src/lisp.h b/src/lisp.h index 2d083dc4582..04489959ed8 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4767,8 +4767,8 @@ SUBR_NATIVE_COMPILEDP (Lisp_Object a) INLINE struct Lisp_Native_Comp_Unit * allocate_native_comp_unit (void) { - return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, data_vec, - PVEC_NATIVE_COMP_UNIT); + return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, + data_impure_vec, PVEC_NATIVE_COMP_UNIT); } #else INLINE bool -- cgit v1.2.3 From 81c34a35aab53978bc2f3608dff3751030d0e914 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 16 Feb 2020 18:14:35 +0100 Subject: Update copyright years plus two style nits --- lisp/emacs-lisp/comp.el | 10 +++++----- src/comp.c | 2 +- src/comp.h | 2 +- test/src/comp-test-funcs.el | 2 +- test/src/comp-tests.el | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 67fc8f39f8c..80a542257fb 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2,7 +2,7 @@ ;; Author: Andrea Corallo -;; Copyright (C) 2019 Free Software Foundation, Inc. +;; Copyright (C) 2019-2020 Free Software Foundation, Inc. ;; Keywords: lisp ;; Package: emacs @@ -1587,8 +1587,8 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non nil." ;; Note: this last is just a property of the code generated ;; by the byte-compiler. (cl-assert (= (comp-mvar-array-idx arg) 0)) - (setf (comp-mvar-slot arg) i) - (setf (comp-mvar-array-idx arg) arr-idx)))) + (setf (comp-mvar-slot arg) i + (comp-mvar-array-idx arg) arr-idx)))) (defun comp-propagate-prologue (backward) "Prologue for the propagate pass. @@ -1682,8 +1682,8 @@ Here goes everything that can be done not iteratively (read once). (cl-loop with slot = (comp-mvar-slot lval) for arg in rest do - (setf (comp-mvar-array-idx arg) arr-idx) - (setf (comp-mvar-slot arg) slot))))))) + (setf (comp-mvar-array-idx arg) arr-idx + (comp-mvar-slot arg) slot))))))) (defun comp-propagate* () "Propagate for set* and phi operands. diff --git a/src/comp.c b/src/comp.c index d95a87b03b1..2f24b10bba0 100644 --- a/src/comp.c +++ b/src/comp.c @@ -1,5 +1,5 @@ /* Compile elisp into native code. - Copyright (C) 2019 Free Software Foundation, Inc. + Copyright (C) 2019-2020 Free Software Foundation, Inc. Author: Andrea Corallo diff --git a/src/comp.h b/src/comp.h index ddebbbcccf0..6019831bc30 100644 --- a/src/comp.h +++ b/src/comp.h @@ -1,5 +1,5 @@ /* Elisp native compiler definitions -Copyright (C) 2012-2019 Free Software Foundation, Inc. +Copyright (C) 2019-2020 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el index cbf287838cb..46d324bc42f 100644 --- a/test/src/comp-test-funcs.el +++ b/test/src/comp-test-funcs.el @@ -1,6 +1,6 @@ ;;; comp-test-funcs.el --- compilation unit tested by comp-tests.el -*- lexical-binding: t; -*- -;; Copyright (C) 2019 Free Software Foundation, Inc. +;; Copyright (C) 2019-2020 Free Software Foundation, Inc. ;; Author: Andrea Corallo diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 15a39c4e883..fc6543bcaec 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -1,6 +1,6 @@ ;;; comp-tests.el --- unit tests for src/comp.c -*- lexical-binding: t; -*- -;; Copyright (C) 2019 Free Software Foundation, Inc. +;; Copyright (C) 2019-2020 Free Software Foundation, Inc. ;; Author: Andrea Corallo -- cgit v1.2.3 From 511415f6f656a5bf4da4f5f49d58de9dc7d5d64d Mon Sep 17 00:00:00 2001 From: AndreaCorallo Date: Tue, 25 Feb 2020 22:37:20 +0000 Subject: Store optimize qualities into .eln files For now just comp-speed and comp-debug are stored. --- src/comp.c | 10 ++++++++++ src/comp.h | 1 + src/print.c | 7 +++++-- 3 files changed, 16 insertions(+), 2 deletions(-) (limited to 'src/comp.h') diff --git a/src/comp.c b/src/comp.c index 9855e352785..0fc6e412924 100644 --- a/src/comp.c +++ b/src/comp.c @@ -47,6 +47,7 @@ along with GNU Emacs. If not, see . */ #define TEXT_DATA_RELOC_SYM "text_data_reloc" #define TEXT_DATA_RELOC_IMPURE_SYM "text_data_reloc_imp" #define TEXT_DATA_RELOC_EPHEMERAL_SYM "text_data_reloc_eph" +#define TEXT_OPTIM_QLY "text_optim_qly" #define SPEED XFIXNUM (Fsymbol_value (Qcomp_speed)) #define COMP_DEBUG XFIXNUM (Fsymbol_value (Qcomp_debug)) @@ -1915,6 +1916,14 @@ declare_runtime_imported_funcs (void) static void emit_ctxt_code (void) { + /* Emit optimize qualities. */ + Lisp_Object opt_qly[] = + { Fcons (Qcomp_speed, + Fsymbol_value (Qcomp_speed)), + Fcons (Qcomp_debug, + Fsymbol_value (Qcomp_debug)) }; + emit_static_object (TEXT_OPTIM_QLY, Flist (2, opt_qly)); + comp.current_thread_ref = gcc_jit_lvalue_as_rvalue ( gcc_jit_context_new_global ( @@ -3414,6 +3423,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump) /* Imported data. */ if (!loading_dump) { + comp_u->optimize_qualities = load_static_obj (comp_u, TEXT_OPTIM_QLY); comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM); comp_u->data_impure_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM); diff --git a/src/comp.h b/src/comp.h index 6019831bc30..3aff440ecb7 100644 --- a/src/comp.h +++ b/src/comp.h @@ -36,6 +36,7 @@ struct Lisp_Native_Comp_Unit union vectorlike_header header; /* Original eln file loaded. */ Lisp_Object file; + Lisp_Object optimize_qualities; /* Analogous to the constant vector but per compilation unit. */ Lisp_Object data_vec; /* Same but for data that cannot be moved to pure space. diff --git a/src/print.c b/src/print.c index ce8dd625b68..9b8308a6758 100644 --- a/src/print.c +++ b/src/print.c @@ -1840,8 +1840,11 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, #ifdef HAVE_NATIVE_COMP case PVEC_NATIVE_COMP_UNIT: { - print_c_string ("#file, printcharfun); + struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (obj); + print_c_string ("#file, printcharfun); + printchar (' ', printcharfun); + print_object (cu->optimize_qualities, printcharfun, escapeflag); printchar ('>', printcharfun); } break; -- 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/comp.h') 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 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/comp.h') 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/comp.h') 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 d73e64076e08cf0bcb81ea9d161fb7409e1bf896 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 25 Apr 2020 16:13:03 +0100 Subject: Store function documentations in a hash table. * src/pdumper.c (dump_subr): Update Lisp_Subr hash. (dump_subr): Update for new compilation unit layout. (dump_vectorlike): Update pvec_type hash. * src/lisp.h (struct Lisp_Subr): Remove 'native_doc' index. (DEFUN): Update macro for new compilation unit layout. * src/doc.c (Fdocumentation): Update for new compilation unit layout. * src/comp.h (struct Lisp_Native_Comp_Unit): Add 'data_fdoc_h' field. * src/comp.c (TEXT_FDOC_SYM): New macro. (emit_ctxt_code): Emit function documentations. (load_comp_unit): Load function documentation. (Fcomp__register_subr): Rename parameter. (Fcomp__register_subr): Update for new compilation unit layout. * src/alloc.c (mark_object): Update for new compilation unit layout. (syms_of_alloc): Likewise. * lisp/emacs-lisp/comp.el (comp-ctxt): Add doc-index-h slot. (comp-emit-for-top-level): Emit doc index as 'comp--register-subr' doc parameter. --- lisp/emacs-lisp/comp.el | 9 ++++++++- src/alloc.c | 5 ++--- src/comp.c | 12 ++++++++++-- src/comp.h | 2 ++ src/doc.c | 5 ++++- src/lisp.h | 7 ++----- src/pdumper.c | 7 +++---- 7 files changed, 31 insertions(+), 16 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index e96de273359..5096a143a0f 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -216,6 +216,8 @@ Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'. See `comp-ctxt'.") (sym-to-c-name-h (make-hash-table :test #'eq) :type hash-table :documentation "symbol-function -> c-name. This is only for optimizing intra CU calls at speed 3.") + (doc-index-h (make-hash-table :test #'eql) :type hash-table + :documentation "Documentation index -> documentation") (d-default (make-comp-data-container) :type comp-data-container :documentation "Standard data relocated in use by functions.") (d-impure (make-comp-data-container) :type comp-data-container @@ -1214,7 +1216,12 @@ the annotation emission." (comp-args-max args) 'many)) (make-comp-mvar :constant c-name) - (make-comp-mvar :constant (comp-func-doc f)) + (make-comp-mvar + :constant + (let* ((h (comp-ctxt-doc-index-h comp-ctxt)) + (i (hash-table-count h))) + (puthash i (comp-func-doc f) h) + i)) (make-comp-mvar :constant (comp-func-int-spec f)) ;; This is the compilation unit it-self passed as diff --git a/src/alloc.c b/src/alloc.c index 147e018095b..f2b80fac882 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6638,7 +6638,6 @@ mark_object (Lisp_Object arg) set_vector_marked (ptr); struct Lisp_Subr *subr = XSUBR (obj); mark_object (subr->native_intspec); - mark_object (subr->native_doc); mark_object (subr->native_comp_u[0]); } break; @@ -7529,14 +7528,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}}}; + 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}}}; + 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 4bd271402c2..2f59164b770 100644 --- a/src/comp.c +++ b/src/comp.c @@ -41,13 +41,17 @@ along with GNU Emacs. If not, see . */ #define DATA_RELOC_SYM "d_reloc" #define DATA_RELOC_IMPURE_SYM "d_reloc_imp" #define DATA_RELOC_EPHEMERAL_SYM "d_reloc_eph" + #define FUNC_LINK_TABLE_SYM "freloc_link_table" #define LINK_TABLE_HASH_SYM "freloc_hash" #define COMP_UNIT_SYM "comp_unit" #define TEXT_DATA_RELOC_SYM "text_data_reloc" #define TEXT_DATA_RELOC_IMPURE_SYM "text_data_reloc_imp" #define TEXT_DATA_RELOC_EPHEMERAL_SYM "text_data_reloc_eph" + #define TEXT_OPTIM_QLY "text_optim_qly" +#define TEXT_FDOC_SYM "text_data_fdoc" + #define SPEED XFIXNUM (Fsymbol_value (Qcomp_speed)) #define COMP_DEBUG XFIXNUM (Fsymbol_value (Qcomp_debug)) @@ -2097,6 +2101,9 @@ emit_ctxt_code (void) Fsymbol_value (Qcomp_debug)) }; emit_static_object (TEXT_OPTIM_QLY, Flist (2, opt_qly)); + emit_static_object (TEXT_FDOC_SYM, + CALL1I (comp-ctxt-doc-index-h, Vcomp_ctxt)); + comp.current_thread_ref = gcc_jit_lvalue_as_rvalue ( gcc_jit_context_new_global ( @@ -3619,6 +3626,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM); comp_u->data_impure_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM); + comp_u->data_fdoc_h = load_static_obj (comp_u, TEXT_FDOC_SYM); if (!NILP (Vpurify_flag)) /* Non impure can be copied into pure space. */ @@ -3668,7 +3676,7 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, doc: /* This gets called by top_level_run during load phase to register each exported subr. */) (Lisp_Object name, Lisp_Object minarg, Lisp_Object maxarg, - Lisp_Object c_name, Lisp_Object doc, Lisp_Object intspec, + Lisp_Object c_name, Lisp_Object doc_idx, Lisp_Object intspec, Lisp_Object comp_u) { dynlib_handle_ptr handle = XNATIVE_COMP_UNIT (comp_u)->handle; @@ -3688,7 +3696,7 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; x->s.symbol_name = xstrdup (SSDATA (Fsymbol_name (name))); x->s.native_intspec = intspec; - x->s.native_doc = doc; + x->s.doc = XFIXNUM (doc_idx); x->s.native_comp_u[0] = comp_u; Lisp_Object tem; XSETSUBR (tem, &x->s); diff --git a/src/comp.h b/src/comp.h index f5baa88853e..6710227b44d 100644 --- a/src/comp.h +++ b/src/comp.h @@ -37,6 +37,8 @@ struct Lisp_Native_Comp_Unit /* Original eln file loaded. */ Lisp_Object file; Lisp_Object optimize_qualities; + /* Hash doc-idx -> function documentaiton. */ + Lisp_Object data_fdoc_h; /* Analogous to the constant vector but per compilation unit. */ Lisp_Object data_vec; /* Same but for data that cannot be moved to pure space. diff --git a/src/doc.c b/src/doc.c index 1b6aa01ef04..8191a914c6e 100644 --- a/src/doc.c +++ b/src/doc.c @@ -337,7 +337,10 @@ string is passed through `substitute-command-keys'. */) fun = XCDR (fun); #ifdef HAVE_NATIVE_COMP if (!NILP (Fsubr_native_elisp_p (fun))) - doc = XSUBR (fun)->native_doc; + doc = + Fgethash (make_fixnum (XSUBR (fun)->doc), + XNATIVE_COMP_UNIT (Fsubr_native_comp_unit (fun))->data_fdoc_h, + Qnil); else #endif if (SUBRP (fun)) diff --git a/src/lisp.h b/src/lisp.h index 1cec62a853c..3d082911f54 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2098,10 +2098,7 @@ struct Lisp_Subr const char *intspec; Lisp_Object native_intspec; }; - union { - EMACS_INT doc; - Lisp_Object native_doc; - }; + EMACS_INT doc; Lisp_Object native_comp_u[NATIVE_COMP_FLAG]; } GCALIGNED_STRUCT; union Aligned_Lisp_Subr @@ -3077,7 +3074,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}}}; \ + minargs, maxargs, lname, {intspec}, 0}}; \ Lisp_Object fnname /* defsubr (Sname); diff --git a/src/pdumper.c b/src/pdumper.c index bf6bc3a3bc3..702b3ffced9 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2938,7 +2938,7 @@ static dump_off dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) { #if CHECK_STRUCTS && ((defined (HAVE_NATIVE_COMP) \ - && !defined (HASH_Lisp_Subr_D4F15794AF)) \ + && !defined (HASH_Lisp_Subr_99B6674034)) \ || (!defined (HAVE_NATIVE_COMP) \ && !defined (HASH_Lisp_Subr_594AB72B54))) # error "Lisp_Subr changed. See CHECK_STRUCTS comment in config.h." @@ -2959,14 +2959,13 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) COLD_OP_NATIVE_SUBR, make_lisp_ptr ((void *) subr, Lisp_Vectorlike)); dump_field_lv (ctx, &out, subr, &subr->native_intspec, WEIGHT_NORMAL); - dump_field_lv (ctx, &out, subr, &subr->native_doc, 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); } + DUMP_FIELD_COPY (&out, subr, doc); if (NATIVE_COMP_FLAG) dump_field_lv (ctx, &out, subr, &subr->native_comp_u[0], WEIGHT_NORMAL); @@ -3023,7 +3022,7 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_pvec_type_A4A6E9984D +#if CHECK_STRUCTS && !defined HASH_pvec_type_F5BA506141 # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Vector *v = XVECTOR (lv); -- cgit v1.2.3 From f691af80f1c2073e610a382029790f7c6f97dd5d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 25 Apr 2020 18:10:06 +0100 Subject: * src/comp.h (load_comp_unit): Fix declaration style. --- src/comp.h | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'src/comp.h') diff --git a/src/comp.h b/src/comp.h index 6710227b44d..c0598468117 100644 --- a/src/comp.h +++ b/src/comp.h @@ -66,8 +66,9 @@ XNATIVE_COMP_UNIT (Lisp_Object a) extern void hash_native_abi (void); -void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, - bool late_load); +extern 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, -- cgit v1.2.3 From a7fac2e91fb424fcf47ea8a23c218c272dd83434 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 25 Apr 2020 18:16:17 +0100 Subject: Lazy load function documentation. * src/comp.c (native_function_doc): New function. (load_comp_unit): Do not load function doc during load. * src/comp.h: Extern 'native_function_doc'. * src/doc.c (Fdocumentation): Call 'native_function_doc' to retrive function doc. * src/pdumper.c (dump_native_comp_unit): Zero 'data_fdoc_h' before dumping. --- src/comp.c | 17 ++++++++++++++++- src/comp.h | 2 ++ src/doc.c | 5 +---- src/pdumper.c | 4 +++- 4 files changed, 22 insertions(+), 6 deletions(-) (limited to 'src/comp.h') diff --git a/src/comp.c b/src/comp.c index 70b0a25a9c0..b33ef92f72b 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3627,7 +3627,6 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM); comp_u->data_impure_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM); - comp_u->data_fdoc_h = load_static_obj (comp_u, TEXT_FDOC_SYM); if (!NILP (Vpurify_flag)) /* Non impure can be copied into pure space. */ @@ -3672,6 +3671,22 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, return; } +Lisp_Object +native_function_doc (Lisp_Object function) +{ + struct Lisp_Native_Comp_Unit *cu = + XNATIVE_COMP_UNIT (Fsubr_native_comp_unit (function)); + + if (NILP (cu->data_fdoc_h)) + cu->data_fdoc_h = load_static_obj (cu, TEXT_FDOC_SYM); + + eassert (!NILP (cu->data_fdoc_h)); + + return Fgethash (make_fixnum (XSUBR (function)->doc), + cu->data_fdoc_h, + Qnil); +} + DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, 7, 7, 0, doc: /* This gets called by top_level_run during load phase to register diff --git a/src/comp.h b/src/comp.h index c0598468117..5beedcfc280 100644 --- a/src/comp.h +++ b/src/comp.h @@ -69,6 +69,8 @@ extern void hash_native_abi (void); extern void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, bool late_load); +extern Lisp_Object native_function_doc (Lisp_Object function); + extern void syms_of_comp (void); extern void maybe_defer_native_compilation (Lisp_Object function_name, diff --git a/src/doc.c b/src/doc.c index 8191a914c6e..31ccee8079b 100644 --- a/src/doc.c +++ b/src/doc.c @@ -337,10 +337,7 @@ string is passed through `substitute-command-keys'. */) fun = XCDR (fun); #ifdef HAVE_NATIVE_COMP if (!NILP (Fsubr_native_elisp_p (fun))) - doc = - Fgethash (make_fixnum (XSUBR (fun)->doc), - XNATIVE_COMP_UNIT (Fsubr_native_comp_unit (fun))->data_fdoc_h, - Qnil); + doc = native_function_doc (fun); else #endif if (SUBRP (fun)) diff --git a/src/pdumper.c b/src/pdumper.c index 702b3ffced9..39adaf3ea21 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2982,8 +2982,10 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) #ifdef HAVE_NATIVE_COMP static dump_off dump_native_comp_unit (struct dump_context *ctx, - const struct Lisp_Native_Comp_Unit *comp_u) + struct Lisp_Native_Comp_Unit *comp_u) { + /* Have function documentation always lazy loaded to optimize load-time. */ + comp_u->data_fdoc_h = Qnil; START_DUMP_PVEC (ctx, &comp_u->header, struct Lisp_Native_Comp_Unit, out); dump_pseudovector_lisp_fields (ctx, &out->header, &comp_u->header); out->handle = NULL; -- cgit v1.2.3 From 9f5b7eb5e05948ccdd7fa2a473e5a55889f5e4ee Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 25 Apr 2020 20:22:17 +0100 Subject: * src/comp.h (Fnative_elisp_load): Add fake inline for stock build. --- src/comp.h | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'src/comp.h') diff --git a/src/comp.h b/src/comp.h index 5beedcfc280..73baa27276e 100644 --- a/src/comp.h +++ b/src/comp.h @@ -82,6 +82,12 @@ maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object definition) {} +static inline Lisp_Object +Fnative_elisp_load (Lisp_Object file, Lisp_Object late_load) +{ + eassume (false); +} + #endif #endif -- cgit v1.2.3 From bb4cf13c47a1a24ce83233cc7b77dc87fc274d52 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 26 Apr 2020 09:11:33 +0100 Subject: Convert before final function doc hash into a vector. * lisp/emacs-lisp/comp.el (comp-finalize-relocs): Convert doc hash table into vector befor final. (comp-emit-for-top-level): Rename `comp-ctxt-doc-index-h' -> `comp-ctxt-function-docs'. (comp-ctxt): Likewise. * src/comp.c (native_function_doc): Update logic for documentation being a vector. (emit_ctxt_code): Update for 'comp-ctxt-doc-index-h' slot rename. * src/comp.h (struct Lisp_Native_Comp_Unit): Rename 'data_fdoc_h' into data_fdoc_v. * src/pdumper.c (dump_native_comp_unit): Likewise. --- lisp/emacs-lisp/comp.el | 14 +++++++++++--- src/comp.c | 16 +++++++--------- src/comp.h | 2 +- src/pdumper.c | 2 +- 4 files changed, 20 insertions(+), 14 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 5096a143a0f..f8e30f0047a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -216,7 +216,7 @@ Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'. See `comp-ctxt'.") (sym-to-c-name-h (make-hash-table :test #'eq) :type hash-table :documentation "symbol-function -> c-name. This is only for optimizing intra CU calls at speed 3.") - (doc-index-h (make-hash-table :test #'eql) :type hash-table + (function-docs (make-hash-table :test #'eql) :type (or hash-table vector) :documentation "Documentation index -> documentation") (d-default (make-comp-data-container) :type comp-data-container :documentation "Standard data relocated in use by functions.") @@ -1218,7 +1218,7 @@ the annotation emission." (make-comp-mvar :constant c-name) (make-comp-mvar :constant - (let* ((h (comp-ctxt-doc-index-h comp-ctxt)) + (let* ((h (comp-ctxt-function-docs comp-ctxt)) (i (hash-table-count h))) (puthash i (comp-func-doc f) h) i)) @@ -2103,7 +2103,15 @@ Update all insn accordingly." do (remhash obj d-ephemeral-idx)) ;; Fix-up indexes in each relocation class and fill corresponding ;; reloc lists. - (mapc #'comp-finalize-container (list d-default d-impure d-ephemeral)))) + (mapc #'comp-finalize-container (list d-default d-impure d-ephemeral)) + ;; Make a vector from the function documentation hash table. + (cl-loop with h = (comp-ctxt-function-docs comp-ctxt) + with v = (make-vector (hash-table-count h) nil) + for idx being each hash-keys of h + for doc = (gethash idx h) + do (setf (aref v idx) doc) + finally + do (setf (comp-ctxt-function-docs comp-ctxt) v)))) (defun comp-compile-ctxt-to-file (name) "Compile as native code the current context naming it NAME. diff --git a/src/comp.c b/src/comp.c index b33ef92f72b..d021be479b0 100644 --- a/src/comp.c +++ b/src/comp.c @@ -2102,7 +2102,7 @@ emit_ctxt_code (void) emit_static_object (TEXT_OPTIM_QLY_SYM, Flist (2, opt_qly)); emit_static_object (TEXT_FDOC_SYM, - CALL1I (comp-ctxt-doc-index-h, Vcomp_ctxt)); + CALL1I (comp-ctxt-function-docs, Vcomp_ctxt)); comp.current_thread_ref = gcc_jit_lvalue_as_rvalue ( @@ -3677,14 +3677,12 @@ native_function_doc (Lisp_Object function) struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (Fsubr_native_comp_unit (function)); - if (NILP (cu->data_fdoc_h)) - cu->data_fdoc_h = load_static_obj (cu, TEXT_FDOC_SYM); - - eassert (!NILP (cu->data_fdoc_h)); - - return Fgethash (make_fixnum (XSUBR (function)->doc), - cu->data_fdoc_h, - Qnil); + if (NILP (cu->data_fdoc_v)) + cu->data_fdoc_v = load_static_obj (cu, TEXT_FDOC_SYM); + if (!VECTORP (cu->data_fdoc_v)) + xsignal2 (Qnative_lisp_file_inconsistent, cu->file, + build_string ("missing documentation vector")); + return AREF (cu->data_fdoc_v, XSUBR (function)->doc); } DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, diff --git a/src/comp.h b/src/comp.h index 73baa27276e..cbdcaccd5fe 100644 --- a/src/comp.h +++ b/src/comp.h @@ -38,7 +38,7 @@ struct Lisp_Native_Comp_Unit Lisp_Object file; Lisp_Object optimize_qualities; /* Hash doc-idx -> function documentaiton. */ - Lisp_Object data_fdoc_h; + Lisp_Object data_fdoc_v; /* Analogous to the constant vector but per compilation unit. */ Lisp_Object data_vec; /* Same but for data that cannot be moved to pure space. diff --git a/src/pdumper.c b/src/pdumper.c index c9015d503cd..f837dfc38d2 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2982,7 +2982,7 @@ dump_native_comp_unit (struct dump_context *ctx, struct Lisp_Native_Comp_Unit *comp_u) { /* Have function documentation always lazy loaded to optimize load-time. */ - comp_u->data_fdoc_h = Qnil; + comp_u->data_fdoc_v = Qnil; START_DUMP_PVEC (ctx, &comp_u->header, struct Lisp_Native_Comp_Unit, out); dump_pseudovector_lisp_fields (ctx, &out->header, &comp_u->header); out->handle = NULL; -- cgit v1.2.3 From 44b0ce6e38f06df10b60ffdd9d9ade4b7e229088 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 2 May 2020 17:29:11 +0100 Subject: Add anonymous lambdas reload mechanism * src/pdumper.c (dump_do_dump_relocation): Initialize 'lambda_gc_guard' while resurrecting. (dump_do_dump_relocation): Revive lambdas and fixup them. * src/comp.h (struct Lisp_Native_Comp_Unit): Define new 'lambda_gc_guard' 'lambda_c_name_idx_h' 'data_imp_relocs' 'loaded_once' fields. * src/comp.c (load_comp_unit): Use compilaiton unit 'loaded_once' field. (make_subr, Fcomp__register_lambda): New functions. (Fcomp__register_subr): Make use of 'make_subr'. (Fnative_elisp_load): Indent. (Fnative_elisp_load): Initialize 'lambda_gc_guard' 'lambda_c_name_idx_h' fields. (syms_of_comp): Add Scomp__register_lambda. * lisp/emacs-lisp/comp.el (comp-ctxt): Change 'byte-func-to-func-h' hash key test. (comp-ctxt): Add 'lambda-fixups-h' slot. (comp-emit-lambda-for-top-level): New function. (comp-finalize-relocs): Never emit lambdas in pure space. (comp-finalize-relocs): Fixup relocation indexes. --- lisp/emacs-lisp/comp.el | 55 +++++++++++++++++++++++++++++-- src/comp.c | 88 ++++++++++++++++++++++++++++++++++++++----------- src/comp.h | 14 ++++++-- src/pdumper.c | 18 +++++++++- 4 files changed, 150 insertions(+), 25 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 3bcfdc9420b..94ffc2d1778 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -230,9 +230,11 @@ Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'. See `comp-ctxt'.") (sym-to-c-name-h (make-hash-table :test #'eq) :type hash-table :documentation "symbol-function -> c-name. This is only for optimizing intra CU calls at speed 3.") - (byte-func-to-func-h (make-hash-table :test #'eq) :type hash-table + (byte-func-to-func-h (make-hash-table :test #'equal) :type hash-table :documentation "byte-function -> comp-func. Needed to replace immediate byte-compiled lambdas with the compiled reference.") + (lambda-fixups-h (make-hash-table :test #'equal) :type hash-table + :documentation "Hash table byte-func -> mvar to fixup.") (function-docs (make-hash-table :test #'eql) :type (or hash-table vector) :documentation "Documentation index -> documentation") (d-default (make-comp-data-container) :type comp-data-container @@ -1276,6 +1278,36 @@ the annotation emission." (make-comp-mvar :constant form)) (make-comp-mvar :constant t)))))) +(defun comp-emit-lambda-for-top-level (func) + "Emit the creation of subrs for lambda FUNC. +These are stored in the reloc data array." + (let ((args (comp-func-args func))) + (let ((comp-curr-allocation-class 'd-impure)) + (comp-add-const-to-relocs (comp-func-byte-func func))) + (comp-emit + (comp-call 'comp--register-lambda + ;; mvar to be fixed-up when containers are + ;; finalized. + (or (gethash (comp-func-byte-func func) + (comp-ctxt-lambda-fixups-h comp-ctxt)) + (puthash (comp-func-byte-func func) + (make-comp-mvar :constant nil) + (comp-ctxt-lambda-fixups-h comp-ctxt))) + (make-comp-mvar :constant (comp-args-base-min args)) + (make-comp-mvar :constant (if (comp-args-p args) + (comp-args-max args) + 'many)) + (make-comp-mvar :constant (comp-func-c-name func)) + (make-comp-mvar + :constant (let* ((h (comp-ctxt-function-docs comp-ctxt)) + (i (hash-table-count h))) + (puthash i (comp-func-doc func) h) + i)) + (make-comp-mvar :constant (comp-func-int-spec func)) + ;; This is the compilation unit it-self passed as + ;; parameter. + (make-comp-mvar :slot 0))))) + (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 @@ -2143,6 +2175,12 @@ Update all insn accordingly." (d-impure-idx (comp-data-container-idx d-impure)) (d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt)) (d-ephemeral-idx (comp-data-container-idx d-ephemeral))) + ;; We never want compiled lambdas ending up in pure space. A copy must + ;; be already present in impure (see `comp-emit-lambda-for-top-level'). + (cl-loop for obj being each hash-keys of d-default-idx + when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt)) + do (cl-assert (gethash obj d-impure-idx)) + (remhash obj d-default-idx)) ;; Remove entries in d-impure already present in d-default. (cl-loop for obj being each hash-keys of d-impure-idx when (gethash obj d-default-idx) @@ -2162,7 +2200,20 @@ Update all insn accordingly." for doc = (gethash idx h) do (setf (aref v idx) doc) finally - do (setf (comp-ctxt-function-docs comp-ctxt) v)))) + do (setf (comp-ctxt-function-docs comp-ctxt) v)) + ;; And now we conclude with the following: We need to pass to + ;; `comp--register-lambda' the index in the impure relocation + ;; array to store revived lambdas, but given we know it only now + ;; we fix it up as last. + (cl-loop for f being each hash-keys of (comp-ctxt-lambda-fixups-h comp-ctxt) + using (hash-value mvar) + with reverse-h = (make-hash-table) ;; Make sure idx is unique. + for idx = (gethash f d-impure-idx) + do + (cl-assert (null (gethash idx reverse-h))) + (cl-assert (fixnump idx)) + (setf (comp-mvar-constant mvar) idx) + (puthash idx t reverse-h)))) (defun comp-compile-ctxt-to-file (name) "Compile as native code the current context naming it NAME. diff --git a/src/comp.c b/src/comp.c index 947da9a8e27..5ace2d28052 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3583,15 +3583,15 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, Lisp_Object *saved_cu = dynlib_sym (handle, COMP_UNIT_SYM); if (!saved_cu) xsignal1 (Qnative_lisp_file_inconsistent, comp_u->file); - bool reloading_cu = !NILP (*saved_cu); + comp_u->loaded_once = !NILP (*saved_cu); Lisp_Object *data_eph_relocs = dynlib_sym (handle, DATA_RELOC_EPHEMERAL_SYM); /* While resurrecting from an image dump loading more than once the same compilation unit does not make any sense. */ - eassert (!(loading_dump && reloading_cu)); + eassert (!(loading_dump && comp_u->loaded_once)); - if (reloading_cu) + if (comp_u->loaded_once) /* 'dlopen' returns the same handle when trying to load two times the same shared. In this case touching 'd_reloc' etc leads to fails in case a frame with a reference to it in a live reg is @@ -3612,13 +3612,17 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, = dynlib_sym (handle, late_load ? "late_top_level_run" : "top_level_run"); - if (!reloading_cu) + /* Always set data_imp_relocs pointer in the compilation unit (in can be + used in 'dump_do_dump_relocation'). */ + comp_u->data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM); + + if (!comp_u->loaded_once) { struct thread_state ***current_thread_reloc = dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); EMACS_INT ***pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM); Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); - Lisp_Object *data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM); + Lisp_Object *data_imp_relocs = comp_u->data_imp_relocs; void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM); if (!(current_thread_reloc @@ -3704,15 +3708,13 @@ native_function_doc (Lisp_Object function) return AREF (cu->data_fdoc_v, XSUBR (function)->doc); } -DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, - 7, 7, 0, - doc: /* This gets called by top_level_run during load phase to register - each exported subr. */) - (Lisp_Object name, Lisp_Object minarg, Lisp_Object maxarg, - Lisp_Object c_name, Lisp_Object doc_idx, Lisp_Object intspec, - Lisp_Object comp_u) +static Lisp_Object +make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg, + Lisp_Object c_name, Lisp_Object doc_idx, Lisp_Object intspec, + Lisp_Object comp_u) { - dynlib_handle_ptr handle = XNATIVE_COMP_UNIT (comp_u)->handle; + struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u); + dynlib_handle_ptr handle = cu->handle; if (!handle) xsignal0 (Qwrong_register_subr_call); @@ -3727,18 +3729,63 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, x->s.function.a0 = func; x->s.min_args = XFIXNUM (minarg); x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; - x->s.symbol_name = xstrdup (SSDATA (Fsymbol_name (name))); + x->s.symbol_name = xstrdup (SSDATA (symbol_name)); x->s.native_intspec = intspec; x->s.doc = XFIXNUM (doc_idx); x->s.native_comp_u[0] = comp_u; Lisp_Object tem; XSETSUBR (tem, &x->s); - set_symbol_function (name, tem); - Fputhash (name, c_name, Vcomp_sym_subr_c_name_h); + return tem; +} + +DEFUN ("comp--register-lambda", Fcomp__register_lambda, Scomp__register_lambda, + 7, 7, 0, + doc: /* This gets called by top_level_run during load phase to register + anonymous lambdas. */) + (Lisp_Object reloc_idx, Lisp_Object minarg, Lisp_Object maxarg, + Lisp_Object c_name, Lisp_Object doc_idx, Lisp_Object intspec, + Lisp_Object comp_u) +{ + struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (comp_u); + if (cu->loaded_once) + return Qnil; + + Lisp_Object tem = + make_subr (c_name, minarg, maxarg, c_name, doc_idx, intspec, comp_u); + + /* We must protect it against GC because the function is not + reachable through symbols. */ + Fputhash (tem, Qt, cu->lambda_gc_guard); + /* This is for fixing up the value in d_reloc while resurrecting + from dump. See 'dump_do_dump_relocation'. */ + Fputhash (c_name, reloc_idx, cu->lambda_c_name_idx_h); + /* The key is not really important as long is the same as + symbol_name so use c_name. */ + Fputhash (Fintern (c_name, Qnil), c_name, Vcomp_sym_subr_c_name_h); + /* Do the real relocation fixup. */ + cu->data_imp_relocs[XFIXNUM (reloc_idx)] = tem; + + return tem; +} + +DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, + 7, 7, 0, + doc: /* This gets called by top_level_run during load phase to register + each exported subr. */) + (Lisp_Object name, Lisp_Object minarg, Lisp_Object maxarg, + Lisp_Object c_name, Lisp_Object doc_idx, Lisp_Object intspec, + Lisp_Object comp_u) +{ + Lisp_Object tem = + make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, doc_idx, intspec, + comp_u); + + set_symbol_function (name, tem); LOADHIST_ATTACH (Fcons (Qdefun, name)); + Fputhash (name, c_name, Vcomp_sym_subr_c_name_h); - return Qnil; + return tem; } DEFUN ("comp--late-register-subr", Fcomp__late_register_subr, @@ -3759,8 +3806,8 @@ DEFUN ("comp--late-register-subr", Fcomp__late_register_subr, /* Load related routines. */ 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. */) + LATE_LOAD has to be non nil when loading for deferred + compilation. */) (Lisp_Object file, Lisp_Object late_load) { CHECK_STRING (file); @@ -3773,6 +3820,8 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ())); comp_u->file = file; comp_u->data_vec = Qnil; + comp_u->lambda_gc_guard = CALLN (Fmake_hash_table, QCtest, Qeq); + comp_u->lambda_c_name_idx_h = CALLN (Fmake_hash_table, QCtest, Qequal); load_comp_unit (comp_u, false, !NILP (late_load)); return Qt; @@ -3886,6 +3935,7 @@ syms_of_comp (void) defsubr (&Scomp__init_ctxt); defsubr (&Scomp__release_ctxt); defsubr (&Scomp__compile_ctxt_to_file); + defsubr (&Scomp__register_lambda); defsubr (&Scomp__register_subr); defsubr (&Scomp__late_register_subr); defsubr (&Snative_elisp_load); diff --git a/src/comp.h b/src/comp.h index cbdcaccd5fe..b03a8055142 100644 --- a/src/comp.h +++ b/src/comp.h @@ -37,13 +37,21 @@ struct Lisp_Native_Comp_Unit /* Original eln file loaded. */ Lisp_Object file; Lisp_Object optimize_qualities; - /* Hash doc-idx -> function documentaiton. */ + /* Guard anonymous lambdas against Garbage Collection and make them + dumpable. */ + Lisp_Object lambda_gc_guard; + /* Hash c_name -> d_reloc_imp index. */ + Lisp_Object lambda_c_name_idx_h; + /* Hash doc-idx -> function documentaiton. */ Lisp_Object data_fdoc_v; /* Analogous to the constant vector but per compilation unit. */ Lisp_Object data_vec; - /* Same but for data that cannot be moved to pure space. - Must be the last lisp object here. */ + /* 'data_impure_vec' must be last (see allocate_native_comp_unit). + Same as data_vec but for data that cannot be moved to pure space. */ Lisp_Object data_impure_vec; + /* STUFFS WE DO NOT DUMP!! */ + Lisp_Object *data_imp_relocs; + bool loaded_once; dynlib_handle_ptr handle; }; diff --git a/src/pdumper.c b/src/pdumper.c index f837dfc38d2..a1b71e87ac6 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5297,7 +5297,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, static enum { UNKNOWN, LOCAL_BUILD, INSTALLED } installation_state; struct Lisp_Native_Comp_Unit *comp_u = dump_ptr (dump_base, reloc_offset); - + comp_u->lambda_gc_guard = CALLN (Fmake_hash_table, QCtest, Qeq); if (!CONSP (comp_u->file)) error ("Trying to load incoherent dumped .eln"); @@ -5320,6 +5320,10 @@ dump_do_dump_relocation (const uintptr_t dump_base, } case RELOC_NATIVE_SUBR: { + /* 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 + here. */ struct Lisp_Subr *subr = dump_ptr (dump_base, reloc_offset); Lisp_Object name = intern (subr->symbol_name); struct Lisp_Native_Comp_Unit *comp_u = @@ -5333,6 +5337,18 @@ dump_do_dump_relocation (const uintptr_t dump_base, if (!func) error ("can't find function in compilation unit"); subr->function.a0 = func; + Lisp_Object lambda_data_idx = + Fgethash (c_name, comp_u->lambda_c_name_idx_h, Qnil); + if (!NILP (lambda_data_idx)) + { + /* This is an anonymous lambda. + We must fixup data_vec so the lambda can be referenced + by code. */ + Lisp_Object tem; + XSETSUBR (tem, subr); + comp_u->data_imp_relocs[XFIXNUM (lambda_data_idx)] = tem; + Fputhash (tem, Qnil, comp_u->lambda_gc_guard); + } break; } #endif -- cgit v1.2.3 From 483cdf7a7942c91f6691953c9fe4618194dd175b Mon Sep 17 00:00:00 2001 From: Nicolás Bértolo Date: Mon, 11 May 2020 20:43:06 -0300 Subject: Load libgccjit dynamically in Windows. * configure.ac: don't add linker flags if compiling on Windows. Compile dynlib.c if modules or native compilation are enabled. Always compile comp.c * lisp/term/w32-win.el: Map 'gccjit to "libgccjit.dll" in `dynamic-library-alist`. * src/Makefile.in: Update comments. Update to handle changes in configure.ac. * src/comp.c: Add declarations of used libgccjit functions using DEF_DLL_FN. Add calls to load_gccjit_if_necessary() where necessary. Add `native-comp-available-p` * src/comp.h: Remove Fnative_elisp_load. Add syms_of_comp(). * src/emacs.c (main): Always call syms_of_comp() * src/w32.c (globals_of_w32): Clear Vlibrary_cache when starting because the libraries loaded when dumping will not be loaded when starting. * src/w32fns.c: Add Qgccjit symbol. --- configure.ac | 19 ++- lisp/term/w32-win.el | 3 +- src/Makefile.in | 9 +- src/comp.c | 374 ++++++++++++++++++++++++++++++++++++++++++++++++++- src/comp.h | 6 +- src/emacs.c | 2 - src/w32.c | 4 + src/w32fns.c | 1 + 8 files changed, 398 insertions(+), 20 deletions(-) (limited to 'src/comp.h') diff --git a/configure.ac b/configure.ac index 23b94cf6ca1..ea0144f4048 100644 --- a/configure.ac +++ b/configure.ac @@ -3666,6 +3666,7 @@ AC_SUBST(LIBZ) LIBMODULES= HAVE_MODULES=no MODULES_OBJ= +NEED_DYNLIB=no case $opsys in cygwin|mingw32) MODULES_SUFFIX=".dll" ;; darwin) MODULES_SUFFIX=".dylib" ;; @@ -3701,7 +3702,8 @@ if test "${with_modules}" != "no"; then fi if test "${HAVE_MODULES}" = yes; then - MODULES_OBJ="dynlib.o emacs-module.o" + MODULES_OBJ="emacs-module.o" + NEED_DYNLIB=yes AC_DEFINE(HAVE_MODULES, 1, [Define to 1 if dynamic modules are enabled]) AC_DEFINE_UNQUOTED(MODULES_SUFFIX, "$MODULES_SUFFIX", [System extension for dynamic libraries]) @@ -3785,7 +3787,6 @@ Here instructions on how to compile and install libgccjit from source: HAVE_NATIVE_COMP=no LIBGCCJIT_LIB= -COMP_OBJ= if test "${with_nativecomp}" != "no"; then emacs_save_LIBS=$LIBS LIBS="-lgccjit" @@ -3793,8 +3794,11 @@ if test "${with_nativecomp}" != "no"; then [AC_LINK_IFELSE([libgccjit_smoke_test], [], [libgccjit_not_found])]) LIBS=$emacs_save_LIBS HAVE_NATIVE_COMP=yes - LIBGCCJIT_LIB="-lgccjit -ldl" - COMP_OBJ="comp.o" + # mingw32 loads the library dynamically. + if test "${opsys}" != "mingw32"; then + LIBGCCJIT_LIB="-lgccjit -ldl" + fi + 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 @@ -3804,7 +3808,12 @@ 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) + +DYNLIB_OBJ= +if test "${NEED_DYNLIB}" = yes; then + DYNLIB_OBJ="dynlib.o" +fi +AC_SUBST(DYNLIB_OBJ) ### Use -lpng if available, unless '--with-png=no'. HAVE_PNG=no diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 5901e0295e1..6b9716ca307 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -289,7 +289,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") '(libxml2 "libxml2-2.dll" "libxml2.dll") '(zlib "zlib1.dll" "libz-1.dll") '(lcms2 "liblcms2-2.dll") - '(json "libjansson-4.dll"))) + '(json "libjansson-4.dll") + '(gccjit "libgccjit.dll"))) ;;; multi-tty support (defvar w32-initialized nil diff --git a/src/Makefile.in b/src/Makefile.in index 63f909ae147..85709184da1 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -241,7 +241,7 @@ LIBZ = @LIBZ@ ## system-specific libs for dynamic modules, else empty LIBMODULES = @LIBMODULES@ -## dynlib.o emacs-module.o if modules enabled, else empty +## emacs-module.o if modules enabled, else empty MODULES_OBJ = @MODULES_OBJ@ XRANDR_LIBS = @XRANDR_LIBS@ @@ -327,8 +327,9 @@ GMP_LIB = @GMP_LIB@ GMP_OBJ = @GMP_OBJ@ LIBGCCJIT = @LIBGCCJIT_LIB@ -## dynlib.o comp.o if native compiler is enabled, otherwise empty. -COMP_OBJ = @COMP_OBJ@ + +## dynlib.o if necessary, else empty +DYNLIB_OBJ = @DYNLIB_OBJ@ RUN_TEMACS = ./temacs @@ -418,7 +419,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \ alloc.o pdumper.o data.o doc.o editfns.o callint.o \ eval.o floatfns.o fns.o font.o print.o lread.o $(MODULES_OBJ) \ - syntax.o $(UNEXEC_OBJ) bytecode.o $(COMP_OBJ) \ + syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \ process.o gnutls.o callproc.o \ region-cache.o sound.o timefns.o atimer.o \ doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \ diff --git a/src/comp.c b/src/comp.c index 994bd7db934..d72fa927460 100644 --- a/src/comp.c +++ b/src/comp.c @@ -20,6 +20,8 @@ along with GNU Emacs. If not, see . */ #include +#include "lisp.h" + #ifdef HAVE_NATIVE_COMP #include @@ -28,7 +30,6 @@ along with GNU Emacs. If not, see . */ #include #include -#include "lisp.h" #include "puresize.h" #include "window.h" #include "dynlib.h" @@ -36,6 +37,347 @@ along with GNU Emacs. If not, see . */ #include "blockinput.h" #include "sha512.h" + +/********************************/ +/* Dynamic loading of libgccjit */ +/********************************/ + +#ifdef WINDOWSNT +# include "w32common.h" + +#undef gcc_jit_block_add_assignment +#undef gcc_jit_block_add_comment +#undef gcc_jit_block_add_eval +#undef gcc_jit_block_end_with_conditional +#undef gcc_jit_block_end_with_jump +#undef gcc_jit_block_end_with_return +#undef gcc_jit_block_end_with_void_return +#undef gcc_jit_context_acquire +#undef gcc_jit_context_compile_to_file +#undef gcc_jit_context_dump_reproducer_to_file +#undef gcc_jit_context_dump_to_file +#undef gcc_jit_context_get_builtin_function +#undef gcc_jit_context_get_first_error +#undef gcc_jit_context_get_int_type +#undef gcc_jit_context_get_type +#undef gcc_jit_context_new_array_access +#undef gcc_jit_context_new_array_type +#undef gcc_jit_context_new_binary_op +#undef gcc_jit_context_new_call +#undef gcc_jit_context_new_call_through_ptr +#undef gcc_jit_context_new_comparison +#undef gcc_jit_context_new_field +#undef gcc_jit_context_new_function +#undef gcc_jit_context_new_function_ptr_type +#undef gcc_jit_context_new_global +#undef gcc_jit_context_new_opaque_struct +#undef gcc_jit_context_new_param +#undef gcc_jit_context_new_rvalue_from_int +#undef gcc_jit_context_new_rvalue_from_long +#undef gcc_jit_context_new_rvalue_from_ptr +#undef gcc_jit_context_new_struct_type +#undef gcc_jit_context_new_unary_op +#undef gcc_jit_context_new_union_type +#undef gcc_jit_context_release +#undef gcc_jit_context_set_bool_option +#undef gcc_jit_context_set_int_option +#undef gcc_jit_context_set_logfile +#undef gcc_jit_function_get_param +#undef gcc_jit_function_new_block +#undef gcc_jit_function_new_local +#undef gcc_jit_lvalue_access_field +#undef gcc_jit_lvalue_as_rvalue +#undef gcc_jit_lvalue_get_address +#undef gcc_jit_param_as_lvalue +#undef gcc_jit_param_as_rvalue +#undef gcc_jit_rvalue_access_field +#undef gcc_jit_rvalue_dereference +#undef gcc_jit_rvalue_dereference_field +#undef gcc_jit_rvalue_get_type +#undef gcc_jit_struct_as_type +#undef gcc_jit_struct_set_fields +#undef gcc_jit_type_get_pointer + +/* In alphabetical order */ +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_rvalue_from_int, + (gcc_jit_context *ctxt, gcc_jit_type *numeric_type, int value)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_lvalue_as_rvalue, + (gcc_jit_lvalue *lvalue)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_rvalue_access_field, + (gcc_jit_rvalue *struct_or_union, gcc_jit_location *loc, + gcc_jit_field *field)); +DEF_DLL_FN (void, gcc_jit_block_add_comment, + (gcc_jit_block *block, gcc_jit_location *loc, const char *text)); +DEF_DLL_FN (void, gcc_jit_context_release, (gcc_jit_context *ctxt)); +DEF_DLL_FN (const char *, gcc_jit_context_get_first_error, + (gcc_jit_context *ctxt)); +DEF_DLL_FN (gcc_jit_block *, gcc_jit_function_new_block, + (gcc_jit_function *func, const char *name)); +DEF_DLL_FN (gcc_jit_context *, gcc_jit_context_acquire, (void)); +DEF_DLL_FN (gcc_jit_field *, gcc_jit_context_new_field, + (gcc_jit_context *ctxt, gcc_jit_location *loc, gcc_jit_type *type, + const char *name)); +DEF_DLL_FN (gcc_jit_function *, gcc_jit_context_get_builtin_function, + (gcc_jit_context *ctxt, const char *name)); +DEF_DLL_FN (gcc_jit_function *, gcc_jit_context_new_function, + (gcc_jit_context *ctxt, gcc_jit_location *loc, + enum gcc_jit_function_kind kind, gcc_jit_type *return_type, + const char *name, int num_params, gcc_jit_param **params, + int is_variadic)); +DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_context_new_array_access, + (gcc_jit_context *ctxt, gcc_jit_location *loc, gcc_jit_rvalue *ptr, + gcc_jit_rvalue *index)); +DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_context_new_global, + (gcc_jit_context *ctxt, gcc_jit_location *loc, + enum gcc_jit_global_kind kind, gcc_jit_type *type, + const char *name)); +DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_function_new_local, + (gcc_jit_function *func, gcc_jit_location *loc, gcc_jit_type *type, + const char *name)); +DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_lvalue_access_field, + (gcc_jit_lvalue *struct_or_union, gcc_jit_location *loc, + gcc_jit_field *field)); +DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_param_as_lvalue, (gcc_jit_param *param)); +DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_rvalue_dereference, + (gcc_jit_rvalue *rvalue, gcc_jit_location *loc)); +DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_rvalue_dereference_field, + (gcc_jit_rvalue *ptr, gcc_jit_location *loc, gcc_jit_field *field)); +DEF_DLL_FN (gcc_jit_param *, gcc_jit_context_new_param, + (gcc_jit_context *ctxt, gcc_jit_location *loc, gcc_jit_type *type, + const char *name)); +DEF_DLL_FN (gcc_jit_param *, gcc_jit_function_get_param, + (gcc_jit_function *func, int index)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_binary_op, + (gcc_jit_context *ctxt, gcc_jit_location *loc, + enum gcc_jit_binary_op op, gcc_jit_type *result_type, + gcc_jit_rvalue *a, gcc_jit_rvalue *b)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_call, + (gcc_jit_context *ctxt, gcc_jit_location *loc, + gcc_jit_function *func, int numargs , gcc_jit_rvalue **args)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_call_through_ptr, + (gcc_jit_context *ctxt, gcc_jit_location *loc, + gcc_jit_rvalue *fn_ptr, int numargs, gcc_jit_rvalue **args)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_comparison, + (gcc_jit_context *ctxt, gcc_jit_location *loc, + enum gcc_jit_comparison op, gcc_jit_rvalue *a, gcc_jit_rvalue *b)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_rvalue_from_long, + (gcc_jit_context *ctxt, gcc_jit_type *numeric_type, long value)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_rvalue_from_ptr, + (gcc_jit_context *ctxt, gcc_jit_type *pointer_type, void *value)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_unary_op, + (gcc_jit_context *ctxt, gcc_jit_location *loc, + enum gcc_jit_unary_op op, gcc_jit_type *result_type, + gcc_jit_rvalue *rvalue)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_lvalue_get_address, + (gcc_jit_lvalue *lvalue, gcc_jit_location *loc)); +DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_param_as_rvalue, (gcc_jit_param *param)); +DEF_DLL_FN (gcc_jit_struct *, gcc_jit_context_new_opaque_struct, + (gcc_jit_context *ctxt, gcc_jit_location *loc, const char *name)); +DEF_DLL_FN (gcc_jit_struct *, gcc_jit_context_new_struct_type, + (gcc_jit_context *ctxt, gcc_jit_location *loc, const char *name, + int num_fields, gcc_jit_field **fields)); +DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_get_int_type, + (gcc_jit_context *ctxt, int num_bytes, int is_signed)); +DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_get_type, + (gcc_jit_context *ctxt, enum gcc_jit_types type_)); +DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_new_array_type, + (gcc_jit_context *ctxt, gcc_jit_location *loc, + gcc_jit_type *element_type, int num_elements)); +DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_new_function_ptr_type, + (gcc_jit_context *ctxt, gcc_jit_location *loc, + gcc_jit_type *return_type, int num_params, + gcc_jit_type **param_types, int is_variadic)); +DEF_DLL_FN (gcc_jit_type *, gcc_jit_context_new_union_type, + (gcc_jit_context *ctxt, gcc_jit_location *loc, const char *name, + int num_fields, gcc_jit_field **fields)); +DEF_DLL_FN (gcc_jit_type *, gcc_jit_rvalue_get_type, (gcc_jit_rvalue *rvalue)); +DEF_DLL_FN (gcc_jit_type *, gcc_jit_struct_as_type, + (gcc_jit_struct *struct_type)); +DEF_DLL_FN (gcc_jit_type *, gcc_jit_type_get_pointer, (gcc_jit_type *type)); +DEF_DLL_FN (void, gcc_jit_block_add_assignment, + (gcc_jit_block *block, gcc_jit_location *loc, gcc_jit_lvalue *lvalue, + gcc_jit_rvalue *rvalue)); +DEF_DLL_FN (void, gcc_jit_block_add_eval, + (gcc_jit_block *block, gcc_jit_location *loc, + gcc_jit_rvalue *rvalue)); +DEF_DLL_FN (void, gcc_jit_block_end_with_conditional, + (gcc_jit_block *block, gcc_jit_location *loc, + gcc_jit_rvalue *boolval, gcc_jit_block *on_true, + gcc_jit_block *on_false)); +DEF_DLL_FN (void, gcc_jit_block_end_with_jump, + (gcc_jit_block *block, gcc_jit_location *loc, + gcc_jit_block *target)); +DEF_DLL_FN (void, gcc_jit_block_end_with_return, + (gcc_jit_block *block, gcc_jit_location *loc, + gcc_jit_rvalue *rvalue)); +DEF_DLL_FN (void, gcc_jit_block_end_with_void_return, + (gcc_jit_block *block, gcc_jit_location *loc)); +DEF_DLL_FN (void, gcc_jit_context_compile_to_file, + (gcc_jit_context *ctxt, enum gcc_jit_output_kind output_kind, + const char *output_path)); +DEF_DLL_FN (void, gcc_jit_context_dump_reproducer_to_file, + (gcc_jit_context *ctxt, const char *path)); +DEF_DLL_FN (void, gcc_jit_context_dump_to_file, + (gcc_jit_context *ctxt, const char *path, int update_locations)); +DEF_DLL_FN (void, gcc_jit_context_set_bool_option, + (gcc_jit_context *ctxt, enum gcc_jit_bool_option opt, int value)); +DEF_DLL_FN (void, gcc_jit_context_set_int_option, + (gcc_jit_context *ctxt, enum gcc_jit_int_option opt, int value)); +DEF_DLL_FN (void, gcc_jit_context_set_logfile, + (gcc_jit_context *ctxt, FILE *logfile, int flags, int verbosity)); +DEF_DLL_FN (void, gcc_jit_struct_set_fields, + (gcc_jit_struct *struct_type, gcc_jit_location *loc, int num_fields, + gcc_jit_field **fields)); + +static bool +init_gccjit_functions (void) +{ + HMODULE library; + + if (!(library = w32_delayed_load (Qgccjit))) + { + return false; + } + + /* In alphabetical order */ + LOAD_DLL_FN(library, gcc_jit_block_add_assignment); + LOAD_DLL_FN(library, gcc_jit_block_add_comment); + LOAD_DLL_FN(library, gcc_jit_block_add_eval); + LOAD_DLL_FN(library, gcc_jit_block_end_with_conditional); + LOAD_DLL_FN(library, gcc_jit_block_end_with_jump); + LOAD_DLL_FN(library, gcc_jit_block_end_with_return); + LOAD_DLL_FN(library, gcc_jit_block_end_with_void_return); + LOAD_DLL_FN(library, gcc_jit_context_acquire); + LOAD_DLL_FN(library, gcc_jit_context_compile_to_file); + LOAD_DLL_FN(library, gcc_jit_context_dump_reproducer_to_file); + LOAD_DLL_FN(library, gcc_jit_context_dump_to_file); + LOAD_DLL_FN(library, gcc_jit_context_get_builtin_function); + LOAD_DLL_FN(library, gcc_jit_context_get_first_error); + LOAD_DLL_FN(library, gcc_jit_context_get_int_type); + LOAD_DLL_FN(library, gcc_jit_context_get_type); + LOAD_DLL_FN(library, gcc_jit_context_new_array_access); + LOAD_DLL_FN(library, gcc_jit_context_new_array_type); + LOAD_DLL_FN(library, gcc_jit_context_new_binary_op); + LOAD_DLL_FN(library, gcc_jit_context_new_call); + LOAD_DLL_FN(library, gcc_jit_context_new_call_through_ptr); + LOAD_DLL_FN(library, gcc_jit_context_new_comparison); + LOAD_DLL_FN(library, gcc_jit_context_new_field); + LOAD_DLL_FN(library, gcc_jit_context_new_function); + LOAD_DLL_FN(library, gcc_jit_context_new_function_ptr_type); + LOAD_DLL_FN(library, gcc_jit_context_new_global); + LOAD_DLL_FN(library, gcc_jit_context_new_opaque_struct); + LOAD_DLL_FN(library, gcc_jit_context_new_param); + LOAD_DLL_FN(library, gcc_jit_context_new_rvalue_from_int); + LOAD_DLL_FN(library, gcc_jit_context_new_rvalue_from_long); + LOAD_DLL_FN(library, gcc_jit_context_new_rvalue_from_ptr); + LOAD_DLL_FN(library, gcc_jit_context_new_struct_type); + LOAD_DLL_FN(library, gcc_jit_context_new_unary_op); + LOAD_DLL_FN(library, gcc_jit_context_new_union_type); + LOAD_DLL_FN(library, gcc_jit_context_release); + LOAD_DLL_FN(library, gcc_jit_context_set_bool_option); + LOAD_DLL_FN(library, gcc_jit_context_set_int_option); + LOAD_DLL_FN(library, gcc_jit_context_set_logfile); + LOAD_DLL_FN(library, gcc_jit_function_get_param); + LOAD_DLL_FN(library, gcc_jit_function_new_block); + LOAD_DLL_FN(library, gcc_jit_function_new_local); + LOAD_DLL_FN(library, gcc_jit_lvalue_access_field); + LOAD_DLL_FN(library, gcc_jit_lvalue_as_rvalue); + LOAD_DLL_FN(library, gcc_jit_lvalue_get_address); + LOAD_DLL_FN(library, gcc_jit_param_as_lvalue); + LOAD_DLL_FN(library, gcc_jit_param_as_rvalue); + LOAD_DLL_FN(library, gcc_jit_rvalue_access_field); + LOAD_DLL_FN(library, gcc_jit_rvalue_dereference); + LOAD_DLL_FN(library, gcc_jit_rvalue_dereference_field); + LOAD_DLL_FN(library, gcc_jit_rvalue_get_type); + LOAD_DLL_FN(library, gcc_jit_struct_as_type); + LOAD_DLL_FN(library, gcc_jit_struct_set_fields); + LOAD_DLL_FN(library, gcc_jit_type_get_pointer); + + return true; +} + +/* In alphabetical order */ +#define gcc_jit_block_add_assignment fn_gcc_jit_block_add_assignment +#define gcc_jit_block_add_comment fn_gcc_jit_block_add_comment +#define gcc_jit_block_add_eval fn_gcc_jit_block_add_eval +#define gcc_jit_block_end_with_conditional fn_gcc_jit_block_end_with_conditional +#define gcc_jit_block_end_with_jump fn_gcc_jit_block_end_with_jump +#define gcc_jit_block_end_with_return fn_gcc_jit_block_end_with_return +#define gcc_jit_block_end_with_void_return fn_gcc_jit_block_end_with_void_return +#define gcc_jit_context_acquire fn_gcc_jit_context_acquire +#define gcc_jit_context_compile_to_file fn_gcc_jit_context_compile_to_file +#define gcc_jit_context_dump_reproducer_to_file fn_gcc_jit_context_dump_reproducer_to_file +#define gcc_jit_context_dump_to_file fn_gcc_jit_context_dump_to_file +#define gcc_jit_context_get_builtin_function fn_gcc_jit_context_get_builtin_function +#define gcc_jit_context_get_first_error fn_gcc_jit_context_get_first_error +#define gcc_jit_context_get_int_type fn_gcc_jit_context_get_int_type +#define gcc_jit_context_get_type fn_gcc_jit_context_get_type +#define gcc_jit_context_new_array_access fn_gcc_jit_context_new_array_access +#define gcc_jit_context_new_array_type fn_gcc_jit_context_new_array_type +#define gcc_jit_context_new_binary_op fn_gcc_jit_context_new_binary_op +#define gcc_jit_context_new_call fn_gcc_jit_context_new_call +#define gcc_jit_context_new_call_through_ptr fn_gcc_jit_context_new_call_through_ptr +#define gcc_jit_context_new_comparison fn_gcc_jit_context_new_comparison +#define gcc_jit_context_new_field fn_gcc_jit_context_new_field +#define gcc_jit_context_new_function fn_gcc_jit_context_new_function +#define gcc_jit_context_new_function_ptr_type fn_gcc_jit_context_new_function_ptr_type +#define gcc_jit_context_new_global fn_gcc_jit_context_new_global +#define gcc_jit_context_new_opaque_struct fn_gcc_jit_context_new_opaque_struct +#define gcc_jit_context_new_param fn_gcc_jit_context_new_param +#define gcc_jit_context_new_rvalue_from_int fn_gcc_jit_context_new_rvalue_from_int +#define gcc_jit_context_new_rvalue_from_long fn_gcc_jit_context_new_rvalue_from_long +#define gcc_jit_context_new_rvalue_from_ptr fn_gcc_jit_context_new_rvalue_from_ptr +#define gcc_jit_context_new_struct_type fn_gcc_jit_context_new_struct_type +#define gcc_jit_context_new_unary_op fn_gcc_jit_context_new_unary_op +#define gcc_jit_context_new_union_type fn_gcc_jit_context_new_union_type +#define gcc_jit_context_release fn_gcc_jit_context_release +#define gcc_jit_context_set_bool_option fn_gcc_jit_context_set_bool_option +#define gcc_jit_context_set_int_option fn_gcc_jit_context_set_int_option +#define gcc_jit_context_set_logfile fn_gcc_jit_context_set_logfile +#define gcc_jit_function_get_param fn_gcc_jit_function_get_param +#define gcc_jit_function_new_block fn_gcc_jit_function_new_block +#define gcc_jit_function_new_local fn_gcc_jit_function_new_local +#define gcc_jit_lvalue_access_field fn_gcc_jit_lvalue_access_field +#define gcc_jit_lvalue_as_rvalue fn_gcc_jit_lvalue_as_rvalue +#define gcc_jit_lvalue_get_address fn_gcc_jit_lvalue_get_address +#define gcc_jit_param_as_lvalue fn_gcc_jit_param_as_lvalue +#define gcc_jit_param_as_rvalue fn_gcc_jit_param_as_rvalue +#define gcc_jit_rvalue_access_field fn_gcc_jit_rvalue_access_field +#define gcc_jit_rvalue_dereference fn_gcc_jit_rvalue_dereference +#define gcc_jit_rvalue_dereference_field fn_gcc_jit_rvalue_dereference_field +#define gcc_jit_rvalue_get_type fn_gcc_jit_rvalue_get_type +#define gcc_jit_struct_as_type fn_gcc_jit_struct_as_type +#define gcc_jit_struct_set_fields fn_gcc_jit_struct_set_fields +#define gcc_jit_type_get_pointer fn_gcc_jit_type_get_pointer + +#endif + +static bool +load_gccjit_if_necessary (bool mandatory) +{ +#ifdef WINDOWSNT + static bool tried_to_initialize_once; + static bool gccjit_initialized; + + if (!tried_to_initialize_once) + { + tried_to_initialize_once = true; + Lisp_Object status; + gccjit_initialized = init_gccjit_functions (); + status = gccjit_initialized ? Qt : Qnil; + Vlibrary_cache = Fcons (Fcons (Qgccjit, status), Vlibrary_cache); + } + + if (mandatory && !gccjit_initialized) + xsignal1(Qnative_compiler_error, build_string("libgccjit not found")); + + return gccjit_initialized; +#else + return true; +#endif +} + + /* C symbols emitted for the load relocation mechanism. */ #define CURRENT_THREAD_RELOC_SYM "current_thread_reloc" #define PURE_RELOC_SYM "pure_reloc" @@ -3295,6 +3637,8 @@ DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt, doc: /* Initialize the native compiler context. Return t on success. */) (void) { + load_gccjit_if_necessary(true); + if (comp.ctxt) { xsignal1 (Qnative_ice, @@ -3441,6 +3785,8 @@ DEFUN ("comp--release-ctxt", Fcomp__release_ctxt, Scomp__release_ctxt, doc: /* Release the native compiler context. */) (void) { + load_gccjit_if_necessary(true); + if (comp.ctxt) gcc_jit_context_release (comp.ctxt); @@ -3457,6 +3803,8 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, doc: /* Compile as native code the current context to file. */) (Lisp_Object base_name) { + load_gccjit_if_necessary(true); + CHECK_STRING (base_name); gcc_jit_context_set_int_option (comp.ctxt, @@ -3626,6 +3974,9 @@ maybe_defer_native_compilation (Lisp_Object function_name, fflush (f); } #endif + if (!load_gccjit_if_necessary(false)) + return; + if (!comp_deferred_compilation || noninteractive || !NILP (Vpurify_flag) @@ -3975,10 +4326,26 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, return Qt; } +#endif /* HAVE_NATIVE_COMP */ + +DEFUN ("native-comp-available-p", Fnative_comp_available_p, + Snative_comp_available_p, 0, 0, 0, + doc: /* Returns t if native compilation of Lisp files is available in +this instance of Emacs. */) + (void) +{ +#ifdef HAVE_NATIVE_COMP + return load_gccjit_if_necessary(false) ? Qt : Qnil; +#else + return Qnil; +#endif +} + void syms_of_comp (void) { +#ifdef HAVE_NATIVE_COMP /* Compiler control customizes. */ DEFVAR_BOOL ("comp-deferred-compilation", comp_deferred_compilation, doc: /* If t compile asyncronously every .elc file loaded. */); @@ -4122,6 +4489,7 @@ syms_of_comp (void) doc: /* Hash table symbol-name -> function-value. For internal use during */); Vcomp_deferred_pending_h = CALLN (Fmake_hash_table, QCtest, Qeq); -} +#endif -#endif /* HAVE_NATIVE_COMP */ + defsubr (&Snative_comp_available_p); +} diff --git a/src/comp.h b/src/comp.h index b03a8055142..36e7cdf4413 100644 --- a/src/comp.h +++ b/src/comp.h @@ -90,11 +90,7 @@ maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object definition) {} -static inline Lisp_Object -Fnative_elisp_load (Lisp_Object file, Lisp_Object late_load) -{ - eassume (false); -} +extern void syms_of_comp (void); #endif diff --git a/src/emacs.c b/src/emacs.c index 2c908257422..e75cb588349 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1606,10 +1606,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_json (); #endif -#ifdef HAVE_NATIVE_COMP if (!initialized) syms_of_comp (); -#endif no_loadup = argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args); diff --git a/src/w32.c b/src/w32.c index 0f69e652a57..d01a45029d8 100644 --- a/src/w32.c +++ b/src/w32.c @@ -10586,6 +10586,10 @@ globals_of_w32 (void) #endif w32_crypto_hprov = (HCRYPTPROV)0; + + /* We need to forget about libraries that were loaded during the + dumping process (e.g. libgccjit) */ + Vlibrary_cache = Qnil; } /* For make-serial-process */ diff --git a/src/w32fns.c b/src/w32fns.c index e595b0285a7..eeb73489dd5 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10462,6 +10462,7 @@ syms_of_w32fns (void) DEFSYM (Qzlib, "zlib"); DEFSYM (Qlcms2, "lcms2"); DEFSYM (Qjson, "json"); + DEFSYM (Qgccjit, "gccjit"); Fput (Qundefined_color, Qerror_conditions, pure_list (Qundefined_color, Qerror)); -- cgit v1.2.3 From 1b809f378f6263bc099da45c5e4a42c89fef8d71 Mon Sep 17 00:00:00 2001 From: Nicolás Bértolo Date: Tue, 19 May 2020 15:57:31 -0300 Subject: Improve handling of native compilation units still in use in Windows When closing emacs will inspect all directories from which it loaded native compilation units. If it finds a ".eln.old" file it will try to delete it, if it fails that means that another Emacs instance is using it. When compiling a file we rename the file that was in the output path in case it has been loaded into another Emacs instance. When deleting a package we move any ".eln" or ".eln.old" files in the package folder that we can't delete to `package-user-dir`. Emacs will check that directory when closing and delete them. * lisp/emacs-lisp/comp.el (comp--replace-output-file): Function called from C code to finish the compilation process. It performs renaming of the old file if necessary. * lisp/emacs-lisp/package.el (package--delete-directory): Function to delete a package directory. It moves native compilation units that it can't delete to `package-user-dir'. * src/alloc.c (cleanup_vector): Call dispose_comp_unit(). (garbage_collect): Call finish_delayed_disposal_of_comp_units(). * src/comp.c: Restore the signal mask using unwind-protect. Store loaded native compilation units in a hash table for disposal on close. Store filenames of native compilation units GC'd in a linked list to finish their disposal when the GC is over. (clean_comp_unit_directory): Delete all *.eln.old files in a directory. (clean_package_user_dir_of_old_comp_units): Delete all *.eln.old files in `package-user-dir'. (dispose_all_remaining_comp_units): Dispose of native compilation units that are still loaded. (dispose_comp_unit): Close handle and cleanup directory or arrange for later cleanup if DELAY is true. (finish_delayed_disposal_of_comp_units): Dispose of native compilation units that were GC'd. (register_native_comp_unit): Register native compilation unit for disposal when Emacs closes. * src/comp.h: Introduce cfile member in Lisp_Native_Comp_Unit. Add declarations of functions that: clean directories of unused native compilation units, handle disposal of native compilation units. * src/emacs.c (kill-emacs): Dispose all remaining compilation units right right before calling exit(). * src/eval.c (internal_condition_case_3, internal_condition_case_4): Add functions. * src/lisp.h (internal_condition_case_3, internal_condition_case_4): Add functions. * src/pdumper.c (dump_do_dump_relocation): Set cfile to a copy of the Lisp string specifying the file path. --- lisp/emacs-lisp/comp.el | 25 +++++ lisp/emacs-lisp/package.el | 31 +++++- src/alloc.c | 3 +- src/comp.c | 260 +++++++++++++++++++++++++++++++++++++++++++-- src/comp.h | 34 ++++++ src/emacs.c | 4 + src/eval.c | 55 ++++++++++ src/lisp.h | 2 + src/pdumper.c | 3 + 9 files changed, 404 insertions(+), 13 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 6c152136fb5..3845827f661 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2277,6 +2277,31 @@ Prepare every function for final compilation and drive the C back-end." ;; Some entry point support code. +(defun comp--replace-output-file (outfile tmpfile) + "Replace OUTFILE with TMPFILE taking the necessary steps when +dealing with shared libraries that may be loaded into Emacs" + (cond ((eq 'windows-nt system-type) + (ignore-errors (delete-file outfile)) + (let ((retry t)) + (while retry + (setf retry nil) + (condition-case _ + (progn + ;; outfile maybe recreated by another Emacs in + ;; between the following two rename-file calls + (if (file-exists-p outfile) + (rename-file outfile (make-temp-file-internal + (file-name-sans-extension outfile) + nil ".eln.old" nil) + t)) + (rename-file tmpfile outfile nil)) + (file-already-exists (setf retry t)))))) + ;; Remove the old eln instead of copying the new one into it + ;; to get a new inode and prevent crashes in case the old one + ;; is currently loaded. + (t (delete-file outfile) + (rename-file tmpfile outfile)))) + (defvar comp-files-queue () "List of Elisp files to be compiled.") diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 808e4f34fc5..4288d906ef5 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2204,6 +2204,35 @@ If some packages are not installed propose to install them." (equal (cadr (assq (package-desc-name pkg) package-alist)) pkg)) +(defun package--delete-directory (dir) + "Delete DIR recursively. +In Windows move .eln and .eln.old files that can not be deleted +to `package-user-dir'." + (cond ((eq 'windows-nt system-type) + (let ((retry t)) + (while retry + (setf retry nil) + (condition-case err + (delete-directory dir t) + (file-error + (cl-destructuring-bind (reason1 reason2 filename) err + (if (and (string= "Removing old name" reason1) + (string= "Permission denied" reason2) + (string-prefix-p (expand-file-name package-user-dir) + filename) + (or (string-suffix-p ".eln" filename) + (string-suffix-p ".eln.old" filename))) + (progn + (rename-file filename + (make-temp-file-internal + (concat package-user-dir + (file-name-base filename)) + nil ".eln.old" nil) + t) + (setf retry t)) + (signal (car err) (cdr err))))))))) + (t (delete-directory dir t)))) + (defun package-delete (pkg-desc &optional force nosave) "Delete package PKG-DESC. @@ -2256,7 +2285,7 @@ If NOSAVE is non-nil, the package is not removed from (package-desc-name pkg-used-elsewhere-by))) (t (add-hook 'post-command-hook #'package-menu--post-refresh) - (delete-directory dir t) + (package--delete-directory dir) ;; Remove NAME-VERSION.signed and NAME-readme.txt files. ;; ;; NAME-readme.txt files are no longer created, but they diff --git a/src/alloc.c b/src/alloc.c index 76d49d2efd6..b892022125e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3119,8 +3119,7 @@ cleanup_vector (struct Lisp_Vector *vector) { struct Lisp_Native_Comp_Unit *cu = PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); - eassert (cu->handle); - dynlib_close (cu->handle); + dispose_comp_unit (cu, true); } } diff --git a/src/comp.c b/src/comp.c index 68ad6d3eb8d..16ad77c74bc 100644 --- a/src/comp.c +++ b/src/comp.c @@ -411,6 +411,10 @@ load_gccjit_if_necessary (bool mandatory) #define CALL1I(fun, arg) \ CALLN (Ffuncall, intern_c_string (STR (fun)), arg) +/* Like call2 but stringify and intern. */ +#define CALL2I(fun, arg1, arg2) \ + CALLN (Ffuncall, intern_c_string (STR (fun)), arg1, arg2) + #define DECL_BLOCK(name, func) \ gcc_jit_block *(name) = \ gcc_jit_function_new_block ((func), STR (name)) @@ -435,6 +439,8 @@ typedef struct { ptrdiff_t size; } f_reloc_t; +sigset_t saved_sigset; + static f_reloc_t freloc; /* C side of the compiler context. */ @@ -3795,6 +3801,13 @@ DEFUN ("comp--release-ctxt", Fcomp__release_ctxt, Scomp__release_ctxt, return Qt; } +static void +restore_sigmask (void) +{ + pthread_sigmask (SIG_SETMASK, &saved_sigset, 0); + unblock_input (); +} + DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, Scomp__compile_ctxt_to_file, 1, 1, 0, @@ -3816,6 +3829,8 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt)); sigset_t oldset; + ptrdiff_t count = 0; + if (!noninteractive) { sigset_t blocked; @@ -3828,6 +3843,8 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, sigaddset (&blocked, SIGIO); #endif pthread_sigmask (SIG_BLOCK, &blocked, &oldset); + count = SPECPDL_INDEX (); + record_unwind_protect_void (restore_sigmask); } emit_ctxt_code (); @@ -3866,18 +3883,10 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY, SSDATA (tmp_file)); - /* Remove the old eln instead of copying the new one into it to get - a new inode and prevent crashes in case the old one is currently - loaded. */ - if (!NILP (Ffile_exists_p (out_file))) - Fdelete_file (out_file, Qnil); - Frename_file (tmp_file, out_file, Qnil); + CALL2I(comp--replace-output-file, out_file, tmp_file); if (!noninteractive) - { - pthread_sigmask (SIG_SETMASK, &oldset, 0); - unblock_input (); - } + unbind_to (count, Qnil); return out_file; } @@ -3938,6 +3947,223 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code) code); } + +/*********************************/ +/* Disposal of compilation units */ +/*********************************/ + +/* +The problem: Windows does not let us delete an .eln file that has been +loaded by a process. This has two implications in Emacs: + +1) It is not possible to recompile a lisp file if the corresponding +.eln file has been loaded. This is because we'd like to use the same +filename, but we can't delete the old .eln file. + +2) It is not possible to delete a package using `package-delete' +if an .eln file has been loaded. + +* General idea + +The solution to these two problems is to move the foo.eln file +somewhere else and have the last Emacs instance using it delete it. +To make it easy to find what files need to be removed we use two approaches. + +In the 1) case we rename foo.eln to fooXXXXXX.eln.old in the same +folder. When Emacs is unloading "foo" (either GC'd the native +compilation unit or Emacs is closing (see below)) we delete all the +.eln.old files in the folder where the original foo.eln was stored. + +Ideally we'd figure out the new name of foo.eln and delete it if +it ends in .eln.old. There is no simple API to do this in +Windows. GetModuleFileName() returns the original filename, not the +current one. This forces us to put .eln.old files in an agreed upon +path. We cannot use %TEMP% because it may be in another drive and then +the rename operation would fail. + +In the 2) case we can't use the same folder where the .eln file +resided, as we are trying to completely remove the package. Since we +are removing packages we can safely move the .eln.old file to +`package-user-dir' as we are sure that that would not mean changing +drives. + +* Implementation details + +The concept of disposal of a native compilation unit refers to +unloading the shared library and deleting all the .eln.old files in +the directory. These are two separate steps. We'll call them +early-disposal and late-disposal. + +There are two data structures used: + +- The `all_loaded_comp_units_h` hashtable. + +This hashtable is used like an array of weak references to native +compilation units. This hash table is filled by load_comp_unit() and +dispose_all_remaining_comp_units() iterates over all values that were +not disposed by the GC and performs all disposal steps when Emacs is +closing. + +- The `delayed_comp_unit_disposal_list` list. + +This is were the dispose_comp_unit() function, when called by the GC +sweep stage, stores the original filenames of the disposed native +compilation units. This is an ad-hoc C structure instead of a Lisp +cons because we need to allocate instances of this structure during +the GC. + +The finish_delayed_disposal_of_comp_units() function will iterate over +this list and perform the late-disposal step when Emacs is closing. + +*/ + +#ifdef WINDOWSNT +#define OLD_ELN_SUFFIX_REGEXP build_string ("\\.eln\\.old\\'") + +static Lisp_Object all_loaded_comp_units_h; + +/* We need to allocate instances of this struct during a GC + * sweep. This is why it can't be transformed into a simple cons. + */ +struct delayed_comp_unit_disposal +{ + struct delayed_comp_unit_disposal *next; + char *filename; +}; + +struct delayed_comp_unit_disposal *delayed_comp_unit_disposal_list; + +static Lisp_Object +return_nil (Lisp_Object arg) +{ + return Qnil; +} + +/* Tries to remove all *.eln.old files in DIRNAME. + + * Any error is ignored because it may be due to the file being loaded + * in another Emacs instance. + */ +static void +clean_comp_unit_directory (Lisp_Object dirpath) +{ + if (NILP (dirpath)) + return; + Lisp_Object files_in_dir; + files_in_dir = internal_condition_case_4 (Fdirectory_files, dirpath, Qt, + OLD_ELN_SUFFIX_REGEXP, Qnil, Qt, + return_nil); + FOR_EACH_TAIL (files_in_dir) { DeleteFile (SSDATA (XCAR (files_in_dir))); } +} + +/* Tries to remove all *.eln.old files in `package-user-dir'. + + * This is called when Emacs is closing to clean any *.eln left from a + * deleted package. + */ +void +clean_package_user_dir_of_old_comp_units (void) +{ + Lisp_Object package_user_dir + = find_symbol_value (intern ("package-user-dir")); + if (EQ (package_user_dir, Qunbound) || !STRINGP (package_user_dir)) + return; + + clean_comp_unit_directory (package_user_dir); +} + +/* This function disposes all compilation units that are still loaded. + * It is important that this function is called only right before + * Emacs is closed, otherwise we risk running a subr that is + * implemented in an unloaded dynamic library. + */ +void +dispose_all_remaining_comp_units (void) +{ + struct Lisp_Hash_Table *h = XHASH_TABLE (all_loaded_comp_units_h); + + for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) + { + Lisp_Object k = HASH_KEY (h, i); + if (!EQ (k, Qunbound)) + { + Lisp_Object val = HASH_VALUE (h, i); + struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (val); + dispose_comp_unit (cu, false); + } + } +} + +/* This function finishes the disposal of compilation units that were + * passed to `dispose_comp_unit` with DELAY == true. + * + * This function is called when Emacs is idle and when it is about to + * close. + */ +void +finish_delayed_disposal_of_comp_units (void) +{ + for (struct delayed_comp_unit_disposal *item + = delayed_comp_unit_disposal_list; + delayed_comp_unit_disposal_list; item = delayed_comp_unit_disposal_list) + { + delayed_comp_unit_disposal_list = item->next; + Lisp_Object dirname = internal_condition_case_1 ( + Ffile_name_directory, build_string (item->filename), Qt, return_nil); + clean_comp_unit_directory (dirname); + xfree (item->filename); + xfree (item); + } +} +#endif + +/* This function puts the compilation unit in the + * `all_loaded_comp_units_h` hashmap. + */ +static void +register_native_comp_unit (Lisp_Object comp_u) +{ +#ifdef WINDOWSNT + Fputhash (CALL1I (gensym, Qnil), comp_u, all_loaded_comp_units_h); +#endif +} + +/* This function disposes compilation units. It is called during the GC sweep + * stage and when Emacs is closing. + + * On Windows the the DELAY parameter specifies whether the native + * compilation file will be deleted right away (if necessary) or put + * on a list. That list will be dealt with by + * `finish_delayed_disposal_of_comp_units`. + */ +void +dispose_comp_unit (struct Lisp_Native_Comp_Unit *comp_handle, bool delay) +{ + eassert (comp_handle->handle); + dynlib_close (comp_handle->handle); +#ifdef WINDOWSNT + if (!delay) + { + Lisp_Object dirname = internal_condition_case_1 ( + Ffile_name_directory, build_string (comp_handle->cfile), Qt, + return_nil); + if (!NILP (dirname)) + clean_comp_unit_directory (dirname); + xfree (comp_handle->cfile); + comp_handle->cfile = NULL; + } + else + { + struct delayed_comp_unit_disposal *head; + head = xmalloc (sizeof (struct delayed_comp_unit_disposal)); + head->next = delayed_comp_unit_disposal_list; + head->filename = comp_handle->cfile; + comp_handle->cfile = NULL; + delayed_comp_unit_disposal_list = head; + } +#endif +} + /***********************************/ /* Deferred compilation mechanism. */ @@ -4159,6 +4385,12 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec)); for (EMACS_INT i = 0; i < d_vec_len; i++) data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i); + + /* If we register them while dumping we will get some entries in + the hash table that will be duplicated when pdumper calls + load_comp_unit. */ + if (!will_dump_p ()) + register_native_comp_unit (comp_u_lisp_obj); } if (!loading_dump) @@ -4316,6 +4548,9 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, if (!comp_u->handle) xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ())); comp_u->file = file; +#ifdef WINDOWSNT + comp_u->cfile = xlispstrdup (file); +#endif comp_u->data_vec = Qnil; comp_u->lambda_gc_guard = CALLN (Fmake_hash_table, QCtest, Qeq); comp_u->lambda_c_name_idx_h = CALLN (Fmake_hash_table, QCtest, Qequal); @@ -4464,6 +4699,11 @@ syms_of_comp (void) staticpro (&delayed_sources); delayed_sources = Qnil; +#ifdef WINDOWSNT + staticpro (&all_loaded_comp_units_h); + all_loaded_comp_units_h = CALLN(Fmake_hash_table, QCweakness, Qvalue); +#endif + DEFVAR_LISP ("comp-ctxt", Vcomp_ctxt, doc: /* The compiler context. */); Vcomp_ctxt = Qnil; diff --git a/src/comp.h b/src/comp.h index 36e7cdf4413..b8e40ceb900 100644 --- a/src/comp.h +++ b/src/comp.h @@ -52,7 +52,15 @@ struct Lisp_Native_Comp_Unit /* STUFFS WE DO NOT DUMP!! */ Lisp_Object *data_imp_relocs; bool loaded_once; + dynlib_handle_ptr handle; +#ifdef WINDOWSNT + /* We need to store a copy of the original file name in memory that + is not subject to GC because the function to dispose native + compilation units is called by the GC. By that time the `file' + string may have been sweeped. */ + char * cfile; +#endif }; #ifdef HAVE_NATIVE_COMP @@ -83,6 +91,14 @@ extern void syms_of_comp (void); extern void maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object definition); + +extern void dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_unit, bool delay); + +extern void finish_delayed_disposal_of_comp_units (void); + +extern void dispose_all_remaining_comp_units (void); + +extern void clean_package_user_dir_of_old_comp_units (void); #else static inline void @@ -92,6 +108,24 @@ maybe_defer_native_compilation (Lisp_Object function_name, extern void syms_of_comp (void); +static inline void +dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_handle) +{ + eassert (false); +} + +static inline void +dispose_all_remaining_comp_units (void) +{} + +static inline void +clean_package_user_dir_of_old_comp_units (void) +{} + +static inline void +finish_delayed_disposal_of_comp_units (void) +{} + #endif #endif diff --git a/src/emacs.c b/src/emacs.c index 93a837a44ef..2a7a5257f15 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2398,6 +2398,10 @@ all of which are called before Emacs is actually killed. */ unlink (SSDATA (listfile)); } + finish_delayed_disposal_of_comp_units (); + dispose_all_remaining_comp_units (); + clean_package_user_dir_of_old_comp_units (); + if (FIXNUMP (arg)) exit_code = (XFIXNUM (arg) < 0 ? XFIXNUM (arg) | INT_MIN diff --git a/src/eval.c b/src/eval.c index 37d466f69ed..9e86a185908 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1419,6 +1419,61 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object), } } +/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3 as + its arguments. */ + +Lisp_Object +internal_condition_case_3 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object, + Lisp_Object), + Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, + Lisp_Object handlers, + Lisp_Object (*hfun) (Lisp_Object)) +{ + struct handler *c = push_handler (handlers, CONDITION_CASE); + if (sys_setjmp (c->jmp)) + { + Lisp_Object val = handlerlist->val; + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; + return hfun (val); + } + else + { + Lisp_Object val = bfun (arg1, arg2, arg3); + eassert (handlerlist == c); + handlerlist = c->next; + return val; + } +} + +/* Like internal_condition_case_1 but call BFUN with ARG1, ARG2, ARG3, ARG4 as + its arguments. */ + +Lisp_Object +internal_condition_case_4 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object), + Lisp_Object arg1, Lisp_Object arg2, + Lisp_Object arg3, Lisp_Object arg4, + Lisp_Object handlers, + Lisp_Object (*hfun) (Lisp_Object)) +{ + struct handler *c = push_handler (handlers, CONDITION_CASE); + if (sys_setjmp (c->jmp)) + { + Lisp_Object val = handlerlist->val; + clobbered_eassert (handlerlist == c); + handlerlist = handlerlist->next; + return hfun (val); + } + else + { + Lisp_Object val = bfun (arg1, arg2, arg3, arg4); + eassert (handlerlist == c); + handlerlist = c->next; + return val; + } +} + /* Like internal_condition_case but call BFUN with NARGS as first, and ARGS as second argument. */ diff --git a/src/lisp.h b/src/lisp.h index 4c0057b2552..52242791aa5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4165,6 +4165,8 @@ extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_ extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object)); extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); +extern Lisp_Object internal_condition_case_3 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); +extern Lisp_Object internal_condition_case_4 (Lisp_Object (*) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); diff --git a/src/pdumper.c b/src/pdumper.c index a6d12b6ea0c..26480388d59 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5312,6 +5312,9 @@ dump_do_dump_relocation (const uintptr_t dump_base, concat2 (Vinvocation_directory, installation_state == LOCAL_BUILD ? XCDR (comp_u->file) : XCAR (comp_u->file)); +#ifdef WINDOWSNT + comp_u->cfile = xlispstrdup(comp_u->file); +#endif comp_u->handle = dynlib_open (SSDATA (comp_u->file)); if (!comp_u->handle) error ("%s", dynlib_error ()); -- cgit v1.2.3 From 1bc558b77e648efa905076f793d28fc0f025ae50 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 24 May 2020 21:50:19 +0100 Subject: Fix non Windows builds * src/emacs.c (Fkill_emacs): Given 'finish_delayed_disposal_of_comp_units', 'dispose_all_remaining_comp_units' and 'clean_package_user_dir_of_old_comp_units' are defined only with windows native-comp builds ifdef them. * src/comp.h (dispose_comp_unit): Fix missing parameter in declaration. --- src/comp.h | 2 +- src/emacs.c | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) (limited to 'src/comp.h') diff --git a/src/comp.h b/src/comp.h index b8e40ceb900..18c5ba12298 100644 --- a/src/comp.h +++ b/src/comp.h @@ -109,7 +109,7 @@ maybe_defer_native_compilation (Lisp_Object function_name, extern void syms_of_comp (void); static inline void -dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_handle) +dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_handle, bool delay) { eassert (false); } diff --git a/src/emacs.c b/src/emacs.c index 2a7a5257f15..cd4f7a0b286 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2398,9 +2398,11 @@ all of which are called before Emacs is actually killed. */ unlink (SSDATA (listfile)); } +#if defined (HAVE_NATIVE_COMP) && defined (WINDOWSNT) finish_delayed_disposal_of_comp_units (); dispose_all_remaining_comp_units (); clean_package_user_dir_of_old_comp_units (); +#endif if (FIXNUMP (arg)) exit_code = (XFIXNUM (arg) < 0 -- cgit v1.2.3 From 0bba0e367b4b5378501de7c91838ea2de8b4af4a Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 24 May 2020 21:59:25 +0100 Subject: Fix GNU style * src/comp.h: Fix GNU style. * src/comp.c (Fcomp__compile_ctxt_to_file): Likewise. * lisp/emacs-lisp/comp.el (comp--replace-output-file): Likewise. * src/pdumper.c (dump_do_dump_relocation): Likewise. --- lisp/emacs-lisp/comp.el | 5 +- src/comp.c | 151 +++++++++++++++++++++++------------------------- src/comp.h | 7 ++- src/pdumper.c | 2 +- 4 files changed, 81 insertions(+), 84 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 3845827f661..02917cb9a0a 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2278,8 +2278,9 @@ Prepare every function for final compilation and drive the C back-end." ;; Some entry point support code. (defun comp--replace-output-file (outfile tmpfile) - "Replace OUTFILE with TMPFILE taking the necessary steps when -dealing with shared libraries that may be loaded into Emacs" + "Replace OUTFILE with TMPFILE. +Takes the necessary steps when dealing with shared libraries that +may be loaded into Emacs" (cond ((eq 'windows-nt system-type) (ignore-errors (delete-file outfile)) (let ((retry t)) diff --git a/src/comp.c b/src/comp.c index 16ad77c74bc..b4e3e2e887f 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3883,7 +3883,7 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY, SSDATA (tmp_file)); - CALL2I(comp--replace-output-file, out_file, tmp_file); + CALL2I (comp--replace-output-file, out_file, tmp_file); if (!noninteractive) unbind_to (count, Qnil); @@ -3953,67 +3953,68 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code) /*********************************/ /* -The problem: Windows does not let us delete an .eln file that has been -loaded by a process. This has two implications in Emacs: + The problem: Windows does not let us delete an .eln file that has + been loaded by a process. This has two implications in Emacs: -1) It is not possible to recompile a lisp file if the corresponding -.eln file has been loaded. This is because we'd like to use the same -filename, but we can't delete the old .eln file. + 1) It is not possible to recompile a lisp file if the corresponding + .eln file has been loaded. This is because we'd like to use the same + filename, but we can't delete the old .eln file. -2) It is not possible to delete a package using `package-delete' -if an .eln file has been loaded. + 2) It is not possible to delete a package using `package-delete' + if an .eln file has been loaded. -* General idea + * General idea -The solution to these two problems is to move the foo.eln file -somewhere else and have the last Emacs instance using it delete it. -To make it easy to find what files need to be removed we use two approaches. + The solution to these two problems is to move the foo.eln file + somewhere else and have the last Emacs instance using it delete it. + To make it easy to find what files need to be removed we use two approaches. -In the 1) case we rename foo.eln to fooXXXXXX.eln.old in the same -folder. When Emacs is unloading "foo" (either GC'd the native -compilation unit or Emacs is closing (see below)) we delete all the -.eln.old files in the folder where the original foo.eln was stored. + In the 1) case we rename foo.eln to fooXXXXXX.eln.old in the same + folder. When Emacs is unloading "foo" (either GC'd the native + compilation unit or Emacs is closing (see below)) we delete all the + .eln.old files in the folder where the original foo.eln was stored. -Ideally we'd figure out the new name of foo.eln and delete it if -it ends in .eln.old. There is no simple API to do this in -Windows. GetModuleFileName() returns the original filename, not the -current one. This forces us to put .eln.old files in an agreed upon -path. We cannot use %TEMP% because it may be in another drive and then -the rename operation would fail. + Ideally we'd figure out the new name of foo.eln and delete it if it + ends in .eln.old. There is no simple API to do this in Windows. + GetModuleFileName () returns the original filename, not the current + one. This forces us to put .eln.old files in an agreed upon path. + We cannot use %TEMP% because it may be in another drive and then the + rename operation would fail. -In the 2) case we can't use the same folder where the .eln file -resided, as we are trying to completely remove the package. Since we -are removing packages we can safely move the .eln.old file to -`package-user-dir' as we are sure that that would not mean changing -drives. + In the 2) case we can't use the same folder where the .eln file + resided, as we are trying to completely remove the package. Since we + are removing packages we can safely move the .eln.old file to + `package-user-dir' as we are sure that that would not mean changing + drives. -* Implementation details + * Implementation details -The concept of disposal of a native compilation unit refers to -unloading the shared library and deleting all the .eln.old files in -the directory. These are two separate steps. We'll call them -early-disposal and late-disposal. + The concept of disposal of a native compilation unit refers to + unloading the shared library and deleting all the .eln.old files in + the directory. These are two separate steps. We'll call them + early-disposal and late-disposal. -There are two data structures used: + There are two data structures used: -- The `all_loaded_comp_units_h` hashtable. + - The `all_loaded_comp_units_h` hashtable. -This hashtable is used like an array of weak references to native -compilation units. This hash table is filled by load_comp_unit() and -dispose_all_remaining_comp_units() iterates over all values that were -not disposed by the GC and performs all disposal steps when Emacs is -closing. + This hashtable is used like an array of weak references to native + compilation units. This hash table is filled by load_comp_unit () + and dispose_all_remaining_comp_units () iterates over all values + that were not disposed by the GC and performs all disposal steps + when Emacs is closing. -- The `delayed_comp_unit_disposal_list` list. + - The `delayed_comp_unit_disposal_list` list. -This is were the dispose_comp_unit() function, when called by the GC -sweep stage, stores the original filenames of the disposed native -compilation units. This is an ad-hoc C structure instead of a Lisp -cons because we need to allocate instances of this structure during -the GC. + This is were the dispose_comp_unit () function, when called by the + GC sweep stage, stores the original filenames of the disposed native + compilation units. This is an ad-hoc C structure instead of a Lisp + cons because we need to allocate instances of this structure during + the GC. -The finish_delayed_disposal_of_comp_units() function will iterate over -this list and perform the late-disposal step when Emacs is closing. + The finish_delayed_disposal_of_comp_units () function will iterate + over this list and perform the late-disposal step when Emacs is + closing. */ @@ -4022,9 +4023,8 @@ this list and perform the late-disposal step when Emacs is closing. static Lisp_Object all_loaded_comp_units_h; -/* We need to allocate instances of this struct during a GC - * sweep. This is why it can't be transformed into a simple cons. - */ +/* We need to allocate instances of this struct during a GC sweep. + This is why it can't be transformed into a simple cons. */ struct delayed_comp_unit_disposal { struct delayed_comp_unit_disposal *next; @@ -4041,9 +4041,8 @@ return_nil (Lisp_Object arg) /* Tries to remove all *.eln.old files in DIRNAME. - * Any error is ignored because it may be due to the file being loaded - * in another Emacs instance. - */ + Any error is ignored because it may be due to the file being loaded + in another Emacs instance. */ static void clean_comp_unit_directory (Lisp_Object dirpath) { @@ -4058,9 +4057,8 @@ clean_comp_unit_directory (Lisp_Object dirpath) /* Tries to remove all *.eln.old files in `package-user-dir'. - * This is called when Emacs is closing to clean any *.eln left from a - * deleted package. - */ + This is called when Emacs is closing to clean any *.eln left from a + deleted package. */ void clean_package_user_dir_of_old_comp_units (void) { @@ -4073,10 +4071,10 @@ clean_package_user_dir_of_old_comp_units (void) } /* This function disposes all compilation units that are still loaded. - * It is important that this function is called only right before - * Emacs is closed, otherwise we risk running a subr that is - * implemented in an unloaded dynamic library. - */ + + It is important that this function is called only right before + Emacs is closed, otherwise we risk running a subr that is + implemented in an unloaded dynamic library. */ void dispose_all_remaining_comp_units (void) { @@ -4095,11 +4093,10 @@ dispose_all_remaining_comp_units (void) } /* This function finishes the disposal of compilation units that were - * passed to `dispose_comp_unit` with DELAY == true. - * - * This function is called when Emacs is idle and when it is about to - * close. - */ + passed to `dispose_comp_unit` with DELAY == true. + + This function is called when Emacs is idle and when it is about to + close. */ void finish_delayed_disposal_of_comp_units (void) { @@ -4118,8 +4115,7 @@ finish_delayed_disposal_of_comp_units (void) #endif /* This function puts the compilation unit in the - * `all_loaded_comp_units_h` hashmap. - */ + `all_loaded_comp_units_h` hashmap. */ static void register_native_comp_unit (Lisp_Object comp_u) { @@ -4128,14 +4124,13 @@ register_native_comp_unit (Lisp_Object comp_u) #endif } -/* This function disposes compilation units. It is called during the GC sweep - * stage and when Emacs is closing. +/* This function disposes compilation units. It is called during the GC sweep + stage and when Emacs is closing. - * On Windows the the DELAY parameter specifies whether the native - * compilation file will be deleted right away (if necessary) or put - * on a list. That list will be dealt with by - * `finish_delayed_disposal_of_comp_units`. - */ + On Windows the the DELAY parameter specifies whether the native + compilation file will be deleted right away (if necessary) or put + on a list. That list will be dealt with by + `finish_delayed_disposal_of_comp_units`. */ void dispose_comp_unit (struct Lisp_Native_Comp_Unit *comp_handle, bool delay) { @@ -4387,10 +4382,10 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i); /* If we register them while dumping we will get some entries in - the hash table that will be duplicated when pdumper calls - load_comp_unit. */ + the hash table that will be duplicated when pdumper calls + load_comp_unit. */ if (!will_dump_p ()) - register_native_comp_unit (comp_u_lisp_obj); + register_native_comp_unit (comp_u_lisp_obj); } if (!loading_dump) @@ -4701,7 +4696,7 @@ syms_of_comp (void) #ifdef WINDOWSNT staticpro (&all_loaded_comp_units_h); - all_loaded_comp_units_h = CALLN(Fmake_hash_table, QCweakness, Qvalue); + all_loaded_comp_units_h = CALLN (Fmake_hash_table, QCweakness, Qvalue); #endif DEFVAR_LISP ("comp-ctxt", Vcomp_ctxt, diff --git a/src/comp.h b/src/comp.h index 18c5ba12298..c6f23dc1468 100644 --- a/src/comp.h +++ b/src/comp.h @@ -57,9 +57,9 @@ struct Lisp_Native_Comp_Unit #ifdef WINDOWSNT /* We need to store a copy of the original file name in memory that is not subject to GC because the function to dispose native - compilation units is called by the GC. By that time the `file' + compilation units is called by the GC. By that time the `file' string may have been sweeped. */ - char * cfile; + char *cfile; #endif }; @@ -92,7 +92,8 @@ extern void syms_of_comp (void); extern void maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object definition); -extern void dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_unit, bool delay); +extern void dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_unit, + bool delay); extern void finish_delayed_disposal_of_comp_units (void); diff --git a/src/pdumper.c b/src/pdumper.c index 26480388d59..b40a29c02ac 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5313,7 +5313,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, installation_state == LOCAL_BUILD ? XCDR (comp_u->file) : XCAR (comp_u->file)); #ifdef WINDOWSNT - comp_u->cfile = xlispstrdup(comp_u->file); + comp_u->cfile = xlispstrdup (comp_u->file); #endif comp_u->handle = dynlib_open (SSDATA (comp_u->file)); if (!comp_u->handle) -- cgit v1.2.3 From 2bc41e0963275e77ca3627fbfd754fcc041405cb Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 24 May 2020 22:49:38 +0100 Subject: ; Ease ifdef navigation in native-comp files * src/comp.c (syms_of_comp): Add a comment to ease #endif understading. * src/comp.h: Likewise. --- src/comp.c | 3 ++- src/comp.h | 7 ++++--- 2 files changed, 6 insertions(+), 4 deletions(-) (limited to 'src/comp.h') diff --git a/src/comp.c b/src/comp.c index b4e3e2e887f..32a98173d53 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4722,7 +4722,8 @@ syms_of_comp (void) doc: /* Hash table symbol-name -> function-value. For internal use during */); Vcomp_deferred_pending_h = CALLN (Fmake_hash_table, QCtest, Qeq); -#endif + +#endif /* #ifdef HAVE_NATIVE_COMP */ defsubr (&Snative_comp_available_p); } diff --git a/src/comp.h b/src/comp.h index c6f23dc1468..1f64a6df550 100644 --- a/src/comp.h +++ b/src/comp.h @@ -100,7 +100,8 @@ extern void finish_delayed_disposal_of_comp_units (void); extern void dispose_all_remaining_comp_units (void); extern void clean_package_user_dir_of_old_comp_units (void); -#else + +#else /* #ifdef HAVE_NATIVE_COMP */ static inline void maybe_defer_native_compilation (Lisp_Object function_name, @@ -127,6 +128,6 @@ static inline void finish_delayed_disposal_of_comp_units (void) {} -#endif +#endif /* #ifdef HAVE_NATIVE_COMP */ -#endif +#endif /* #ifndef COMP_H */ -- cgit v1.2.3 From f2864e3354fd60174b1d8df05a301673a81cd3ea Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 8 Jun 2020 22:13:29 +0100 Subject: Rename lambda_gc_guard -> lambda_gc_guard_h * src/comp.h (struct Lisp_Native_Comp_Unit): Rename lambda_gc_guard -> lambda_gc_guard_h * src/pdumper.c (dump_do_dump_relocation): Likewise. * src/comp.c (check_comp_unit_relocs, Fcomp__register_lambda) (Fnative_elisp_load): Likewise. --- src/comp.c | 6 +++--- src/comp.h | 6 +++--- src/pdumper.c | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) (limited to 'src/comp.h') diff --git a/src/comp.c b/src/comp.c index 960badb6467..521cadcb10c 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4400,7 +4400,7 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) return false; else if (SUBR_NATIVE_COMPILEDP (x)) { - if (NILP (Fgethash (x, comp_u->lambda_gc_guard, Qnil))) + if (NILP (Fgethash (x, comp_u->lambda_gc_guard_h, Qnil))) return false; } else if (!EQ (data_imp_relocs[i], AREF (comp_u->data_impure_vec, i))) @@ -4601,7 +4601,7 @@ DEFUN ("comp--register-lambda", Fcomp__register_lambda, Scomp__register_lambda, /* We must protect it against GC because the function is not reachable through symbols. */ - Fputhash (tem, Qt, cu->lambda_gc_guard); + Fputhash (tem, Qt, cu->lambda_gc_guard_h); /* This is for fixing up the value in d_reloc while resurrecting from dump. See 'dump_do_dump_relocation'. */ eassert (NILP (Fgethash (c_name, cu->lambda_c_name_idx_h, Qnil))); @@ -4669,7 +4669,7 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, comp_u->cfile = xlispstrdup (file); #endif comp_u->data_vec = Qnil; - comp_u->lambda_gc_guard = CALLN (Fmake_hash_table, QCtest, Qeq); + comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq); comp_u->lambda_c_name_idx_h = CALLN (Fmake_hash_table, QCtest, Qequal); load_comp_unit (comp_u, false, !NILP (late_load)); diff --git a/src/comp.h b/src/comp.h index 1f64a6df550..d46cdc735ff 100644 --- a/src/comp.h +++ b/src/comp.h @@ -37,9 +37,9 @@ struct Lisp_Native_Comp_Unit /* Original eln file loaded. */ Lisp_Object file; Lisp_Object optimize_qualities; - /* Guard anonymous lambdas against Garbage Collection and make them - dumpable. */ - Lisp_Object lambda_gc_guard; + /* Guard anonymous lambdas against Garbage Collection and serve + sanity checks. */ + Lisp_Object lambda_gc_guard_h; /* Hash c_name -> d_reloc_imp index. */ Lisp_Object lambda_c_name_idx_h; /* Hash doc-idx -> function documentaiton. */ diff --git a/src/pdumper.c b/src/pdumper.c index 8cb9284c014..3089adb35d8 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5299,7 +5299,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, static enum { UNKNOWN, LOCAL_BUILD, INSTALLED } installation_state; struct Lisp_Native_Comp_Unit *comp_u = dump_ptr (dump_base, reloc_offset); - comp_u->lambda_gc_guard = CALLN (Fmake_hash_table, QCtest, Qeq); + comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq); if (!CONSP (comp_u->file)) error ("Trying to load incoherent dumped .eln"); @@ -5367,7 +5367,7 @@ dump_do_dump_relocation (const uintptr_t dump_base, &(comp_u->data_imp_relocs[XFIXNUM (lambda_data_idx)]); eassert (EQ (*fixup, Qlambda_fixup)); *fixup = tem; - Fputhash (tem, Qt, comp_u->lambda_gc_guard); + Fputhash (tem, Qt, comp_u->lambda_gc_guard_h); } break; } -- cgit v1.2.3 From 5e8cdca71a661a6d95355ac5fdaa1e2fa32ed0df Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 8 Jun 2020 22:31:19 +0100 Subject: * src/comp.h (struct Lisp_Native_Comp_Unit): Fix missing GCALIGNED_STRUCT. --- src/comp.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/comp.h') diff --git a/src/comp.h b/src/comp.h index d46cdc735ff..507379bf5e6 100644 --- a/src/comp.h +++ b/src/comp.h @@ -61,7 +61,7 @@ struct Lisp_Native_Comp_Unit string may have been sweeped. */ char *cfile; #endif -}; +} GCALIGNED_STRUCT; #ifdef HAVE_NATIVE_COMP -- cgit v1.2.3 From 904550d8c8e1583d0444bcb28b5d1130af6bafc3 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 11 Jun 2020 20:23:00 +0200 Subject: Fix recursive load for non cons hashed 'data_ephemeral_vec' content Removing `Vcomp_sym_subr_c_name_h' all c_name functions are GC markable only through 'data_ephemeral_vec'. A recursive load must not overide its content otherwise a previously activated load will have the original content collected before it's used. * src/comp.h (struct Lisp_Native_Comp_Unit): Add 'load_ongoing' field. * src/comp.c (unset_cu_load_ongoing): New function. (load_comp_unit): Update logic to detect and handle recursive loads. --- src/comp.c | 39 ++++++++++++++++++++++++++++++++------- src/comp.h | 2 +- 2 files changed, 33 insertions(+), 8 deletions(-) (limited to 'src/comp.h') diff --git a/src/comp.c b/src/comp.c index 0f7c04129b3..18a2a1ff912 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4398,6 +4398,12 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) return true; } +static void +unset_cu_load_ongoing (Lisp_Object comp_u) +{ + XNATIVE_COMP_UNIT (comp_u)->load_ongoing = false; +} + void load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, bool late_load) @@ -4433,6 +4439,14 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, else *saved_cu = comp_u_lisp_obj; + /* Once we are sure to have the right compilation unit we want to + identify is we have at least another load active on it. */ + bool recursive_load = comp_u->load_ongoing; + comp_u->load_ongoing = true; + ptrdiff_t count = SPECPDL_INDEX (); + if (!recursive_load) + record_unwind_protect (unset_cu_load_ongoing, comp_u_lisp_obj); + freloc_check_fill (); Lisp_Object (*top_level_run)(Lisp_Object) @@ -4508,14 +4522,21 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, are necessary exclusively during the first load. Once these are collected we don't have to maintain them in the heap forever. */ + Lisp_Object volatile data_ephemeral_vec; + /* In case another load of the same CU is active on the stack + all ephemeral data is hold by that frame. Re-writing + 'data_ephemeral_vec' would be not only a waste of cycles but + more importanly would lead to crashed if the contained data + is not cons hashed. */ + if (!recursive_load) + { + Lisp_Object volatile data_ephemeral_vec = + load_static_obj (comp_u, TEXT_DATA_RELOC_EPHEMERAL_SYM); - Lisp_Object volatile data_ephemeral_vec = - load_static_obj (comp_u, TEXT_DATA_RELOC_EPHEMERAL_SYM); - - EMACS_INT d_vec_len = XFIXNUM (Flength (data_ephemeral_vec)); - for (EMACS_INT i = 0; i < d_vec_len; i++) - data_eph_relocs[i] = AREF (data_ephemeral_vec, i); - + EMACS_INT d_vec_len = XFIXNUM (Flength (data_ephemeral_vec)); + for (EMACS_INT i = 0; i < d_vec_len; i++) + data_eph_relocs[i] = AREF (data_ephemeral_vec, i); + } /* Executing this will perform all the expected environment modifications. */ top_level_run (comp_u_lisp_obj); @@ -4525,6 +4546,10 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, eassert (check_comp_unit_relocs (comp_u)); } + if (!recursive_load) + /* Clean-up the load ongoing flag in case. */ + unbind_to (count, Qnil); + return; } diff --git a/src/comp.h b/src/comp.h index 507379bf5e6..687e426b1ef 100644 --- a/src/comp.h +++ b/src/comp.h @@ -52,7 +52,7 @@ struct Lisp_Native_Comp_Unit /* STUFFS WE DO NOT DUMP!! */ Lisp_Object *data_imp_relocs; bool loaded_once; - + bool load_ongoing; dynlib_handle_ptr handle; #ifdef WINDOWSNT /* We need to store a copy of the original file name in memory that -- cgit v1.2.3 From 171db3110159d95803dea13c4ee7bca4a795747b Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 16 Aug 2020 11:18:36 +0200 Subject: Make install target functional for new eln-cache directory arrangement * src/comp.h (fixup_eln_load_path): New extern. * src/comp.c (fixup_eln_load_path): New function. * src/pdumper.c (dump_do_dump_relocation): Update to make use of 'fixup_eln_load_path'. * lisp/loadup.el: Update to store in the compilation unit the correct eln-cache installed path. Rename --lisp-dest -> --eln-dest and. * Makefile.in: Pass the eln destination directory to src/Makefile. Rename LISP_DESTDIR -> ELN_DESTDIR. (ELN_DESTDIR): Define. (install-eln): New target. (install): Add install-eln as prerequisite. * src/Makefile.in: Rename --lisp-dest -> --eln-dest and LISP_DESTDIR -> ELN_DESTDIR. --- Makefile.in | 16 +++++++++++++--- lisp/loadup.el | 44 ++++++++++++++++++++++---------------------- src/Makefile.in | 2 +- src/comp.c | 21 +++++++++++++++++++++ src/comp.h | 2 ++ src/pdumper.c | 15 ++------------- 6 files changed, 61 insertions(+), 39 deletions(-) (limited to 'src/comp.h') diff --git a/Makefile.in b/Makefile.in index 253f7f7a54b..a15850d55ef 100644 --- a/Makefile.in +++ b/Makefile.in @@ -108,6 +108,8 @@ am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) am__v_at_0 = @ am__v_at_1 = +HAVE_NATIVE_COMP = @HAVE_NATIVE_COMP@ + # ==================== Where To Install Things ==================== # Location to install Emacs.app under GNUstep / macOS. @@ -330,6 +332,8 @@ CONFIG_STATUS_FILES_IN = \ COPYDIR = ${srcdir}/etc ${srcdir}/lisp COPYDESTS = "$(DESTDIR)${etcdir}" "$(DESTDIR)${lispdir}" +ELN_DESTDIR = "$(DESTDIR)${libexecdir}/emacs/${version}/${configuration}/" + all: ${SUBDIR} info .PHONY: all ${SUBDIR} blessmail epaths-force epaths-force-w32 etc-emacsver @@ -422,7 +426,7 @@ dirstate = .git/logs/HEAD VCSWITNESS = $(if $(wildcard $(srcdir)/$(dirstate)),$$(srcdir)/../$(dirstate)) src: Makefile $(MAKE) -C $@ VCSWITNESS='$(VCSWITNESS)' BIN_DESTDIR='$(DESTDIR)${bindir}/' \ - LISP_DESTDIR='$(DESTDIR)${lispdir}/' all + ELN_DESTDIR='$(ELN_DESTDIR)' all blessmail: Makefile src $(MAKE) -C lib-src maybe-blessmail @@ -462,14 +466,14 @@ $(srcdir)/configure: $(srcdir)/configure.ac $(srcdir)/m4/*.m4 # ==================== Installation ==================== .PHONY: install install-arch-dep install-arch-indep install-etcdoc install-info -.PHONY: install-man install-etc install-strip install-$(NTDIR) +.PHONY: install-man install-etc install-strip install-$(NTDIR) install-eln .PHONY: uninstall uninstall-$(NTDIR) ## If we let lib-src do its own installation, that means we ## don't have to duplicate the list of utilities to install in ## this Makefile as well. -install: all install-arch-indep install-etcdoc install-arch-dep install-$(NTDIR) blessmail +install: all install-arch-indep install-etcdoc install-arch-dep install-$(NTDIR) blessmail install-eln @true ## Ensure that $subdir contains a subdirs.el file. @@ -753,6 +757,12 @@ install-etc: done ; \ done +### Install native compiled Lisp files. +install-eln: +ifeq ($(HAVE_NATIVE_COMP),yes) + find eln-cache -type f -exec ${INSTALL_DATA} -D "{}" "$(ELN_DESTDIR){}" \; +endif + ### Build Emacs and install it, stripping binaries while installing them. install-strip: $(MAKE) INSTALL_STRIP=-s install diff --git a/lisp/loadup.el b/lisp/loadup.el index 31843fc24d1..aaa5888bf92 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -449,33 +449,33 @@ lost after dumping"))) ;; At this point, we're ready to resume undo recording for scratch. (buffer-enable-undo "*scratch*") -(when (native-comp-available-p) +(when (boundp 'comp-ctxt) ;; 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). (let ((h (make-hash-table :test #'eq)) - (lisp-src-dir (expand-file-name (concat default-directory "../lisp"))) (bin-dest-dir (cadr (member "--bin-dest" command-line-args))) - (lisp-dest-dir (cadr (member "--lisp-dest" command-line-args)))) - (mapatoms (lambda (s) - (let ((f (symbol-function s))) - (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 path from the installed binary. - (file-relative-name - (concat lisp-dest-dir - (replace-regexp-in-string - (regexp-quote lisp-src-dir) "" - (native-comp-unit-file cu))) - bin-dest-dir) - ;; Relative path from the built uninstalled binary. - (file-relative-name (native-comp-unit-file cu) - invocation-directory)))) - h))) + (eln-dest-dir (cadr (member "--eln-dest" command-line-args)))) + (when (and bin-dest-dir eln-dest-dir) + (setq eln-dest-dir + (concat eln-dest-dir "eln-cache/" comp-native-path-postfix "/")) + (mapatoms (lambda (s) + (let ((f (symbol-function s))) + (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 path 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. + (file-relative-name (native-comp-unit-file cu) + invocation-directory)))) + h)))) (when (hash-table-p purify-flag) (let ((strings 0) diff --git a/src/Makefile.in b/src/Makefile.in index 7380a87644b..31a5a7e7709 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -587,7 +587,7 @@ endif ifeq ($(DUMPING),pdumper) $(pdmp): emacs$(EXEEXT) LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=pdump \ - --bin-dest $(BIN_DESTDIR) --lisp-dest $(LISP_DESTDIR) + --bin-dest $(BIN_DESTDIR) --eln-dest $(ELN_DESTDIR) cp -f $@ $(bootstrap_pdmp) endif diff --git a/src/comp.c b/src/comp.c index b795afae351..d42bb4f8eb5 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4529,6 +4529,27 @@ maybe_defer_native_compilation (Lisp_Object function_name, /* Functions used to load eln files. */ /**************************************/ +/* Fixup the system eln-cache dir. This is the last entry in + `comp-eln-load-path'. */ +void +fixup_eln_load_path (Lisp_Object directory) +{ + Lisp_Object last_cell = Qnil; + Lisp_Object tmp = Vcomp_eln_load_path; + FOR_EACH_TAIL (tmp) + if (CONSP (tmp)) + last_cell = tmp; + + Lisp_Object eln_cache_sys = + Ffile_name_directory (concat2 (Vinvocation_directory, + directory)); + /* One directory up... */ + eln_cache_sys = + Ffile_name_directory (Fsubstring (eln_cache_sys, Qnil, + make_fixnum (-1))); + Fsetcar (last_cell, eln_cache_sys); +} + typedef char *(*comp_lit_str_func) (void); /* Deserialize read and return static object. */ diff --git a/src/comp.h b/src/comp.h index 687e426b1ef..9270f8bf664 100644 --- a/src/comp.h +++ b/src/comp.h @@ -101,6 +101,8 @@ extern void dispose_all_remaining_comp_units (void); extern void clean_package_user_dir_of_old_comp_units (void); +extern void fixup_eln_load_path (Lisp_Object directory); + #else /* #ifdef HAVE_NATIVE_COMP */ static inline void diff --git a/src/pdumper.c b/src/pdumper.c index ca055a1327c..8172389a49b 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5249,23 +5249,12 @@ dump_do_dump_relocation (const uintptr_t dump_base, { fclose (file); installation_state = INSTALLED; - /* FIXME Vcomp_eln_load_path = ?? */ + fixup_eln_load_path (XCAR (comp_u->file)); } else { 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); + fixup_eln_load_path (XCDR (comp_u->file)); } } -- cgit v1.2.3 From a71f54eff80cb7d7b36326849eea878073963594 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 6 Sep 2020 18:17:00 +0200 Subject: Rework eln deletion strategy for new eln-cache folder structure When recompiling remove the corresponding stale elns found in the `comp-eln-load-path'. When removing a package remove the corresponding elns too. On Windows both of these are performed only when possible, when it's not the file is renamed as .eln.old and a last attempt to remove this is performed closing the Emacs session. When a file being deleted was loaded by multiple Emacs sessions the last one being closed should delete it. * lisp/emacs-lisp/comp.el (comp-clean-up-stale-eln): New function. (comp-delete-or-replace-file): Rename from `comp--replace-output-file' and update so it can be used for replacing or deleting shared libs safetly. * lisp/emacs-lisp/package.el (package--delete-directory): When native compiled just call `comp-clean-up-stale-eln' for each eln file we want to clean-up. * src/alloc.c (cleanup_vector): Call directly the dynlib_close. * src/comp.c (syms_of_comp): Update for comp_u->cfile removal. Make 'all_loaded_comp_units_h' key-value weak as now the key will be the filename. (load_comp_unit): Register the compilation unit only when the load is fully completed. (register_native_comp_unit): Make the key of all_loaded_comp_units_h the load filename. (eln_load_path_final_clean_up): New function. (dispose_comp_unit) (finish_delayed_disposal_of_comp_units) (dispose_all_remaining_comp_units) (clean_package_user_dir_of_old_comp_units): Remove. (Fcomp__compile_ctxt_to_file): Update for `comp--replace-output-file' -> `comp-delete-or-replace-file' rename. * src/comp.h (dispose_comp_unit) (finish_delayed_disposal_of_comp_units) (dispose_all_remaining_comp_units) (clean_package_user_dir_of_old_comp_units): Remove. (eln_load_path_final_clean_up): Add. (struct Lisp_Native_Comp_Unit): Remove cfile field. * src/emacs.c (Fkill_emacs): Call 'eln_load_path_final_clean_up'. * src/pdumper.c (dump_do_dump_relocation): Do not set comp_u->cfile. --- lisp/emacs-lisp/comp.el | 53 +++++++--- lisp/emacs-lisp/package.el | 33 ++----- src/alloc.c | 3 +- src/comp.c | 236 +++++---------------------------------------- src/comp.h | 34 +------ src/emacs.c | 6 +- src/pdumper.c | 3 - 7 files changed, 75 insertions(+), 293 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 84b5a8bc873..129a4dedaf9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2505,31 +2505,52 @@ Prepare every function for final compilation and drive the C back-end." ;; Some entry point support code. -(defun comp--replace-output-file (outfile tmpfile) - "Replace OUTFILE with TMPFILE. -Takes the necessary steps when dealing with shared libraries that -may be loaded into Emacs" +;;;###autoload +(defun comp-clean-up-stale-eln (file) + "Given FILE remove all the .eln files in `comp-eln-load-path' +sharing the original source filename (including FILE)." + (string-match (rx "-" (group-n 1 (1+ hex)) "-" (1+ hex) ".eln" eos) file) + (cl-loop + with filename-hash = (match-string 1 file) + with regexp = (rx-to-string + `(seq "-" ,filename-hash "-" (1+ hex) ".eln" eos)) + for dir in (butlast comp-eln-load-path) ; Skip last dir. + do (cl-loop + for f in (directory-files (concat dir comp-native-version-dir) t regexp + t) + do (comp-delete-or-replace-file f)))) + +(defun comp-delete-or-replace-file (oldfile &optional newfile) + "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 +session." (cond ((eq 'windows-nt system-type) - (ignore-errors (delete-file outfile)) - (let ((retry t)) - (while retry - (setf retry nil) + (ignore-errors (delete-file oldfile)) + (while (condition-case _ (progn - ;; outfile maybe recreated by another Emacs in + ;; oldfile maybe recreated by another Emacs in ;; between the following two rename-file calls - (if (file-exists-p outfile) - (rename-file outfile (make-temp-file-internal - (file-name-sans-extension outfile) + (if (file-exists-p oldfile) + (rename-file oldfile (make-temp-file-internal + (file-name-sans-extension oldfile) nil ".eln.old" nil) t)) - (rename-file tmpfile outfile nil)) - (file-already-exists (setf retry t)))))) + (when newfile + (rename-file newfile oldfile nil)) + ;; Keep on trying. + nil) + (file-already-exists + ;; Done + t)))) ;; Remove the old eln instead of copying the new one into it ;; to get a new inode and prevent crashes in case the old one ;; is currently loaded. - (t (delete-file outfile) - (rename-file tmpfile outfile)))) + (t (delete-file oldfile) + (when newfile + (rename-file newfile oldfile))))) (defvar comp-files-queue () "List of Elisp files to be compiled.") diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c349b5d49f6..c20659a1ae6 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2206,32 +2206,13 @@ If some packages are not installed propose to install them." (defun package--delete-directory (dir) "Delete DIR recursively. -In Windows move .eln and .eln.old files that can not be deleted -to `package-user-dir'." - (cond ((eq 'windows-nt system-type) - (let ((retry t)) - (while retry - (setf retry nil) - (condition-case err - (delete-directory dir t) - (file-error - (cl-destructuring-bind (_ reason1 reason2 filename) err - (if (and (string= "Removing old name" reason1) - (string= "Permission denied" reason2) - (string-prefix-p (expand-file-name package-user-dir) - filename) - (or (string-suffix-p ".eln" filename) - (string-suffix-p ".eln.old" filename))) - (progn - (rename-file filename - (make-temp-file-internal - (concat package-user-dir - (file-name-base filename)) - nil ".eln.old" nil) - t) - (setf retry t)) - (signal (car err) (cdr err))))))))) - (t (delete-directory dir t)))) +Clean-up the corresponding .eln files if Emacs is native +compiled." + (when (boundp 'comp-ctxt) + (cl-loop + for file in (directory-files-recursively dir ".el\\'") + do (comp-clean-up-stale-eln (comp-el-to-eln-filename file)))) + (delete-directory dir t)) (defun package-delete (pkg-desc &optional force nosave) "Delete package PKG-DESC. diff --git a/src/alloc.c b/src/alloc.c index 6701bf002b7..bde0a16ac15 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3153,7 +3153,8 @@ cleanup_vector (struct Lisp_Vector *vector) { struct Lisp_Native_Comp_Unit *cu = PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); - dispose_comp_unit (cu, true); + eassert (cu->handle); + dynlib_close (cu->handle); } else if (NATIVE_COMP_FLAG && PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR)) diff --git a/src/comp.c b/src/comp.c index 3a56f5f22c6..68a0ead69ae 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4361,7 +4361,8 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, GCC_JIT_OUTPUT_KIND_DYNAMIC_LIBRARY, SSDATA (tmp_file)); - CALL2I (comp--replace-output-file, file_name, tmp_file); + CALL1I (comp-clean-up-stale-eln, file_name); + CALL2I (comp-delete-or-replace-file, file_name, tmp_file); if (!noninteractive) unbind_to (count, Qnil); @@ -4438,220 +4439,44 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code) } -/*********************************/ -/* Disposal of compilation units */ -/*********************************/ - -/* - The problem: Windows does not let us delete an .eln file that has - been loaded by a process. This has two implications in Emacs: - - 1) It is not possible to recompile a lisp file if the corresponding - .eln file has been loaded. This is because we'd like to use the same - filename, but we can't delete the old .eln file. - - 2) It is not possible to delete a package using `package-delete' - if an .eln file has been loaded. - - * General idea - - The solution to these two problems is to move the foo.eln file - somewhere else and have the last Emacs instance using it delete it. - To make it easy to find what files need to be removed we use two approaches. - - In the 1) case we rename foo.eln to fooXXXXXX.eln.old in the same - folder. When Emacs is unloading "foo" (either GC'd the native - compilation unit or Emacs is closing (see below)) we delete all the - .eln.old files in the folder where the original foo.eln was stored. - - Ideally we'd figure out the new name of foo.eln and delete it if it - ends in .eln.old. There is no simple API to do this in Windows. - GetModuleFileName () returns the original filename, not the current - one. This forces us to put .eln.old files in an agreed upon path. - We cannot use %TEMP% because it may be in another drive and then the - rename operation would fail. - - In the 2) case we can't use the same folder where the .eln file - resided, as we are trying to completely remove the package. Since we - are removing packages we can safely move the .eln.old file to - `package-user-dir' as we are sure that that would not mean changing - drives. - - * Implementation details - - The concept of disposal of a native compilation unit refers to - unloading the shared library and deleting all the .eln.old files in - the directory. These are two separate steps. We'll call them - early-disposal and late-disposal. - - There are two data structures used: - - - The `all_loaded_comp_units_h` hashtable. - - This hashtable is used like an array of weak references to native - compilation units. This hash table is filled by load_comp_unit () - and dispose_all_remaining_comp_units () iterates over all values - that were not disposed by the GC and performs all disposal steps - when Emacs is closing. - - - The `delayed_comp_unit_disposal_list` list. - - This is were the dispose_comp_unit () function, when called by the - GC sweep stage, stores the original filenames of the disposed native - compilation units. This is an ad-hoc C structure instead of a Lisp - cons because we need to allocate instances of this structure during - the GC. - - The finish_delayed_disposal_of_comp_units () function will iterate - over this list and perform the late-disposal step when Emacs is - closing. - -*/ - -#ifdef WINDOWSNT -#define OLD_ELN_SUFFIX_REGEXP build_string ("\\.eln\\.old\\'") +/* `comp-eln-load-path' clean-up support code. */ static Lisp_Object all_loaded_comp_units_h; -/* We need to allocate instances of this struct during a GC sweep. - This is why it can't be transformed into a simple cons. */ -struct delayed_comp_unit_disposal -{ - struct delayed_comp_unit_disposal *next; - char *filename; -}; - -struct delayed_comp_unit_disposal *delayed_comp_unit_disposal_list; - -static Lisp_Object -return_nil (Lisp_Object arg) -{ - return Qnil; -} - -/* Tries to remove all *.eln.old files in DIRNAME. +/* Windows does not let us delete a .eln file that is currently loaded + by a process. The strategy is to rename .eln files into .old.eln + instead of removing them when this is not possible and clean-up + `comp-eln-load-path' when exiting. Any error is ignored because it may be due to the file being loaded in another Emacs instance. */ -static void -clean_comp_unit_directory (Lisp_Object dirpath) -{ - if (NILP (dirpath)) - return; - Lisp_Object files_in_dir; - files_in_dir = internal_condition_case_4 (Fdirectory_files, dirpath, Qt, - OLD_ELN_SUFFIX_REGEXP, Qnil, Qt, - return_nil); - FOR_EACH_TAIL (files_in_dir) { DeleteFile (SSDATA (XCAR (files_in_dir))); } -} - -/* Tries to remove all *.eln.old files in `package-user-dir'. - - This is called when Emacs is closing to clean any *.eln left from a - deleted package. */ void -clean_package_user_dir_of_old_comp_units (void) +eln_load_path_final_clean_up (void) { - Lisp_Object package_user_dir - = find_symbol_value (intern ("package-user-dir")); - if (EQ (package_user_dir, Qunbound) || !STRINGP (package_user_dir)) - return; - - clean_comp_unit_directory (package_user_dir); -} - -/* This function disposes all compilation units that are still loaded. - - It is important that this function is called only right before - Emacs is closed, otherwise we risk running a subr that is - implemented in an unloaded dynamic library. */ -void -dispose_all_remaining_comp_units (void) -{ - struct Lisp_Hash_Table *h = XHASH_TABLE (all_loaded_comp_units_h); - - for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) - { - Lisp_Object k = HASH_KEY (h, i); - if (!EQ (k, Qunbound)) - { - Lisp_Object val = HASH_VALUE (h, i); - struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (val); - dispose_comp_unit (cu, false); - } - } -} - -/* This function finishes the disposal of compilation units that were - passed to `dispose_comp_unit` with DELAY == true. +#ifdef WINDOWSNT + Lisp_Object return_nil (Lisp_Object arg) { return Qnil; } - This function is called when Emacs is idle and when it is about to - close. */ -void -finish_delayed_disposal_of_comp_units (void) -{ - for (struct delayed_comp_unit_disposal *item - = delayed_comp_unit_disposal_list; - delayed_comp_unit_disposal_list; item = delayed_comp_unit_disposal_list) + Lisp_Object dir_tail = Vcomp_eln_load_path; + FOR_EACH_TAIL (dir_tail) { - delayed_comp_unit_disposal_list = item->next; - Lisp_Object dirname = internal_condition_case_1 ( - Ffile_name_directory, build_string (item->filename), Qt, return_nil); - clean_comp_unit_directory (dirname); - xfree (item->filename); - xfree (item); + Lisp_Object files_in_dir = + internal_condition_case_4 (Fdirectory_files, + concat2 (XCAR (dir_tail), + Vcomp_native_version_dir), + Qt, build_string ("\\.eln\\.old\\'"), Qnil, + Qt, return_nil); + FOR_EACH_TAIL (files_in_dir) + Fdelete_file (XCAR (files_in_dir), Qnil); } -} #endif +} /* This function puts the compilation unit in the `all_loaded_comp_units_h` hashmap. */ static void register_native_comp_unit (Lisp_Object comp_u) { -#ifdef WINDOWSNT - /* We have to do this since we can't use `gensym'. This function is - called early when loading a dump file and subr.el may not have - been loaded yet. */ - static intmax_t count; - - Fputhash (make_int (count++), comp_u, all_loaded_comp_units_h); -#endif -} - -/* This function disposes compilation units. It is called during the GC sweep - stage and when Emacs is closing. - - On Windows the the DELAY parameter specifies whether the native - compilation file will be deleted right away (if necessary) or put - on a list. That list will be dealt with by - `finish_delayed_disposal_of_comp_units`. */ -void -dispose_comp_unit (struct Lisp_Native_Comp_Unit *comp_handle, bool delay) -{ - eassert (comp_handle->handle); - dynlib_close (comp_handle->handle); -#ifdef WINDOWSNT - if (!delay) - { - Lisp_Object dirname = internal_condition_case_1 ( - Ffile_name_directory, build_string (comp_handle->cfile), Qt, - return_nil); - if (!NILP (dirname)) - clean_comp_unit_directory (dirname); - xfree (comp_handle->cfile); - comp_handle->cfile = NULL; - } - else - { - struct delayed_comp_unit_disposal *head; - head = xmalloc (sizeof (struct delayed_comp_unit_disposal)); - head->next = delayed_comp_unit_disposal_list; - head->filename = comp_handle->cfile; - comp_handle->cfile = NULL; - delayed_comp_unit_disposal_list = head; - } -#endif + Fputhash (XNATIVE_COMP_UNIT (comp_u)->file, comp_u, all_loaded_comp_units_h); } @@ -4663,7 +4488,6 @@ dispose_comp_unit (struct Lisp_Native_Comp_Unit *comp_handle, bool delay) loaded the compiler and its dependencies. */ static Lisp_Object delayed_sources; - /* Queue an asyncronous compilation for the source file defining FUNCTION_NAME and perform a late load. @@ -4922,12 +4746,6 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec)); for (EMACS_INT i = 0; i < d_vec_len; i++) data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i); - - /* If we register them while dumping we will get some entries in - the hash table that will be duplicated when pdumper calls - load_comp_unit. */ - if (!will_dump_p ()) - register_native_comp_unit (comp_u_lisp_obj); } if (!loading_dump) @@ -4968,6 +4786,8 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, /* Clean-up the load ongoing flag in case. */ unbind_to (count, Qnil); + register_native_comp_unit (comp_u_lisp_obj); + return; } @@ -5110,9 +4930,6 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, if (!comp_u->handle) xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ())); comp_u->file = file; -#ifdef WINDOWSNT - comp_u->cfile = xlispstrdup (file); -#endif comp_u->data_vec = Qnil; comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq); comp_u->lambda_c_name_idx_h = CALLN (Fmake_hash_table, QCtest, Qequal); @@ -5275,10 +5092,9 @@ native compiled one. */); staticpro (&loadsearch_re_list); loadsearch_re_list = Qnil; -#ifdef WINDOWSNT staticpro (&all_loaded_comp_units_h); - all_loaded_comp_units_h = CALLN (Fmake_hash_table, QCweakness, Qvalue); -#endif + all_loaded_comp_units_h = + CALLN (Fmake_hash_table, QCweakness, Qkey_and_value, QCtest, Qequal); DEFVAR_LISP ("comp-ctxt", Vcomp_ctxt, doc: /* The compiler context. */); diff --git a/src/comp.h b/src/comp.h index 9270f8bf664..5c7bed6a304 100644 --- a/src/comp.h +++ b/src/comp.h @@ -54,13 +54,6 @@ struct Lisp_Native_Comp_Unit bool loaded_once; bool load_ongoing; dynlib_handle_ptr handle; -#ifdef WINDOWSNT - /* We need to store a copy of the original file name in memory that - is not subject to GC because the function to dispose native - compilation units is called by the GC. By that time the `file' - string may have been sweeped. */ - char *cfile; -#endif } GCALIGNED_STRUCT; #ifdef HAVE_NATIVE_COMP @@ -92,14 +85,7 @@ extern void syms_of_comp (void); extern void maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object definition); -extern void dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_unit, - bool delay); - -extern void finish_delayed_disposal_of_comp_units (void); - -extern void dispose_all_remaining_comp_units (void); - -extern void clean_package_user_dir_of_old_comp_units (void); +extern void eln_load_path_final_clean_up (void); extern void fixup_eln_load_path (Lisp_Object directory); @@ -112,24 +98,6 @@ maybe_defer_native_compilation (Lisp_Object function_name, extern void syms_of_comp (void); -static inline void -dispose_comp_unit (struct Lisp_Native_Comp_Unit * comp_handle, bool delay) -{ - eassert (false); -} - -static inline void -dispose_all_remaining_comp_units (void) -{} - -static inline void -clean_package_user_dir_of_old_comp_units (void) -{} - -static inline void -finish_delayed_disposal_of_comp_units (void) -{} - #endif /* #ifdef HAVE_NATIVE_COMP */ #endif /* #ifndef COMP_H */ diff --git a/src/emacs.c b/src/emacs.c index 8e52da75926..07e40fdc8bd 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2407,10 +2407,8 @@ all of which are called before Emacs is actually killed. */ unlink (SSDATA (listfile)); } -#if defined (HAVE_NATIVE_COMP) && defined (WINDOWSNT) - finish_delayed_disposal_of_comp_units (); - dispose_all_remaining_comp_units (); - clean_package_user_dir_of_old_comp_units (); +#ifdef HAVE_NATIVE_COMP + eln_load_path_final_clean_up (); #endif if (FIXNUMP (arg)) diff --git a/src/pdumper.c b/src/pdumper.c index 9c615a9a1a7..da5e7a17363 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5275,9 +5275,6 @@ dump_do_dump_relocation (const uintptr_t dump_base, concat2 (Vinvocation_directory, installation_state == INSTALLED ? XCAR (comp_u->file) : XCDR (comp_u->file)); -#ifdef WINDOWSNT - comp_u->cfile = xlispstrdup (comp_u->file); -#endif comp_u->handle = dynlib_open (SSDATA (comp_u->file)); if (!comp_u->handle) error ("%s", dynlib_error ()); -- cgit v1.2.3 From 8861ee8b087b4e5d9ac9186a2c2d8e44b07fc186 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Mon, 12 Oct 2020 22:11:06 +0200 Subject: Have `native-elisp-load' return the last registerd function * lisp/emacs-lisp/comp.el (comp-emit-for-top-level): Synthesize 'top_level_run' so it returns the last value returned by `comp--register-subr'. * src/comp.c (load_comp_unit): Return what 'top_level_run' returns. (Fnative_elisp_load): Return what 'load_comp_unit' returns. * src/comp.h (load_comp_unit): Update signature. --- lisp/emacs-lisp/comp.el | 47 +++++++++++++++++++++++++++-------------------- src/comp.c | 11 +++++------ src/comp.h | 4 ++-- 3 files changed, 34 insertions(+), 28 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 89b4230dc2c..98f552599e9 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1480,24 +1480,26 @@ the annotation emission." (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt))) (args (comp-prepare-args-for-top-level f))) (cl-assert (and name f)) - (comp-emit (comp-call (if for-late-load - 'comp--late-register-subr - 'comp--register-subr) - (make-comp-mvar :constant name) - (car args) - (cdr args) - (make-comp-mvar :constant c-name) - (make-comp-mvar - :constant - (let* ((h (comp-ctxt-function-docs comp-ctxt)) - (i (hash-table-count h))) - (puthash i (comp-func-doc f) h) - i)) - (make-comp-mvar :constant - (comp-func-int-spec f)) - ;; This is the compilation unit it-self passed as - ;; parameter. - (make-comp-mvar :slot 0))))) + (comp-emit + `(set ,(make-comp-mvar :slot 1) + ,(comp-call (if for-late-load + 'comp--late-register-subr + 'comp--register-subr) + (make-comp-mvar :constant name) + (car args) + (cdr args) + (make-comp-mvar :constant c-name) + (make-comp-mvar + :constant + (let* ((h (comp-ctxt-function-docs comp-ctxt)) + (i (hash-table-count h))) + (puthash i (comp-func-doc f) h) + i)) + (make-comp-mvar :constant + (comp-func-int-spec f)) + ;; This is the compilation unit it-self passed as + ;; parameter. + (make-comp-mvar :slot 0)))))) (cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level) for-late-load) @@ -1558,7 +1560,12 @@ into the C code forwarding the compilation unit." "late_top_level_run" "top_level_run") :args (make-comp-args :min 1 :max 1) - :frame-size 1 + ;; Frame is 2 wide: Slot 0 is the + ;; compilation unit being loaded + ;; (incoming parameter). Slot 1 is + ;; the last function being + ;; registered. + :frame-size 2 :speed comp-speed)) (comp-func func) (comp-pass (make-comp-limplify @@ -1575,7 +1582,7 @@ into the C code forwarding the compilation unit." (comp-ctxt-byte-func-to-func-h comp-ctxt)) (mapc (lambda (x) (comp-emit-for-top-level x for-late-load)) (comp-ctxt-top-level-forms comp-ctxt)) - (comp-emit `(return ,(make-comp-mvar :constant t))) + (comp-emit `(return ,(make-comp-mvar :slot 1))) (puthash 0 (comp-func-frame-size func) (comp-func-array-h func)) (comp-limplify-finalize-function func))) diff --git a/src/comp.c b/src/comp.c index 0b5a49fd1f1..f80172e89bf 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4768,10 +4768,11 @@ unset_cu_load_ongoing (Lisp_Object comp_u) XNATIVE_COMP_UNIT (comp_u)->load_ongoing = false; } -void +Lisp_Object load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, bool late_load) { + Lisp_Object res = Qnil; dynlib_handle_ptr handle = comp_u->handle; Lisp_Object comp_u_lisp_obj; XSETNATIVE_COMP_UNIT (comp_u_lisp_obj, comp_u); @@ -4897,7 +4898,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, } /* Executing this will perform all the expected environment modifications. */ - top_level_run (comp_u_lisp_obj); + res = top_level_run (comp_u_lisp_obj); /* Make sure data_ephemeral_vec still exists after top_level_run has run. Guard against sibling call optimization (or any other). */ data_ephemeral_vec = data_ephemeral_vec; @@ -4910,7 +4911,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, register_native_comp_unit (comp_u_lisp_obj); - return; + return res; } Lisp_Object @@ -5090,9 +5091,7 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, comp_u->data_vec = Qnil; comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq); comp_u->lambda_c_name_idx_h = CALLN (Fmake_hash_table, QCtest, Qequal); - load_comp_unit (comp_u, false, !NILP (late_load)); - - return Qt; + return load_comp_unit (comp_u, false, !NILP (late_load)); } #endif /* HAVE_NATIVE_COMP */ diff --git a/src/comp.h b/src/comp.h index 5c7bed6a304..077250ea869 100644 --- a/src/comp.h +++ b/src/comp.h @@ -75,8 +75,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, bool late_load); +extern Lisp_Object load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, + bool loading_dump, bool late_load); extern Lisp_Object native_function_doc (Lisp_Object function); -- cgit v1.2.3 From cf436db285bd27dae35fecfa9038c9ce48953853 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 20 Nov 2020 20:34:32 +0100 Subject: ; Fix trivial typos --- lisp/emacs-lisp/bytecomp.el | 2 +- lisp/emacs-lisp/comp.el | 24 ++++++++++++------------ src/comp.c | 12 ++++++------ src/comp.h | 2 +- src/pdumper.c | 2 +- test/src/comp-tests.el | 4 ++-- 6 files changed, 23 insertions(+), 23 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5508a60c444..6d2bff103e7 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -602,7 +602,7 @@ Each element is (INDEX . VALUE)") "To spill default qualities from the compiled file.") (defvar byte-native-for-bootstrap nil "Non nil while compiling for bootstrap." - ;; During boostrap we produce both the .eln and the .elc together. + ;; During bootstrap we produce both the .eln and the .elc together. ;; Because the make target is the later this has to be produced as ;; last to be resilient against build interruptions. ) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index cc5922c61c6..633ededebe4 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -118,7 +118,7 @@ compilation input." :type 'hook) (defcustom comp-async-env-modifier-form nil - "Form evaluated before compilation by each asyncronous compilation worker. + "Form evaluated before compilation by each asynchronous compilation worker. Usable to modify the compiler environment." :type 'list) @@ -352,7 +352,7 @@ Needed to replace immediate byte-compiled lambdas with the compiled reference.") :documentation "Standard data relocated in use by functions.") (d-impure (make-comp-data-container) :type comp-data-container :documentation "Relocated data that cannot be moved into pure space. -This is tipically for top-level forms other than defun.") +This is typically for top-level forms other than defun.") (d-ephemeral (make-comp-data-container) :type comp-data-container :documentation "Relocated data not necessary after load.") (with-late-load nil :type boolean @@ -389,7 +389,7 @@ To be used when ncall-conv is nil.")) :documentation "List of instructions.") (closed nil :type boolean :documentation "t if closed.") - ;; All the followings are for SSA and CGF analysis. + ;; All the following are for SSA and CGF analysis. ;; Keep in sync with `comp-clean-ssa'!! (in-edges () :type list :documentation "List of incoming edges.") @@ -461,7 +461,7 @@ CFG is mutated by a pass.") (blocks (make-hash-table) :type hash-table :documentation "Basic block name -> basic block.") (lap-block (make-hash-table :test #'equal) :type hash-table - :documentation "LAP lable -> LIMPLE basic block name.") + :documentation "LAP label -> LIMPLE basic block name.") (edges-h (make-hash-table) :type hash-table :documentation "Hash edge-num -> edge connecting basic two blocks.") (block-cnt-gen (funcall #'comp-gen-counter) :type function @@ -749,7 +749,7 @@ Assume allocation class 'd-default as default." comp-curr-allocation-class)))) -;;; Log rountines. +;;; Log routines. (defconst comp-limple-lock-keywords `((,(rx bol "(comment" (1+ not-newline)) . font-lock-comment-face) @@ -873,7 +873,7 @@ instruction." Add PREFIX in front of it. If FIRST is not nil, pick the first available name ignoring compilation context and potential name clashes." - ;; Unfortunatelly not all symbol names are valid as C function names... + ;; Unfortunately not all symbol names are valid as C function names... ;; Nassi's algorithm here: (let* ((orig-name (if (symbolp name) (symbol-name name) name)) (crypted (cl-loop with str = (make-string (* 2 (length orig-name)) 0) @@ -2008,7 +2008,7 @@ Return the corresponding rhs slot number." (defun comp-cond-rw (_) "Rewrite conditional branches adding appropriate 'assume' insns. This is introducing and placing 'assume' insns in use by fwprop -to propagate conditional branch test informations on target basic +to propagate conditional branch test information on target basic blocks." (maphash (lambda (_ f) (when (and (>= (comp-func-speed f) 1) @@ -2051,7 +2051,7 @@ blocks." f)))) (defun comp-pure-infer-func (f) - "If all funtions called by F are pure then F is pure too." + "If all functions called by F are pure then F is pure too." (when (and (cl-every (lambda (x) (or (comp-function-pure-p x) (eq x (comp-func-name f)))) @@ -2094,7 +2094,7 @@ blocks." mvar)) (defun comp-clean-ssa (f) - "Clean-up SSA for funtion F." + "Clean-up SSA for function F." (setf (comp-func-edges-h f) (make-hash-table)) (cl-loop for b being each hash-value of (comp-func-blocks f) @@ -2367,7 +2367,7 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non-nil." do (finalize-phi args b))))) (defun comp-ssa () - "Port all functions into mininal SSA form." + "Port all functions into minimal SSA form." (maphash (lambda (_ f) (let* ((comp-func f) (ssa-status (comp-func-ssa-status f))) @@ -3139,7 +3139,7 @@ Prepare every function for final compilation and drive the C back-end." x) -;; Primitive funciton advice machinery +;; Primitive function advice machinery (defun comp-trampoline-filename (subr-name) "Given SUBR-NAME return the filename containing the trampoline." @@ -3445,7 +3445,7 @@ load once finished compiling." ;;;###autoload (defun native-compile (function-or-file &optional output) "Compile FUNCTION-OR-FILE into native code. -This is the syncronous entry-point for the Emacs Lisp native +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 an Emacs Lisp source file. diff --git a/src/comp.c b/src/comp.c index 292f0e7e707..6ddfad528b4 100644 --- a/src/comp.c +++ b/src/comp.c @@ -1517,7 +1517,7 @@ emit_XFIXNUM (gcc_jit_rvalue *obj) emit_comment ("XFIXNUM"); gcc_jit_rvalue *i = emit_coerce (comp.emacs_uint_type, emit_XLI (obj)); - /* FIXME: Implementation dependent (both RSHIFT are arithmetics). */ + /* FIXME: Implementation dependent (both RSHIFT are arithmetic). */ if (!USE_LSB_TAG) { @@ -3780,7 +3780,7 @@ define_maybe_gc_or_quit (void) /* 9 translates into checking for GC or quit every 512 calls to 'maybe_gc_quit'. This is the smallest value I could find with no performance impact running elisp-banechmarks and the same - used by the byte intepreter (see 'exec_byte_code'). */ + used by the byte interpreter (see 'exec_byte_code'). */ maybe_do_it_block, pass_block); @@ -4067,7 +4067,7 @@ If BASE-DIR is nil use the first entry in `comp-eln-load-path'. */) 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 + same filename, should be possible to clean up all filename-path_hash-* except the most recent one (or the new one being recompiled). @@ -4617,7 +4617,7 @@ register_native_comp_unit (Lisp_Object comp_u) loaded the compiler and its dependencies. */ static Lisp_Object delayed_sources; -/* Queue an asyncronous compilation for the source file defining +/* Queue an asynchronous compilation for the source file defining FUNCTION_NAME and perform a late load. NOTE: ideally would be nice to move its call simply into Fload but @@ -4671,7 +4671,7 @@ maybe_defer_native_compilation (Lisp_Object function_name, } /* This is to have deferred compilaiton able to compile comp - dependecies breaking circularity. */ + dependencies breaking circularity. */ if (!NILP (Ffeaturep (Qcomp, Qnil))) { /* Comp already loaded. */ @@ -5297,7 +5297,7 @@ 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 + /* 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); diff --git a/src/comp.h b/src/comp.h index 077250ea869..f7d17f398c7 100644 --- a/src/comp.h +++ b/src/comp.h @@ -42,7 +42,7 @@ struct Lisp_Native_Comp_Unit Lisp_Object lambda_gc_guard_h; /* Hash c_name -> d_reloc_imp index. */ Lisp_Object lambda_c_name_idx_h; - /* Hash doc-idx -> function documentaiton. */ + /* Hash doc-idx -> function documentation. */ Lisp_Object data_fdoc_v; /* Analogous to the constant vector but per compilation unit. */ Lisp_Object data_vec; diff --git a/src/pdumper.c b/src/pdumper.c index c253fc53c47..e0f8f5577ed 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -326,7 +326,7 @@ dump_fingerprint (char const *label, /* To be used if some order in the relocation process has to be enforced. */ enum reloc_phase { - /* First to run. Place here every relocation with no dependecy. */ + /* First to run. Place every relocation with no dependency here. */ EARLY_RELOCS, /* Late and very late relocs are relocated at the very last after all hooks has been run. All lisp machinery is at disposal diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index bf3f57a85e3..fffc72015b8 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -393,7 +393,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (defvar comp-test-primitive-advice) (comp-deftest primitive-advice () - "Test effectiveness of primitve advicing." + "Test effectiveness of primitive advicing." (let (comp-test-primitive-advice (f (lambda (&rest args) (setq comp-test-primitive-advice args)))) @@ -406,7 +406,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." (defvar comp-test-primitive-redefine-args) (comp-deftest primitive-redefine () - "Test effectiveness of primitve redefinition." + "Test effectiveness of primitive redefinition." (cl-letf ((comp-test-primitive-redefine-args nil) ((symbol-function #'-) (lambda (&rest args) -- cgit v1.2.3 From 93f92cf1ba37f8b9abaee4b9487705bae464c4e0 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Sun, 7 Mar 2021 21:26:29 +0000 Subject: Zero stale pointer when unloading comp units (bug#46256) * src/alloc.c (cleanup_vector): Call unload_comp_unit. * src/comp.c (unload_comp_unit): New function. --- src/alloc.c | 3 +-- src/comp.c | 14 ++++++++++++++ src/comp.h | 2 ++ 3 files changed, 17 insertions(+), 2 deletions(-) (limited to 'src/comp.h') diff --git a/src/alloc.c b/src/alloc.c index af083361770..fee8cc08aa4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3157,8 +3157,7 @@ cleanup_vector (struct Lisp_Vector *vector) { struct Lisp_Native_Comp_Unit *cu = PSEUDOVEC_STRUCT (vector, Lisp_Native_Comp_Unit); - eassert (cu->handle); - dynlib_close (cu->handle); + unload_comp_unit (cu); } else if (NATIVE_COMP_FLAG && PSEUDOVECTOR_TYPEP (&vector->header, PVEC_SUBR)) diff --git a/src/comp.c b/src/comp.c index e6f672de254..e1809785410 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4949,6 +4949,20 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, return res; } +void +unload_comp_unit (struct Lisp_Native_Comp_Unit *cu) +{ + if (cu->handle == NULL) + return; + + Lisp_Object *saved_cu = dynlib_sym (cu->handle, COMP_UNIT_SYM); + Lisp_Object this_cu; + XSETNATIVE_COMP_UNIT (this_cu, cu); + if (EQ (this_cu, *saved_cu)) + *saved_cu = Qnil; + dynlib_close (cu->handle); +} + Lisp_Object native_function_doc (Lisp_Object function) { diff --git a/src/comp.h b/src/comp.h index f7d17f398c7..d01bc17565d 100644 --- a/src/comp.h +++ b/src/comp.h @@ -78,6 +78,8 @@ extern void hash_native_abi (void); extern Lisp_Object load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, bool late_load); +extern void unload_comp_unit (struct Lisp_Native_Comp_Unit *); + extern Lisp_Object native_function_doc (Lisp_Object function); extern void syms_of_comp (void); -- cgit v1.2.3 From 978afd788fd0496540f715b83f18ed390ca8d5a4 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 1 Apr 2021 22:15:08 +0200 Subject: * src/comp.h (unload_comp_unit): Define for vanilla build (warning removal). --- src/comp.h | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'src/comp.h') diff --git a/src/comp.h b/src/comp.h index d01bc17565d..e17b843d139 100644 --- a/src/comp.h +++ b/src/comp.h @@ -98,6 +98,10 @@ maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object definition) {} +static inline +void unload_comp_unit (struct Lisp_Native_Comp_Unit *cu) +{} + extern void syms_of_comp (void); #endif /* #ifdef HAVE_NATIVE_COMP */ -- cgit v1.2.3 From 9aa5203b542f0c9ea7d074c6cfde2a28b466f5d1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 17 Apr 2021 16:49:16 +0300 Subject: Fix loading *.eln files when Emacs is installed via symlinks * src/emacs.c (real_filename, set_invocation_vars) (init_vars_for_load): Functions deleted; callers adjusted. (init_cmdargs): Put back all the code which was extracted into set_invocation_vars. (load_pdump_find_executable): Make sure the return value has any symlinks in it expanded. (load_pdump): Accept only 2 arguments, not 3. Determine both the file name of the Emacs executable and of the dump file in synchronized manner, so that if we decided to look for the dump file in its hardcoded installation directory, the directory of the Emacs executable will also be where we expect it to be installed. Pass only 2 arguments to pdumper_load. (Bug#47800) (Bug#44128) * src/pdumper.c (dump_do_dump_relocation): Use emacs_execdir instead of Vinvocation_directory to produce absolute file names of *.eln files that are recorded in the pdumper file. Pass the full .eln file name to fixup_eln_load_path. (pdumper_set_emacs_execdir) [HAVE_NATIVE_COMP]: New function. (pdumper_load) [HAVE_NATIVE_COMP]: Call pdumper_set_emacs_execdir. * src/comp.c (fixup_eln_load_path): Use Fsubstring_no_properties instead of Fsubstring. No need to cons a file name, as the caller already did that. Use explicit const string to avoid "magic" values. * lisp/startup.el (normal-top-level): Use expand-file-name instead of concat. Decode comp-eln-load-path and expand-file-name its members. --- lisp/startup.el | 13 +++- src/comp.c | 35 ++++----- src/comp.h | 6 +- src/emacs.c | 223 +++++++++++++++++++++++--------------------------------- src/lisp.h | 1 - src/pdumper.c | 93 +++++++++++++++++------ src/pdumper.h | 3 +- 7 files changed, 200 insertions(+), 174 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/startup.el b/lisp/startup.el index 6e0faf3f68a..01d28141654 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -544,7 +544,8 @@ It is the default value of the variable `top-level'." (dolist (path (split-string path-env path-separator)) (unless (string= "" path) (push path comp-eln-load-path))))) - (push (concat user-emacs-directory "eln-cache/") comp-eln-load-path) + (push (expand-file-name "eln-cache/" user-emacs-directory) + 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. @@ -636,6 +637,16 @@ It is the default value of the variable `top-level'." (set pathsym (mapcar (lambda (dir) (decode-coding-string dir coding t)) path))))) + (when (featurep 'nativecomp) + (let ((npath (symbol-value 'comp-eln-load-path))) + (set '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. + (expand-file-name + (decode-coding-string dir coding t))) + npath)))) (dolist (filesym '(data-directory doc-directory exec-directory installation-directory invocation-directory invocation-name diff --git a/src/comp.c b/src/comp.c index c4b9b4b6c10..50947316df8 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4749,29 +4749,30 @@ maybe_defer_native_compilation (Lisp_Object function_name, /* Functions used to load eln files. */ /**************************************/ -/* Fixup the system eln-cache dir. This is the last entry in - `comp-eln-load-path'. */ +/* Fixup the system eln-cache directory, which is the last entry in + `comp-eln-load-path'. Argument is a .eln file in that directory. */ void fixup_eln_load_path (Lisp_Object eln_filename) { Lisp_Object last_cell = Qnil; - Lisp_Object tmp = Vcomp_eln_load_path; - FOR_EACH_TAIL (tmp) - if (CONSP (tmp)) - last_cell = tmp; - - Lisp_Object eln_cache_sys = - Ffile_name_directory (concat2 (Vinvocation_directory, - eln_filename)); - bool preloaded = - !NILP (Fequal (Fsubstring (eln_cache_sys, make_fixnum (-10), - make_fixnum (-1)), - build_string ("preloaded"))); + Lisp_Object tem = Vcomp_eln_load_path; + FOR_EACH_TAIL (tem) + if (CONSP (tem)) + last_cell = tem; + + const char preloaded[] = "preloaded"; + ptrdiff_t preloaded_len = sizeof (preloaded) - 1; + Lisp_Object eln_cache_sys = Ffile_name_directory (eln_filename); + bool preloaded_p = + !NILP (Fequal (Fsubstring_no_properties (eln_cache_sys, + make_fixnum (-preloaded_len - 1), + make_fixnum (-1)), + build_string (preloaded))); /* One or two directories up... */ - for (int i = 0; i < (preloaded ? 2 : 1); i++) + for (int i = 0; i < (preloaded_p ? 2 : 1); i++) eln_cache_sys = - Ffile_name_directory (Fsubstring (eln_cache_sys, Qnil, - make_fixnum (-1))); + Ffile_name_directory (Fsubstring_no_properties (eln_cache_sys, Qnil, + make_fixnum (-1))); Fsetcar (last_cell, eln_cache_sys); } diff --git a/src/comp.h b/src/comp.h index e17b843d139..03d22dfaa0e 100644 --- a/src/comp.h +++ b/src/comp.h @@ -34,7 +34,11 @@ enum { struct Lisp_Native_Comp_Unit { union vectorlike_header header; - /* Original eln file loaded. */ + /* The original eln file loaded. In the pdumper file this is stored + as a cons cell of 2 alternative file names: the car is the + filename relative to the directory of an installed binary, the + cdr is the filename relative to the directory of an uninstalled + binary. This is arranged in loadup.el. */ Lisp_Object file; Lisp_Object optimize_qualities; /* Guard anonymous lambdas against Garbage Collection and serve diff --git a/src/emacs.c b/src/emacs.c index a2565645c6c..d27b1c1351d 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -440,53 +440,33 @@ terminate_due_to_signal (int sig, int backtrace_limit) exit (1); } -/* Return the real filename following symlinks in case. - The caller should deallocate the returned buffer. */ - -static char * -real_filename (char *filename) -{ - char *real_name; -#ifdef WINDOWSNT - /* w32_my_exename resolves symlinks internally, so no need to - call realpath. */ - real_name = xstrdup (filename); -#else - real_name = realpath (filename, NULL); - if (!real_name) - fatal ("could not resolve realpath of \"%s\": %s", - filename, strerror (errno)); -#endif - return real_name; -} - -/* Set `invocation-name' `invocation-directory'. */ - + +/* Code for dealing with Lisp access to the Unix command line. */ static void -set_invocation_vars (char *argv0, char const *original_pwd) +init_cmdargs (int argc, char **argv, int skip_args, char const *original_pwd) { - Lisp_Object raw_name, handler; + int i; + Lisp_Object name, dir, handler; + ptrdiff_t count = SPECPDL_INDEX (); + Lisp_Object raw_name; AUTO_STRING (slash_colon, "/:"); + initial_argv = argv; + initial_argc = argc; + #ifdef WINDOWSNT - /* Must use argv0 converted to UTF-8, as it begets many standard + /* Must use argv[0] converted to UTF-8, as it begets many standard file and directory names. */ { - char argv0_1[MAX_UTF8_PATH]; + char argv0[MAX_UTF8_PATH]; - /* Avoid calling 'openp' below, as we aren't ready for that yet: - emacs_dir is not yet defined in the environment, and therefore - emacs_root_dir, called by expand-file-name, will abort. */ - if (!IS_ABSOLUTE_FILE_NAME (argv0)) - argv0 = w32_my_exename (); - - if (filename_from_ansi (argv0, argv0_1) == 0) - raw_name = build_unibyte_string (argv0_1); - else + if (filename_from_ansi (argv[0], argv0) == 0) raw_name = build_unibyte_string (argv0); + else + raw_name = build_unibyte_string (argv[0]); } #else - raw_name = build_unibyte_string (argv0); + raw_name = build_unibyte_string (argv[0]); #endif /* Add /: to the front of the name @@ -495,26 +475,16 @@ set_invocation_vars (char *argv0, char const *original_pwd) if (! NILP (handler)) raw_name = concat2 (slash_colon, raw_name); - char *filename = real_filename (SSDATA (raw_name)); - raw_name = build_unibyte_string (filename); - xfree (filename); - Vinvocation_name = Ffile_name_nondirectory (raw_name); Vinvocation_directory = Ffile_name_directory (raw_name); -#ifdef WINDOWSNT - eassert (!NILP (Vinvocation_directory) - && !NILP (Ffile_name_absolute_p (Vinvocation_directory))); -#endif - - /* If we got no directory in argv0, search PATH to find where + /* If we got no directory in argv[0], search PATH to find where Emacs actually came from. */ if (NILP (Vinvocation_directory)) { Lisp_Object found; - int yes = - openp (Vexec_path, Vinvocation_name, Vexec_suffixes, &found, - make_fixnum (X_OK), false, 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 @@ -536,38 +506,6 @@ set_invocation_vars (char *argv0, char const *original_pwd) Vinvocation_directory = Fexpand_file_name (Vinvocation_directory, odir); } -} - -/* Initialize a number of variables (ultimately - 'Vinvocation_directory') needed by pdumper to complete native code - load. */ - -void -init_vars_for_load (char *argv0, char const *original_pwd) -{ - /* This function is called from within pdumper while loading (as - soon as we are able to allocate) or later during boot if pdumper - is not used. No need to run it twice. */ - static bool double_run_guard; - if (double_run_guard) - return; - double_run_guard = true; - - init_callproc_1 (); /* Must precede init_cmdargs and init_sys_modes. */ - set_invocation_vars (argv0, original_pwd); -} - - -/* Code for dealing with Lisp access to the Unix command line. */ -static void -init_cmdargs (int argc, char **argv, int skip_args, char const *original_pwd) -{ - int i; - Lisp_Object name, dir; - ptrdiff_t count = SPECPDL_INDEX (); - - initial_argv = argv; - initial_argc = argc; Vinstallation_directory = Qnil; @@ -801,6 +739,8 @@ load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size) implementation of malloc, since the caller calls our free. */ #ifdef WINDOWSNT char *prog_fname = w32_my_exename (); + if (prog_fname) + *candidate_size = strlen (prog_fname) + 1; return prog_fname ? xstrdup (prog_fname) : NULL; #else /* !WINDOWSNT */ char *candidate = NULL; @@ -846,7 +786,19 @@ load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size) struct stat st; if (file_access_p (candidate, X_OK) && stat (candidate, &st) == 0 && S_ISREG (st.st_mode)) - return candidate; + { + /* People put on PATH a symlink to the real Emacs + executable, with all the auxiliary files where the real + executable lives. Support that. */ + if (lstat (candidate, &st) == 0 && S_ISLNK (st.st_mode)) + { + char *real_name = realpath (candidate, NULL); + + if (real_name) + return real_name; + } + return candidate; + } *candidate = '\0'; } while (*path++ != '\0'); @@ -856,10 +808,11 @@ load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size) } static void -load_pdump (int argc, char **argv, char const *original_pwd) +load_pdump (int argc, char **argv) { const char *const suffix = ".pdmp"; int result; + char *emacs_executable = argv[0]; const char *strip_suffix = #if defined DOS_NT || defined CYGWIN ".exe" @@ -889,9 +842,19 @@ load_pdump (int argc, char **argv, char const *original_pwd) skip_args++; } + /* Where's our executable? */ + ptrdiff_t bufsize, exec_bufsize; + emacs_executable = load_pdump_find_executable (argv[0], &bufsize); + exec_bufsize = bufsize; + + /* If we couldn't find our executable, go straight to looking for + the dump in the hardcoded location. */ + if (!(emacs_executable && *emacs_executable)) + goto hardcoded; + if (dump_file) { - result = pdumper_load (dump_file, argv[0], original_pwd); + result = pdumper_load (dump_file, emacs_executable); if (result != PDUMPER_LOAD_SUCCESS) fatal ("could not load dump file \"%s\": %s", @@ -905,42 +868,29 @@ load_pdump (int argc, char **argv, char const *original_pwd) so we can't use decode_env_path. We're working in whatever encoding the system natively uses for filesystem access, so there's no need for character set conversion. */ - ptrdiff_t bufsize; - dump_file = load_pdump_find_executable (argv[0], &bufsize); - - /* If we couldn't find our executable, go straight to looking for - the dump in the hardcoded location. */ - if (dump_file && *dump_file) - { - char *real_exename = real_filename (dump_file); - xfree (dump_file); - dump_file = real_exename; - ptrdiff_t exenamelen = strlen (dump_file); -#ifndef WINDOWSNT - bufsize = exenamelen + 1; -#endif - if (strip_suffix) - { - ptrdiff_t strip_suffix_length = strlen (strip_suffix); - ptrdiff_t prefix_length = exenamelen - strip_suffix_length; - if (0 <= prefix_length - && !memcmp (&dump_file[prefix_length], strip_suffix, - strip_suffix_length)) - exenamelen = prefix_length; - } - ptrdiff_t needed = exenamelen + strlen (suffix) + 1; - if (bufsize < needed) - dump_file = xpalloc (dump_file, &bufsize, needed - bufsize, -1, 1); - strcpy (dump_file + exenamelen, suffix); - result = pdumper_load (dump_file, argv[0], original_pwd); - if (result == PDUMPER_LOAD_SUCCESS) - goto out; - - if (result != PDUMPER_LOAD_FILE_NOT_FOUND) - fatal ("could not load dump file \"%s\": %s", - dump_file, dump_error_to_string (result)); - } - + ptrdiff_t exenamelen = strlen (emacs_executable); + if (strip_suffix) + { + ptrdiff_t strip_suffix_length = strlen (strip_suffix); + ptrdiff_t prefix_length = exenamelen - strip_suffix_length; + if (0 <= prefix_length + && !memcmp (&emacs_executable[prefix_length], strip_suffix, + strip_suffix_length)) + exenamelen = prefix_length; + } + ptrdiff_t needed = exenamelen + strlen (suffix) + 1; + dump_file = xpalloc (NULL, &bufsize, needed - bufsize, -1, 1); + memcpy (dump_file, emacs_executable, exenamelen); + strcpy (dump_file + exenamelen, suffix); + result = pdumper_load (dump_file, emacs_executable); + if (result == PDUMPER_LOAD_SUCCESS) + goto out; + + if (result != PDUMPER_LOAD_FILE_NOT_FOUND) + fatal ("could not load dump file \"%s\": %s", + dump_file, dump_error_to_string (result)); + + hardcoded: #ifdef WINDOWSNT /* On MS-Windows, PATH_EXEC normally starts with a literal "%emacs_dir%", so it will never work without some tweaking. */ @@ -951,11 +901,11 @@ load_pdump (int argc, char **argv, char const *original_pwd) "emacs.pdmp" so that the Emacs binary still works if the user copies and renames it. */ const char *argv0_base = "emacs"; - ptrdiff_t needed = (strlen (path_exec) - + 1 - + strlen (argv0_base) - + strlen (suffix) - + 1); + needed = (strlen (path_exec) + + 1 + + strlen (argv0_base) + + strlen (suffix) + + 1); if (bufsize < needed) { xfree (dump_file); @@ -963,7 +913,19 @@ load_pdump (int argc, char **argv, char const *original_pwd) } sprintf (dump_file, "%s%c%s%s", path_exec, DIRECTORY_SEP, argv0_base, suffix); - result = pdumper_load (dump_file, argv[0], original_pwd); + /* Assume the Emacs binary lives in a sibling directory as set up by + the default installation configuration. */ + const char *go_up = "../../../../bin/"; + needed += strlen (strip_suffix) - strlen (suffix) + strlen (go_up); + if (exec_bufsize < needed) + { + xfree (emacs_executable); + emacs_executable = xpalloc (NULL, &exec_bufsize, needed - exec_bufsize, + -1, 1); + } + sprintf (emacs_executable, "%s%c%s%s%s", + path_exec, DIRECTORY_SEP, go_up, argv0_base, strip_suffix); + result = pdumper_load (dump_file, emacs_executable); if (result == PDUMPER_LOAD_FILE_NOT_FOUND) { @@ -998,7 +960,7 @@ load_pdump (int argc, char **argv, char const *original_pwd) #endif sprintf (dump_file, "%s%c%s%s", path_exec, DIRECTORY_SEP, argv0_base, suffix); - result = pdumper_load (dump_file, argv[0], original_pwd); + result = pdumper_load (dump_file, emacs_executable); } if (result != PDUMPER_LOAD_SUCCESS) @@ -1010,6 +972,7 @@ load_pdump (int argc, char **argv, char const *original_pwd) out: xfree (dump_file); + xfree (emacs_executable); } #endif /* HAVE_PDUMPER */ @@ -1320,10 +1283,9 @@ main (int argc, char **argv) w32_init_main_thread (); #endif - emacs_wd = emacs_get_current_dir_name (); #ifdef HAVE_PDUMPER if (attempt_load_pdump) - load_pdump (argc, argv, emacs_wd); + load_pdump (argc, argv); #endif argc = maybe_disable_address_randomization (argc, argv); @@ -1395,6 +1357,7 @@ main (int argc, char **argv) exit (0); } + emacs_wd = emacs_get_current_dir_name (); #ifdef HAVE_PDUMPER if (dumped_with_pdumper_p ()) pdumper_record_wd (emacs_wd); @@ -2038,8 +2001,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem /* Init buffer storage and default directory of main buffer. */ init_buffer (); - init_vars_for_load (argv[0], original_pwd); - /* Must precede init_lread. */ init_cmdargs (argc, argv, skip_args, original_pwd); diff --git a/src/lisp.h b/src/lisp.h index 474e49c8e1e..f83c55f827d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4450,7 +4450,6 @@ extern bool display_arg; extern Lisp_Object decode_env_path (const char *, const char *, bool); extern Lisp_Object empty_unibyte_string, empty_multibyte_string; extern AVOID terminate_due_to_signal (int, int); -extern void init_vars_for_load (char *, char const *); #ifdef WINDOWSNT extern Lisp_Object Vlibrary_cache; #endif diff --git a/src/pdumper.c b/src/pdumper.c index dc893c59bfa..c9285ddbc78 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4356,6 +4356,16 @@ pdumper_remember_lv_ptr_raw_impl (void *ptr, enum Lisp_Type type) } +#ifdef HAVE_NATIVE_COMP +/* This records the directory where the Emacs executable lives, to be + used for locating the native-lisp directory from which we need to + load the preloaded *.eln files. See pdumper_set_emacs_execdir + below. */ +static char *emacs_execdir; +static ptrdiff_t execdir_size; +static ptrdiff_t execdir_len; +#endif + /* Dump runtime */ enum dump_memory_protection { @@ -5269,35 +5279,54 @@ dump_do_dump_relocation (const uintptr_t dump_base, struct Lisp_Native_Comp_Unit *comp_u = dump_ptr (dump_base, reloc_offset); comp_u->lambda_gc_guard_h = CALLN (Fmake_hash_table, QCtest, Qeq); - if (!CONSP (comp_u->file)) + if (STRINGP (comp_u->file)) error ("Trying to load incoherent dumped eln file %s", SSDATA (comp_u->file)); + /* emacs_execdir is always unibyte, but the file names in + comp_u->file could be multibyte, so we need to encode + them. */ + Lisp_Object cu_file1 = ENCODE_FILE (XCAR (comp_u->file)); + Lisp_Object cu_file2 = ENCODE_FILE (XCDR (comp_u->file)); + ptrdiff_t fn1_len = SBYTES (cu_file1), fn2_len = SBYTES (cu_file2); + Lisp_Object eln_fname; + char *fndata; + /* Check just once if this is a local build or Emacs was installed. */ + /* Can't use expand-file-name here, because we are too early + in the startup, and we will crash at least on WINDOWSNT. */ if (installation_state == UNKNOWN) { - /* Can't use expand-file-name here, because we are too - early in the startup, and we will crash at least on - WINDOWSNT. */ - Lisp_Object fname = - concat2 (Vinvocation_directory, XCAR (comp_u->file)); - if (file_access_p (SSDATA (ENCODE_FILE (fname)), F_OK)) - { - installation_state = INSTALLED; - fixup_eln_load_path (XCAR (comp_u->file)); - } + eln_fname = make_uninit_string (execdir_len + fn1_len); + fndata = SSDATA (eln_fname); + memcpy (fndata, emacs_execdir, execdir_len); + memcpy (fndata + execdir_len, SSDATA (cu_file1), fn1_len); + if (file_access_p (fndata, F_OK)) + installation_state = INSTALLED; else { + eln_fname = make_uninit_string (execdir_len + fn2_len); + fndata = SSDATA (eln_fname); + memcpy (fndata, emacs_execdir, execdir_len); + memcpy (fndata + execdir_len, SSDATA (cu_file2), fn2_len); installation_state = LOCAL_BUILD; - fixup_eln_load_path (XCDR (comp_u->file)); } + fixup_eln_load_path (eln_fname); + } + else + { + ptrdiff_t fn_len = + installation_state == INSTALLED ? fn1_len : fn2_len; + Lisp_Object cu_file = + installation_state == INSTALLED ? cu_file1 : cu_file2; + eln_fname = make_uninit_string (execdir_len + fn_len); + fndata = SSDATA (eln_fname); + memcpy (fndata, emacs_execdir, execdir_len); + memcpy (fndata + execdir_len, SSDATA (cu_file), fn_len); } - comp_u->file = - concat2 (Vinvocation_directory, - installation_state == INSTALLED - ? XCAR (comp_u->file) : XCDR (comp_u->file)); - comp_u->handle = dynlib_open (SSDATA (ENCODE_FILE (comp_u->file))); + comp_u->file = eln_fname; + comp_u->handle = dynlib_open (SSDATA (eln_fname)); if (!comp_u->handle) error ("%s", dynlib_error ()); load_comp_unit (comp_u, true, false); @@ -5435,6 +5464,26 @@ dump_do_all_emacs_relocations (const struct dump_header *const header, dump_do_emacs_relocation (dump_base, r[i]); } +#ifdef HAVE_NATIVE_COMP +/* Compute and record the directory of the Emacs executable given the + file name of that executable. */ +static void +pdumper_set_emacs_execdir (char *emacs_executable) +{ + char *p = emacs_executable + strlen (emacs_executable); + + while (p > emacs_executable + && !IS_DIRECTORY_SEP (p[-1])) + --p; + eassert (p > emacs_executable); + emacs_execdir = xpalloc (emacs_execdir, &execdir_size, + p - emacs_executable + 1 - execdir_size, -1, 1); + memcpy (emacs_execdir, emacs_executable, p - emacs_executable); + execdir_len = p - emacs_executable; + emacs_execdir[execdir_len] = '\0'; +} +#endif + enum dump_section { DS_HOT, @@ -5451,7 +5500,7 @@ static Lisp_Object *pdumper_hashes = &zero_vector; N.B. We run very early in initialization, so we can't use lisp, unwinding, xmalloc, and so on. */ int -pdumper_load (const char *dump_filename, char *argv0, char const *original_pwd) +pdumper_load (const char *dump_filename, char *argv0) { intptr_t dump_size; struct stat stat; @@ -5607,9 +5656,11 @@ pdumper_load (const char *dump_filename, char *argv0, char const *original_pwd) for (int i = 0; i < nr_dump_hooks; ++i) dump_hooks[i] (); - /* Once we can allocate and before loading .eln files we must set - Vinvocation_directory (.eln paths are relative to it). */ - init_vars_for_load (argv0, original_pwd); +#ifdef HAVE_NATIVE_COMP + pdumper_set_emacs_execdir (argv0); +#else + (void) argv0; +#endif dump_do_all_dump_reloc_for_phase (header, dump_base, LATE_RELOCS); dump_do_all_dump_reloc_for_phase (header, dump_base, VERY_LATE_RELOCS); diff --git a/src/pdumper.h b/src/pdumper.h index 49e6739b0dc..deec9af046d 100644 --- a/src/pdumper.h +++ b/src/pdumper.h @@ -140,8 +140,7 @@ enum pdumper_load_result PDUMPER_LOAD_ERROR /* Must be last, as errno may be added. */ }; -int pdumper_load (const char *dump_filename, char *argv0, - char const *original_pwd); +int pdumper_load (const char *dump_filename, char *argv0); struct pdumper_loaded_dump { -- cgit v1.2.3 From b7c22fab7d0c9644276127701191d5297e9023b4 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 25 Apr 2021 17:24:48 -0700 Subject: ; Add 2021 to copyright years --- lisp/emacs-lisp/comp-cstr.el | 3 +-- lisp/emacs-lisp/comp.el | 3 +-- src/comp.h | 3 ++- test/lisp/emacs-lisp/comp-cstr-tests.el | 2 +- test/src/comp-test-funcs-dyn.el | 2 +- test/src/comp-test-pure.el | 2 +- test/src/emacs-tests.el | 2 +- 7 files changed, 8 insertions(+), 9 deletions(-) (limited to 'src/comp.h') diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index 5b189e70bef..d22d19ce1ec 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el @@ -1,9 +1,8 @@ ;;; comp-cstr.el --- native compiler constraint library -*- lexical-binding: t -*- -;; Author: Andrea Corallo - ;; Copyright (C) 2020-2021 Free Software Foundation, Inc. +;; Author: Andrea Corallo ;; Keywords: lisp ;; Package: emacs diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 82799a4d4ee..fd8a8c61cce 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1,9 +1,8 @@ ;;; comp.el --- compilation of Lisp code into native code -*- lexical-binding: t -*- -;; Author: Andrea Corallo - ;; Copyright (C) 2019-2021 Free Software Foundation, Inc. +;; Author: Andrea Corallo ;; Keywords: lisp ;; Package: emacs diff --git a/src/comp.h b/src/comp.h index 03d22dfaa0e..c4af4193d0b 100644 --- a/src/comp.h +++ b/src/comp.h @@ -1,5 +1,6 @@ /* Elisp native compiler definitions -Copyright (C) 2019-2020 Free Software Foundation, Inc. + +Copyright (C) 2019-2021 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el b/test/lisp/emacs-lisp/comp-cstr-tests.el index c2492b93f6f..2e4628522f4 100644 --- a/test/lisp/emacs-lisp/comp-cstr-tests.el +++ b/test/lisp/emacs-lisp/comp-cstr-tests.el @@ -1,6 +1,6 @@ ;;; comp-cstr-tests.el --- unit tests for src/comp.c -*- lexical-binding: t; -*- -;; Copyright (C) 2020 Free Software Foundation, Inc. +;; Copyright (C) 2020-2021 Free Software Foundation, Inc. ;; Author: Andrea Corallo diff --git a/test/src/comp-test-funcs-dyn.el b/test/src/comp-test-funcs-dyn.el index 67db7587bf9..3118455e3f6 100644 --- a/test/src/comp-test-funcs-dyn.el +++ b/test/src/comp-test-funcs-dyn.el @@ -1,6 +1,6 @@ ;;; comp-test-funcs-dyn.el --- compilation unit tested by comp-tests.el -*- lexical-binding: nil; -*- -;; Copyright (C) 2020 Free Software Foundation, Inc. +;; Copyright (C) 2020-2021 Free Software Foundation, Inc. ;; Author: Andrea Corallo diff --git a/test/src/comp-test-pure.el b/test/src/comp-test-pure.el index f606a44a10e..5c1d2d17472 100644 --- a/test/src/comp-test-pure.el +++ b/test/src/comp-test-pure.el @@ -1,6 +1,6 @@ ;;; comp-test-pure.el --- compilation unit tested by comp-tests.el -*- lexical-binding: t; -*- -;; Copyright (C) 2020 Free Software Foundation, Inc. +;; Copyright (C) 2020-2021 Free Software Foundation, Inc. ;; Author: Andrea Corallo diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el index 87c3e84cdd2..ee5586fbaf4 100644 --- a/test/src/emacs-tests.el +++ b/test/src/emacs-tests.el @@ -1,6 +1,6 @@ ;;; emacs-tests.el --- unit tests for emacs.c -*- lexical-binding: t; -*- -;; Copyright (C) 2020 Free Software Foundation, Inc. +;; Copyright (C) 2020-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. -- cgit v1.2.3