Once in SSA form this *must* be set to 'dirty' every time the topology of the
CFG is mutated by a pass.")
(frame-size nil :type integer)
+ (vframe-size 0 :type integer)
(blocks (make-hash-table :test #'eq) :type hash-table
:documentation "Basic block symbol -> basic block.")
(lap-block (make-hash-table :test #'equal) :type hash-table
(setf (comp-mvar-typeset mvar) (list type)))
mvar))
-(defun comp-new-frame (size &optional ssa)
+(defun comp-new-frame (size vsize &optional ssa)
"Return a clean frame of meta variables of size SIZE.
If SSA non-nil populate it of m-var in ssa form."
- (cl-loop with v = (make-comp-vec)
- for i below size
+ (cl-loop with v = (make-comp-vec :beg (- vsize) :end size)
+ for i from (- vsize) below size
for mvar = (if ssa
(make-comp-ssa-mvar :slot i)
(make-comp-mvar :slot i))
(comp-func func)
(comp-pass (make-comp-limplify
:curr-block (make--comp-block-lap -1 0 'top-level)
- :frame (comp-new-frame 1))))
+ :frame (comp-new-frame 1 0))))
(comp-make-curr-block 'entry (comp-sp))
(comp-emit-annotation (if for-late-load
"Late top level"
(let* ((frame-size (comp-func-frame-size func))
(comp-func func)
(comp-pass (make-comp-limplify
- :frame (comp-new-frame frame-size))))
+ :frame (comp-new-frame frame-size 0))))
(comp-fill-label-h)
;; Prologue
(comp-make-curr-block 'entry (comp-sp))
(_ (cl-assert nil)))
(setf (comp-func-ssa-status comp-func) 'dirty)))
+(defun comp-maybe-add-vmvar (op cmp-res insns-seq)
+ "If CMP-RES is clobbering OP emit a new constrained MVAR and return it.
+Return OP otherwise."
+ (if-let ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res)))
+ (new-mvar (make-comp-mvar
+ :slot
+ (- (cl-incf (comp-func-vframe-size comp-func))))))
+ (progn
+ (push `(assume ,new-mvar ,op) (cdr insns-seq))
+ new-mvar)
+ op))
+
(defun comp-add-new-block-between (bb-symbol bb-a bb-b)
"Create a new basic-block named BB-SYMBOL and add it between BB-A and BB-B."
(cl-loop
do
(cl-loop
named in-the-basic-block
+ with prev-insns-seq
for insns-seq on (comp-block-insns b)
do
(pcase insns-seq
(let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
(setf (car branch-target-cell) (comp-block-name block-target))
(when (comp-mvar-used-p target-mvar1)
- (comp-emit-assume kind target-mvar1 op2 block-target negated))
+ (comp-emit-assume kind target-mvar1
+ (comp-maybe-add-vmvar op2 cmp-res prev-insns-seq)
+ block-target negated))
(when (comp-mvar-used-p target-mvar2)
(comp-emit-assume (comp-reverse-cmp-fun kind)
- target-mvar2 op1 block-target negated)))
+ target-mvar2
+ (comp-maybe-add-vmvar op1 cmp-res prev-insns-seq)
+ block-target negated)))
finally (cl-return-from in-the-basic-block)))
(`((set ,(and (pred comp-mvar-p) cmp-res)
(,(pred comp-call-op-p)
(let ((block-target (comp-add-cond-cstrs-target-block b branch-target)))
(setf (car branch-target-cell) (comp-block-name block-target))
(comp-emit-assume 'and target-mvar cstr block-target negated))
- finally (cl-return-from in-the-basic-block)))))))
+ finally (cl-return-from in-the-basic-block))))
+ (setf prev-insns-seq insns-seq))))
(defsubst comp-insert-insn (insn insn-cell)
"Insert INSN as second insn of INSN-CELL."
(eq op 'fetch-handler))
return t)))
- (cl-loop for i from 0 below (comp-func-frame-size comp-func) ; FIXME
+ (cl-loop for i from (- (comp-func-vframe-size comp-func))
+ below (comp-func-frame-size comp-func)
;; List of blocks with a definition of mvar i
for defs-v = (cl-loop with blocks = (comp-func-blocks comp-func)
for b being each hash-value of blocks
(cl-defstruct (comp-ssa (:copier nil))
"Support structure used while SSA renaming."
- (frame (comp-new-frame (comp-func-frame-size comp-func) t) :type comp-vec
+ (frame (comp-new-frame (comp-func-frame-size comp-func)
+ (comp-func-vframe-size comp-func) t)
+ :type comp-vec
:documentation "`comp-vec' of m-vars."))
(defun comp-ssa-rename-insn (insn frame)
- (dotimes (slot-n (comp-func-frame-size comp-func))
- (cl-flet ((targetp (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 (comp-vec-aref frame slot-n) mvar
- (cadr insn) mvar))))
- (pcase insn
- (`(,(pred comp-assign-op-p) ,(pred targetp) . ,_)
- (let ((mvar (comp-vec-aref frame slot-n)))
- (setf (cddr insn) (cl-nsubst-if mvar #'targetp (cddr insn))))
- (new-lvalue))
- (`(fetch-handler . ,_)
- ;; Clobber all no matter what!
- (setf (comp-vec-aref frame slot-n) (make-comp-ssa-mvar :slot slot-n)))
- (`(phi ,n)
- (when (equal n slot-n)
- (new-lvalue)))
- (_
- (let ((mvar (comp-vec-aref frame slot-n)))
- (setcdr insn (cl-nsubst-if mvar #'targetp (cdr insn)))))))))
+ (cl-loop
+ for slot-n from (- (comp-func-vframe-size comp-func))
+ below (comp-func-frame-size comp-func)
+ do
+ (cl-flet ((targetp (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 (comp-vec-aref frame slot-n) mvar
+ (cadr insn) mvar))))
+ (pcase insn
+ (`(,(pred comp-assign-op-p) ,(pred targetp) . ,_)
+ (let ((mvar (comp-vec-aref frame slot-n)))
+ (setf (cddr insn) (cl-nsubst-if mvar #'targetp (cddr insn))))
+ (new-lvalue))
+ (`(fetch-handler . ,_)
+ ;; Clobber all no matter what!
+ (setf (comp-vec-aref frame slot-n) (make-comp-ssa-mvar :slot slot-n)))
+ (`(phi ,n)
+ (when (equal n slot-n)
+ (new-lvalue)))
+ (_
+ (let ((mvar (comp-vec-aref frame slot-n)))
+ (setcdr insn (cl-nsubst-if mvar #'targetp (cdr insn)))))))))
(defun comp-ssa-rename ()
"Entry point to rename into SSA within the current function."
(comp-log "Renaming\n" 2)
- (let ((frame-size (comp-func-frame-size comp-func))
- (visited (make-hash-table)))
+ (let ((visited (make-hash-table)))
(cl-labels ((ssa-rename-rec (bb in-frame)
(unless (gethash bb visited)
(puthash bb t visited)
do (ssa-rename-rec child (comp-vec-copy in-frame)))))))
(ssa-rename-rec (gethash 'entry (comp-func-blocks comp-func))
- (comp-new-frame frame-size t)))))
+ (comp-new-frame (comp-func-frame-size comp-func)
+ (comp-func-vframe-size comp-func)
+ t)))))
(defun comp-finalize-phis ()
"Fixup r-values into phis in all basic blocks."
(comp-fwprop-call insn lval f args)))
(_
(comp-mvar-propagate lval rval))))
+ (`(assume ,lval ,(and (pred comp-mvar-p) rval))
+ (comp-mvar-propagate lval rval))
(`(assume ,lval (,kind . ,operands))
(cl-case kind
(and
projects / emacs.git / commitdiff