diff options
Diffstat (limited to 'src/comp.c')
| -rw-r--r-- | src/comp.c | 369 |
1 files changed, 236 insertions, 133 deletions
diff --git a/src/comp.c b/src/comp.c index c3803464827..5b947fc99b6 100644 --- a/src/comp.c +++ b/src/comp.c @@ -71,6 +71,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #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_cast #undef gcc_jit_context_new_comparison #undef gcc_jit_context_new_field #undef gcc_jit_context_new_function @@ -151,8 +152,10 @@ DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_context_new_global, 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)); +#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) DEF_DLL_FN (gcc_jit_lvalue *, gcc_jit_global_set_initializer, (gcc_jit_lvalue *global, const void *blob, size_t num_bytes)); +#endif 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)); @@ -176,6 +179,9 @@ DEF_DLL_FN (gcc_jit_rvalue *, gcc_jit_context_new_call, 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_cast, + (gcc_jit_context *ctxt, gcc_jit_location *loc, + gcc_jit_rvalue *rvalue, gcc_jit_type *type)); 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)); @@ -255,9 +261,11 @@ DEF_DLL_FN (void, gcc_jit_context_set_str_option, 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)); +#if defined (LIBGCCJIT_HAVE_gcc_jit_version) DEF_DLL_FN (int, gcc_jit_version_major, (void)); DEF_DLL_FN (int, gcc_jit_version_minor, (void)); DEF_DLL_FN (int, gcc_jit_version_patchlevel, (void)); +#endif static bool init_gccjit_functions (void) @@ -288,6 +296,7 @@ init_gccjit_functions (void) 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_cast); 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); @@ -327,10 +336,14 @@ init_gccjit_functions (void) LOAD_DLL_FN (library, gcc_jit_type_get_pointer); LOAD_DLL_FN_OPT (library, gcc_jit_context_add_command_line_option); LOAD_DLL_FN_OPT (library, gcc_jit_context_add_driver_option); +#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) LOAD_DLL_FN_OPT (library, gcc_jit_global_set_initializer); +#endif +#if defined (LIBGCCJIT_HAVE_gcc_jit_version) LOAD_DLL_FN_OPT (library, gcc_jit_version_major); LOAD_DLL_FN_OPT (library, gcc_jit_version_minor); LOAD_DLL_FN_OPT (library, gcc_jit_version_patchlevel); +#endif return true; } @@ -358,6 +371,7 @@ init_gccjit_functions (void) #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_cast fn_gcc_jit_context_new_cast #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 @@ -382,7 +396,9 @@ init_gccjit_functions (void) #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_global_set_initializer fn_gcc_jit_global_set_initializer +#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) + #define gcc_jit_global_set_initializer fn_gcc_jit_global_set_initializer +#endif #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 @@ -396,9 +412,11 @@ init_gccjit_functions (void) #define gcc_jit_struct_set_fields fn_gcc_jit_struct_set_fields #define gcc_jit_type_get_const fn_gcc_jit_type_get_const #define gcc_jit_type_get_pointer fn_gcc_jit_type_get_pointer -#define gcc_jit_version_major fn_gcc_jit_version_major -#define gcc_jit_version_minor fn_gcc_jit_version_minor -#define gcc_jit_version_patchlevel fn_gcc_jit_version_patchlevel +#if defined (LIBGCCJIT_HAVE_gcc_jit_version) + #define gcc_jit_version_major fn_gcc_jit_version_major + #define gcc_jit_version_minor fn_gcc_jit_version_minor + #define gcc_jit_version_patchlevel fn_gcc_jit_version_patchlevel +#endif #endif @@ -499,13 +517,6 @@ static f_reloc_t freloc; #define NUM_CAST_TYPES 15 -enum cast_kind_of_type - { - kind_unsigned, - kind_signed, - kind_pointer - }; - typedef struct { EMACS_INT len; gcc_jit_rvalue *r_val; @@ -516,6 +527,7 @@ typedef struct { typedef struct { EMACS_INT speed; EMACS_INT debug; + Lisp_Object compiler_options; Lisp_Object driver_options; gcc_jit_context *ctxt; gcc_jit_type *void_type; @@ -571,14 +583,9 @@ typedef struct { be used for the scope. */ gcc_jit_type *cast_union_type; gcc_jit_function *cast_functions_from_to[NUM_CAST_TYPES][NUM_CAST_TYPES]; - /* We add one to make space for the last member which is the "biggest_type" - member. */ - gcc_jit_type *cast_types[NUM_CAST_TYPES + 1]; - size_t cast_type_sizes[NUM_CAST_TYPES + 1]; - enum cast_kind_of_type cast_type_kind[NUM_CAST_TYPES + 1]; - const char *cast_type_names[NUM_CAST_TYPES + 1]; - gcc_jit_field *cast_union_fields[NUM_CAST_TYPES + 1]; - size_t cast_union_field_biggest_type; + gcc_jit_function *cast_ptr_to_int; + gcc_jit_function *cast_int_to_ptr; + gcc_jit_type *cast_types[NUM_CAST_TYPES]; gcc_jit_function *func; /* Current function being compiled. */ bool func_has_non_local; /* From comp-func has-non-local slot. */ EMACS_INT func_speed; /* From comp-func speed slot. */ @@ -698,6 +705,12 @@ comp_hash_source_file (Lisp_Object filename) /* Can't use Finsert_file_contents + Fbuffer_hash as this is called by Fcomp_el_to_eln_filename too early during bootstrap. */ bool is_gz = suffix_p (filename, ".gz"); +#ifndef HAVE_ZLIB + if (is_gz) + xsignal2 (Qfile_notify_error, + build_string ("Cannot natively compile compressed *.el files without zlib support"), + filename); +#endif Lisp_Object encoded_filename = ENCODE_FILE (filename); FILE *f = emacs_fopen (SSDATA (encoded_filename), is_gz ? "rb" : "r"); @@ -706,9 +719,13 @@ comp_hash_source_file (Lisp_Object filename) Lisp_Object digest = make_uninit_string (MD5_DIGEST_SIZE * 2); +#ifdef HAVE_ZLIB int res = is_gz ? md5_gz_stream (f, SSDATA (digest)) : md5_stream (f, SSDATA (digest)); +#else + int res = md5_stream (f, SSDATA (digest)); +#endif fclose (f); if (res) @@ -1113,13 +1130,6 @@ emit_coerce (gcc_jit_type *new_type, gcc_jit_rvalue *obj) int old_index = type_to_cast_index (old_type); int new_index = type_to_cast_index (new_type); - if (comp.cast_type_sizes[old_index] < comp.cast_type_sizes[new_index] - && comp.cast_type_kind[new_index] == kind_signed) - xsignal3 (Qnative_ice, - build_string ("FIXME: sign extension not implemented"), - build_string (comp.cast_type_names[old_index]), - build_string (comp.cast_type_names[new_index])); - /* Lookup the appropriate cast function in the cast matrix. */ return gcc_jit_context_new_call (comp.ctxt, NULL, @@ -2493,8 +2503,7 @@ emit_static_object (const char *name, Lisp_Object obj) ptrdiff_t len = SBYTES (str); const char *p = SSDATA (str); -#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) \ - || defined (WINDOWSNT) +#if defined (LIBGCCJIT_HAVE_gcc_jit_global_set_initializer) if (gcc_jit_global_set_initializer) { ptrdiff_t str_size = len + 1; @@ -3111,30 +3120,17 @@ define_thread_state_struct (void) gcc_jit_type_get_pointer (gcc_jit_struct_as_type (comp.thread_state_s)); } -struct cast_type -{ - gcc_jit_type *type; - const char *name; - size_t bytes_size; - enum cast_kind_of_type kind; -}; - static gcc_jit_function * -define_cast_from_to (struct cast_type from, int from_index, struct cast_type to, - int to_index) +define_type_punning (const char *name, + gcc_jit_type *from, gcc_jit_field *from_field, + gcc_jit_type *to, gcc_jit_field *to_field) { - /* FIXME: sign extension not implemented. */ - if (comp.cast_type_sizes[from_index] < comp.cast_type_sizes[to_index] - && comp.cast_type_kind[to_index] == kind_signed) - return NULL; - - char *name = format_string ("cast_from_%s_to_%s", from.name, to.name); gcc_jit_param *param = gcc_jit_context_new_param (comp.ctxt, NULL, - from.type, "arg"); + from, "arg"); gcc_jit_function *result = gcc_jit_context_new_function (comp.ctxt, NULL, GCC_JIT_FUNCTION_INTERNAL, - to.type, + to, name, 1, ¶m, @@ -3148,26 +3144,63 @@ define_cast_from_to (struct cast_type from, int from_index, struct cast_type to, comp.cast_union_type, "union_cast"); - /* Zero the union first. */ gcc_jit_block_add_assignment (entry_block, NULL, gcc_jit_lvalue_access_field (tmp_union, NULL, - comp.cast_union_fields[NUM_CAST_TYPES]), - gcc_jit_context_new_rvalue_from_int ( - comp.ctxt, - comp.cast_types[NUM_CAST_TYPES], - 0)); - - gcc_jit_block_add_assignment (entry_block, NULL, - gcc_jit_lvalue_access_field (tmp_union, NULL, - comp.cast_union_fields[from_index]), + from_field), gcc_jit_param_as_rvalue (param)); gcc_jit_block_end_with_return (entry_block, NULL, gcc_jit_rvalue_access_field ( gcc_jit_lvalue_as_rvalue (tmp_union), - NULL, - comp.cast_union_fields[to_index])); + NULL, to_field)); + + return result; +} + +struct cast_type +{ + gcc_jit_type *type; + const char *name; + bool is_ptr; +}; + +static gcc_jit_function * +define_cast_from_to (struct cast_type from, struct cast_type to) +{ + char *name = format_string ("cast_from_%s_to_%s", from.name, to.name); + gcc_jit_param *param = gcc_jit_context_new_param (comp.ctxt, NULL, + from.type, "arg"); + gcc_jit_function *result + = gcc_jit_context_new_function (comp.ctxt, + NULL, + GCC_JIT_FUNCTION_INTERNAL, + to.type, name, + 1, ¶m, 0); + DECL_BLOCK (entry_block, result); + + gcc_jit_rvalue *tmp = gcc_jit_param_as_rvalue (param); + if (from.is_ptr != to.is_ptr) + { + if (from.is_ptr) + { + tmp = gcc_jit_context_new_cast (comp.ctxt, NULL, + tmp, comp.void_ptr_type); + tmp = gcc_jit_context_new_call (comp.ctxt, NULL, + comp.cast_ptr_to_int, 1, &tmp); + } + else + { + tmp = gcc_jit_context_new_cast (comp.ctxt, NULL, + tmp, comp.uintptr_type); + tmp = gcc_jit_context_new_call (comp.ctxt, NULL, + comp.cast_int_to_ptr, 1, &tmp); + } + } + + tmp = gcc_jit_context_new_cast (comp.ctxt, NULL, tmp, to.type); + + gcc_jit_block_end_with_return (entry_block, NULL, tmp); return result; } @@ -3176,69 +3209,58 @@ static void define_cast_functions (void) { struct cast_type cast_types[NUM_CAST_TYPES] - = { { comp.bool_type, "bool", sizeof (bool), kind_unsigned }, - { comp.char_ptr_type, "char_ptr", sizeof (char *), kind_pointer }, - { comp.int_type, "int", sizeof (int), kind_signed }, - { comp.lisp_cons_ptr_type, "cons_ptr", sizeof (struct Lisp_Cons *), - kind_pointer }, - { comp.lisp_obj_ptr_type, "lisp_obj_ptr", sizeof (Lisp_Object *), - kind_pointer }, - { comp.lisp_word_tag_type, "lisp_word_tag", sizeof (Lisp_Word_tag), - kind_unsigned }, - { comp.lisp_word_type, "lisp_word", sizeof (Lisp_Word), - LISP_WORDS_ARE_POINTERS ? kind_pointer : kind_signed }, - { comp.long_long_type, "long_long", sizeof (long long), kind_signed }, - { comp.long_type, "long", sizeof (long), kind_signed }, - { comp.ptrdiff_type, "ptrdiff", sizeof (ptrdiff_t), kind_signed }, - { comp.uintptr_type, "uintptr", sizeof (uintptr_t), kind_unsigned }, - { comp.unsigned_long_long_type, "unsigned_long_long", - sizeof (unsigned long long), kind_unsigned }, - { comp.unsigned_long_type, "unsigned_long", sizeof (unsigned long), - kind_unsigned }, - { comp.unsigned_type, "unsigned", sizeof (unsigned), kind_unsigned }, - { comp.void_ptr_type, "void_ptr", sizeof (void*), kind_pointer } }; - - /* Find the biggest size. It should be unsigned long long, but to be - sure we find it programmatically. */ - size_t biggest_size = 0; - for (int i = 0; i < NUM_CAST_TYPES; ++i) - biggest_size = max (biggest_size, cast_types[i].bytes_size); + = { { comp.bool_type, "bool", false }, + { comp.char_ptr_type, "char_ptr", true }, + { comp.int_type, "int", false }, + { comp.lisp_cons_ptr_type, "lisp_cons_ptr", true }, + { comp.lisp_obj_ptr_type, "lisp_obj_ptr", true }, + { comp.lisp_word_tag_type, "lisp_word_tag", false }, + { comp.lisp_word_type, "lisp_word", LISP_WORDS_ARE_POINTERS }, + { comp.long_long_type, "long_long", false }, + { comp.long_type, "long", false }, + { comp.ptrdiff_type, "ptrdiff", false }, + { comp.uintptr_type, "uintptr", false }, + { comp.unsigned_long_long_type, "unsigned_long_long", false }, + { comp.unsigned_long_type, "unsigned_long", false }, + { comp.unsigned_type, "unsigned", false }, + { comp.void_ptr_type, "void_ptr", true } }; + gcc_jit_field *cast_union_fields[2]; + + /* Define the union used for type punning. */ + cast_union_fields[0] = gcc_jit_context_new_field (comp.ctxt, + NULL, + comp.void_ptr_type, + "void_ptr"); + cast_union_fields[1] = gcc_jit_context_new_field (comp.ctxt, + NULL, + comp.uintptr_type, + "uintptr"); - /* Define the union used for casting. */ - for (int i = 0; i < NUM_CAST_TYPES; ++i) - { - comp.cast_types[i] = cast_types[i].type; - comp.cast_union_fields[i] = gcc_jit_context_new_field (comp.ctxt, - NULL, - cast_types[i].type, - cast_types[i].name); - comp.cast_type_names[i] = cast_types[i].name; - comp.cast_type_sizes[i] = cast_types[i].bytes_size; - comp.cast_type_kind[i] = cast_types[i].kind; - } + comp.cast_union_type + = gcc_jit_context_new_union_type (comp.ctxt, + NULL, + "cast_union", + 2, cast_union_fields); + + comp.cast_ptr_to_int = define_type_punning ("cast_pointer_to_uintptr_t", + comp.void_ptr_type, + cast_union_fields[0], + comp.uintptr_type, + cast_union_fields[1]); + comp.cast_int_to_ptr = define_type_punning ("cast_uintptr_t_to_pointer", + comp.uintptr_type, + cast_union_fields[1], + comp.void_ptr_type, + cast_union_fields[0]); - gcc_jit_type *biggest_type = gcc_jit_context_get_int_type (comp.ctxt, - biggest_size, - false); - comp.cast_types[NUM_CAST_TYPES] = biggest_type; - comp.cast_union_fields[NUM_CAST_TYPES] = - gcc_jit_context_new_field (comp.ctxt, NULL, biggest_type, "biggest_type"); - comp.cast_type_names[NUM_CAST_TYPES] = "biggest_type"; - comp.cast_type_sizes[NUM_CAST_TYPES] = biggest_size; - comp.cast_type_kind[NUM_CAST_TYPES] = kind_unsigned; - - comp.cast_union_type = - gcc_jit_context_new_union_type (comp.ctxt, - NULL, - "cast_union", - NUM_CAST_TYPES + 1, - comp.cast_union_fields); + for (int i = 0; i < NUM_CAST_TYPES; ++i) + comp.cast_types[i] = cast_types[i].type; /* Define the cast functions using a matrix. */ for (int i = 0; i < NUM_CAST_TYPES; ++i) for (int j = 0; j < NUM_CAST_TYPES; ++j) comp.cast_functions_from_to[i][j] = - define_cast_from_to (cast_types[i], i, cast_types[j], j); + define_cast_from_to (cast_types[i], cast_types[j]); } static void @@ -4029,7 +4051,13 @@ make_directory_wrapper_1 (Lisp_Object ignore) DEFUN ("comp-el-to-eln-rel-filename", Fcomp_el_to_eln_rel_filename, Scomp_el_to_eln_rel_filename, 1, 1, 0, - doc: /* Return the corresponding .eln relative filename. */) + doc: /* Return the relative name of the .eln file for FILENAME. +FILENAME must exist, and if it's a symlink, the target must exist. +If FILENAME is compressed, it must have the \".gz\" extension, +and Emacs must have been compiled with zlib; the file will be +uncompressed on the fly to hash its contents. +Value includes the original base name, followed by 2 hash values, +one for the file name and another for its contents, followed by .eln. */) (Lisp_Object filename) { CHECK_STRING (filename); @@ -4095,7 +4123,7 @@ DEFUN ("comp-el-to-eln-rel-filename", Fcomp_el_to_eln_rel_filename, FOR_EACH_TAIL (lds_re_tail) { Lisp_Object match_idx = - Fstring_match (XCAR (lds_re_tail), filename, Qnil); + Fstring_match (XCAR (lds_re_tail), filename, Qnil, Qnil); if (EQ (match_idx, make_fixnum (0))) { filename = @@ -4114,10 +4142,22 @@ DEFUN ("comp-el-to-eln-rel-filename", Fcomp_el_to_eln_rel_filename, DEFUN ("comp-el-to-eln-filename", Fcomp_el_to_eln_filename, Scomp_el_to_eln_filename, 1, 2, 0, - doc: /* Return the .eln filename for source FILENAME to used -for new compilations. -If BASE-DIR is non-nil use it as a base directory, look for a suitable -directory in `comp-eln-load-path' otherwise. */) + doc: /* Return the absolute .eln file name for source FILENAME. +The resulting .eln file name is intended to be used for natively +compiling FILENAME. FILENAME must exist and be readable, but other +than that, its leading directories are ignored when constructing +the name of the .eln file. +If BASE-DIR is non-nil, use it as the directory for the .eln file; +non-absolute BASE-DIR is interpreted as relative to `invocation-directory'. +If BASE-DIR is omitted or nil, look for the first writable directory +in `native-comp-eln-load-path', and use as BASE-DIR its subdirectory +whose name is given by `comp-native-version-dir'. +If FILENAME specifies a preloaded file, the directory for the .eln +file is the \"preloaded/\" subdirectory of the directory determined +as described above. FILENAME is considered to be a preloaded file if +the value of `comp-file-preloaded-p' is non-nil, or if FILENAME +appears in the value of the environment variable LISP_PRELOADED; +the latter is supposed to be used by the Emacs build procedure. */) (Lisp_Object filename, Lisp_Object base_dir) { Lisp_Object source_filename = filename; @@ -4374,8 +4414,7 @@ DEFUN ("comp-native-driver-options-effective-p", doc: /* Return t if `comp-native-driver-options' is effective. */) (void) { -#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \ - || defined (WINDOWSNT) +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) if (gcc_jit_context_add_driver_option) return Qt; #endif @@ -4383,13 +4422,28 @@ DEFUN ("comp-native-driver-options-effective-p", } #pragma GCC diagnostic pop +#pragma GCC diagnostic ignored "-Waddress" +DEFUN ("comp-native-compiler-options-effective-p", + Fcomp_native_compiler_options_effective_p, + Scomp_native_compiler_options_effective_p, + 0, 0, 0, + doc: /* Return t if `comp-native-compiler-options' is effective. */) + (void) +{ +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option) + if (gcc_jit_context_add_command_line_option) + return Qt; +#endif + return Qnil; +} +#pragma GCC diagnostic pop + static void add_driver_options (void) { Lisp_Object options = Fsymbol_value (Qnative_comp_driver_options); -#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \ - || defined (WINDOWSNT) +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) load_gccjit_if_necessary (true); if (!NILP (Fcomp_native_driver_options_effective_p ())) FOR_EACH_TAIL (options) @@ -4408,8 +4462,7 @@ add_driver_options (void) " and above.")); /* Captured `comp-native-driver-options' because file-local. */ -#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \ - || defined (WINDOWSNT) +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) options = comp.driver_options; if (!NILP (Fcomp_native_driver_options_effective_p ())) FOR_EACH_TAIL (options) @@ -4422,6 +4475,43 @@ add_driver_options (void) #endif } +static void +add_compiler_options (void) +{ + Lisp_Object options = Fsymbol_value (Qnative_comp_compiler_options); + +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option) + load_gccjit_if_necessary (true); + if (!NILP (Fcomp_native_compiler_options_effective_p ())) + FOR_EACH_TAIL (options) + gcc_jit_context_add_command_line_option (comp.ctxt, + /* FIXME: Need to encode + this, but how? either + ENCODE_FILE or + ENCODE_SYSTEM. */ + SSDATA (XCAR (options))); +#endif + if (CONSP (options)) + xsignal1 (Qnative_compiler_error, + build_string ("Customizing native compiler options" + " via `comp-native-compiler-options' is" + " only available on libgccjit version 9" + " and above.")); + + /* Captured `comp-native-compiler-options' because file-local. */ +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option) + options = comp.compiler_options; + if (!NILP (Fcomp_native_compiler_options_effective_p ())) + FOR_EACH_TAIL (options) + gcc_jit_context_add_command_line_option (comp.ctxt, + /* FIXME: Need to encode + this, but how? either + ENCODE_FILE or + ENCODE_SYSTEM. */ + SSDATA (XCAR (options))); +#endif +} + DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, Scomp__compile_ctxt_to_file, 1, 1, 0, @@ -4467,6 +4557,7 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, comp.debug = XFIXNUM (CALL1I (comp-ctxt-debug, Vcomp_ctxt)); eassert (comp.debug < INT_MAX); comp.driver_options = CALL1I (comp-ctxt-driver-options, Vcomp_ctxt); + comp.compiler_options = CALL1I (comp-ctxt-compiler-options, Vcomp_ctxt); if (comp.debug) gcc_jit_context_set_bool_option (comp.ctxt, @@ -4490,6 +4581,15 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, GCC_JIT_INT_OPTION_OPTIMIZATION_LEVEL, comp.speed < 0 ? 0 : (comp.speed > 3 ? 3 : comp.speed)); + + /* On MacOS set a unique dylib ID. */ +#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_driver_option) \ + && defined (DARWIN_OS) + gcc_jit_context_add_driver_option (comp.ctxt, "-install_name"); + gcc_jit_context_add_driver_option ( + comp.ctxt, SSDATA (Ffile_name_nondirectory (filename))); +#endif + comp.d_default_idx = CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-default, Vcomp_ctxt)); comp.d_impure_idx = @@ -4523,8 +4623,7 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, /* Work around bug#46495 (GCC PR99126). */ #if defined (WIDE_EMACS_INT) \ - && (defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option) \ - || defined (WINDOWSNT)) + && defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option) Lisp_Object version = Fcomp_libgccjit_version (); if (NILP (version) || XFIXNUM (XCAR (version)) < 11) @@ -4532,6 +4631,7 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file, "-fdisable-tree-isolate-paths"); #endif + add_compiler_options (); add_driver_options (); if (comp.debug > 1) @@ -4575,7 +4675,7 @@ The return value has the form (MAJOR MINOR PATCHLEVEL) or nil if unknown (before GCC version 10). */) (void) { -#if defined (LIBGCCJIT_HAVE_gcc_jit_version) || defined (WINDOWSNT) +#if defined (LIBGCCJIT_HAVE_gcc_jit_version) load_gccjit_if_necessary (true); return gcc_jit_version_major @@ -4635,7 +4735,7 @@ helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code) } -/* `comp-eln-load-path' clean-up support code. */ +/* `native-comp-eln-load-path' clean-up support code. */ static Lisp_Object all_loaded_comp_units_h; @@ -4650,7 +4750,7 @@ return_nil (Lisp_Object arg) /* 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. + `native-comp-eln-load-path' when exiting. Any error is ignored because it may be due to the file being loaded in another Emacs instance. */ @@ -4778,7 +4878,7 @@ maybe_defer_native_compilation (Lisp_Object function_name, /**************************************/ /* Fixup the system eln-cache directory, which is the last entry in - `comp-eln-load-path'. Argument is a .eln file in that directory. */ + `native-comp-eln-load-path'. Argument is a .eln file in that directory. */ void fixup_eln_load_path (Lisp_Object eln_filename) { @@ -5160,7 +5260,8 @@ file_in_eln_sys_dir (Lisp_Object filename) eln_sys_dir = XCAR (tmp); return !NILP (Fstring_match (Fregexp_quote (Fexpand_file_name (eln_sys_dir, Qnil)), - Fexpand_file_name (filename, Qnil), Qnil)); + Fexpand_file_name (filename, Qnil), + Qnil, Qnil)); } /* Load related routines. */ @@ -5239,6 +5340,7 @@ compiled one. */); DEFSYM (Qnative_comp_speed, "native-comp-speed"); DEFSYM (Qnative_comp_debug, "native-comp-debug"); DEFSYM (Qnative_comp_driver_options, "native-comp-driver-options"); + DEFSYM (Qnative_comp_compiler_options, "native-comp-compiler-options"); DEFSYM (Qcomp_libgccjit_reproducer, "comp-libgccjit-reproducer"); /* Limple instruction set. */ @@ -5348,6 +5450,7 @@ compiled one. */); defsubr (&Scomp_el_to_eln_rel_filename); defsubr (&Scomp_el_to_eln_filename); defsubr (&Scomp_native_driver_options_effective_p); + defsubr (&Scomp_native_compiler_options_effective_p); defsubr (&Scomp__install_trampoline); defsubr (&Scomp__init_ctxt); defsubr (&Scomp__release_ctxt); |