X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftn.lisp;h=18e9ca63bfdc53d15ffb3d340da2b7c3f806f2c3;hb=cd2c70c8b5d4dcc62b968f5a9bedd3c9c8698e82;hp=e0b6a2640a69eb47372ef4687f1ded203ad31ae2;hpb=34dd23563d2f5cf05c72b971da0d0b065a09bf2a;p=sbcl.git diff --git a/src/compiler/tn.lisp b/src/compiler/tn.lisp index e0b6a26..18e9ca6 100644 --- a/src/compiler/tn.lisp +++ b/src/compiler/tn.lisp @@ -16,9 +16,9 @@ ;;; in this component. (defvar *component-being-compiled*) -;;; Do-Packed-TNs (TN-Var Component [Result]) Declaration* Form* +;;; DO-PACKED-TNS (TN-Var Component [Result]) Declaration* Form* ;;; -;;; Iterate over all packed TNs allocated in Component. +;;; Iterate over all packed TNs allocated in COMPONENT. (defmacro do-packed-tns ((tn component &optional result) &body body) (let ((n-component (gensym))) `(let ((,n-component (component-info ,component))) @@ -33,6 +33,24 @@ ,result) ,@body)))) +(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 @@ -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 @@ -249,9 +267,10 @@ ;;;; 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))) @@ -260,10 +279,10 @@ (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 @@ -286,7 +305,7 @@ (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) @@ -386,7 +405,7 @@ (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))) @@ -408,10 +427,8 @@ ;;; Return a list of N normal TNs of the specified primitive type. (defun make-n-tns (n ptype) (declare (type unsigned-byte n) (type primitive-type ptype)) - (collect ((res)) - (dotimes (i n) - (res (make-normal-tn ptype))) - (res))) + (loop repeat n + collect (make-normal-tn ptype))) ;;; Return true if X and Y are packed in the same location, false otherwise. ;;; This is false if either operand is constant.