procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fix non local propagation handling

Browse source
This commit is contained in:
Andrea Corallo 2019-12-28 11:39:29 +01:00
parent 0bb5a47402
commit 00f7fd7d42
2 changed files with 21 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

14
lisp/emacs-lisp/comp.el
View file

@ -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))
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)))

9
src/comp.c
View file

@ -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,