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'.
This commit is contained in:
Andrea Corallo
parent
e72f17e462
commit
0b0c7da8c8
3 changed files with 86 additions and 3 deletions
|
|
@ -256,6 +256,7 @@ display a message."
|
|||
load-path
|
||||
backtrace-line-length
|
||||
byte-compile-warnings
|
||||
comp-sanitizer-emit
|
||||
;; package-load-list
|
||||
;; package-user-dir
|
||||
;; package-directory-list
|
||||
|
|
|
|||
|
|
@ -165,6 +165,7 @@ Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.")
|
|||
comp--tco
|
||||
comp--fwprop
|
||||
comp--remove-type-hints
|
||||
comp--sanitizer
|
||||
comp--compute-function-types
|
||||
comp--final)
|
||||
"Passes to be executed in order.")
|
||||
|
|
@ -3006,6 +3007,51 @@ These are substituted with a normal `set' op."
|
|||
(comp--log-func comp-func 3))))
|
||||
(comp-ctxt-funcs-h comp-ctxt)))
|
||||
|
||||
|
||||
;;; Sanitizer pass specific code.
|
||||
|
||||
;; This pass aims to verify compile time value type predictions during
|
||||
;; execution.
|
||||
;; The sanitizer pass injects a call to 'helper_sanitizer_assert' before
|
||||
;; each conditional branch. 'helper_sanitizer_assert' will verify that
|
||||
;; the variable tested by the conditional branch is of the predicted
|
||||
;; value type and signal an error otherwise.
|
||||
|
||||
(defvar comp-sanitizer-emit nil
|
||||
"Gates the sanitizer pass.
|
||||
In use for native compiler development and verification only.")
|
||||
|
||||
(defun comp--sanitizer (_)
|
||||
(when comp-sanitizer-emit
|
||||
(cl-loop
|
||||
for f being each hash-value of (comp-ctxt-funcs-h comp-ctxt)
|
||||
for comp-func = f
|
||||
unless (comp-func-has-non-local comp-func)
|
||||
do
|
||||
(cl-loop
|
||||
for b being each hash-value of (comp-func-blocks f)
|
||||
do
|
||||
(cl-loop
|
||||
named in-the-basic-block
|
||||
for insns-seq on (comp-block-insns b)
|
||||
do (pcase insns-seq
|
||||
(`((cond-jump ,(and (pred comp-mvar-p) mvar-tested)
|
||||
,(pred comp-mvar-p) ,_bb1 ,_bb2))
|
||||
(let ((type (comp-cstr-to-type-spec mvar-tested))
|
||||
(insn (car insns-seq)))
|
||||
;; No need to check if type is t.
|
||||
(unless (eq type t)
|
||||
(comp--add-const-to-relocs type)
|
||||
(setcar
|
||||
insns-seq
|
||||
(comp--call 'helper_sanitizer_assert
|
||||
mvar-tested
|
||||
(make--comp-mvar :constant type)))
|
||||
(setcdr insns-seq (list insn)))
|
||||
;; (setf (comp-func-ssa-status comp-func) 'dirty)
|
||||
(cl-return-from in-the-basic-block))))))
|
||||
do (comp--log-func comp-func 3))))
|
||||
|
||||
|
||||
;;; Function types pass specific code.
|
||||
|
||||
|
|
|
|||
42
src/comp.c
42
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 */
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue