Skip to content
Snippets Groups Projects
ir1opt.lisp 39.2 KiB
Newer Older
wlott's avatar
wlott committed
;;; -*- Package: C; Log: C.Log -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC). 
;;; **********************************************************************
;;;
;;;    This file implements the IR1 optimization phase of the compiler.  IR1
;;; optimization is a grab-bag of optimizations that don't make major changes
;;; to the block-level control flow and don't use flow analysis.  These
;;; optimizations can mostly be classified as "meta-evaluation", but there is a
;;; sizable top-down component as well.
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)

;;;
;;;    A hashtable from combination nodes to things describing how an
;;; optimization of the node failed.  If the thing is a list, then it is format
;;; arguments.  If it is a type, then the type is a type that the call failed
;;; to match.
;;;
(defvar *failed-optimizations* (make-hash-table :test #'eq))


;;;; Interface for obtaining results of constant folding:

;;; Constant-Continuation-P  --  Interface
;;;
;;;    Return true if the sole use of Cont is a reference to a constant leaf.
;;;
(proclaim '(function constant-continuation-p (continuation) boolean))
(defun constant-continuation-p (cont)
  (let ((use (continuation-use cont)))
    (and (ref-p use)
	 (constant-p (ref-leaf use)))))


;;; Continuation-Value  --  Interface
;;;
;;;    Return the constant value for a continuation whose only use is a
;;; constant node.
;;;
(proclaim '(function continuation-value (continuation) t))
(defun continuation-value (cont)
  (constant-value (ref-leaf (continuation-use cont))))


;;;; Interface for obtaining results of type inference:

;;; CONTINUATION-PROVEN-TYPE  --  Interface
;;;
;;;    Return a (possibly values) type that describes what we have proven about
;;; the type of Cont without taking any type assertions into consideration.
;;; This is just the union of the NODE-DERIVED-TYPE of all the uses.  Most
;;; often people use CONTINUATION-DERIVED-TYPE or CONTINUATION-TYPE instead of
;;; using this function directly.
;;;
(defun continuation-proven-type (cont)
  (declare (type continuation cont))
  (ecase (continuation-kind cont)
    ((:block-start :deleted-block-start)
     (let ((uses (block-start-uses (continuation-block cont))))
       (if uses
	   (do ((res (node-derived-type (first uses))
		     (values-type-union (node-derived-type (first current))
					res))
		(current (rest uses) (rest current)))
	       ((null current) res))
	   *empty-type*)))
    (:inside-block
     (node-derived-type (continuation-use cont)))))


;;; Continuation-Derived-Type  --  Interface
;;;
;;;    Our best guess for the type of this continuation's value.  Note that
;;; this may be Values or Function type, which cannot be passed as an argument
;;; to the normal type operations.  See Continuation-Type.  This may be called
;;; on deleted continuations, always returning *.
;;;
;;;    What we do is call CONTINUATION-PROVEN-TYPE and check whether the result
;;; is a subtype of the assertion.  If so, return the proven type and set
;;; TYPE-CHECK to nil.  Otherwise, return the intersection of the asserted and
;;; proven types, and set TYPE-CHECK T.  If TYPE-CHECK already has a non-null
;;; value, then preserve it.  Only in the somewhat unusual circumstance of
;;; a newly discovered assertion will we change TYPE-CHECK from NIL to T.
;;;
;;;    The result value is cached in the Continuation-%Derived-Type.  If the
;;; slot is true, just return that value, otherwise recompute and stash the
;;; value there.
;;;
(proclaim '(inline continuation-derived-type))
(defun continuation-derived-type (cont)
  (declare (type continuation cont))
  (or (continuation-%derived-type cont)
      (%continuation-derived-type cont)))
;;;
(defun %continuation-derived-type (cont)
  (declare (type continuation cont))
  (let ((proven (continuation-proven-type cont))
	(asserted (continuation-asserted-type cont)))
    (cond ((values-subtypep proven asserted)
	   (setf (continuation-%type-check cont) nil)
	   (setf (continuation-%derived-type cont) proven))
	  (t
	   (unless (or (continuation-%type-check cont)
		       (not (continuation-dest cont))
		       (eq asserted *universal-type*))
	     (setf (continuation-%type-check cont) t))

	   (setf (continuation-%derived-type cont)
		 (values-type-intersection asserted proven))))))


;;; CONTINUATION-TYPE-CHECK  --  Interface
;;;
;;;    Call CONTINUATION-DERIVED-TYPE to make sure the slot is up to date, then
;;; return it.
;;;
(proclaim '(inline continuation-type-check))
(defun continuation-type-check (cont)
  (declare (type continuation cont))
  (continuation-derived-type cont)
  (continuation-%type-check cont))


;;; Continuation-Type  --  Interface
;;;
;;;    Return the derived type for Cont's first value.  This is guaranteed not
;;; to be a Values or Function type.
;;;
(proclaim '(function continuation-type (continuation) type))
(defun continuation-type (cont)
  (single-value-type (continuation-derived-type cont)))


;;;; Interface routines used by optimizers:

;;; Reoptimize-Continuation  --  Interface
;;;
;;;    This function is called by optimizers to indicate that something
;;; interesting has happened to the value of Cont.  Optimizers must make sure
;;; that they don't call for reoptimization when nothing has happened, since
;;; optimization will fail to terminate.
;;;
;;;    We clear any cached type for the continuation and set the reoptimize
;;; flags on everything in sight, unless the continuation is deleted (in which
;;; case we do nothing.)
;;;
;;;    Since this can get called curing IR1 conversion, we have to be careful
;;; not to fly into space when the Dest's Prev is missing. 
;;;
(defun reoptimize-continuation (cont)
  (declare (type continuation cont))
  (unless (eq (continuation-kind cont) :deleted)
    (setf (continuation-%derived-type cont) nil)
    (let ((dest (continuation-dest cont)))
      (when dest
	(setf (continuation-reoptimize cont) t)
	(setf (node-reoptimize dest) t)
	(let ((prev (node-prev dest)))
	  (when prev
	    (let* ((block (continuation-block prev))
		   (component (block-component block)))
	      (setf (block-reoptimize block) t)
	      (setf (component-reoptimize component) t))))))
    (do-uses (node cont)
      (setf (block-type-check (node-block node)) t)))
  (undefined-value))


;;; Derive-Node-Type  --  Interface
;;;
;;;    Annotate Node to indicate that its result has been proven to be typep to
;;; RType.  After IR1 conversion has happened, this is the only correct way to
;;; supply information discovered about a node's type.  If you fuck with the
;;; Node-Derived-Type directly, then information may be lost and reoptimization
;;; may not happen. 
;;;
;;;    What we do is intersect Rtype with Node's Derived-Type.  If the
;;; intersection is different from the old type, then we do a
;;; Reoptimize-Continuation on the Node-Cont.
;;;
(defun derive-node-type (node rtype)
  (declare (type node node) (type ctype rtype))
  (let ((node-type (node-derived-type node)))
    (unless (eq node-type rtype)
      (let ((int (values-type-intersection node-type rtype)))
	(when (type/= node-type int)
	  (setf (node-derived-type node) int)
	  (reoptimize-continuation (node-cont node))))))
  (undefined-value))


;;; Assert-Continuation-Type  --  Interface
;;;
Loading
Loading full blame...