fix non local propagation handling

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 983ba0e0ba13eb12f981f3e3ba00e29d19a65df1..b212f24bf9cc9e41625a2d78ca24f5f826914620 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -248,7 +248,9 @@ structure.")
   (edge-cnt-gen (funcall #'comp-gen-counter) :type function
                 :documentation "Generates edges numbers.")
   (ssa-cnt-gen (funcall #'comp-gen-counter) :type function
-               :documentation "Counter to create ssa limple vars."))
+               :documentation "Counter to create ssa limple vars.")
+  (has-non-local nil :type boolean
+                 :documentation "t if non local jumps are present."))
 
 (defun comp-func-reset-generators (func)
   "Reset unique id generators for FUNC."
@@ -660,6 +662,7 @@ Return value is the fall through block name."
   "Emit a non local exit handler to LAP-LABEL of type HANDLER-TYPE."
   (cl-destructuring-bind (label-num . label-sp) lap-label
     (cl-assert (= (- label-sp 2) (comp-sp)))
+    (setf (comp-func-has-non-local comp-func) t)
     (let* ((guarded-bb (comp-bb-maybe-add (1+ (comp-limplify-pc comp-pass))
                                           (comp-sp)))
            (handler-bb (comp-bb-maybe-add (comp-label-to-addr label-num)
@@ -1350,8 +1353,12 @@ Top-level forms for the current context are rendered too."
             (slot-assigned-p (slot-n bb)
              ;; Return t if a SLOT-N was assigned within BB.
              (cl-loop for insn in (comp-block-insns bb)
-                      when (and (comp-assign-op-p (car insn))
-                                (eql slot-n (comp-mvar-slot (cadr insn))))
+                      for op = (car insn)
+                      when (or (and (comp-assign-op-p op)
+                                    (eql slot-n (comp-mvar-slot (cadr insn))))
+                               ;; fetch-handler is after a non local
+                               ;; therefore clobbers all frame!!!
+                               (eq op 'fetch-handler))
                         return t)))
 
     (cl-loop for i from 0 below (comp-func-frame-size comp-func)
@@ -1411,6 +1418,9 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non nil."
          (let ((mvar (aref frame slot-n)))
            (setcdr insn (cl-nsubst-if mvar #'targetp (cdr insn))))
          (new-lvalue))
+        (`(fetch-handler . ,_)
+         ;; Clobber all no matter what!
+         (setf (aref frame slot-n) (make-comp-ssa-mvar :slot slot-n)))
         (`(phi  ,n)
          (when (equal n slot-n)
            (new-lvalue)))

diff --git a/src/comp.c b/src/comp.c
index 5ef09086407dbc64aee714175ab46365a93f0ad0..df841a66fd1bdaaa7e66693bdd7f960efba6b220 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -146,6 +146,7 @@ typedef struct {
   gcc_jit_field *cast_union_as_lisp_obj;
   gcc_jit_field *cast_union_as_lisp_obj_ptr;
   gcc_jit_function *func; /* Current function being compiled.  */
+  bool func_has_non_local; /* From comp-func has-non-local slot.  */
   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.  */
@@ -355,7 +356,11 @@ get_slot (Lisp_Object mvar)
     }
   EMACS_INT slot_n = XFIXNUM (mvar_slot);
   gcc_jit_lvalue **frame =
-    (CALL1I (comp-mvar-ref, mvar) || SPEED < 2)
+    /* Disable floating frame for functions with non local jumps.
+       This is probably overkill cause we could do it just for blocks
+       dominated by push-handler.  */
+    comp.func_has_non_local
+    || (CALL1I (comp-mvar-ref, mvar) || SPEED < 2)
     ? comp.frame : comp.f_frame;
   return frame[slot_n];
 }
@@ -2824,6 +2829,8 @@ compile_function (Lisp_Object func)
   comp.func = xmint_pointer (Fgethash (CALL1I (comp-func-name, func),
                                       comp.exported_funcs_h, Qnil));
 
+  comp.func_has_non_local = !NILP (CALL1I (comp-func-has-non-local, func));
+
   gcc_jit_lvalue *frame_array =
     gcc_jit_function_new_local (
       comp.func,