From: Andrea Corallo <andrea_corallo@yahoo.it>
Date: Mon, 10 Jun 2019 08:34:04 +0000 (+0200)
Subject: add Badd1 support
X-Git-Tag: emacs-28.0.90~2727^2~1499
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=097f36bc75a6570e64f80451ae4bbe2172d610e0;p=emacs.git

add Badd1 support
---

diff --git a/src/comp.c b/src/comp.c
index ede417c794f..3cb51892959 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -633,6 +633,7 @@ compute_bblocks (ptrdiff_t bytestr_length, unsigned char *bytestr_data)
 	  new_bb = true;
 	  break;
 	case Bsub1:
+	case Badd1:
 	case Breturn:
 	  new_bb = true;
 	  break;
@@ -1004,9 +1005,9 @@ compile_f (const char *f_name, ptrdiff_t bytestr_length,
 	       : Fsub1 (TOP)) */
 
 	    gcc_jit_block *sub1_inline_block =
-		 gcc_jit_function_new_block (comp.func, "inline-1");
+		 gcc_jit_function_new_block (comp.func, "inline_sub1");
 	    gcc_jit_block *sub1_fcall_block =
-		 gcc_jit_function_new_block (comp.func, "fcall-1");
+		 gcc_jit_function_new_block (comp.func, "fcall_sub1");
 
 	    gcc_jit_rvalue *tos_as_num =
 	      comp_XFIXNUM (gcc_jit_lvalue_as_rvalue (TOS));
@@ -1057,7 +1058,63 @@ compile_f (const char *f_name, ptrdiff_t bytestr_length,
 
 	  break;
 	case Badd1:
-	  error ("Badd1 unsupported bytecode\n");
+	  {
+
+	    /* (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_POSITIVE_FIXNUM
+	       ? make_fixnum (XFIXNUM (TOP) + 1)
+	       : Fadd (TOP)) */
+
+	    gcc_jit_block *add1_inline_block =
+		 gcc_jit_function_new_block (comp.func, "inline_add1");
+	    gcc_jit_block *add1_fcall_block =
+		 gcc_jit_function_new_block (comp.func, "fcall_add1");
+
+	    gcc_jit_rvalue *tos_as_num =
+	      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_positive_fixnum)),
+	      add1_inline_block,
+	      add1_fcall_block);
+
+	    gcc_jit_rvalue *add1_inline_res =
+	      gcc_jit_context_new_binary_op (comp.ctxt,
+					     NULL,
+					     GCC_JIT_BINARY_OP_PLUS,
+					     comp.long_long_type,
+					     tos_as_num,
+					     comp.one);
+
+	    gcc_jit_block_add_assignment (add1_inline_block,
+					  NULL,
+					  TOS,
+					  comp_make_fixnum (add1_inline_block,
+							    add1_inline_res));
+	    basic_block_t bb_orig = *comp.bblock;
+
+	    comp.bblock->gcc_bb = add1_fcall_block;
+	    POP1;
+	    res = comp_emit_call ("Fadd1", comp.lisp_obj_type, 1, args);
+	    PUSH_LVAL (res);
+
+	    *comp.bblock = bb_orig;
+
+	    gcc_jit_block_end_with_jump (add1_inline_block, NULL,
+					 bb_map[pc].gcc_bb);
+	    gcc_jit_block_end_with_jump (add1_fcall_block, NULL,
+					 bb_map[pc].gcc_bb);
+	  }
 	  break;
 	case Beqlsign:
 	  error ("Beqlsign unsupported bytecode\n");
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index e13db89ddc6..06c7697be74 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -148,18 +148,29 @@
 
 (ert-deftest  comp-tests-fixnum ()
   "Testing some fixnum inline operation."
-  (defun comp-tests-fixnum-1-f (x)
+  (defun comp-tests-fixnum-1--f (x)
     (1- x))
+  (defun comp-tests-fixnum-1+-f (x)
+    (1+ x))
 
-  (byte-compile #'comp-tests-fixnum-1-f)
-  (native-compile #'comp-tests-fixnum-1-f)
+  (byte-compile #'comp-tests-fixnum-1--f)
+  (byte-compile #'comp-tests-fixnum-1+-f)
+  ;; (native-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)
+  (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)))
+                     (comp-tests-fixnum-1--f 'a)
+                   (error err))
+                 '(wrong-type-argument number-or-marker-p a)))
+  (should (= (comp-tests-fixnum-1+-f 10) 11))
+  (should (= (comp-tests-fixnum-1+-f most-positive-fixnum)
+             (1+ most-positive-fixnum)))
+  (should (equal (condition-case err
+                     (comp-tests-fixnum-1+-f 'a)
+                   (error err))
                  '(wrong-type-argument number-or-marker-p a))))
 
 (ert-deftest comp-tests-gc ()