From: Andrea Corallo Date: Tue, 27 Oct 2020 19:40:55 +0000 (+0000) Subject: Add new cond-rw pass to have forward propagation track cond branches X-Git-Tag: emacs-28.0.90~2727^2~350 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=42970cceb9b15212f1a2a28a4595efc8c960f929;p=emacs.git Add new cond-rw pass to have forward propagation track cond branches Add a new pass to rewrite conditional branches. This is introducing and placing a new LIMPLE operator 'assume' in use by fwprop to propagate conditional branch test informations on target basic blocks. * lisp/emacs-lisp/comp.el (comp-passes): Add `comp-cond-rw'. (comp-limple-assignments): Add `assume' operator. (comp-emit-assume, comp-cond-rw-target-slot, comp-cond-rw-func) (comp-cond-rw): Add new functions. (comp-fwprop-insn): Update to pattern match `assume' insns. * src/comp.c (emit_limple_insn): Add for `assume'. (syms_of_comp): Define 'Qassume' symbol. --- diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 15b8b3ab8da..9b26f6c4198 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -171,6 +171,7 @@ Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'. See `comp-ctxt'.") comp-fwprop comp-call-optim comp-ipa-pure + comp-cond-rw comp-fwprop comp-dead-code comp-tco @@ -216,7 +217,8 @@ Useful to hook into pass checkers.") set-rest-args-to-local) "Limple set operators.") -(defconst comp-limple-assignments `(fetch-handler +(defconst comp-limple-assignments `(assume + fetch-handler ,@comp-limple-sets) "Limple operators that clobbers the first m-var argument.") @@ -1676,6 +1678,73 @@ into the C code forwarding the compilation unit." (when (comp-ctxt-with-late-load comp-ctxt) (comp-add-func-to-ctxt (comp-limplify-top-level t)))) + +;;; conditional branches rewrite pass specific code. + +(defun comp-emit-assume (target-slot rhs bb-name kind) + "Emit an assume of kind KIND for TARGET-SLOT being RHS. +The assume is emitted at the beginning of the block named +BB-NAME." + (push `(assume ,(make-comp-mvar :slot target-slot) ,rhs ,kind) + (comp-block-insns (gethash bb-name (comp-func-blocks comp-func)))) + (setf (comp-func-ssa-status comp-func) 'dirty)) + +(defun comp-cond-rw-target-slot (slot-num exit-insn bb) + "Search for the last assignment of SLOT-NUM in BB. +Keep on searching till EXIT-INSN is encountered. +Return the corresponding rhs slot number." + (cl-flet ((targetp (x) + ;; Ret t if x is an mvar and target the correct slot number. + (and (comp-mvar-p x) + (eql slot-num (comp-mvar-slot x))))) + (cl-loop + with res = nil + for insn in (comp-block-insns bb) + when (eq insn exit-insn) + do (cl-return (and (comp-mvar-p res) (comp-mvar-slot res))) + do (pcase insn + (`(,(pred comp-assign-op-p) ,(pred targetp) ,rhs) + (setf res rhs))) + finally (cl-assert nil)))) + +(defun comp-cond-rw-func () + "`comp-cond-rw' worker function for each selected function." + (cl-loop + for b being each hash-value of (comp-func-blocks comp-func) + do (cl-loop + named in-the-basic-block + for insns-seq on (comp-block-insns b) + do (pcase insns-seq + (`((set ,(and (pred comp-mvar-p) cond) + (,(pred comp-call-op-p) + ,(and (or 'eq 'eql '= 'equal) test-fn) ,op1 ,op2)) + (comment ,_comment-str) + (cond-jump ,cond ,(pred comp-mvar-p) ,bb-1 ,_bb-2)) + (when-let ((target-slot1 (comp-cond-rw-target-slot + (comp-mvar-slot op1) (car insns-seq) b))) + (comp-emit-assume target-slot1 op2 bb-1 test-fn)) + (when-let ((target-slot2 (comp-cond-rw-target-slot + (comp-mvar-slot op2) (car insns-seq) b))) + (comp-emit-assume target-slot2 op1 bb-1 test-fn)) + (cl-return-from in-the-basic-block)))))) + +(defun comp-cond-rw (_) + "Rewrite conditional branches adding appropriate 'assume' insns. +This is introducing and placing 'assume' insns in use by fwprop +to propagate conditional branch test informations on target basic +blocks." + (maphash (lambda (_ f) + (when (and (>= (comp-func-speed f) 1) + ;; No point to run this on dynamic scope as + ;; this pass is effecive only on local + ;; variables. + (comp-func-l-p f) + (not (comp-func-has-non-local f))) + (let ((comp-func f)) + (comp-cond-rw-func) + (comp-log-func comp-func 3)))) + (comp-ctxt-funcs-h comp-ctxt))) + ;;; pure-func pass specific code. @@ -2158,6 +2227,18 @@ Forward propagate immediate involed in assignments." (comp-function-call-maybe-remove insn f args))) (_ (comp-mvar-propagate lval rval)))) + (`(assume ,lval ,rval ,kind) + (pcase kind + ('eq + (comp-mvar-propagate lval rval)) + ((or 'eql 'equal) + (if (memq (comp-mvar-type rval) '(symbol fixnum)) + (comp-mvar-propagate lval rval) + (setf (comp-mvar-type lval) (comp-mvar-type rval)))) + ('= + (if (eq (comp-mvar-type rval) 'fixnum) + (comp-mvar-propagate lval rval) + (setf (comp-mvar-type lval) 'number))))) (`(setimm ,lval ,v) (setf (comp-mvar-const-vld lval) t (comp-mvar-constant lval) v diff --git a/src/comp.c b/src/comp.c index 0c555578f81..48e4f1c8cde 100644 --- a/src/comp.c +++ b/src/comp.c @@ -2131,9 +2131,9 @@ emit_limple_insn (Lisp_Object insn) n); emit_cond_jump (test, target2, target1); } - else if (EQ (op, Qphi)) + else if (EQ (op, Qphi) || EQ (op, Qassume)) { - /* Nothing to do for phis into the backend. */ + /* Nothing to do for phis or assumes in the backend. */ } else if (EQ (op, Qpush_handler)) { @@ -5134,6 +5134,7 @@ native compiled one. */); DEFSYM (Qcallref, "callref"); DEFSYM (Qdirect_call, "direct-call"); DEFSYM (Qdirect_callref, "direct-callref"); + DEFSYM (Qassume, "assume"); DEFSYM (Qsetimm, "setimm"); DEFSYM (Qreturn, "return"); DEFSYM (Qcomp_mvar, "comp-mvar");