add arithmetic comparisons

diff --git a/src/comp.c b/src/comp.c
index 712fd01af070ee49abeb4d3c03698ad955ca0d05..1c2a5818be0d85885897c0c4ae14e22c74c02b1c 100644 (file)
--- 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 dc2c396392bd87b356c4d649e4a5f7df9d31b538..f83fa8c8be9ead2efc9da76f79771eecca1c9f2f 100644 (file)
--- 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)