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, 46 insertions, 0 deletions

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 9c2182092cb..6afb357bef2 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -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.")
@@ -3007,6 +3008,51 @@ These are substituted with a normal `set' op."
            (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.
 
 (defun comp--compute-function-type (_ func)