diff --git a/compiler/pack.lisp b/compiler/pack.lisp
index 6e62738626d6b6d4e24cff80a2d4a4de27e08c70..7e0d8e47c3aa3e6a9f1fe970a29fccc3d367ab73 100644
--- a/compiler/pack.lisp
+++ b/compiler/pack.lisp
@@ -523,7 +523,9 @@
   (declare (type tn tn) (type (or vop null) before) (type vop context))
   (let ((writes (tn-writes tn))
 	(save (tn-save-tn tn)))
-    (assert save)
+    (when (eq (tn-kind save) :specified-save)
+      (setf (tn-kind save) :save))
+    (assert (eq (tn-kind save) :save))
     (cond
      ((eq (tn-kind save) :save-once))
      ((and writes (null (tn-ref-next writes)))
@@ -535,6 +537,7 @@
       (emit-operand-load (vop-node context) (vop-block context)
 			 tn save before)))))
 
+
 ;;; RESTORE-TN  --  Internal
 ;;;
 ;;;    Load the TN from its save location, allocating one if necessary.  The
@@ -1150,18 +1153,30 @@
 ;;; don't attempt to pack in SCs that must be saved.  If Restricted, then we
 ;;; can only pack in TN-SC, not in any Alternate-SCs.
 ;;;
-;;;    If we can't pack in the initial SC, and the TN has a :SPECIFIED-SAVE TN,
-;;; then instead of using the latnerate SCs, pack the save TN (if necessary)
-;;; and then pack this TN in the same location.
+;;;    If we are attempting to pack in the SC of the save TN for a TN with a
+;;; :SPECIFIED-SAVE TN, then we pack in that location, instead of allocating a
+;;; new stack location.
 ;;;
 (defun pack-tn (tn restricted)
   (declare (type tn tn))
   (let* ((original (original-tn tn))
 	 (fsc (tn-sc tn))
-	 (alternates (unless restricted (sc-alternate-scs fsc))))
+	 (alternates (unless restricted (sc-alternate-scs fsc)))
+	 (save (tn-save-tn tn))
+	 (specified-save-sc
+	  (when (and save
+		     (eq (tn-kind save) :specified-save))
+	    (tn-sc save))))
+
     (do ((sc fsc (pop alternates)))
 	((null sc)
 	 (failed-to-pack-error tn restricted))
+      (when (eq sc specified-save-sc)
+	(unless (tn-offset save)
+	  (pack-tn save nil))
+	(setf (tn-offset tn) (tn-offset save))
+	(setf (tn-sc tn) (tn-sc save))
+	(return))
       (when (or restricted
 		(not (and (minusp (tn-cost tn)) (sc-save-p sc))))
 	(let ((loc (or (find-ok-target-offset original sc)
@@ -1174,15 +1189,7 @@
 	    (add-location-conflicts original sc loc)
 	    (setf (tn-sc tn) sc)
 	    (setf (tn-offset tn) loc)
-	    (return))
-	  (let ((save (tn-save-tn tn)))
-	    (when (and save
-		       (eq (tn-kind save) :specified-save))
-	      (unless (tn-offset save)
-		(pack-tn save nil))
-	      (setf (tn-offset tn) (tn-offset save))
-	      (setf (tn-sc tn) (tn-sc save))
-	      (return)))))))
+	    (return))))))
 	    
   (undefined-value))