X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fpack.lisp;h=5057a72b66f1581d156bace4b7a247a40e11bf23;hb=98a76d4426660876dec6649b1e228d2e5b47f579;hp=e67f0f9812606bffbfa7f9a0984bef19deb03fd6;hpb=82653abf5573c22c691e2243b70647ecdaa6aea8;p=sbcl.git diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp index e67f0f9..5057a72 100644 --- a/src/compiler/pack.lisp +++ b/src/compiler/pack.lisp @@ -26,12 +26,12 @@ ;;; Return true if the element at the specified offset in SB has a ;;; conflict with TN: -;;; -- If a component-live TN (:component kind), then iterate over -;;; all the blocks. If the element at Offset is used anywhere in +;;; -- If a component-live TN (:COMPONENT kind), then iterate over +;;; all the blocks. If the element at OFFSET is used anywhere in ;;; any of the component's blocks (always-live /= 0), then there ;;; is a conflict. ;;; -- If TN is global (Confs true), then iterate over the blocks TN -;;; is live in (using TN-Global-Conflicts). If the TN is live +;;; is live in (using TN-GLOBAL-CONFLICTS). If the TN is live ;;; everywhere in the block (:LIVE), then there is a conflict ;;; if the element at offset is used anywhere in the block ;;; (Always-Live /= 0). Otherwise, we use the local TN number for @@ -52,7 +52,7 @@ (confs (let ((loc-confs (svref (finite-sb-conflicts sb) offset)) (loc-live (svref (finite-sb-always-live sb) offset))) - (do ((conf confs (global-conflicts-tn-next conf))) + (do ((conf confs (global-conflicts-next-tnwise conf))) ((null conf) nil) (let* ((block (global-conflicts-block conf)) @@ -104,12 +104,12 @@ (loc-live (svref (finite-sb-always-live sb) this-offset))) (cond ((eq kind :component) - (dotimes (num (ir2-block-count *component-being-compiled*) nil) + (dotimes (num (ir2-block-count *component-being-compiled*)) (declare (type index num)) (setf (sbit loc-live num) 1) (set-bit-vector (svref loc-confs num)))) (confs - (do ((conf confs (global-conflicts-tn-next conf))) + (do ((conf confs (global-conflicts-next-tnwise conf))) ((null conf)) (let* ((block (global-conflicts-block conf)) (num (ir2-block-number block)) @@ -125,7 +125,7 @@ (bit-ior (the local-tn-bit-vector (svref loc-confs num)) (tn-local-conflicts tn) t)))))))) -;;; Return the total number of IR2 blocks in Component. +;;; Return the total number of IR2-BLOCKs in COMPONENT. (defun ir2-block-count (component) (declare (type component component)) (do ((2block (block-info (block-next (component-head component))) @@ -135,7 +135,7 @@ (when (ir2-block-number 2block) (return (1+ (ir2-block-number 2block)))))) -;;; Ensure that the conflicts vectors for each :Finite SB are large +;;; Ensure that the conflicts vectors for each :FINITE SB are large ;;; enough for the number of blocks allocated. Also clear any old ;;; conflicts and reset the current size to the initial size. (defun init-sb-vectors (component) @@ -187,7 +187,7 @@ (setf (finite-sb-current-size sb) (sb-size sb)) (setf (finite-sb-last-offset sb) 0)))))) -;;; Expand the :Unbounded SB backing SC by either the initial size or +;;; Expand the :UNBOUNDED SB backing SC by either the initial size or ;;; the SC element size, whichever is larger. If NEEDED-SIZE is ;;; larger, then use that size. (defun grow-sc (sc &optional (needed-size 0)) @@ -254,7 +254,7 @@ (dolist (sb *backend-sb-list*) (unless (eq (sb-kind sb) :non-packed) (let ((size (sb-size sb))) - (fill nil (finite-sb-always-live sb)) + (fill (finite-sb-always-live sb) nil) (setf (finite-sb-always-live sb) (make-array size :initial-element @@ -265,11 +265,11 @@ ;; until runtime. #+sb-xc (make-array 0 :element-type 'bit))) - (fill nil (finite-sb-conflicts sb)) + (fill (finite-sb-conflicts sb) nil) (setf (finite-sb-conflicts sb) (make-array size :initial-element '#())) - (fill nil (finite-sb-live-tns sb)) + (fill (finite-sb-live-tns sb) nil) (setf (finite-sb-live-tns sb) (make-array size :initial-element nil)))))) (values)) @@ -323,11 +323,11 @@ (cond (ptype (aver (member (sc-number sc) (primitive-type-scs ptype))) - (error "SC ~S doesn't have any :Unbounded alternate SCs, but is~@ + (error "SC ~S doesn't have any :UNBOUNDED alternate SCs, but is~@ a SC for primitive-type ~S." (sc-name sc) (primitive-type-name ptype))) (t - (error "SC ~S doesn't have any :Unbounded alternate SCs." + (error "SC ~S doesn't have any :UNBOUNDED alternate SCs." (sc-name sc))))))))) ;;; Return a list of format arguments describing how TN is used in @@ -590,8 +590,8 @@ ;;;; optimized saving ;;; Save TN if it isn't a single-writer TN that has already been -;;; saved. If multi-write, we insert the save Before the specified -;;; VOP. Context is a VOP used to tell which node/block to use for the +;;; saved. If multi-write, we insert the save BEFORE the specified +;;; VOP. CONTEXT is a VOP used to tell which node/block to use for the ;;; new VOP. (defun save-if-necessary (tn before context) (declare (type tn tn) (type (or vop null) before) (type vop context)) @@ -606,7 +606,7 @@ (values)) ;;; Load the TN from its save location, allocating one if necessary. -;;; The load is inserted Before the specifier VOP. Context is a VOP +;;; The load is inserted BEFORE the specifier VOP. CONTEXT is a VOP ;;; used to tell which node/block to use for the new VOP. (defun restore-tn (tn before context) (declare (type tn tn) (type (or vop null) before) (type vop context)) @@ -805,7 +805,7 @@ (defvar *repack-blocks*) (declaim (type (or hash-table null) *repack-blocks*)) -;;; Set the Live-TNs vectors in all :FINITE SBs to represent the TNs +;;; Set the LIVE-TNS vectors in all :FINITE SBs to represent the TNs ;;; live at the end of BLOCK. (defun init-live-tns (block) (dolist (sb *backend-sb-list*) @@ -1387,7 +1387,7 @@ ;;; Pack a wired TN, checking that the offset is in bounds for the SB, ;;; and that the TN doesn't conflict with some other TN already packed ;;; in that location. If the TN is wired to a location beyond the end -;;; of a :Unbounded SB, then grow the SB enough to hold the TN. +;;; of a :UNBOUNDED SB, then grow the SB enough to hold the TN. ;;; ;;; ### Checking for conflicts is disabled for :SPECIFIED-SAVE TNs. ;;; This is kind of a hack to make specifying wired stack save