mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-05 11:45:45 +00:00
Code Issues Releases Activity

rewriting ssa rename

Browse Source
This commit is contained in:
Andrea Corallo 2019-09-16 22:18:58 +02:00
parent 17ecb1c728
commit 83a146b24e
1 changed files with 47 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
lisp/emacs-lisp/comp.el
View File

@ -148,10 +148,7 @@ into it.")
(df (make-hash-table) :type hash-table
:documentation "Dominance frontier set. Block-name -> block")
(post-num nil :type number
:documentation "Post order number.")
(final-frame nil :type vector
:documentation "This is a copy of the frame when leaving the block.
Is in use to help the SSA rename pass."))
:documentation "Post order number."))
(cl-defstruct (comp-edge (:copier nil) (:constructor make--comp-edge))
"An edge connecting two basic blocks."
@ -227,12 +224,6 @@ LIMPLE basic block.")
(defsubst comp-mvar-propagate (lval rval)
"Propagate into LVAL properties of RVAL."
(setf (comp-mvar-const-vld lval) (comp-mvar-const-vld rval))
(setf (comp-mvar-constant lval) (comp-mvar-constant rval))
(setf (comp-mvar-type lval) (comp-mvar-type rval)))
(defun comp-assign-op-p (op)
"Assignment predicate for OP."
(cl-find op comp-limple-assignments))
@ -1179,38 +1170,47 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non nil."
(frame (comp-new-frame (comp-func-frame-size comp-func) t) :type vector
:documentation "Vector of mvars."))
(defun comp-ssa-rename-insn (insn slot-n)
(cl-flet ((target-p (x)
;; Ret t if x is an mvar and target the correct slot number.
(and (comp-mvar-p x)
(eql slot-n (comp-mvar-slot x))))
(new-lvalue ()
;; If is an assignment make a new mvar and put it as l-value.
(let ((mvar (make-comp-ssa-mvar :slot slot-n)))
(setf (aref (comp-ssa-frame comp-pass) slot-n) mvar)
(setf (cadr insn) mvar))))
(pcase insn
(`(,(pred comp-assign-op-p) ,(pred target-p) . ,_)
(let ((mvar (aref (comp-ssa-frame comp-pass) slot-n)))
(cl-nsubst-if mvar #'target-p (cdr insn)))
(new-lvalue))
(`(phi ,n)
(when (equal n slot-n)
(new-lvalue)))
(_
(let ((mvar (aref (comp-ssa-frame comp-pass) slot-n)))
(cl-nsubst-if mvar #'target-p (cdr insn)))))))
(defun comp-ssa-rename-insn (insn frame)
(dotimes (slot-n (comp-func-frame-size comp-func))
(cl-flet ((target-p (x)
;; Ret t if x is an mvar and target the correct slot number.
(and (comp-mvar-p x)
(eql slot-n (comp-mvar-slot x))))
(new-lvalue ()
;; If is an assignment make a new mvar and put it as l-value.
(let ((mvar (make-comp-ssa-mvar :slot slot-n)))
(setf (aref frame slot-n) mvar)
(setf (cadr insn) mvar))))
(pcase insn
(`(,(pred comp-assign-op-p) ,(pred target-p) . ,_)
(let ((mvar (aref frame slot-n)))
(setcdr insn (cl-nsubst-if mvar #'target-p (cdr insn))))
(new-lvalue))
(`(phi ,n)
(when (equal n slot-n)
(new-lvalue)))
(_
(let ((mvar (aref frame slot-n)))
(setcdr insn (cl-nsubst-if mvar #'target-p (cdr insn)))))))))
(defun comp-ssa-rename-in-blocks (n)
"Given slot number N rename in the blocks."
(comp-dom-tree-walker (gethash 'entry (comp-func-blocks comp-func))
(lambda (b)
(cl-loop for insn in (comp-block-insns b)
do (comp-ssa-rename-insn insn n))
;; Save a copy into final frame while leaving.
(setf (aref (comp-block-final-frame b) n)
(aref (comp-ssa-frame comp-pass) n)))
nil))
(defun comp-ssa-rename ()
"Entry point to rename SSA within the current function."
(comp-log "Renaming\n")
(let ((frame-size (comp-func-frame-size comp-func))
(visited (make-hash-table)))
(cl-labels ((ssa-rename-rec (bb in-frame)
(unless (gethash bb visited)
(puthash bb t visited)
(cl-loop for insn in (comp-block-insns bb)
do (comp-ssa-rename-insn insn in-frame))
(when-let ((out-edges (comp-block-out-edges bb)))
(cl-loop for ed in out-edges
for child = (comp-edge-dst ed)
;; Provide a copy of the same frame to all childs.
do (ssa-rename-rec child (copy-sequence in-frame)))))))
(ssa-rename-rec (gethash 'entry (comp-func-blocks comp-func))
(comp-new-frame frame-size t)))))
(defun comp-finalize-phis ()
"Fixup r-values into phis in all basic blocks."
@ -1228,19 +1228,6 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non nil."
when (eq op 'phi)
do (finalize-phi args b)))))
(defun comp-ssa-rename ()
"Entry point to rename SSA within the current function."
(comp-log "Renaming\n")
(let ((frame-size (comp-func-frame-size comp-func)))
;; Initialize the final frame.
(cl-loop for b being each hash-value of (comp-func-blocks comp-func)
do (setf (comp-block-final-frame b) (make-vector frame-size nil)))
;; Do the renaming for each frame slot.
(cl-loop with comp-pass = (make-comp-ssa)
for n from 0 below frame-size
;; For every slot frame rename down to the dominator tree.
do (comp-ssa-rename-in-blocks n))))
(defun comp-ssa (funcs)
"Port FUNCS into mininal SSA form."
(cl-loop for comp-func in funcs
@ -1273,6 +1260,12 @@ This can run just once."
(setf (comp-mvar-constant lval) v)
(setf (comp-mvar-type lval) (type-of v)))))))
(defsubst comp-mvar-propagate (lval rval)
"Propagate into LVAL properties of RVAL."
(setf (comp-mvar-const-vld lval) (comp-mvar-const-vld rval))
(setf (comp-mvar-constant lval) (comp-mvar-constant rval))
(setf (comp-mvar-type lval) (comp-mvar-type rval)))
(defun comp-propagate-insn (insn)
(pcase insn
(`(set ,lval ,rval)