From 4da353c6a3900ddacab00d685432fba12099dbd0 Mon Sep 17 00:00:00 2001
From: Andrea Corallo <andrea_corallo@yahoo.it>
Date: Tue, 11 Jun 2019 19:23:31 +0200
Subject: [PATCH] add comp_TAGGEDP

---
 src/comp.c | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)

diff --git a/src/comp.c b/src/comp.c
index 97b617ce2be..823956e147a 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -281,6 +281,54 @@ comp_XLI (gcc_jit_rvalue *obj)
 				      comp.lisp_obj_as_num);
 }
 
+static gcc_jit_rvalue *
+comp_TAGGEDP (gcc_jit_rvalue *obj, unsigned tag)
+{
+   /* (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
+	- (unsigned) (tag)) \
+	& ((1 << GCTYPEBITS) - 1))) */
+
+  gcc_jit_rvalue *sh_res =
+    gcc_jit_context_new_binary_op (
+      comp.ctxt,
+      NULL,
+      GCC_JIT_BINARY_OP_RSHIFT,
+      comp.long_long_type,
+      comp_XLI (obj),
+      gcc_jit_context_new_rvalue_from_int (comp.ctxt,
+					   comp.long_long_type,
+					   (USE_LSB_TAG ? 0 : VALBITS)));
+
+  gcc_jit_rvalue *minus_res =
+    gcc_jit_context_new_binary_op (comp.ctxt,
+				   NULL,
+				   GCC_JIT_BINARY_OP_MINUS,
+				   comp.unsigned_type,
+				   comp_cast (comp.unsigned_type, sh_res),
+				   gcc_jit_context_new_rvalue_from_int (
+				     comp.ctxt,
+				     comp.unsigned_type,
+				     tag));
+
+  gcc_jit_rvalue *res =
+   gcc_jit_context_new_unary_op (
+     comp.ctxt,
+     NULL,
+     GCC_JIT_UNARY_OP_LOGICAL_NEGATE,
+     comp.int_type,
+     gcc_jit_context_new_binary_op (comp.ctxt,
+				    NULL,
+				    GCC_JIT_BINARY_OP_BITWISE_AND,
+				    comp.unsigned_type,
+				    minus_res,
+				    gcc_jit_context_new_rvalue_from_int (
+				      comp.ctxt,
+				      comp.unsigned_type,
+				      ((1 << GCTYPEBITS) - 1))));
+
+  return res;
+}
+
 static gcc_jit_rvalue *
 comp_FIXNUMP (gcc_jit_rvalue *obj)
 {
-- 
2.39.5