From e96cd4e82c9aca01f136ccdd7a3b0fbf2db01e50 Mon Sep 17 00:00:00 2001
From: Andrea Corallo
Date: Sat, 7 Nov 2020 21:47:30 +0100
Subject: Add initial nativecomp typeset and range propagation support

This commit add an initial support for a better type propagation and
integer range propagation.

Each mvar can be now characterized by a set of types, a set of values
and an integral range.

	* lisp/emacs-lisp/comp.el (comp-known-ret-types): Store into
	typeset and remove fixnum.
	(comp-known-ret-ranges, comp-type-predicates): New variables.
	(comp-ctxt): Remove supertype-memoize slot and add
	union-typesets-mem.
	(comp-mvar): Remove const-vld, constant, type slots. Add typeset,
	valset, range slots.
	(comp-mvar-value-vld-p, comp-mvar-value, comp-mvar-fixnum-p)
	(comp-mvar-symbol-p, comp-mvar-cons-p)
	(comp-mvar-type-hint-match-p, comp-func-ret-typeset)
	(comp-func-ret-range): New functions.
	(make-comp-mvar, make-comp-ssa-mvar): Update logic.
	(comp--typeof-types): New variable.
	(comp-supertypes, comp-common-supertype): Logic update.
	(comp-subtype-p, comp-union-typesets, comp-range-1+)
	(comp-range-1-, comp-range-<, comp-range-union)
	(comp-range-intersection): New functions.
	(comp-fwprop-prologue, comp-mvar-propagate)
	(comp-function-foldable-p, comp-function-call-maybe-fold)
	(comp-fwprop-insn, comp-call-optim-func, comp-finalize-relocs):
	Logic update.

	* src/comp.c (emit_mvar_rval, emit_call_with_type_hint)
	(emit_call2_with_type_hint): Logic update.

	* lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types): Undo the add
	of fixnum and bignum as unnecessary.

	* test/src/comp-tests.el
	(comp-tests-mentioned-p-1, comp-tests-cond-rw-checker-val)
	(comp-tests-cond-rw-checker-type, cond-rw-1, cond-rw-2)
	(cond-rw-3, cond-rw-4, cond-rw-5): Update for new type interface.
	(range-simple-union, range-simple-intersection): New integer range
	tests.
	(union-types): New union type test.
---
 src/comp.c | 24 +++++++++++++-----------
 1 file changed, 13 insertions(+), 11 deletions(-)

(limited to 'src')

diff --git a/src/comp.c b/src/comp.c
index cb5f1a1ce96..0d464281858 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -1845,32 +1845,32 @@ emit_PURE_P (gcc_jit_rvalue *ptr)
 static gcc_jit_rvalue *
 emit_mvar_rval (Lisp_Object mvar)
 {
-  Lisp_Object const_vld = CALL1I (comp-mvar-const-vld, mvar);
-  Lisp_Object constant = CALL1I (comp-mvar-constant, mvar);
+  Lisp_Object const_vld = CALL1I (comp-mvar-value-vld-p, mvar);
 
   if (!NILP (const_vld))
     {
+      Lisp_Object value = CALL1I (comp-mvar-value, mvar);
       if (comp.debug > 1)
 	{
 	  Lisp_Object func =
-	    Fgethash (constant,
+	    Fgethash (value,
 		      CALL1I (comp-ctxt-byte-func-to-func-h, Vcomp_ctxt),
 		      Qnil);
 
 	  emit_comment (
 	    SSDATA (
 	      Fprin1_to_string (
-		NILP (func) ? constant : CALL1I (comp-func-c-name, func),
+		NILP (func) ? value : CALL1I (comp-func-c-name, func),
 		Qnil)));
 	}
-      if (FIXNUMP (constant))
+      if (FIXNUMP (value))
 	{
 	  /* We can still emit directly objects that are self-contained in a
 	     word (read fixnums).  */
-          return emit_rvalue_from_lisp_obj (constant);
+          return emit_rvalue_from_lisp_obj (value);
 	}
       /* Other const objects are fetched from the reloc array.  */
-      return emit_lisp_obj_rval (constant);
+      return emit_lisp_obj_rval (value);
     }
 
   return gcc_jit_lvalue_as_rvalue (emit_mvar_lval (mvar));
@@ -2371,12 +2371,13 @@ static gcc_jit_rvalue *
 emit_call_with_type_hint (gcc_jit_function *func, Lisp_Object insn,
 			  Lisp_Object type)
 {
-  bool type_hint = EQ (CALL1I (comp-mvar-type, SECOND (insn)), type);
+  bool hint_match =
+    !NILP (CALL2I (comp-mvar-type-hint-match-p, SECOND (insn), type));
   gcc_jit_rvalue *args[] =
     { emit_mvar_rval (SECOND (insn)),
       gcc_jit_context_new_rvalue_from_int (comp.ctxt,
 					   comp.bool_type,
-					   type_hint) };
+					   hint_match) };
 
   return gcc_jit_context_new_call (comp.ctxt, NULL, func, 2, args);
 }
@@ -2386,13 +2387,14 @@ static gcc_jit_rvalue *
 emit_call2_with_type_hint (gcc_jit_function *func, Lisp_Object insn,
 			   Lisp_Object type)
 {
-  bool type_hint = EQ (CALL1I (comp-mvar-type, SECOND (insn)), type);
+  bool hint_match =
+    !NILP (CALL2I (comp-mvar-type-hint-match-p, SECOND (insn), type));
   gcc_jit_rvalue *args[] =
     { emit_mvar_rval (SECOND (insn)),
       emit_mvar_rval (THIRD (insn)),
       gcc_jit_context_new_rvalue_from_int (comp.ctxt,
 					   comp.bool_type,
-					   type_hint) };
+					   hint_match) };
 
   return gcc_jit_context_new_call (comp.ctxt, NULL, func, 3, args);
 }
-- 
cgit v1.2.1