;;; -*- Mode:Common-Lisp; Package:L; Base:10 -*-
;;;
;;; il-node
;;;
;;; jsp 12-April-88



;;; il-node
;;;
;;; This is the compiler-object definition for il-node, along with its printing function.

(define-co il-node print-il-node
  ())


;;; Accessors for IL-NODEs
;;;

(defaccessor il-node 'keep :op)			; operation
(defaccessor il-node 'keep :source)		; source code for statement
(defaccessor il-node 'keep :n)			; line number

(defaccessor il-node 'keep :read)		; symbol names read
(defaccessor il-node 'keep :written)		; symbol names written

(defaccessor il-node 'keep :defined)		; symbol names defined
(defaccessor il-node 'keep :type)		; type of symbols defined
(defaccessor il-node 'keep :value)		; value of some symbols defined

(defaccessor il-node 'punt :need)		; symbols need at the node
(defaccessor il-node 'punt :have)		; symbols have at the node

(defaccessor il-node 'punt :visited)		; flag used during live variable analysis

(defaccessor il-node 'keep :alive)		; symbol names alive
(defaccessor il-node 'keep :newly-live)		; symbol names to be born after statement
(defaccessor il-node 'keep :newly-dead)		; symbol names killed after statement

(defaccessor il-node 'keep :cdx)		; condition code comparaison for IF statements
(defaccessor il-node 'keep :targets)		; list of symbols referenced as labels

(defaccessor il-node 'keep :ancestors)		; pointers to all local statements that lead here
(defaccessor il-node 'keep :offspring)		; pointers to all local statements that this leads to
(defaccessor il-node 'keep :t-code)



(define-print-il-option *il-print-n*       "il-node-n" t (:boolean))
(define-print-il-option *il-print-op*      "il-node-op" '() (:boolean))
(define-print-il-option *il-print-infix*   "infix" t (:boolean))
(define-print-il-option *il-print-cdx*     "il-node-cdx" '() (:boolean))
(define-print-il-option *il-print-read*    "il-node-read" '() (:boolean))
(define-print-il-option *il-print-written* "il-node-written" '() (:boolean))
(define-print-il-option *il-print-targets* "il-node-targets" '() (:boolean))
(define-print-il-option *il-print-source*  "il-node-source" '() (:boolean))
(define-print-il-option *il-print-defined* "il-node-defined" '() (:boolean))
(define-print-il-option *il-print-alive*   "il-node-alive" '() (:boolean))
(define-print-il-option *il-print-need*    "il-node-need" '() (:boolean))
(define-print-il-option *il-print-have*    "il-node-have" '() (:boolean))
(define-print-il-option *il-print-newly-live* "il-node-newly-live" '() (:boolean))
(define-print-il-option *il-print-newly-dead* "il-node-newly-dead" '() (:boolean))
(define-print-il-option *il-print-ancestors*  "il-node-ancestors" '() (:boolean))
(define-print-il-option *il-print-offspring*  "il-node-offspring" '() (:boolean))



;;; print-il-node
;;;
;;; This prints out a human-readable version of an il-node.  This is NOT the function used to create a machine-parsable
;;; version.  For that functionality, please see dump-il-node.

(defun print-il-node (node stream depth)
  (ignore depth)
  (format stream "<il")
  (if (and *il-print-infix* (il-instruction? (il-node-op node)))
      (progn
	(format stream "~@[ ~2a ~]" (il-node-n node))
	(case (il-instruction-name (il-node-op node))
	  (if    (format stream " (if ~(~a~{ ~a~}~{ ~a~}~)" (il-node-cdx node) (il-node-read node) (il-node-targets node)))
	  (goto  (format stream " (goto~(~{ ~a~}~)" (il-node-targets node)))
	  (label (format stream "(label~(~{ ~a~}~)" (il-node-defined node)))
	  (otherwise
	   (format t " (")
	   (format stream "~@[~(~{~a ~}~)~]" (il-node-written node))
	   (format stream "~@[~(~a~)~]"      (il-instruction-name (il-node-op node)))
	   (format stream "~@[~(~{ ~a~}~)~]" (il-node-read node))
	   (format stream "~@[ (~a~(~{ ~a~}~))~]" (car (il-node-defined node)) (cdr (il-node-defined node)))
	   (format stream "~@[ (~a~(~{ ~a~}~))~]" (car (il-node-type node)) (cdr (il-node-type node)))
	   (format stream "~@[ (~a~(~{ ~a~}~))~]" (car (il-node-value node)) (cdr (il-node-value node)))
	   )
	  )
	(format t ")"))
      (progn
	(if *il-print-n*       (format stream "~@[ ~2a~]" (il-node-n node)))
	(if *il-print-op*      (format stream "~@[ ~7a~]" (il-instruction-name (il-node-op node))))
	(if *il-print-cdx*     (format stream "~@[ ~a~]" (il-node-cdx node)))
	(if *il-print-read*    (format stream "~@[ :r ~a~]" (il-node-read node)))
	(if *il-print-written* (format stream "~@[ ~35T:w ~a~]" (il-node-written node)))
	(if *il-print-targets* (format stream "~@[ :t ~a~]" (il-node-targets node)))
	(if *il-print-source*  (format stream "~@[ :source ~a~]" (il-node-source node)))
	(if *il-print-defined* (format stream "~@[ :d ~a~]" (il-node-defined node)))
	))
  (if *il-print-alive*        (format stream "~@[ ~40T:alive ~a~]" (il-node-alive node)))
  (if *il-print-need*         (format stream "~@[ ~40T:need ~a~]" (il-node-need node)))
  (if *il-print-have*         (format stream "~@[ ~40T:have ~a~]" (il-node-have node)))
  (if *il-print-newly-live*   (format stream "~@[ ~40T:newly-live ~a~]" (il-node-newly-live node)))
  (if *il-print-newly-dead*   (format stream "~@[ ~40T:newly-dead ~a~]" (il-node-newly-dead node)))
  (if (and *il-print-ancestors* (il-node-ancestors node))
      (progn
	(format stream " ~40T:anc")
	(dolist (parent (il-node-ancestors node))
	  (format stream " ~a" (il-node-n parent)))))
  (if (and *il-print-offspring* (il-node-offspring node))
      (progn
	(format stream " ~40T:off")
	(dolist (child (il-node-offspring node))
	  (format stream " ~a" (il-node-n child)))))
  (format stream "~35T>")
  )


;;; dump-decl-list
;;;
;;; This prepares a list of declarations for dumping.

(defun dump-decl-list (decl-list)
  (mapcar #'declaration-symbol decl-list))


;;; dump-node-list
;;;
;;; This prepares a list of node references for dumping.

(defun dump-node-list (node-list)
  (mapcar #'il-node-n node-list))


;;; dump-il-node
;;;
;;; This prints out a complete version of an il-node, including exactly that information necessary to transport a
;;; list of code from one machine to another.

(defun dump-il-node (node stream depth)
  (ignore depth)
  (format stream "(~a~@[ :n ~a~]~@[ :cdx ~a~]~@[ :r ~a~]~@[ :w ~a~]~@[ :d ~a~]~@[ :t ~a~]~
                     ~@[ :live ~a~]~@[ :nlive ~a~]~@[ :ndead ~a~]~@[ :anc ~a~]~@[ :off ~a~])"
	  (il-instruction-name (il-node-op node))
	  (il-node-n node)
	  (il-node-cdx node)
	  (dump-decl-list (il-node-read node))
	  (dump-decl-list (il-node-written node))
	  (dump-decl-list (il-node-defined node))
	  (dump-decl-list (il-node-targets node))
	  (dump-decl-list (il-node-alive node))
	  (dump-decl-list (il-node-newly-live node))
	  (dump-decl-list (il-node-newly-dead node))
	  (dump-node-list (il-node-ancestors node))
	  (dump-node-list (il-node-offspring node))
	  )
  )


;;; short-dump-il-node
;;;
;;; This prints out a short version of an il-node, including only the minimum information necessary to transport a
;;; list of code from one machine to another.

(defun short-dump-il-node (node stream depth)
  (ignore depth)
  (format stream "(~a~@[ :cdx ~a~]~@[ :r ~a~]~@[ :w ~a~]~@[ :d ~a~]~@[ :t ~a~])"
	  (il-instruction-name (il-node-op node))
	  (il-node-cdx node)
	  (dump-decl-list (il-node-read node))
	  (dump-decl-list (il-node-written node))
	  (dump-decl-list (il-node-defined node))
	  (dump-decl-list (il-node-targets node))
	  )
  )



;;; create-il-node
;;;
;;; This should be used instead of make-il-node to create a new il-node.  It fills the appropriate fields in the il-node
;;; according to the flags in the instruction.

(defun create-il-node (inst source)
  (new-il-node :op (get-il-instruction inst) :source source)
  )



;;; a number of macros for il-nodes, which facilitate the addition of information.
;;;
;;; add-ancestor, add-offspring (for control-flow)
;;; add-need, add-have (for live-variable analysis)
;;; add-read, add-write (also for live-variable analysis)

(defmacro add-ancestor (node parent)
  "Add an ancestor (parent) to an il-node."
  `(pushnew ,parent (il-node-ancestors ,node)))

(defmacro add-offspring (node child)
  "Add an offspring (child) to an il-node."
  `(pushnew ,child (il-node-offspring ,node)))

(defun update-c-flow (parent child)
  (pushnew-end parent (il-node-ancestors child))
  (pushnew-end child  (il-node-offspring parent))
  )

(defun remove-c-flow (parent child)
  (zip-remove parent (il-node-ancestors child))
  (zip-remove child  (il-node-offspring parent))
  )


(defmacro add-need (n sym)
  "Add a needed symbol to an il-node."
  `(pushnew ,sym (il-node-need ,n)))

(defmacro add-have (n sym)
  "Add a have'd symbol to an il-node."
  `(pushnew ,sym (il-node-have ,n)))

(defmacro add-alive (n sym)
  "Add a live symbol to an il-node."
  `(pushnew ,sym (il-node-alive ,n)))








;;; true-target
;;;
;;; Returns the first element of the targets list.

(defmacro true-target (il-node)
  `(first (il-node-targets ,il-node)))


;;; false-target
;;;
;;; Returns the second element of the targets list.

(defmacro false-target (il-node)
  `(second (il-node-targets ,il-node)))




;;; next-il-node
;;;
;;; This returns the lexically next il-node.

(defun next-il-node (il-node)
  (first (il-node-offspring il-node)))


;;; true-target-node
;;;
;;; This returns the il-node corresponding to the first target in the list.

(defun true-target-node (il-node)
  (label-il-node (declaration-value (true-target il-node))))


;;; false-target-node
;;;
;;; This returns the il-node corresponding to the second target in the list.

(defun false-target-node (il-node)
  (label-il-node (declaration-value (false-target il-node))))

;;; target-node
;;;
;;; Given a label, this returns the il-node to which it points.

(defun target-node (label)
  (label-il-node (declaration-value label)))




;;; remove-il-node
;;;
;;; Given a list of intertwined il-nodes (one whose ancestors and offspring lists have been fully created), and
;;; a particulat il-node, this removes the il-node and leaves the ancestors and offspring graphs in a consistent
;;; state.

(defun remove-il-node (this il-nodes)
  (let ((next (second (member this il-nodes))))
    
    ;; For each parent, remove this from offspring list
    (dolist (parent (il-node-ancestors this))
      (zip-remove this (il-node-offspring parent)))

    ;; For each parent, adjoin next to offspring list
    (dolist (parent (il-node-ancestors this))
      (pushnew next (il-node-offspring parent)))
    
    ;; For each child, remove this from ancestors list
    (dolist (child (il-node-offspring this))
      (zip-remove this (il-node-ancestors child)))
    
    ;; For next, augment ancestors list by this's ancestors list.
    (setf (il-node-ancestors next) (union (il-node-ancestors next) (il-node-ancestors this)))
    
    ;; Finally, remove this from the list of il-nodes.
    (zip-remove this il-nodes)
    )

  il-nodes
  )