From: Andrea Corallo <akrl@sdf.org>
Date: Sun, 22 Sep 2019 18:58:26 +0000 (+0200)
Subject: fix push handler propagation
X-Git-Tag: emacs-28.0.90~2727^2~1119
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=59d53e1fde516b911c29cedf338779df29f59dff;p=emacs.git

fix push handler propagation
---

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 24548242c37..34aafe401d4 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -644,7 +644,9 @@ If NEGATED non nil negate the tested condition."
   (let ((guarded-bb (comp-new-block-sym)))
     (comp-block-maybe-add :name guarded-bb :sp (comp-sp))
     (let ((handler-bb (comp-lap-to-limple-bb guarded-label)))
-      (comp-emit (list 'push-handler (comp-slot+1)
+      (comp-emit (list 'push-handler
+                       (comp-slot+1)
+                       (comp-slot+1)
                        handler-type
                        handler-bb
                        guarded-bb))
@@ -1022,7 +1024,7 @@ Top level forms for the current context are rendered too."
     (cl-loop with blocks = (comp-func-blocks comp-func)
              for bb being each hash-value of blocks
              for last-insn = (car (last (comp-block-insns bb)))
-             for (op first second third forth) = last-insn
+             for (op first second third forth fifth) = last-insn
              do (cl-case op
                   (jump
                    (edge-add :src bb :dst (gethash first blocks)))
@@ -1033,8 +1035,8 @@ Top level forms for the current context are rendered too."
                    (edge-add :src bb :dst (gethash second blocks))
                    (edge-add :src bb :dst (gethash third blocks)))
                   (push-handler
-                   (edge-add :src bb :dst (gethash third blocks))
-                   (edge-add :src bb :dst (gethash forth blocks)))
+                   (edge-add :src bb :dst (gethash forth blocks))
+                   (edge-add :src bb :dst (gethash fifth blocks)))
                   (return)
                   (otherwise
                    (error "Block %s does not end with a branch in func %s"
diff --git a/src/comp.c b/src/comp.c
index afc7a3b1873..4905dbfdcaf 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -62,6 +62,8 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
   XCAR (XCDR (XCDR (x)))
 #define FORTH(x)				\
   XCAR (XCDR (XCDR (XCDR (x))))
+#define FIFTH(x)				\
+  XCAR (XCDR (XCDR (XCDR (XCDR (x)))))
 
 #define FUNCALL1(fun, arg)			\
   CALLN (Ffuncall, intern_c_string (STR(fun)), arg)
@@ -1149,7 +1151,11 @@ emit_limple_push_handler (gcc_jit_rvalue *handler, gcc_jit_rvalue *handler_type,
 			  gcc_jit_block *handler_bb, gcc_jit_block *guarded_bb,
 			  Lisp_Object clobbered_mvar)
 {
-  /* Ex: (push-handler #s(comp-mvar 6 0 t (arith-error) nil) 1 bb_3 bb_2).  */
+  /*
+     Ex: (push-handler #s(comp-mvar 1 8 nil nil nil nil)
+                       #s(comp-mvar 1 7 t done symbol nil)
+		       catcher bb_2 bb_1).
+  */
 
   static unsigned pushhandler_n; /* FIXME move at ctxt or func level.  */
 
@@ -1158,8 +1164,7 @@ emit_limple_push_handler (gcc_jit_rvalue *handler, gcc_jit_rvalue *handler_type,
     gcc_jit_function_new_local (comp.func,
 				NULL,
 				comp.handler_ptr_type,
-				format_string ("c_%u",
-					       pushhandler_n));
+				format_string ("c_%u", pushhandler_n));
 
   gcc_jit_rvalue *args[] = { handler, handler_type };
   gcc_jit_block_add_assignment (
@@ -1263,9 +1268,10 @@ emit_limple_insn (Lisp_Object insn)
     {
       gcc_jit_rvalue *handler = emit_mvar_val (arg0);
       int h_num UNINIT;
-      if (EQ (SECOND (args), Qcatcher))
+      Lisp_Object handler_spec = THIRD (args);
+      if (EQ (handler_spec, Qcatcher))
 	h_num = CATCHER;
-      else if (EQ (SECOND (args), Qcondition_case))
+      else if (EQ (handler_spec, Qcondition_case))
 	h_num = CONDITION_CASE;
       else
 	ice ("incoherent insn");
@@ -1273,8 +1279,8 @@ emit_limple_insn (Lisp_Object insn)
 	gcc_jit_context_new_rvalue_from_int (comp.ctxt,
 					     comp.int_type,
 					     h_num);
-      gcc_jit_block *handler_bb = retrive_block (THIRD (args));
-      gcc_jit_block *guarded_bb = retrive_block (FORTH (args));
+      gcc_jit_block *handler_bb = retrive_block (FORTH (args));
+      gcc_jit_block *guarded_bb = retrive_block (FIFTH (args));
       emit_limple_push_handler (handler, handler_type, handler_bb, guarded_bb,
 				arg0);
     }