diff --git a/compiler/pack.lisp b/compiler/pack.lisp
index 34496f4f0a5c479ef7fe726a6940d016a754a2af..4249360db8168b445f1777309d2a19e2939a3368 100644
--- a/compiler/pack.lisp
+++ b/compiler/pack.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/pack.lisp,v 1.46 1993/08/05 15:38:34 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/pack.lisp,v 1.47 1993/08/12 17:32:36 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -17,7 +17,9 @@
 ;;;
 ;;; Written by Rob MacLachlan
 ;;;
-(in-package 'c)
+(in-package "C")
+
+(declaim (optimize (inhibit-warnings 1)))
 
 ;;; Some parameters controlling which optimizations we attempt (for debugging.)
 ;;;
@@ -28,6 +30,7 @@
 
 ;;;; Conflict determination:
 
+(declaim (start-block offset-conflicts-in-sb conflicts-in-sc))
 
 ;;; Offset-Conflicts-In-SB  --  Internal
 ;;;
@@ -88,6 +91,7 @@
       (when (offset-conflicts-in-sb tn sb (+ offset i))
 	(return t)))))
 
+(declaim (end-block))
 
 ;;; Add-Location-Conflicts  --  Internal
 ;;;
@@ -112,12 +116,14 @@
 	(sb (sc-sb sc))
 	(kind (tn-kind tn)))
     (dotimes (i (sc-element-size sc))
+      (declare (type index i))
       (let* ((this-offset (+ offset i))
 	     (loc-confs (svref (finite-sb-conflicts sb) this-offset))
 	     (loc-live (svref (finite-sb-always-live sb) this-offset)))
 	(cond
 	 ((eq kind :component)
 	  (dotimes (num (ir2-block-count *compile-component*) nil)
+	    (declare (type index num))
 	    (setf (sbit loc-live num) 1)
 	    (set-bit-vector (svref loc-confs num))))
 	 (confs
@@ -188,7 +194,7 @@
 		(declare (simple-vector conf))
 		(dotimes (j (length conf))
 		  (declare (type index j))
-		  (clear-bit-vector (svref conf j))))
+		  (clear-ltn-bit-vector (svref conf j))))
 	      (clear-bit-vector (svref always-live i)))))
 
 	(setf (finite-sb-current-size sb) (sb-size sb))
@@ -202,13 +208,13 @@
 ;;; size.
 ;;;
 (defun grow-sc (sc &optional (needed-size 0))
-  (declare (type sc sc))
+  (declare (type sc sc) (type index needed-size))
   (let* ((sb (sc-sb sc))
 	 (size (finite-sb-current-size sb))
+	 (align-mask (1- (sc-alignment sc)))
 	 (inc (max (sb-size sb)
 		   (+ (sc-element-size sc)
-		      (- (* (ceiling size (sc-alignment sc))
-			    (sc-alignment sc))
+		      (- (logandc2 (+ size align-mask) align-mask)
 			 size))
 		   (- needed-size size)))
 	 (new-size (+ size inc))
@@ -223,6 +229,7 @@
 	(replace new-conf conflicts)
 	(do ((i size (1+ i)))
 	    ((= i new-size))
+	  (declare (type index i))
 	  (let ((loc-confs (make-array block-size)))
 	    (dotimes (j block-size)
 	      (setf (svref loc-confs j)
@@ -286,6 +293,7 @@
 
 
 ;;;; Internal errors:
+(declaim (optimize (inhibit-warnings 2)))
 
 ;;; NO-LOAD-FUNCTION-ERROR  --  Internal
 ;;;
@@ -342,8 +350,7 @@
 		 (sc-name sc) (primitive-type-name ptype)))
 	 (t
 	  (error "SC ~S doesn't have any :Unbounded alternate SCs."
-		 (sc-name sc))))))))
-  (undefined-value))
+		 (sc-name sc)))))))))
 
 
 ;;; DESCRIBE-TN-USE  --  Internal
@@ -394,16 +401,19 @@
 	     (confs (finite-sb-live-tns sb)))
 	(assert (eq (sb-kind sb) :finite))
 	(dolist (el (sc-locations sc))
+	  (declare (type index el))
 	  (let ((conf (load-tn-conflicts-in-sc op sc el t)))
 	    (if conf
 		(used (describe-tn-use el conf op))
-		(loop for i from el
-		      as victim = (svref confs i)
-		      repeat (sc-element-size sc) do
-		  (when (and victim (eq (tn-kind victim) :component))
-		    (used (describe-tn-use el victim op))
-		    (return t))
-		  finally (unused el)))))))
+		(do ((i el (1+ i))
+		     (end (+ el (sc-element-size sc))))
+		    ((= i end)
+		     (unused el))
+		  (declare (type index i end))
+		  (let ((victim (svref confs i)))
+		    (when (and victim (eq (tn-kind victim) :component))
+		      (used (describe-tn-use el victim op))
+		      (return t)))))))))
       
     (multiple-value-bind (arg-p n more-p costs load-scs incon)
 			 (get-operand-info op)
@@ -421,8 +431,7 @@
 	       n arg-p
 	       (vop-info-name (vop-info (tn-ref-vop op)))
 	       (unused) (used)
-	       incon)))
-  (undefined-value))
+	       incon))))
 
 
 ;;; NO-LOAD-SCS-ALLOWED-BY-PRIMITIVE-TYPE-ERROR  --  Internal
@@ -449,23 +458,14 @@
 	     (template-name (vop-info (tn-ref-vop ref)))
 	     (primitive-type-name ptype)
 	     (mapcar #'sc-name (listify-restrictions load-scs))
-	     incon)))
-  (undefined-value))
+	     incon))))
+
+(declaim (optimize (inhibit-warnings 1)))
 
 
 ;;;; Register saving:
 
-;;; Original-TN  --  Internal
-;;;
-;;;    If a save TN, return the saved TN, otherwise return TN.  Useful for
-;;; getting the conflicts of a TN that might be a save TN.
-;;;
-(defun original-tn (tn)
-  (declare (type tn tn))
-  (if (member (tn-kind tn) '(:save :save-once :specified-save))
-      (tn-save-tn tn)
-      tn))
-
+(declaim (start-block optimized-emit-saves emit-saves assign-tn-costs))
 
 ;;; Note-Spilled-TN  --  Internal
 ;;;
@@ -577,12 +577,13 @@
        (res nil))
       ((null write)
        (when (and res
-		  (loop for read = (tn-reads tn) then (tn-ref-next read)
-		        while read
-		        never (eq (vop-info-move-args
-				   (vop-info
-				    (tn-ref-vop read)))
-				  :local-call)))
+		  (do ((read (tn-reads tn) (tn-ref-next read)))
+		      ((not read) t)
+		    (when (eq (vop-info-move-args
+			       (vop-info
+				(tn-ref-vop read)))
+			      :local-call)
+		      (return nil))))
 	 (tn-ref-vop res)))
 
     (unless (eq (vop-info-name (vop-info (tn-ref-vop write)))
@@ -851,7 +852,8 @@
 	((null vop))
       (when (eq (vop-info-save-p (vop-info vop)) t)
 	(do-live-tns (tn (vop-save-set vop) block)
-	  (decf (tn-cost tn) (backend-register-save-penalty *backend*))))))
+	  (decf (tn-cost tn)
+		(the index (backend-register-save-penalty *backend*)))))))
   
   (do ((tn (ir2-component-normal-tns (component-info component))
 	   (tn-next tn)))
@@ -866,142 +868,12 @@
 	(incf cost))
       (setf (tn-cost tn) cost))))
 
-
-;;;; Targeting:
-
-;;; Target-If-Desirable  --  Internal
-;;;
-;;;    Link the TN-Refs Read and Write together using the TN-Ref-Target when
-;;; this seems like a good idea.  Currently we always do, as this increases the
-;;; sucess of load-TN targeting.
-;;;
-(defun target-if-desirable (read write)
-  (declare (type tn-ref read write))
-  (setf (tn-ref-target read) write)
-  (setf (tn-ref-target write) read))
-
-
-;;; Check-OK-Target  --  Internal
-;;;
-;;;    If TN can be packed into SC so as to honor a preference to Target, then
-;;; return the offset to pack at, otherwise return NIL.  Target must be already
-;;; packed.  We can honor a preference if:
-;;; -- Target's location is in SC's locations.
-;;; -- The element sizes of the two SCs are the same.
-;;; -- TN doesn't conflict with target's location.
-;;; 
-(defun check-ok-target (target tn sc)
-  (declare (type tn target tn) (type sc sc) (inline member))
-  (let* ((loc (tn-offset target))
-	 (target-sc (tn-sc target))
-	 (target-sb (sc-sb target-sc)))
-    (declare (type index loc))
-    (if (and (eq target-sb (sc-sb sc))
-	     (or (eq (sb-kind target-sb) :unbounded)
-		 (member loc (sc-locations sc)))
-	     (= (sc-element-size target-sc) (sc-element-size sc))
-	     (not (conflicts-in-sc tn sc loc))
-	     (zerop (mod loc (sc-alignment sc))))
-	loc
-	nil)))
-
-
-;;; Find-OK-Target-Offset  --  Internal
-;;;
-;;;    Scan along the target path from TN, looking at readers or writers.  When
-;;; we find a packed TN, return Check-OK-Target of that TN.  If there is no
-;;; target, or if the TN has multiple readers (writers), then we return NIL.
-;;; We also always return NIL after 10 iterations to get around potential
-;;; circularity problems.
-;;;
-(macrolet ((frob (slot)
-	     `(let ((count 10)
-		    (current tn))
-		(declare (type index count))
-		(loop
-		  (let ((refs (,slot current)))
-		    (unless (and (plusp count) refs (not (tn-ref-next refs)))
-		      (return nil))
-		    (let ((target (tn-ref-target refs)))
-		      (unless target (return nil))
-		      (setq current (tn-ref-tn target))
-		      (when (tn-offset current)
-			(return (check-ok-target current tn sc)))
-		      (decf count)))))))
-  (defun find-ok-target-offset (tn sc)
-    (declare (type tn tn) (type sc sc))
-    (or (frob tn-reads)
-	(frob tn-writes))))
-
-
-
-;;;; Location selection:
-
-;;; Select-Location  --  Internal
-;;;
-;;;    Select some location for TN in SC, returning the offset if we succeed,
-;;; and NIL if we fail.  We start scanning at the Last-Offset in an attempt
-;;; to distribute the TNs across all storage.
-;;;
-;;; We call Offset-Conflicts-In-SB directly, rather than using Conflicts-In-SC.
-;;; This allows us to more efficient in packing multi-location TNs: we don't
-;;; have to multiply the number of tests by the TN size.  This falls out
-;;; natually, since we have to be aware of TN size anyway so that we don't call
-;;; Conflicts-In-SC on a bogus offset.
-;;;
-;;; We give up on finding a location after our current pointer has wrapped
-;;; twice.  This will result in testing some locations twice in the case that
-;;; we fail, but is simpler than trying to figure out the soonest failure
-;;; point.
-;;;
-;;; We also give up without bothering to wrap if the current size isn't large
-;;; enough to hold a single element of element-size without bothering to wrap.
-;;; If it doesn't fit this iteration, it won't fit next.
-;;; 
-;;; ### Note that we actually try to pack as many consecutive TNs as possible
-;;; in the same location, since we start scanning at the same offset that the
-;;; last TN was successfully packed in.  This is a weakening of the scattering
-;;; hueristic that was put in to prevent restricted VOP temps from hogging all
-;;; of the registers.  This way, all of these temps probably end up in one
-;;; register.
-;;;
-(defun select-location (tn sc &optional use-reserved-locs)
-  (declare (type tn tn) (type sc sc) (inline member))
-  (let* ((sb (sc-sb sc))
-	 (element-size (sc-element-size sc))
-	 (alignment (sc-alignment sc))
-	 (size (finite-sb-current-size sb))
-	 (start-offset (finite-sb-last-offset sb)))
-    (let ((current-start (* (the index (ceiling start-offset alignment))
-			    alignment))
-	  (wrap-p nil))
-      (declare (type index current-start))
-      (loop
-	(when (> (+ current-start element-size) size)
-	  (cond ((or wrap-p (> element-size size))
-		 (return nil))
-		(t
-		 (setq current-start 0)
-		 (setq wrap-p t))))
-
-	(if (or (eq (sb-kind sb) :unbounded)
-		(and (member current-start (sc-locations sc))
-		     (or use-reserved-locs
-			 (not (member current-start
-				      (sc-reserve-locations sc))))))
-	    (dotimes (i element-size
-			(return-from select-location current-start))
-	      (let ((offset (+ current-start i)))
-		(when (offset-conflicts-in-sb tn sb offset)
-		  (setq current-start
-			(* (the index (ceiling (1+ offset) alignment))
-			   alignment))
-		  (return))))
-	    (incf current-start alignment))))))
+(declaim (end-block))
 
 
 ;;;; Load TN packing:
 
+(declaim (start-block pack-load-tns))
 
 ;;; These variables indicate the last location at which we computed the
 ;;; Live-TNs.  They hold the Block and VOP values that were passed to
@@ -1031,8 +903,10 @@
     (let* ((sc (tn-sc tn))
 	   (sb (sc-sb sc)))
       (when (eq (sb-kind sb) :finite)
-	(loop for offset from (tn-offset tn)
-	      repeat (sc-element-size sc) do
+	(do ((offset (tn-offset tn) (1+ offset))
+	     (end (+ (tn-offset tn) (sc-element-size sc))))
+	    ((= offset end))
+	  (declare (type index offset end))
 	  (setf (svref (finite-sb-live-tns sb) offset) tn)))))
 
   (setq *live-block* block)
@@ -1061,8 +935,10 @@
 		(sc (tn-sc tn))
 		(sb (sc-sb sc)))
 	   (when (eq (sb-kind sb) :finite)
-	     (loop for offset from (tn-offset tn)
-	           repeat (sc-element-size sc) do
+	     (do ((offset (tn-offset tn) (1+ offset))
+		  (end (+ (tn-offset tn) (sc-element-size sc))))
+		 ((= offset end))
+	       (declare (type index offset end))
 	       (setf (svref (finite-sb-live-tns sb) offset) nil))))))
     (do ((ref (vop-refs current) (tn-ref-next-ref ref)))
 	((null ref))
@@ -1072,8 +948,10 @@
 		 (sb (sc-sb sc)))
 	    (when (eq (sb-kind sb) :finite)
 	      (let ((tns (finite-sb-live-tns sb)))
-		(loop for offset from (tn-offset ltn)
-		      repeat (sc-element-size sc) do
+		(do ((offset (tn-offset ltn) (1+ offset))
+		     (end (+ (tn-offset ltn) (sc-element-size sc))))
+		    ((= offset end))
+		  (declare (type index offset end))
 		  (assert (null (svref tns offset)))))))))
 
       (let* ((tn (tn-ref-tn ref))
@@ -1081,8 +959,10 @@
 	     (sb (sc-sb sc)))
 	(when (eq (sb-kind sb) :finite)
 	  (let ((tns (finite-sb-live-tns sb)))
-	    (loop for offset from (tn-offset tn)
-	          repeat (sc-element-size sc) do
+	    (do ((offset (tn-offset tn) (1+ offset))
+		 (end (+ (tn-offset tn) (sc-element-size sc))))
+		((= offset end))
+	      (declare (type index offset end))
 	      (if (tn-ref-write-p ref)
 		  (setf (svref tns offset) nil)
 		  (let ((old (svref tns offset)))
@@ -1171,12 +1051,15 @@
 (defun load-tn-conflicts-in-sc (op sc offset ignore-live)
   (let* ((sb (sc-sb sc))
 	 (size (finite-sb-current-size sb)))
-    (loop for i from offset
-          repeat (sc-element-size sc)
-          thereis (or (when (>= i size) :overflow)
-		      (and (not ignore-live)
-			   (svref (finite-sb-live-tns sb) offset))
-		      (load-tn-offset-conflicts-in-sb op sb i)))))
+    (do ((i offset (1+ i))
+	 (end (+ offset (sc-element-size sc))))
+	((= i end) nil)
+      (declare (type index i end))
+      (let ((res (or (when (>= i size) :overflow)
+		     (and (not ignore-live)
+			  (svref (finite-sb-live-tns sb) offset))
+		     (load-tn-offset-conflicts-in-sb op sb i))))
+	(when res (return res))))))
 
 
 ;;; Find-Load-TN-Target  --  Internal
@@ -1278,13 +1161,15 @@
 	(declare (type index loc))
 	(block SKIP
 	  (collect ((victims nil adjoin))
-	    (loop for i from loc
-	      as victim = (svref (finite-sb-live-tns sb) i)
-	      repeat (sc-element-size sc) do
-	      (when victim
-		(unless (find-in #'tn-next victim normal-tns)
-		  (return-from SKIP))
-		(victims victim)))
+	    (do ((i loc (1+ i))
+		 (end (+ loc (sc-element-size sc))))
+		((= i end))
+	      (declare (type index i end))
+	      (let ((victim (svref (finite-sb-live-tns sb) i)))
+		(when victim
+		  (unless (find-in #'tn-next victim normal-tns)
+		    (return-from SKIP))
+		  (victims victim))))
 	    
 	    (let ((conf (load-tn-conflicts-in-sc op sc loc t)))
 	      (cond ((not conf)
@@ -1390,6 +1275,159 @@
   (undefined-value))
 
 
+;;;; Location-selection, targeting & pack interface.
+
+(declaim (start-block pack pack-tn target-if-desirable))
+
+
+;;;; Targeting:
+
+;;; Target-If-Desirable  --  Internal
+;;;
+;;;    Link the TN-Refs Read and Write together using the TN-Ref-Target when
+;;; this seems like a good idea.  Currently we always do, as this increases the
+;;; sucess of load-TN targeting.
+;;;
+(defun target-if-desirable (read write)
+  (declare (type tn-ref read write))
+  (setf (tn-ref-target read) write)
+  (setf (tn-ref-target write) read))
+
+
+;;; Check-OK-Target  --  Internal
+;;;
+;;;    If TN can be packed into SC so as to honor a preference to Target, then
+;;; return the offset to pack at, otherwise return NIL.  Target must be already
+;;; packed.  We can honor a preference if:
+;;; -- Target's location is in SC's locations.
+;;; -- The element sizes of the two SCs are the same.
+;;; -- TN doesn't conflict with target's location.
+;;; 
+(defun check-ok-target (target tn sc)
+  (declare (type tn target tn) (type sc sc) (inline member))
+  (let* ((loc (tn-offset target))
+	 (target-sc (tn-sc target))
+	 (target-sb (sc-sb target-sc)))
+    (declare (type index loc))
+    (if (and (eq target-sb (sc-sb sc))
+	     (or (eq (sb-kind target-sb) :unbounded)
+		 (member loc (sc-locations sc)))
+	     (= (sc-element-size target-sc) (sc-element-size sc))
+	     (not (conflicts-in-sc tn sc loc))
+	     (zerop (mod loc (sc-alignment sc))))
+	loc
+	nil)))
+
+
+;;; Find-OK-Target-Offset  --  Internal
+;;;
+;;;    Scan along the target path from TN, looking at readers or writers.  When
+;;; we find a packed TN, return Check-OK-Target of that TN.  If there is no
+;;; target, or if the TN has multiple readers (writers), then we return NIL.
+;;; We also always return NIL after 10 iterations to get around potential
+;;; circularity problems.
+;;;
+(macrolet ((frob (slot)
+	     `(let ((count 10)
+		    (current tn))
+		(declare (type index count))
+		(loop
+		  (let ((refs (,slot current)))
+		    (unless (and (plusp count) refs (not (tn-ref-next refs)))
+		      (return nil))
+		    (let ((target (tn-ref-target refs)))
+		      (unless target (return nil))
+		      (setq current (tn-ref-tn target))
+		      (when (tn-offset current)
+			(return (check-ok-target current tn sc)))
+		      (decf count)))))))
+  (defun find-ok-target-offset (tn sc)
+    (declare (type tn tn) (type sc sc))
+    (or (frob tn-reads)
+	(frob tn-writes))))
+
+
+;;;; Location selection:
+
+;;; Select-Location  --  Internal
+;;;
+;;;    Select some location for TN in SC, returning the offset if we succeed,
+;;; and NIL if we fail.  We start scanning at the Last-Offset in an attempt
+;;; to distribute the TNs across all storage.
+;;;
+;;; We call Offset-Conflicts-In-SB directly, rather than using Conflicts-In-SC.
+;;; This allows us to more efficient in packing multi-location TNs: we don't
+;;; have to multiply the number of tests by the TN size.  This falls out
+;;; natually, since we have to be aware of TN size anyway so that we don't call
+;;; Conflicts-In-SC on a bogus offset.
+;;;
+;;; We give up on finding a location after our current pointer has wrapped
+;;; twice.  This will result in testing some locations twice in the case that
+;;; we fail, but is simpler than trying to figure out the soonest failure
+;;; point.
+;;;
+;;; We also give up without bothering to wrap if the current size isn't large
+;;; enough to hold a single element of element-size without bothering to wrap.
+;;; If it doesn't fit this iteration, it won't fit next.
+;;; 
+;;; ### Note that we actually try to pack as many consecutive TNs as possible
+;;; in the same location, since we start scanning at the same offset that the
+;;; last TN was successfully packed in.  This is a weakening of the scattering
+;;; hueristic that was put in to prevent restricted VOP temps from hogging all
+;;; of the registers.  This way, all of these temps probably end up in one
+;;; register.
+;;;
+(defun select-location (tn sc &optional use-reserved-locs)
+  (declare (type tn tn) (type sc sc) (inline member))
+  (let* ((sb (sc-sb sc))
+	 (element-size (sc-element-size sc))
+	 (alignment (sc-alignment sc))
+	 (align-mask (1- alignment))
+	 (size (finite-sb-current-size sb))
+	 (start-offset (finite-sb-last-offset sb)))
+    (let ((current-start
+	   (logandc2 (the index (+ start-offset align-mask)) align-mask))
+	  (wrap-p nil))
+      (declare (type index current-start))
+      (loop
+	(when (> (+ current-start element-size) size)
+	  (cond ((or wrap-p (> element-size size))
+		 (return nil))
+		(t
+		 (setq current-start 0)
+		 (setq wrap-p t))))
+
+	(if (or (eq (sb-kind sb) :unbounded)
+		(and (member current-start (sc-locations sc))
+		     (or use-reserved-locs
+			 (not (member current-start
+				      (sc-reserve-locations sc))))))
+	    (dotimes (i element-size
+			(return-from select-location current-start))
+	      (declare (type index i))
+	      (let ((offset (+ current-start i)))
+		(when (offset-conflicts-in-sb tn sb offset)
+		  (setq current-start
+			(logandc2 (the index (+ (the index (1+ offset))
+						align-mask))
+				  align-mask))
+		  (return))))
+	    (incf current-start alignment))))))
+
+
+;;; Original-TN  --  Internal
+;;;
+;;;    If a save TN, return the saved TN, otherwise return TN.  Useful for
+;;; getting the conflicts of a TN that might be a save TN.
+;;;
+(defun original-tn (tn)
+  (declare (type tn tn))
+  (if (member (tn-kind tn) '(:save :save-once :specified-save))
+      (tn-save-tn tn)
+      tn))
+
+;;;; Pack interface:
+
 ;;; Pack-TN  --  Internal
 ;;;
 ;;;    Attempt to pack TN in all possible SCs, first in the SC chosen by