;;; in this component.
(defvar *component-being-compiled*)
+;;; DO-PACKED-TNS (TN-Var Component [Result]) Declaration* Form*
+;;;
+;;; Iterate over all packed TNs allocated in COMPONENT.
(defmacro do-packed-tns ((tn component &optional result) &body body)
- #!+sb-doc
- "Do-Packed-TNs (TN-Var Component [Result]) Declaration* Form*
- Iterate over all packed TNs allocated in Component."
(let ((n-component (gensym)))
`(let ((,n-component (component-info ,component)))
(do ((,tn (ir2-component-normal-tns ,n-component) (tn-next ,tn)))
,result)
,@body))))
\f
-;;; Remove all TNs with no references from the lists of unpacked TNs. We
-;;; null out the Offset so that nobody will mistake deleted wired TNs for
-;;; properly packed TNs. We mark non-deleted alias TNs so that aliased TNs
-;;; aren't considered to be unreferenced.
+(defun set-ir2-physenv-live-tns (value instance)
+ (setf (ir2-physenv-live-tns instance) value))
+
+(defun set-ir2-physenv-debug-live-tns (value instance)
+ (setf (ir2-physenv-debug-live-tns instance) value))
+
+(defun set-ir2-component-alias-tns (value instance)
+ (setf (ir2-component-alias-tns instance) value))
+
+(defun set-ir2-component-normal-tns (value instance)
+ (setf (ir2-component-normal-tns instance) value))
+
+(defun set-ir2-component-restricted-tns (value instance)
+ (setf (ir2-component-restricted-tns instance) value))
+
+(defun set-ir2-component-wired-tns (value instance)
+ (setf (ir2-component-wired-tns instance) value))
+
+;;; Remove all TNs with no references from the lists of unpacked TNs.
+;;; We null out the Offset so that nobody will mistake deleted wired
+;;; TNs for properly packed TNs. We mark non-deleted alias TNs so that
+;;; aliased TNs aren't considered to be unreferenced.
(defun delete-unreferenced-tns (component)
(let* ((2comp (component-info component))
(aliases (make-array (1+ (ir2-component-global-tn-counter 2comp))
(:environment
(clear-live tn
#'ir2-physenv-live-tns
- #'(setf ir2-physenv-live-tns)))
+ #'set-ir2-physenv-live-tns))
(:debug-environment
(clear-live tn
#'ir2-physenv-debug-live-tns
- #'(setf ir2-physenv-debug-live-tns)))))
+ #'set-ir2-physenv-debug-live-tns))))
(clear-live (tn getter setter)
(let ((env (physenv-info (tn-physenv tn))))
(funcall setter (delete tn (funcall getter env)) env))))
(declare (inline used-p delete-some delete-1 clear-live))
(delete-some #'ir2-component-alias-tns
- #'(setf ir2-component-alias-tns))
+ #'set-ir2-component-alias-tns)
(do ((tn (ir2-component-alias-tns 2comp) (tn-next tn)))
((null tn))
(setf (sbit aliases (tn-number (tn-save-tn tn))) 1))
(delete-some #'ir2-component-normal-tns
- #'(setf ir2-component-normal-tns))
+ #'set-ir2-component-normal-tns)
(delete-some #'ir2-component-restricted-tns
- #'(setf ir2-component-restricted-tns))
+ #'set-ir2-component-restricted-tns)
(delete-some #'ir2-component-wired-tns
- #'(setf ir2-component-wired-tns))))
+ #'set-ir2-component-wired-tns)))
(values))
\f
;;;; TN creation
;;; Return a load-time constant TN with the specified KIND and INFO.
;;; If the desired CONSTANTS entry already exists, then reuse it,
-;;; otherwise allocate a anew load-time constant slot.
+;;; otherwise allocate a new load-time constant slot.
(defun make-load-time-constant-tn (kind info)
(declare (type keyword kind))
(let* ((component (component-info *component-being-compiled*))
\f
;;;; TN referencing
-;;; Make a TN-Ref that references TN and return it. Write-P should be true
-;;; if this is a write reference, otherwise false. All we do other than
-;;; calling the constructor is add the reference to the TN's references.
+;;; Make a TN-REF that references TN and return it. WRITE-P should be
+;;; true if this is a write reference, otherwise false. All we do
+;;; other than calling the constructor is add the reference to the
+;;; TN's references.
(defun reference-tn (tn write-p)
(declare (type tn tn) (type boolean write-p))
(let ((res (make-tn-ref tn write-p)))
(push-in tn-ref-next res (tn-reads tn)))
res))
-;;; Make TN-Refs to reference each TN in TNs, linked together by
-;;; TN-Ref-Across. Write-P is the Write-P value for the refs. More is
-;;; stuck in the TN-Ref-Across of the ref for the last TN, or returned as the
-;;; result if there are no TNs.
+;;; Make TN-REFS to reference each TN in TNs, linked together by
+;;; TN-REF-ACROSS. WRITE-P is the WRITE-P value for the refs. MORE is
+;;; stuck in the TN-REF-ACROSS of the ref for the last TN, or returned
+;;; as the result if there are no TNs.
(defun reference-tn-list (tns write-p &optional more)
(declare (list tns) (type boolean write-p) (type (or tn-ref null) more))
(if tns
(values))
;;; Do stuff to change the TN referenced by Ref. We remove Ref from its
-;;; old TN's refs, add ref to TN's refs, and set the TN-Ref-TN.
+;;; old TN's refs, add ref to TN's refs, and set the TN-REF-TN.
(defun change-tn-ref-tn (ref tn)
(declare (type tn-ref ref) (type tn tn))
(delete-tn-ref ref)
(insert-vop-sequence first last block before)
last)))
-;;; Like EMIT-MOVE-TEMPLATE, except that we pass in Info args too.
+;;; like EMIT-MOVE-TEMPLATE, except that we pass in INFO args too
(defun emit-load-template (node block template x y info &optional before)
(declare (type node node) (type ir2-block block)
(type template template) (type tn x y))
(insert-vop-sequence first last block before)
last)))
-;;; Like EMIT-MOVE-TEMPLATE, except that the VOP takes two args.
+;;; like EMIT-MOVE-TEMPLATE, except that the VOP takes two args
(defun emit-move-arg-template (node block template x f y &optional before)
(declare (type node node) (type ir2-block block)
(type template template) (type tn x f y))
(insert-vop-sequence first last block before)
last)))
-;;; Like EMIT-MOVE-TEMPLATE, except that the VOP takes no args.
+;;; like EMIT-MOVE-TEMPLATE, except that the VOP takes no args
(defun emit-context-template (node block template y &optional before)
(declare (type node node) (type ir2-block block)
(type template template) (type tn y))
(setf (ir2-block-start-vop block) first))))
(values))
-;;; Delete all of the TN-Refs associated with VOP and remove VOP from the IR2.
+;;; Delete all of the TN-REFs associated with VOP and remove VOP from the IR2.
(defun delete-vop (vop)
(declare (type vop vop))
(do ((ref (vop-refs vop) (tn-ref-next-ref ref)))
projects / sbcl.git / blobdiff