;;; -*- Mode:Common-Lisp; Package:L; Base:10 -*-
;;;
;;; live-variable-analysis
;;;
;;; Lisp code to perform live variable analysis and reigster allocation for the new L assembler.
;;;
;;; jsp 28-January-87


;;; Contents:
;;;
;;;  In this file we find defintions for the following:
;;;
;;;    build-control-flow-graph
;;;    build-need-tree
;;;    build-have-tree



;;; pre-optimize
;;;
;;; This performs a straight-forward optimization of coalescing labels that appear in clusters.  This should be run
;;; after the control-flow-graph has been created, and will update it appropriately.  The modified il-code is returned.

(defun pre-optimize (il-code)
  (mapl #'(lisp:lambda (sub-code)
	    (let* ((il-node (first sub-code))
		   (next-il-node (second sub-code))
		   (inst (il-node-op il-node)))
	      (cond
		;; Look for multiple label instructions.  Coalese the labels by replacing the current label by 
		;; the following label in all of the current label's parents.
		((and (eq *il-label-instruction* inst)
		      (eq *il-label-instruction* (il-node-op next-il-node)))
		 (let ((old (first (il-node-defined il-node)))
		       (new (first (il-node-defined next-il-node))))
		   (dolist (parent (il-node-ancestors il-node))
		     (zip-replace new old (il-node-targets parent))))
		 (setq il-code (remove-il-node il-node il-code)))

		;; Look for comment instructions.  Remove them.
		((eq *il-comment-instruction* inst)
		 (values t (remove-il-node il-node il-code) "remove comment"))
		)))
	il-code)
  il-code)



;;; build-control-flow-graph
;;;
;;; This performs the task of building the control-flow graph within the list of i-nodes by assigning values to
;;; the offspring and ancestor lists for each i-node.  It then checks to insure that all statements are reachable.

(defun build-control-flow-graph (il-code env)
  "Builds the control-flow graph for a list of il-nodes.  Returns nil."
  (ignore env)

  ;; Builds the links between explicit jumps.
  (mapc #'(lisp:lambda (this)
	    (let ((labels (il-node-targets this)))
	      (mapc #'(lisp:lambda (lab)
			(let ((target (label-il-node (declaration-value lab))))
			  (if (null target)
			      (error-message 2 "Undefined target ~a in ~a" lab this)
			      (progn
				(add-offspring this   target)
				(add-ancestor  target this)))))
		    labels)))
	il-code)

  ;; Builds the links between implicit jumps.
  (let ((prev '()))
    (dolist (this il-code)
      (when (or (and prev
		     (eq *il-if-instruction* (il-node-op prev))		; IF with one target has an implicit target
		     (= 1 (list-length (il-node-offspring prev))))	; of the next instruction.
		(and prev
		     (eq *il-label-instruction* (il-node-op this))	; If there are labels, and there isn't
		     (null (il-node-offspring prev))))			; explicit control-flow, then add it.
	(add-ancestor  this prev)
	(add-offspring prev this))      
      (setq prev this)
      ))

  '()
  )


;(defun build-control-flow-graph (il-code env)
;  "Builds the control-flow graph for a list of il-nodes.  Returns nil."
;  (ignore env)
;  (let ((prev '()))

;    (dolist (this il-code)
;      (when prev
;	(add-ancestor  this prev)				; fixes back pointer
;	(add-offspring prev this))				; sets previous forward pointer
;      (setq prev this)						; set prev for next time around
      
;      (let ((inst (il-node-op this))
;	    (labels (il-node-targets this)))

;	(when labels
;	  (mapcar #'(lisp:lambda (lab)
;		      (let ((target (label-loc (declaration-value lab))))
;			(if (null target)
;			    (error-message 2 "Undefined target ~a in ~a" lab this)
;			    (progn
;			      (add-offspring this target)
;			      (add-ancestor  target this)))))
;		  labels)

;	  ;; hack for if[-then-else] statement
;	  (if (= 2 (length labels)) (setq prev '()))
;	  )

;	;; if instruction does not normally flow to next instruction, then remove prev.
;	(if (il-instruction-noflo? inst) (setq prev '()))
	
;	))

;    '())
;  )




;;; build-need-tree
;;;
;;; This does the grunt work of building the need tree for a list of code.  It presumes that the control-flow
;;; tree has already been generated (by a call to process-function-def5).  Since it works in the ancestral
;;; direction, it needs to be given a terminal i-node (one with no offspring), with which it will appropriately
;;; create the need lists for each of the i-node's ancestors.  The algorithm used is akin to graph coloring:
;;; at each i-node, it checks each ancestor for already having been colored by each of the current i-node's
;;; needed variables.  If an ancestor has already been colored, then there is no need to pursuse that path for
;;; that particular variable, and nothing is done.  If an ancesstor is uncolored, then the variable is added to
;;; its need list, and build-need-tree is called recursivly for the ancestor (to potentially further propagate
;;; the variable).  A new modification of this algorithm is to check at each i-node if the variable in question
;;; is written;  if so, then no further propagation is needed, unless the parent has not been visited, in which
;;; case, the recursion is continued (but the variable's propagation is not).


(defun build-need-tree (start)
  "Given a terminal il-node, this builds the need tree for all ancestors of the il-node.  Returns t."

  (when (null (il-node-visited start))
    (let ((reads (il-node-read start)))
      (if (null reads)						; special pathalogical case which ruins things.
	  (add-need start nil)
	  (dolist (need reads)					; add the autologous needs
	    (add-need start need))))
    (setf (il-node-visited start) 't))

  (let* ((reads (il-node-read start))
	 (writes (il-node-written start))
	 (needs (remove-if-not #'(lisp:lambda (need)
				   (or (member need reads)
				       (not (member need writes))))
			       (il-node-need start))))
    (dolist (parent (il-node-ancestors start))
      (let ((propagate-flag nil))				; non-nil iff propagation should be made
	(dolist (need needs)					; propagate the needs
	  (if (add-need parent need)				; is parent not colored?
	      (setq propagate-flag t)))				; force propagation
	(if propagate-flag (build-need-tree parent)))
      )
    )
  t)



;;; build-have-tree
;;;
;;; This does the grunt work of building the have tree for a list of code.  It also presumes that the control-flow
;;; tree has already been generated (by a call to process-function-def5).  Since it works in the offspring's
;;; direction, it needs to be given the initial (entry-point) i-node, which which it will appropriately create
;;; the have lists for each of the i-node's offspring.  The algorithm used is similar to the one used in
;;; build-need-tree.

(defun build-have-tree (start)
  "Given a starting il-node, this builds the have tree for all offspring of the il-node.  Returns t."
  
  (when (null (il-node-visited start))
    (let ((writes (il-node-written start)))
      (if (null writes)						; special pathalogical case which ruins things.
	  (add-have start nil)
	  (dolist (have writes)					; add the autologous haves
	    (add-have start have))))
    (setf (il-node-visited start) 't))
  
  (let ((haves (il-node-have start)))
    (dolist (child (il-node-offspring start))
      (let ((propagate-flag nil))
	(dolist (have haves)					; propagate all of the haves
	  (if (add-have child have)
	      (setq propagate-flag t)))
	(if propagate-flag (build-have-tree child)))
      
      ))
  t)