diff --git a/code/macros.lisp b/code/macros.lisp
index e98eb781b460af3a323b886376ce104b9e7ab4f7..28b6827c0990e2e0654d76f80d0f5262130113f2 100644
--- a/code/macros.lisp
+++ b/code/macros.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.72 2002/01/27 18:29:23 moore Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.73 2002/07/25 14:50:24 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -768,27 +768,44 @@
 		   `(progn ,@(setters) nil))))
       (thunk (let*-bindings) (mv-bindings)))))
 
-(defmacro shiftf (&whole form &rest args &environment env)
+(defmacro shiftf (&rest args &environment env)
   "One or more SETF-style place expressions, followed by a single
    value expression.  Evaluates all of the expressions in turn, then
    assigns the value of each expression to the place on its left,
    returning the value of the leftmost."
-  (when (< (length args) 2)
-    (error "~S called with too few arguments: ~S" 'shiftf form))
-  (let ((resultvar (gensym)))
-    (do ((arglist args (cdr arglist))
-         (bindlist nil)
-         (storelist nil)
-         (lastvar resultvar))
-        ((atom (cdr arglist))
-         (push `(,lastvar ,(first arglist)) bindlist)
-         `(LET* ,(nreverse bindlist) ,@(nreverse storelist) ,resultvar))
-      (multiple-value-bind (SM1 SM2 SM3 SM4 SM5)
-          (get-setf-method (first arglist) env)
-        (mapc #'(lambda (var val) (push `(,var ,val) bindlist)) SM1 SM2)
-        (push `(,lastvar ,SM5) bindlist)
-        (push SM4 storelist)
-        (setq lastvar (first SM3))))))
+  (when args
+    (collect ((let*-bindings) (mv-bindings) (setters) (getters))
+      ;; The last arg isn't necessarily a place, so we have to handle
+      ;; that separately.
+      (dolist (arg (butlast args))
+	(multiple-value-bind
+	      (temps subforms store-vars setter getter)
+	    (get-setf-expansion arg env)
+	  (loop
+	      for temp in temps
+	      for subform in subforms
+	      do (let*-bindings `(,temp ,subform)))
+	  (mv-bindings store-vars)
+	  (setters setter)
+	  (getters getter)))
+      ;; Handle the last arg specially here.  Just put something to
+      ;; force the setter so the setter for the previous var gets set,
+      ;; and the getter is just the last arg itself.
+      (setters nil)
+      (getters (car (last args)))
+	
+      (labels ((thunk (mv-bindings getters)
+		 (if mv-bindings
+		     `((multiple-value-bind
+			     ,(car mv-bindings)
+			   ,(car getters)
+			 ,@(thunk (cdr mv-bindings) (cdr getters))))
+		     `(,@(butlast (setters))))))
+	`(let* ,(let*-bindings)
+	  (multiple-value-bind ,(car (mv-bindings))
+	      ,(car (getters))
+	    ,@(thunk (mv-bindings) (cdr (getters)))
+	    (values ,@(car (mv-bindings)))))))))
 
 (defmacro rotatef (&rest args &environment env)
   "Takes any number of SETF-style place expressions.  Evaluates all of the