From 00f7fd7d427b85e69a53403a1d10ac122a92a95d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sat, 28 Dec 2019 11:39:29 +0100 Subject: [PATCH] fix non local propagation handling --- lisp/emacs-lisp/comp.el | 16 +++++++++++++--- src/comp.c | 9 ++++++++- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 983ba0e0ba1..b212f24bf9c 100644 --- 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 5ef09086407..df841a66fd1 100644 --- 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, -- 2.39.5