From: Andrea Corallo <akrl@sdf.org>
Date: Sun, 17 Nov 2019 23:05:55 +0000 (+0100)
Subject: fix jump table emission when test fn is not eq
X-Git-Tag: emacs-28.0.90~2727^2~973
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a99a3fbc40076aa3965feb759e816a8a25621c6a;p=emacs.git

fix jump table emission when test fn is not eq
---

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 859e0dedd9c..f805540fcd4 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -256,7 +256,8 @@ structure.")
 (cl-defstruct (comp-mvar (:constructor make--comp-mvar))
   "A meta-variable being a slot in the meta-stack."
   (slot nil :type fixnum
-        :documentation "Slot number.")
+        :documentation "Slot number.
+-1 is a special value and indicates the scratch slot.")
   (id nil :type (or null number)
      :documentation "SSA number.")
   (const-vld nil :type boolean
@@ -712,12 +713,15 @@ Return value is the fall through block name."
 
 (defun comp-emit-switch (var last-insn)
   "Emit a limple for a lap jump table given VAR and LAST-INSN."
+  ;; FIXME this not efficent for big jump tables. We should have a second
+  ;; strategy for this case.
   (pcase last-insn
-    (`(setimm ,_ ,_ ,const)
+    (`(setimm ,_ ,_ ,jmp-table)
      (cl-loop
-      for test being each hash-keys of const
+      for test being each hash-keys of jmp-table
       using (hash-value target-label)
-      with len = (hash-table-count const)
+      with len = (hash-table-count jmp-table)
+      with test-func = (hash-table-test jmp-table)
       for n from 1
       for last = (= n len)
       for m-test = (make-comp-mvar :constant test)
@@ -730,12 +734,21 @@ Return value is the fall through block name."
                                       (comp-sp)
                                       (comp-new-block-sym)))
       for ff-bb-name = (comp-block-name ff-bb)
-      do
-      (comp-emit (list 'cond-jump var m-test ff-bb-name target-name))
-      (unless last
-        ;; All fall through are artificially created here except the last one.
-        (puthash ff-bb-name ff-bb (comp-func-blocks comp-func))
-        (setf (comp-limplify-curr-block comp-pass) ff-bb))))
+      if (eq test-func 'eq)
+        do (comp-emit (list 'cond-jump var m-test ff-bb-name target-name))
+      else
+        ;; Store the result of the comparison into the scratch slot before
+        ;; emitting the conditional jump.
+        do (comp-emit (list 'set (make-comp-mvar :slot -1)
+                            (comp-call test-func var m-test)))
+           (comp-emit (list 'cond-jump
+                            (make-comp-mvar :slot -1)
+                            (make-comp-mvar :constant nil)
+                            target-name ff-bb-name))
+      do (unless last
+           ;; All fall through are artificially created here except the last one.
+           (puthash ff-bb-name ff-bb (comp-func-blocks comp-func))
+           (setf (comp-limplify-curr-block comp-pass) ff-bb))))
     (_ (error "Missing previous setimm while creating a switch"))))
 
 (defun comp-emit-set-call-subr (subr-name sp-delta)
diff --git a/src/comp.c b/src/comp.c
index 8001580eba2..3687bdb86a9 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -146,6 +146,7 @@ typedef struct {
   gcc_jit_block *block;  /* Current basic block being compiled.  */
   gcc_jit_lvalue **frame; /* Frame for the current function.  */
   gcc_jit_lvalue **f_frame; /* "Floating" frame for the current function.  */
+  gcc_jit_lvalue *scratch; /* Used as scratch slot for some code sequence (switch).  */
   gcc_jit_rvalue *most_positive_fixnum;
   gcc_jit_rvalue *most_negative_fixnum;
   gcc_jit_rvalue *one;
@@ -301,6 +302,15 @@ static gcc_jit_lvalue *
 get_slot (Lisp_Object mvar)
 {
   EMACS_INT slot_n = XFIXNUM (CALL1I (comp-mvar-slot, mvar));
+  if (slot_n == -1)
+    {
+      if (!comp.scratch)
+	comp.scratch = gcc_jit_function_new_local (comp.func,
+						   NULL,
+						   comp.lisp_obj_type,
+						   "scratch");
+      return comp.scratch;
+    }
   gcc_jit_lvalue **frame =
     (CALL1I (comp-mvar-ref, mvar) || SPEED < 2)
     ? comp.frame : comp.f_frame;
@@ -2823,6 +2833,8 @@ compile_function (Lisp_Object func)
 				      format_string ("local%u", i));
     }
 
+  comp.scratch = NULL;
+
   comp.loc_handler =  gcc_jit_function_new_local (comp.func,
 						  NULL,
 						  comp.handler_ptr_type,