X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftn.lisp;h=8ec52609027a14eb05b3b1a3a4a9bcc926b4830d;hb=305177dc7a7d11245e42e003ac4070eb1705c699;hp=3409a638c0b0f5ffafee7d8a5ead7d7cae6314de;hpb=7fd2eb4b1bc68e8aaec233c4a39bdfc40225bda2;p=sbcl.git

diff --git a/src/compiler/tn.lisp b/src/compiler/tn.lisp
index 3409a63..8ec5260 100644
--- a/src/compiler/tn.lisp
+++ b/src/compiler/tn.lisp
@@ -16,10 +16,10 @@
 ;;; 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)))
@@ -33,10 +33,28 @@
 	    ,result)
 	 ,@body))))
 
-;;; 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))
@@ -65,26 +83,26 @@
 		 (: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))
 
 ;;;; TN creation
@@ -179,8 +197,8 @@
   tn)
 
 ;;; Create a constant TN. The implementation dependent
-;;; Immediate-Constant-SC function is used to determine whether the constant
-;;; has an immediate representation.
+;;; IMMEDIATE-CONSTANT-SC function is used to determine whether the
+;;; constant has an immediate representation.
 (defun make-constant-tn (constant)
   (declare (type constant constant))
   (let* ((component (component-info *component-being-compiled*))
@@ -218,9 +236,9 @@
 	     (ir2-component-alias-tns component))
     res))
 
-;;; 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
-;;; new load-time constant slot.
+;;; 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 new load-time constant slot.
 (defun make-load-time-constant-tn (kind info)
   (declare (type keyword kind))
   (let* ((component (component-info *component-being-compiled*))
@@ -314,7 +332,7 @@
       (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))
@@ -326,7 +344,7 @@
       (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))
@@ -340,7 +358,7 @@
       (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))