feature/native-comp 9f6c12b 3/3: * Throw an ICE when asked to emit a cast with sign extension.

[Andrea Corallo]

branch: feature/native-comp
commit 9f6c12be5574060014f91ad6190d79124ea19802
Author: Nicolás Bértolo <nicolasbertolo@gmail.com>
Commit: Andrea Corallo <akrl@sdf.org>

    * Throw an ICE when asked to emit a cast with sign extension.
    
    * src/comp.c (cast_kind_of_type): Enum that specifies the kind of type
    in the cast enum (unsigned, signed, pointer).
    (emit_coerce): Throw an ICE when asked to emit a cast with sign
    extension.
    (define_cast_from_to): Return NULL for casts involving sign extension.
    (define_cast_functions): Specify the kind of each type in the cast
    union.
---
 src/comp.c | 70 +++++++++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 49 insertions(+), 21 deletions(-)

diff --git a/src/comp.c b/src/comp.c
index 8ccae7c..d0574ac 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -456,6 +456,13 @@ static f_reloc_t freloc;
 
 #define NUM_CAST_TYPES 15
 
+enum cast_kind_of_type
+  {
+    kind_unsigned,
+    kind_signed,
+    kind_pointer
+  };
+
 /* C side of the compiler context.  */
 
 typedef struct {
@@ -518,10 +525,11 @@ typedef struct {
   gcc_jit_function *cast_functions_from_to[NUM_CAST_TYPES][NUM_CAST_TYPES];
   /*  We add one to make space for the last member which is the "biggest_type"
       member.  */
-  gcc_jit_type *cast_types[NUM_CAST_TYPES+1];
-  size_t cast_type_sizes[NUM_CAST_TYPES+1];
-  const char *cast_type_names[NUM_CAST_TYPES+1];
-  gcc_jit_field *cast_union_fields[NUM_CAST_TYPES+1];
+  gcc_jit_type *cast_types[NUM_CAST_TYPES + 1];
+  size_t cast_type_sizes[NUM_CAST_TYPES + 1];
+  enum cast_kind_of_type cast_type_kind[NUM_CAST_TYPES + 1];
+  const char *cast_type_names[NUM_CAST_TYPES + 1];
+  gcc_jit_field *cast_union_fields[NUM_CAST_TYPES + 1];
   size_t cast_union_field_biggest_type;
   gcc_jit_function *func; /* Current function being compiled.  */
   bool func_has_non_local; /* From comp-func has-non-local slot.  */
@@ -986,6 +994,13 @@ emit_coerce (gcc_jit_type *new_type, gcc_jit_rvalue *obj)
   int old_index = type_to_cast_index (old_type);
   int new_index = type_to_cast_index (new_type);
 
+  if (comp.cast_type_sizes[old_index] < comp.cast_type_sizes[new_index]
+      && comp.cast_type_kind[new_index] == kind_signed)
+    xsignal3 (Qnative_ice,
+              build_string ("FIXME: sign extension not implemented"),
+              build_string (comp.cast_type_names[old_index]),
+              build_string (comp.cast_type_names[new_index]));
+
   /* Lookup the appropriate cast function in the cast matrix.  */
   return gcc_jit_context_new_call (comp.ctxt,
            NULL,
@@ -2919,12 +2934,18 @@ struct cast_type
   gcc_jit_type *type;
   const char *name;
   size_t bytes_size;
+  enum cast_kind_of_type kind;
 };
 
 static gcc_jit_function *
 define_cast_from_to (struct cast_type from, int from_index, struct cast_type 
to,
                     int to_index)
 {
+  /*  FIXME: sign extension not implemented.  */
+  if (comp.cast_type_sizes[from_index] < comp.cast_type_sizes[to_index]
+      && comp.cast_type_kind[to_index] == kind_signed)
+    return NULL;
+
   char *name = format_string ("cast_from_%s_to_%s", from.name, to.name);
   gcc_jit_param *param = gcc_jit_context_new_param (comp.ctxt, NULL,
                                                     from.type, "arg");
@@ -2973,22 +2994,27 @@ static void
 define_cast_functions (void)
 {
   struct cast_type cast_types[NUM_CAST_TYPES]
-    = { { comp.bool_type, "bool", sizeof (bool) },
-        { comp.char_ptr_type, "char_ptr", sizeof (char *) },
-        { comp.int_type, "int", sizeof (int) },
-        { comp.lisp_cons_ptr_type, "cons_ptr", sizeof (struct Lisp_Cons *) },
-        { comp.lisp_obj_ptr_type, "lisp_obj_ptr", sizeof (Lisp_Object *) },
-        { comp.lisp_word_tag_type, "lisp_word_tag", sizeof (Lisp_Word_tag) },
-        { comp.lisp_word_type, "lisp_word", sizeof (Lisp_Word) },
-        { comp.long_long_type, "long_long", sizeof (long long) },
-        { comp.long_type, "long", sizeof (long) },
-        { comp.ptrdiff_type, "ptrdiff", sizeof (ptrdiff_t) },
-        { comp.uintptr_type, "uintptr", sizeof (uintptr_t) },
+    = { { comp.bool_type, "bool", sizeof (bool), kind_unsigned },
+        { comp.char_ptr_type, "char_ptr", sizeof (char *), kind_pointer },
+        { comp.int_type, "int", sizeof (int), kind_signed },
+        { comp.lisp_cons_ptr_type, "cons_ptr", sizeof (struct Lisp_Cons *),
+          kind_pointer },
+        { comp.lisp_obj_ptr_type, "lisp_obj_ptr", sizeof (Lisp_Object *),
+          kind_pointer },
+        { comp.lisp_word_tag_type, "lisp_word_tag", sizeof (Lisp_Word_tag),
+          kind_unsigned },
+        { comp.lisp_word_type, "lisp_word", sizeof (Lisp_Word),
+          LISP_WORDS_ARE_POINTERS ? kind_pointer : kind_signed },
+        { comp.long_long_type, "long_long", sizeof (long long), kind_signed },
+        { comp.long_type, "long", sizeof (long), kind_signed },
+        { comp.ptrdiff_type, "ptrdiff", sizeof (ptrdiff_t), kind_signed },
+        { comp.uintptr_type, "uintptr", sizeof (uintptr_t), kind_unsigned },
         { comp.unsigned_long_long_type, "unsigned_long_long",
-          sizeof (unsigned long long) },
-        { comp.unsigned_long_type, "unsigned_long", sizeof (unsigned long) },
-        { comp.unsigned_type, "unsigned", sizeof (unsigned) },
-        { comp.void_ptr_type, "void_ptr", sizeof (void*) } };
+          sizeof (unsigned long long), kind_unsigned },
+        { comp.unsigned_long_type, "unsigned_long", sizeof (unsigned long),
+          kind_unsigned },
+        { comp.unsigned_type, "unsigned", sizeof (unsigned), kind_unsigned },
+        { comp.void_ptr_type, "void_ptr", sizeof (void*), kind_pointer } };
 
   /* Find the biggest size.  It should be unsigned long long, but to be
      sure we find it programmatically.  */
@@ -3006,16 +3032,18 @@ define_cast_functions (void)
                                     cast_types[i].name);
       comp.cast_type_names[i] = cast_types[i].name;
       comp.cast_type_sizes[i] = cast_types[i].bytes_size;
+      comp.cast_type_kind[i] = cast_types[i].kind;
     }
 
   gcc_jit_type *biggest_type = gcc_jit_context_get_int_type (comp.ctxt,
                                                              biggest_size,
                                                              false);
   comp.cast_types[NUM_CAST_TYPES] = biggest_type;
-  comp.cast_union_fields[NUM_CAST_TYPES]
-    = gcc_jit_context_new_field (comp.ctxt, NULL, biggest_type, 
"biggest_type");
+  comp.cast_union_fields[NUM_CAST_TYPES] =
+    gcc_jit_context_new_field (comp.ctxt, NULL, biggest_type, "biggest_type");
   comp.cast_type_names[NUM_CAST_TYPES] = "biggest_type";
   comp.cast_type_sizes[NUM_CAST_TYPES] = biggest_size;
+  comp.cast_type_kind[NUM_CAST_TYPES] = kind_unsigned;
 
   comp.cast_union_type =
     gcc_jit_context_new_union_type (comp.ctxt,