Add native compiler sanitizer

* src/comp.c (ABI_VERSION): Bump new version.
(CALL0I): Uncomment.
(helper_link_table, declare_runtime_imported_funcs): Add
'helper_sanitizer_assert'.
(Fcomp__init_ctxt): Register emitter for
'helper_sanitizer_assert'.
(helper_sanitizer_assert): New function.
(syms_of_comp): 'helper_sanitizer_assert' defsym.
(syms_of_comp): 'comp-sanitizer-error' define error.
(syms_of_comp): 'comp-sanitizer-active' defvar.

* lisp/emacs-lisp/comp.el (comp-passes): Add 'comp--sanitizer'.
(comp-sanitizer-emit): Define var.
(comp--sanitizer): Define function.

* lisp/emacs-lisp/comp-run.el (comp-run-async-workers): Forward
'comp-sanitizer-emit'.

1 files changed, 39 insertions, 3 deletions

diff --git a/src/comp.c b/src/comp.c
index 76cf1f3ab6e..5e4ca643072 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
@@ -502,11 +502,9 @@ load_gccjit_if_necessary (bool mandatory)
 #define THIRD(x)				\
   XCAR (XCDR (XCDR (x)))
 
-#if 0	/* unused for now */
 /* Like call0 but stringify and intern.  */
 #define CALL0I(fun)				\
   CALLN (Ffuncall, intern_c_string (STR (fun)))
-#endif
 
 /* Like call1 but stringify and intern.  */
 #define CALL1I(fun, arg)				\
@@ -702,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'.  */
@@ -714,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,
@@ -2975,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;
@@ -4619,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);
@@ -5082,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.  */
 
@@ -5709,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-");
@@ -5779,6 +5802,12 @@ 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);
@@ -5901,6 +5930,13 @@ 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: /* When non-nil enable sanitizer runtime execution.
+To be effective Lisp Code must have been compiled with
+`comp-sanitizer-emit' non-nil.
+In use for native compiler development and verification only.  */);
+  comp_sanitizer_active = false;
+
   Fprovide (intern_c_string ("native-compile"), Qnil);
 #endif /* #ifdef HAVE_NATIVE_COMP */