mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

* Improve comp-fwprop pass

Browse source 
Wire-up comp-cstr.el routines in fwprop and constraint mvars also on
the else side of branches.

	* lisp/emacs-lisp/comp.el (comp-emit-assume)
	(comp-cond-cstr-target-mvar, comp-cond-cstr-func)
	(comp-fwprop-insn): Logic update.
	(comp-mvar-value-vld-p, comp-mvar-propagate, comp-fwprop-call):
	Handle neg slot.
This commit is contained in:
Andrea Corallo 2020-12-13 12:19:30 +01:00
parent 2a117ad3d7
commit bad18f509d
1 changed files with 44 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -520,7 +520,8 @@ CFG is mutated by a pass.")
(defun comp-mvar-value-vld-p (mvar) (defun comp-mvar-value-vld-p (mvar)
"Return t if one single value can be extracted by the MVAR constrains." "Return t if one single value can be extracted by the MVAR constrains."
(when (null (comp-mvar-typeset mvar)) (when (and (null (comp-mvar-typeset mvar))
(null (comp-mvar-neg mvar)))
(let* ((v (comp-mvar-valset mvar)) (let* ((v (comp-mvar-valset mvar))
(r (comp-mvar-range mvar)) (r (comp-mvar-range mvar))
(valset-len (length v)) (valset-len (length v))
@ -1868,26 +1869,34 @@ into the C code forwarding the compilation unit."
;;; conditional branches rewrite pass specific code. ;;; conditional branches rewrite pass specific code.
(defun comp-emit-assume (target-slot rhs bb kind) (defun comp-emit-assume (target rhs bb negated)
"Emit an assume of kind KIND for TARGET-SLOT being RHS. "Emit an assume for mvar TARGET being RHS.
When NEGATED is non-nil the assumption is negated.
The assume is emitted at the beginning of the block BB." The assume is emitted at the beginning of the block BB."
(push `(assume ,(make-comp-mvar :slot target-slot) ,rhs ,kind) (let ((target-slot (comp-mvar-slot target))
(comp-block-insns bb)) (tmp-mvar (if negated
(setf (comp-func-ssa-status comp-func) 'dirty)) (make-comp-mvar :slot (comp-mvar-slot rhs))
rhs)))
(push `(assume ,(make-comp-mvar :slot target-slot) (and ,target ,tmp-mvar))
(comp-block-insns bb))
(if negated
(push `(assume ,tmp-mvar (not ,rhs))
(comp-block-insns bb)))
(setf (comp-func-ssa-status comp-func) 'dirty)))
(defun comp-cond-cstr-target-slot (slot-num exit-insn bb) (defun comp-cond-cstr-target-mvar (mvar exit-insn bb)
"Search for the last assignment of SLOT-NUM in BB. "Given MVAR search in BB what we'll use as assume target.
Keep on searching till EXIT-INSN is encountered. Keep on searching till EXIT-INSN is encountered.
Return the corresponding rhs slot number." Return the corresponding rhs mvar."
(cl-flet ((targetp (x) (cl-flet ((targetp (x)
;; Ret t if x is an mvar and target the correct slot number. ;; Ret t if x is an mvar and target the correct slot number.
(and (comp-mvar-p x) (and (comp-mvar-p x)
(eql slot-num (comp-mvar-slot x))))) (eql (comp-mvar-slot mvar) (comp-mvar-slot x)))))
(cl-loop (cl-loop
with res = nil with res = nil
for insn in (comp-block-insns bb) for insn in (comp-block-insns bb)
when (eq insn exit-insn) when (eq insn exit-insn)
do (cl-return (and (comp-mvar-p res) (comp-mvar-slot res))) do (cl-return (and (comp-mvar-p res) res))
do (pcase insn do (pcase insn
(`(,(pred comp-assign-op-p) ,(pred targetp) ,rhs) (`(,(pred comp-assign-op-p) ,(pred targetp) ,rhs)
(setf res rhs))) (setf res rhs)))
@ -1941,19 +1950,22 @@ TARGET-BB-SYM is the symbol name of the target block."
(pcase insns-seq (pcase insns-seq
(`((set ,(and (pred comp-mvar-p) cond) (`((set ,(and (pred comp-mvar-p) cond)
(,(pred comp-call-op-p) (,(pred comp-call-op-p)
,(and (or 'eq 'eql '= 'equal) test-fn) ,op1 ,op2)) ,(or 'eq 'eql '= 'equal) ,op1 ,op2))
(comment ,_comment-str) (comment ,_comment-str)
(cond-jump ,cond ,(pred comp-mvar-p) . ,blocks)) (cond-jump ,cond ,(pred comp-mvar-p) . ,blocks))
(let* ((bb-1 (car blocks)) (cl-loop
(bb-target (comp-cond-cstr-target-block b bb-1))) with target-mvar1 = (comp-cond-cstr-target-mvar op1 (car insns-seq) b)
(setf (car blocks) (comp-block-name bb-target)) with target-mvar2 = (comp-cond-cstr-target-mvar op2 (car insns-seq) b)
(when-let ((target-slot1 (comp-cond-cstr-target-slot for branch-target-cell on blocks
(comp-mvar-slot op1) (car insns-seq) b))) for branch-target = (car branch-target-cell)
(comp-emit-assume target-slot1 op2 bb-target test-fn)) for assume-target = (comp-cond-cstr-target-block b branch-target)
(when-let ((target-slot2 (comp-cond-cstr-target-slot for negated in '(nil t)
(comp-mvar-slot op2) (car insns-seq) b))) do (setf (car branch-target-cell) (comp-block-name assume-target))
(comp-emit-assume target-slot2 op1 bb-target test-fn))) when target-mvar1
(cl-return-from in-the-basic-block)))))) do (comp-emit-assume target-mvar1 op2 assume-target negated)
when target-mvar2
do (comp-emit-assume target-mvar2 op1 assume-target negated)
finally (cl-return-from in-the-basic-block)))))))
(defun comp-cond-cstr (_) (defun comp-cond-cstr (_)
"Rewrite conditional branches adding appropriate 'assume' insns. "Rewrite conditional branches adding appropriate 'assume' insns.
@ -2384,7 +2396,8 @@ Forward propagate immediate involed in assignments."
"Propagate into LVAL properties of RVAL." "Propagate into LVAL properties of RVAL."
(setf (comp-mvar-typeset lval) (comp-mvar-typeset rval) (setf (comp-mvar-typeset lval) (comp-mvar-typeset rval)
(comp-mvar-valset lval) (comp-mvar-valset rval) (comp-mvar-valset lval) (comp-mvar-valset rval)
(comp-mvar-range lval) (comp-mvar-range rval))) (comp-mvar-range lval) (comp-mvar-range rval)
(comp-mvar-neg lval) (comp-mvar-neg rval)))
(defun comp-function-foldable-p (f args) (defun comp-function-foldable-p (f args)
"Given function F called with ARGS return non-nil when optimizable." "Given function F called with ARGS return non-nil when optimizable."
@ -2430,7 +2443,8 @@ Fold the call in case."
(let ((cstr (comp-cstr-f-ret cstr-f))) (let ((cstr (comp-cstr-f-ret cstr-f)))
(setf (comp-mvar-range lval) (comp-cstr-range cstr) (setf (comp-mvar-range lval) (comp-cstr-range cstr)
(comp-mvar-valset lval) (comp-cstr-valset cstr) (comp-mvar-valset lval) (comp-cstr-valset cstr)
(comp-mvar-typeset lval) (comp-cstr-typeset cstr)))))) (comp-mvar-typeset lval) (comp-cstr-typeset cstr)
(comp-mvar-neg lval) (comp-cstr-neg cstr))))))
(defun comp-fwprop-insn (insn) (defun comp-fwprop-insn (insn)
"Propagate within INSN." "Propagate within INSN."
@ -2444,21 +2458,12 @@ Fold the call in case."
(comp-fwprop-call insn lval f args))) (comp-fwprop-call insn lval f args)))
(_ (_
(comp-mvar-propagate lval rval)))) (comp-mvar-propagate lval rval))))
(`(assume ,lval ,rval ,kind) (`(assume ,lval (,kind . ,operands))
(pcase kind (cl-ecase kind
('eq (and
(comp-mvar-propagate lval rval)) (apply #'comp-cstr-intersection lval operands))
((or 'eql 'equal) (not
(if (or (comp-mvar-symbol-p rval) (comp-cstr-negation lval (car operands)))))
(comp-mvar-fixnum-p rval))
(comp-mvar-propagate lval rval)
(setf (comp-mvar-typeset lval) (comp-mvar-typeset rval))))
('=
(if (comp-mvar-fixnum-p rval)
(comp-mvar-propagate lval rval)
(setf (comp-mvar-typeset lval)
(unless (comp-mvar-range rval)
'(number)))))))
(`(setimm ,lval ,v) (`(setimm ,lval ,v)
(setf (comp-mvar-value lval) v)) (setf (comp-mvar-value lval) v))
(`(phi ,lval . ,rest) (`(phi ,lval . ,rest)