add sub1

diff --git a/src/comp.c b/src/comp.c
index 63bf88870bde95018bd2cfd77775732ce9400167..0098b814581a957629274e19e6f110563cb18e48 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -149,7 +149,9 @@ typedef struct {
 typedef struct {
   gcc_jit_context *ctxt;
   gcc_jit_type *void_type;
+  gcc_jit_type *bool_type;
   gcc_jit_type *int_type;
+  gcc_jit_type *unsigned_type;
   gcc_jit_type *long_type;
   gcc_jit_type *long_long_type;
   gcc_jit_type *void_ptr_type;
@@ -157,6 +159,13 @@ typedef struct {
   gcc_jit_type *lisp_obj_type;
   gcc_jit_field *lisp_obj_as_ptr;
   gcc_jit_field *lisp_obj_as_num;
+  /* libgccjit has really limited support for casting therefore this union will
+     be used for the scope.  */
+  gcc_jit_type *cast_union_type;
+  gcc_jit_field *cast_union_as_ll;
+  gcc_jit_field *cast_union_as_u;
+  gcc_jit_field *cast_union_as_i;
+  gcc_jit_field *cast_union_as_b;
   gcc_jit_function *func; /* Current function being compiled  */
   gcc_jit_rvalue *scratch; /* Will point to scratch_call_area  */
   gcc_jit_rvalue *most_positive_fixnum;
@@ -211,22 +220,118 @@ pop (unsigned n, gcc_jit_lvalue ***stack_ref, gcc_jit_rvalue *args[])
   *stack_ref = stack;
 }
 
+INLINE static gcc_jit_field *
+type_to_cast_field (gcc_jit_type *type)
+{
+  gcc_jit_field *field;
+
+  if (type == comp.long_long_type)
+    field = comp.cast_union_as_ll;
+  else if (type == comp.unsigned_type)
+    field = comp.cast_union_as_u;
+  else if (type == comp.int_type)
+    field = comp.cast_union_as_i;
+  else if (type == comp.bool_type)
+    field = comp.cast_union_as_b;
+  else
+    error ("unsopported cast\n");
+
+  return field;
+}
+
+static gcc_jit_rvalue *
+comp_cast (gcc_jit_type *new_type, gcc_jit_rvalue *obj)
+{
+  gcc_jit_field *orig_field =
+    type_to_cast_field (gcc_jit_rvalue_get_type (obj));
+  gcc_jit_field *dest_field = type_to_cast_field (new_type);
+
+  gcc_jit_lvalue *tmp_u =
+    gcc_jit_function_new_local (comp.func,
+                               NULL,
+                               comp.cast_union_type,
+                               "union_cast");
+  gcc_jit_block_add_assignment (comp.bblock->gcc_bb,
+                               NULL,
+                               gcc_jit_lvalue_access_field (tmp_u,
+                                                            NULL,
+                                                            orig_field),
+                               obj);
+
+  return gcc_jit_rvalue_access_field ( gcc_jit_lvalue_as_rvalue (tmp_u),
+                                      NULL,
+                                      dest_field);
+}
+
 INLINE static gcc_jit_rvalue *
-comp_xfixnum (gcc_jit_rvalue *obj)
+comp_XLI (gcc_jit_rvalue *obj)
+{
+  return gcc_jit_rvalue_access_field (obj,
+                                     NULL,
+                                     comp.lisp_obj_as_num);
+}
+
+static gcc_jit_rvalue *
+comp_FIXNUMP (gcc_jit_rvalue *obj)
 {
-  return gcc_jit_context_new_binary_op (
-          comp.ctxt,
-          NULL,
-          GCC_JIT_BINARY_OP_RSHIFT,
-          comp.long_long_type,
-          gcc_jit_rvalue_access_field (obj,
+  /* (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS))
+        - (unsigned) (Lisp_Int0 >> !USE_LSB_TAG))
+       & ((1 << INTTYPEBITS) - 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 : FIXNUM_BITS)));
+
+  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,
+                                    (Lisp_Int0 >> !USE_LSB_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 << INTTYPEBITS) - 1))));
+
+  return res;
+}
+
+static gcc_jit_rvalue *
+comp_XFIXNUM (gcc_jit_rvalue *obj)
+{
+  return gcc_jit_context_new_binary_op (comp.ctxt,
                                        NULL,
-                                       comp.lisp_obj_as_num),
-          comp.inttypebits);
+                                       GCC_JIT_BINARY_OP_RSHIFT,
+                                       comp.long_long_type,
+                                       comp_XLI (obj),
+                                       comp.inttypebits);
 }
 
-INLINE static gcc_jit_rvalue *
-comp_make_fixnum (gcc_jit_rvalue *obj)
+static gcc_jit_rvalue *
+comp_make_fixnum (gcc_jit_block *block, gcc_jit_rvalue *obj)
 {
   gcc_jit_rvalue *tmp =
     gcc_jit_context_new_binary_op (comp.ctxt,
@@ -248,7 +353,7 @@ comp_make_fixnum (gcc_jit_rvalue *obj)
                                                    comp.lisp_obj_type,
                                                    "lisp_obj_fixnum");
 
-  gcc_jit_block_add_assignment (comp.bblock->gcc_bb,
+  gcc_jit_block_add_assignment (block,
                                NULL,
                                gcc_jit_lvalue_access_field (
                                  res,
@@ -261,7 +366,7 @@ comp_make_fixnum (gcc_jit_rvalue *obj)
 
 /* Construct fill and return a lisp object form a raw pointer.  */
 
-INLINE static gcc_jit_rvalue *
+static gcc_jit_rvalue *
 comp_lisp_obj_as_ptr_from_ptr (basic_block_t *bblock, void *p)
 {
   gcc_jit_lvalue *lisp_obj = gcc_jit_function_new_local (comp.func,
@@ -567,9 +672,8 @@ compute_bblocks (ptrdiff_t bytestr_length, unsigned char *bytestr_data)
 
 /* Close current basic block emitting a conditional.  */
 
-static void
-comp_emit_conditional (enum gcc_jit_comparison op,
-                      gcc_jit_rvalue *test,
+INLINE static void
+comp_emit_cond_jump (gcc_jit_rvalue *test,
                       gcc_jit_block *then_target, gcc_jit_block *else_target)
 {
   gcc_jit_block_end_with_conditional (comp.bblock->gcc_bb,
@@ -583,16 +687,16 @@ comp_emit_conditional (enum gcc_jit_comparison op,
 /* Close current basic block emitting a comparison between two rval.  */
 
 static gcc_jit_rvalue *
-comp_emit_comparison (enum gcc_jit_comparison op,
-                     gcc_jit_rvalue *a, gcc_jit_rvalue *b,
-                     gcc_jit_block *then_target, gcc_jit_block *else_target)
+comp_emit_comp_jump (enum gcc_jit_comparison op,
+                    gcc_jit_rvalue *a, gcc_jit_rvalue *b,
+                    gcc_jit_block *then_target, gcc_jit_block *else_target)
 {
   gcc_jit_rvalue *test = gcc_jit_context_new_comparison (comp.ctxt,
                                                         NULL,
                                                         op,
                                                         a, b);
 
-  comp_emit_conditional (op, test, then_target, else_target);
+  comp_emit_cond_jump (test, then_target, else_target);
 
   return test;
 }
@@ -892,38 +996,60 @@ compile_f (const char *f_name, ptrdiff_t bytestr_length,
 
        case Bsub1:
          {
-           gcc_jit_block *sub1_inline =
-             gcc_jit_function_new_block (comp.func, "-1 inline");
-           gcc_jit_block *sub1_fcall =
-             gcc_jit_function_new_block (comp.func, "-1 fcall");
+
+           /* (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM
+              ? make_fixnum (XFIXNUM (TOP) - 1)
+              : Fsub1 (TOP)) */
+
+           gcc_jit_block *sub1_inline_block =
+                gcc_jit_function_new_block (comp.func, "inline-1");
+           gcc_jit_block *sub1_fcall_block =
+                gcc_jit_function_new_block (comp.func, "fcall-1");
 
            gcc_jit_rvalue *tos_as_num =
-             gcc_jit_rvalue_access_field (gcc_jit_lvalue_as_rvalue (TOS),
-                                          NULL,
-                                          comp.lisp_obj_as_num);
-           comp_emit_comparison (GCC_JIT_COMPARISON_NE,
-                                 tos_as_num,
-                                 comp.most_negative_fixnum,
-                                 sub1_inline, sub1_fcall);
+             comp_XFIXNUM (gcc_jit_lvalue_as_rvalue (TOS));
+
+           comp_emit_cond_jump (
+             gcc_jit_context_new_binary_op (
+               comp.ctxt,
+               NULL,
+               GCC_JIT_BINARY_OP_LOGICAL_AND,
+               comp.bool_type,
+               comp_cast (comp.bool_type,
+                          comp_FIXNUMP (gcc_jit_lvalue_as_rvalue (TOS))),
+               gcc_jit_context_new_comparison (comp.ctxt,
+                                               NULL,
+                                               GCC_JIT_COMPARISON_NE,
+                                               tos_as_num,
+                                               comp.most_negative_fixnum)),
+             sub1_inline_block,
+             sub1_fcall_block);
+
            gcc_jit_rvalue *sub1_inline_res =
              gcc_jit_context_new_binary_op (comp.ctxt,
                                             NULL,
                                             GCC_JIT_BINARY_OP_MINUS,
-                                            comp.lisp_obj_type,
+                                            comp.long_long_type,
                                             tos_as_num,
                                             comp.one);
-           gcc_jit_block_add_assignment (sub1_inline,
+
+           gcc_jit_block_add_assignment (sub1_inline_block,
                                          NULL,
                                          TOS,
-                                         sub1_inline_res);
+                                         comp_make_fixnum (sub1_inline_block,
+                                                           sub1_inline_res));
+           basic_block_t bb_orig = *comp.bblock;
+
+           comp.bblock->gcc_bb = sub1_fcall_block;
+           POP1;
+           res = comp_emit_call ("Fsub1", comp.lisp_obj_type, 1, args);
+           PUSH_LVAL (res);
 
-           /* TODO fill sub1_fcall */
-           /* comp.bblock->gcc_bb = sub1_fcall; */
-           /* comp.bblock->terminated = false; */
+           *comp.bblock = bb_orig;
 
-           gcc_jit_block_end_with_jump (sub1_inline, NULL,
+           gcc_jit_block_end_with_jump (sub1_inline_block, NULL,
                                         bb_map[pc].gcc_bb);
-           gcc_jit_block_end_with_jump (sub1_fcall, NULL,
+           gcc_jit_block_end_with_jump (sub1_fcall_block, NULL,
                                         bb_map[pc].gcc_bb);
          }
 
@@ -1053,32 +1179,32 @@ compile_f (const char *f_name, ptrdiff_t bytestr_length,
        case Bgotoifnil:
          op = FETCH2;
          POP1;
-         comp_emit_comparison (GCC_JIT_COMPARISON_EQ, args[0], nil,
-                               bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
+         comp_emit_comp_jump (GCC_JIT_COMPARISON_EQ, args[0], nil,
+                              bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
          break;
 
        case Bgotoifnonnil:
          op = FETCH2;
          POP1;
-         comp_emit_comparison (GCC_JIT_COMPARISON_NE, args[0], nil,
-                               bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
+         comp_emit_comp_jump (GCC_JIT_COMPARISON_NE, args[0], nil,
+                              bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
          break;
 
        case Bgotoifnilelsepop:
          op = FETCH2;
-         comp_emit_comparison (GCC_JIT_COMPARISON_EQ,
-                               gcc_jit_lvalue_as_rvalue (TOS),
-                               nil,
-                               bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
+         comp_emit_comp_jump (GCC_JIT_COMPARISON_EQ,
+                              gcc_jit_lvalue_as_rvalue (TOS),
+                              nil,
+                              bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
          POP1;
          break;
 
        case Bgotoifnonnilelsepop:
          op = FETCH2;
-         comp_emit_comparison (GCC_JIT_COMPARISON_NE,
-                               gcc_jit_lvalue_as_rvalue (TOS),
-                               nil,
-                               bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
+         comp_emit_comp_jump (GCC_JIT_COMPARISON_NE,
+                              gcc_jit_lvalue_as_rvalue (TOS),
+                              nil,
+                              bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
          POP1;
          break;
 
@@ -1239,35 +1365,35 @@ compile_f (const char *f_name, ptrdiff_t bytestr_length,
          op = FETCH - 128;
          op += pc;
          POP1;
-         comp_emit_comparison (GCC_JIT_COMPARISON_EQ, args[0], nil,
-                               bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
+         comp_emit_comp_jump (GCC_JIT_COMPARISON_EQ, args[0], nil,
+                              bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
          break;
 
        case BRgotoifnonnil:
          op = FETCH - 128;
          op += pc;
          POP1;
-         comp_emit_comparison (GCC_JIT_COMPARISON_NE, args[0], nil,
-                               bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
+         comp_emit_comp_jump (GCC_JIT_COMPARISON_NE, args[0], nil,
+                              bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
          break;
 
        case BRgotoifnilelsepop:
          op = FETCH - 128;
          op += pc;
-         comp_emit_comparison (GCC_JIT_COMPARISON_EQ,
-                               gcc_jit_lvalue_as_rvalue (TOS),
-                               nil,
-                               bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
+         comp_emit_comp_jump (GCC_JIT_COMPARISON_EQ,
+                              gcc_jit_lvalue_as_rvalue (TOS),
+                              nil,
+                              bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
          POP1;
          break;
 
        case BRgotoifnonnilelsepop:
          op = FETCH - 128;
          op += pc;
-         comp_emit_comparison (GCC_JIT_COMPARISON_NE,
-                               gcc_jit_lvalue_as_rvalue (TOS),
-                               nil,
-                               bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
+         comp_emit_comp_jump (GCC_JIT_COMPARISON_NE,
+                              gcc_jit_lvalue_as_rvalue (TOS),
+                              nil,
+                              bb_map[op].gcc_bb, bb_map[pc].gcc_bb);
          POP1;
          break;
 
@@ -1464,6 +1590,9 @@ init_comp (void)
   comp.void_ptr_type =
     gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_VOID_PTR);
   comp.int_type = gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_INT);
+  comp.unsigned_type = gcc_jit_context_get_type (comp.ctxt,
+                                                GCC_JIT_TYPE_UNSIGNED_INT);
+  comp.bool_type = gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_BOOL);
   comp.long_type = gcc_jit_context_get_type (comp.ctxt, GCC_JIT_TYPE_LONG);
   comp.long_long_type = gcc_jit_context_get_type (comp.ctxt,
                                                  GCC_JIT_TYPE_LONG_LONG);
@@ -1498,6 +1627,38 @@ init_comp (void)
                                                       "LispObj",
                                                       2,
                                                       lisp_obj_fields);
+
+  comp.cast_union_as_ll =
+    gcc_jit_context_new_field (comp.ctxt,
+                              NULL,
+                              comp.long_long_type,  /* FIXME? */
+                              "ll");
+  comp.cast_union_as_u =
+    gcc_jit_context_new_field (comp.ctxt,
+                              NULL,
+                              comp.unsigned_type,
+                              "u");
+  comp.cast_union_as_i =
+    gcc_jit_context_new_field (comp.ctxt,
+                              NULL,
+                              comp.int_type,
+                              "i");
+  comp.cast_union_as_b =
+    gcc_jit_context_new_field (comp.ctxt,
+                              NULL,
+                              comp.bool_type,
+                              "b");
+
+  gcc_jit_field *cast_union_fields[4] =
+    { comp.cast_union_as_ll,
+      comp.cast_union_as_u,
+      comp.cast_union_as_i,
+      comp.cast_union_as_b,};
+  comp.cast_union_type = gcc_jit_context_new_union_type (comp.ctxt,
+                                                        NULL,
+                                                        "cast_union",
+                                                        4,
+                                                        cast_union_fields);
   comp.most_positive_fixnum =
     gcc_jit_context_new_rvalue_from_long (comp.ctxt,
                                          comp.long_long_type, /* FIXME? */

diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index e1d6f313fd78b583d867085d38b937f5331293ed..e13db89ddc63073ef9f07a3a3b76b8e15ca9f945 100644 (file)
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -146,6 +146,22 @@
   (should (= (comp-tests-conditionals-2-f t) 1340))
   (should (eq (comp-tests-conditionals-2-f nil) nil)))
 
+(ert-deftest  comp-tests-fixnum ()
+  "Testing some fixnum inline operation."
+  (defun comp-tests-fixnum-1-f (x)
+    (1- x))
+
+  (byte-compile #'comp-tests-fixnum-1-f)
+  (native-compile #'comp-tests-fixnum-1-f)
+
+  (should (= (comp-tests-fixnum-1-f 10) 9))
+  (should (= (comp-tests-fixnum-1-f most-negative-fixnum)
+             (1- most-negative-fixnum)))
+  (should (equal (condition-case err
+                     (comp-tests-fixnum-1-f 'a)
+                   (error (print err)))
+                 '(wrong-type-argument number-or-marker-p a))))
+
 (ert-deftest comp-tests-gc ()
   "Try to do some longer computation to let the gc kick in."
   (dotimes (_ 100000)