summaryrefslogtreecommitdiff
path: root/src/comp.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/comp.c')
-rw-r--r--src/comp.c122
1 files changed, 71 insertions, 51 deletions
diff --git a/src/comp.c b/src/comp.c
index 8428cf9020e..99f51e07048 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -469,7 +469,7 @@ load_gccjit_if_necessary (bool mandatory)
/* Increase this number to force a new Vcomp_abi_hash to be generated. */
-#define ABI_VERSION "5"
+#define ABI_VERSION "6"
/* Length of the hashes used for eln file naming. */
#define HASH_LENGTH 8
@@ -520,7 +520,7 @@ load_gccjit_if_necessary (bool mandatory)
#define DECL_BLOCK(name, func) \
gcc_jit_block *(name) = \
- gcc_jit_function_new_block ((func), STR (name))
+ gcc_jit_function_new_block (func, STR (name))
#ifndef WINDOWSNT
# ifdef HAVE__SETJMP
@@ -535,7 +535,7 @@ load_gccjit_if_necessary (bool mandatory)
#define SETJMP_NAME SETJMP
/* Max number function importable by native compiled code. */
-#define F_RELOC_MAX_SIZE 1500
+#define F_RELOC_MAX_SIZE 1600
typedef struct {
void *link_table[F_RELOC_MAX_SIZE];
@@ -700,6 +700,8 @@ static void helper_save_restriction (void);
static bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object, enum pvec_type);
static struct Lisp_Symbol_With_Pos *
helper_GET_SYMBOL_WITH_POSITION (Lisp_Object);
+static Lisp_Object
+helper_sanitizer_assert (Lisp_Object, Lisp_Object);
/* Note: helper_link_table must match the list created by
`declare_runtime_imported_funcs'. */
@@ -712,6 +714,7 @@ static void *helper_link_table[] =
helper_unbind_n,
helper_save_restriction,
helper_GET_SYMBOL_WITH_POSITION,
+ helper_sanitizer_assert,
record_unwind_current_buffer,
set_internal,
helper_unwind_protect,
@@ -774,7 +777,7 @@ comp_hash_source_file (Lisp_Object filename)
#else
int res = md5_stream (f, SSDATA (digest));
#endif
- fclose (f);
+ emacs_fclose (f);
if (res)
xsignal2 (Qfile_notify_error, build_string ("hashing failed"), filename);
@@ -2440,7 +2443,7 @@ emit_limple_insn (Lisp_Object insn)
{
Lisp_Object arg1 = arg[1];
- if (EQ (Ftype_of (arg1), Qcomp_mvar))
+ if (EQ (Fcl_type_of (arg1), Qcomp_mvar))
res = emit_mvar_rval (arg1);
else if (EQ (FIRST (arg1), Qcall))
res = emit_limple_call (XCDR (arg1));
@@ -2973,6 +2976,10 @@ declare_runtime_imported_funcs (void)
ADD_IMPORTED (helper_GET_SYMBOL_WITH_POSITION, comp.lisp_symbol_with_position_ptr_type,
1, args);
+ args[0] = comp.lisp_obj_type;
+ args[1] = comp.lisp_obj_type;
+ ADD_IMPORTED (helper_sanitizer_assert, comp.lisp_obj_type, 2, args);
+
ADD_IMPORTED (record_unwind_current_buffer, comp.void_type, 0, NULL);
args[0] = args[1] = args[2] = comp.lisp_obj_type;
@@ -4328,11 +4335,10 @@ compile_function (Lisp_Object func)
declare_block (Qentry);
Lisp_Object blocks = CALL1I (comp-func-blocks, func);
struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks);
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++)
+ DOHASH_SAFE (ht, i)
{
Lisp_Object block_name = HASH_KEY (ht, i);
- if (!EQ (block_name, Qentry)
- && !BASE_EQ (block_name, Qunbound))
+ if (!EQ (block_name, Qentry))
declare_block (block_name);
}
@@ -4342,24 +4348,21 @@ compile_function (Lisp_Object func)
gcc_jit_lvalue_as_rvalue (comp.func_relocs));
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (ht); i++)
+ DOHASH_SAFE (ht, i)
{
Lisp_Object block_name = HASH_KEY (ht, i);
- if (!BASE_EQ (block_name, Qunbound))
+ Lisp_Object block = HASH_VALUE (ht, i);
+ Lisp_Object insns = CALL1I (comp-block-insns, block);
+ if (NILP (block) || NILP (insns))
+ xsignal1 (Qnative_ice,
+ build_string ("basic block is missing or empty"));
+
+ comp.block = retrive_block (block_name);
+ while (CONSP (insns))
{
- Lisp_Object block = HASH_VALUE (ht, i);
- Lisp_Object insns = CALL1I (comp-block-insns, block);
- if (NILP (block) || NILP (insns))
- xsignal1 (Qnative_ice,
- build_string ("basic block is missing or empty"));
-
- comp.block = retrive_block (block_name);
- while (CONSP (insns))
- {
- Lisp_Object insn = XCAR (insns);
- emit_limple_insn (insn);
- insns = XCDR (insns);
- }
+ Lisp_Object insn = XCAR (insns);
+ emit_limple_insn (insn);
+ insns = XCDR (insns);
}
}
const char *err = gcc_jit_context_get_first_error (comp.ctxt);
@@ -4621,6 +4624,8 @@ Return t on success. */)
emit_simple_limple_call_void_ret);
register_emitter (Qhelper_save_restriction,
emit_simple_limple_call_void_ret);
+ register_emitter (Qhelper_sanitizer_assert,
+ emit_simple_limple_call_lisp_ret);
/* Inliners. */
register_emitter (Qadd1, emit_add1);
register_emitter (Qsub1, emit_sub1);
@@ -4747,7 +4752,7 @@ DEFUN ("comp--release-ctxt", Fcomp__release_ctxt, Scomp__release_ctxt,
gcc_jit_context_release (comp.ctxt);
if (logfile)
- fclose (logfile);
+ emacs_fclose (logfile);
comp.ctxt = NULL;
return Qt;
@@ -4861,8 +4866,8 @@ add_compiler_options (void)
#endif
}
-DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
- Scomp__compile_ctxt_to_file,
+DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0,
+ Scomp__compile_ctxt_to_file0,
1, 1, 0,
doc: /* Compile the current context as native code to file FILENAME. */)
(Lisp_Object filename)
@@ -4963,14 +4968,12 @@ DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
struct Lisp_Hash_Table *func_h =
XHASH_TABLE (CALL1I (comp-ctxt-funcs-h, Vcomp_ctxt));
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++)
- if (!BASE_EQ (HASH_KEY (func_h, i), Qunbound))
- declare_function (HASH_VALUE (func_h, i));
+ DOHASH_SAFE (func_h, i)
+ declare_function (HASH_VALUE (func_h, i));
/* Compile all functions. Can't be done before because the
relocation structs has to be already defined. */
- for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (func_h); i++)
- if (!BASE_EQ (HASH_KEY (func_h, i), Qunbound))
- compile_function (HASH_VALUE (func_h, i));
+ DOHASH_SAFE (func_h, i)
+ compile_function (HASH_VALUE (func_h, i));
/* Work around bug#46495 (GCC PR99126). */
#if defined (WIDE_EMACS_INT) \
@@ -5086,6 +5089,21 @@ helper_GET_SYMBOL_WITH_POSITION (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos);
}
+static Lisp_Object
+helper_sanitizer_assert (Lisp_Object val, Lisp_Object type)
+{
+ if (!comp_sanitizer_active
+ || !NILP ((CALL2I (cl-typep, val, type))))
+ return Qnil;
+
+ AUTO_STRING (format, "Comp sanitizer FAIL for %s with type %s");
+ CALLN (Fmessage, format, val, type);
+ CALL0I (backtrace);
+ xsignal2 (Qcomp_sanitizer_error, val, type);
+
+ return Qnil;
+}
+
/* `native-comp-eln-load-path' clean-up support code. */
@@ -5199,17 +5217,9 @@ maybe_defer_native_compilation (Lisp_Object function_name,
Fputhash (function_name, definition, Vcomp_deferred_pending_h);
- /* This is so deferred compilation is able to compile comp
- dependencies breaking circularity. */
- if (comp__compilable)
- {
- /* Startup is done, comp is usable. */
- CALL0I (startup--require-comp-safely);
- CALLN (Ffuncall, intern_c_string ("native--compile-async"),
- src, Qnil, Qlate);
- }
- else
- Vcomp__delayed_sources = Fcons (src, Vcomp__delayed_sources);
+ pending_funcalls
+ = Fcons (list (Qnative__compile_async, src, Qnil, Qlate),
+ pending_funcalls);
}
@@ -5674,13 +5684,6 @@ void
syms_of_comp (void)
{
#ifdef HAVE_NATIVE_COMP
- DEFVAR_LISP ("comp--delayed-sources", Vcomp__delayed_sources,
- doc: /* List of sources to be native-compiled when startup is finished.
-For internal use. */);
- DEFVAR_BOOL ("comp--compilable", comp__compilable,
- doc: /* Non-nil when comp.el can be native compiled.
-For internal use. */);
- /* Compiler control customizes. */
DEFVAR_BOOL ("native-comp-jit-compilation", native_comp_jit_compilation,
doc: /* If non-nil, compile loaded .elc files asynchronously.
@@ -5728,6 +5731,7 @@ natively-compiled one. */);
DEFSYM (Qhelper_unbind_n, "helper_unbind_n");
DEFSYM (Qhelper_unwind_protect, "helper_unwind_protect");
DEFSYM (Qhelper_save_restriction, "helper_save_restriction");
+ DEFSYM (Qhelper_sanitizer_assert, "helper_sanitizer_assert");
/* Inliners. */
DEFSYM (Qadd1, "1+");
DEFSYM (Qsub1, "1-");
@@ -5798,6 +5802,14 @@ natively-compiled one. */);
build_pure_c_string ("eln file inconsistent with current runtime "
"configuration, please recompile"));
+ DEFSYM (Qcomp_sanitizer_error, "comp-sanitizer-error");
+ Fput (Qcomp_sanitizer_error, Qerror_conditions,
+ pure_list (Qcomp_sanitizer_error, Qerror));
+ Fput (Qcomp_sanitizer_error, Qerror_message,
+ build_pure_c_string ("Native code sanitizer runtime error"));
+
+ DEFSYM (Qnative__compile_async, "native--compile-async");
+
defsubr (&Scomp__subr_signature);
defsubr (&Scomp_el_to_eln_rel_filename);
defsubr (&Scomp_el_to_eln_filename);
@@ -5806,7 +5818,7 @@ natively-compiled one. */);
defsubr (&Scomp__install_trampoline);
defsubr (&Scomp__init_ctxt);
defsubr (&Scomp__release_ctxt);
- defsubr (&Scomp__compile_ctxt_to_file);
+ defsubr (&Scomp__compile_ctxt_to_file0);
defsubr (&Scomp_libgccjit_version);
defsubr (&Scomp__register_lambda);
defsubr (&Scomp__register_subr);
@@ -5918,6 +5930,14 @@ subr-name -> arity
For internal use. */);
Vcomp_subr_arities_h = CALLN (Fmake_hash_table, QCtest, Qequal);
+ DEFVAR_BOOL ("comp-sanitizer-active", comp_sanitizer_active,
+ doc: /* If non-nil, enable runtime execution of native-compiler sanitizer.
+For this to be effective, Lisp code must be compiled
+with `comp-sanitizer-emit' non-nil.
+This is intended to be used only for development and
+verification of the native compiler. */);
+ comp_sanitizer_active = false;
+
Fprovide (intern_c_string ("native-compile"), Qnil);
#endif /* #ifdef HAVE_NATIVE_COMP */
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-02 14:52:10 +0000