fix push handler propagation

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 24548242c376f79016e7a87f533e900fe6e7a6be..34aafe401d4e6e0f97e2299b412ceb0b7e6f7701 100644 (file)
--- 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 afc7a3b18736c936b0994cedde985ce5b0e4a8ac..4905dbfdcaf1aabf8cdfd381c7f6b256aefc5c29 100644 (file)
--- 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);
     }