From: Andrea Corallo <andrea_corallo@yahoo.it>
Date: Tue, 11 Jun 2019 21:40:29 +0000 (+0200)
Subject: add arithmetic comparisons
X-Git-Tag: emacs-28.0.90~2727^2~1496
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5c406adac75e1b007545991fb7f20068bcaa5b22;p=emacs.git

add arithmetic comparisons
---

diff --git a/src/comp.c b/src/comp.c
index 712fd01af07..1c2a5818be0 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -141,6 +141,17 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
     PUSH_LVAL (res);				\
   } while (0)
 
+#define EMIT_ARITHCOMPARE(comparison)					\
+  do {									\
+    POP2;								\
+    args[2] = gcc_jit_context_new_rvalue_from_int (comp.ctxt,		\
+						   comp.int_type,	\
+						   comparison);		\
+    res = comp_emit_call ("arithcompare", comp.lisp_obj_type, 3, args);	\
+    PUSH_LVAL (res);							\
+  } while (0)
+
+
 typedef struct {
   gcc_jit_block *gcc_bb;
   bool terminated;
@@ -192,9 +203,6 @@ typedef struct {
   short min_args, max_args;
 } comp_f_res_t;
 
-INLINE static void pop (unsigned n, gcc_jit_lvalue ***stack_ref,
-			gcc_jit_rvalue *args[]);
-
 void emacs_native_compile (const char *lisp_f_name, const char *c_f_name,
 			   Lisp_Object func, int opt_level, bool dump_asm);
 
@@ -1113,24 +1121,31 @@ compile_f (const char *f_name, ptrdiff_t bytestr_length,
 					 bb_map[pc].gcc_bb);
 	  }
 	  break;
+
 	case Beqlsign:
-	  error ("Beqlsign unsupported bytecode\n");
+	  EMIT_ARITHCOMPARE (ARITH_EQUAL);
 	  break;
+
 	case Bgtr:
-	  error ("Bgtr unsupported bytecode\n");
+	  EMIT_ARITHCOMPARE (ARITH_GRTR);
 	  break;
+
 	case Blss:
-	  error ("Blss unsupported bytecode\n");
+	  EMIT_ARITHCOMPARE (ARITH_LESS);
 	  break;
+
 	case Bleq:
-	  error ("Bleq unsupported bytecode\n");
+	  EMIT_ARITHCOMPARE (ARITH_LESS_OR_EQUAL);
 	  break;
+
 	case Bgeq:
-	  error ("Bgeq unsupported bytecode\n");
+	  EMIT_ARITHCOMPARE (ARITH_GRTR_OR_EQUAL);
 	  break;
+
 	case Bdiff:
 	  EMIT_SCRATCH_CALL_N ("Fminus", 2);
 	  break;
+
 	case Bnegate:
 	  {
 
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index dc2c396392b..f83fa8c8be9 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -187,6 +187,52 @@
                    (error err))
                  '(wrong-type-argument number-or-marker-p a))))
 
+(ert-deftest  comp-tests-arith-comp ()
+  "Testing arithmetic comparisons."
+  (defun comp-tests-eqlsign-f (x y)
+    ;; Beqlsign
+    (= x y))
+  (defun comp-tests-gtr-f (x y)
+    ;; Bgtr
+    (> x y))
+  (defun comp-tests-lss-f (x y)
+    ;; Blss
+    (< x y))
+  (defun comp-tests-les-f (x y)
+    ;; Bleq
+    (<= x y))
+  (defun comp-tests-geq-f (x y)
+    ;; Bgeq
+    (>= x y))
+
+  (byte-compile #'comp-tests-eqlsign-f)
+  (byte-compile #'comp-tests-gtr-f)
+  (byte-compile #'comp-tests-lss-f)
+  (byte-compile #'comp-tests-les-f)
+  (byte-compile #'comp-tests-geq-f)
+
+  (native-compile #'comp-tests-eqlsign-f)
+  (native-compile #'comp-tests-gtr-f)
+  (native-compile #'comp-tests-lss-f)
+  (native-compile #'comp-tests-les-f)
+  (native-compile #'comp-tests-geq-f)
+
+  (should (eq (comp-tests-eqlsign-f 4 3) nil))
+  (should (eq (comp-tests-eqlsign-f 3 3) t))
+  (should (eq (comp-tests-eqlsign-f 2 3) nil))
+  (should (eq (comp-tests-gtr-f 4 3) t))
+  (should (eq (comp-tests-gtr-f 3 3) nil))
+  (should (eq (comp-tests-gtr-f 2 3) nil))
+  (should (eq (comp-tests-lss-f 4 3) nil))
+  (should (eq (comp-tests-lss-f 3 3) nil))
+  (should (eq (comp-tests-lss-f 2 3) t))
+  (should (eq (comp-tests-les-f 4 3) nil))
+  (should (eq (comp-tests-les-f 3 3) t))
+  (should (eq (comp-tests-les-f 2 3) t))
+  (should (eq (comp-tests-geq-f 4 3) t))
+  (should (eq (comp-tests-geq-f 3 3) t))
+  (should (eq (comp-tests-geq-f 2 3) nil)))
+
 (ert-deftest comp-tests-gc ()
   "Try to do some longer computation to let the gc kick in."
   (dotimes (_ 100000)