Changeset 5399

Timestamp:

Oct 22, 2006, 7:02:25 AM (18 years ago)

Author:

Gary Byers

Message:

MULTIPLE-VALUE-PROG1: treat the first form like a PROGN if there are no other
forms.

File:

• trunk/ccl/compiler/PPC/ppc2.lisp (modified) (1 diff)

trunk/ccl/compiler/PPC/ppc2.lisp

@@ -6695 +6695 @@
   (if (or (not (ppc2-mv-p xfer)) (ppc2-single-valued-form-p (%car forms)))
     (ppc2-use-operator (%nx1-operator prog1) seg vreg xfer forms)
-    (progn
-      (let* ((*ppc2-vstack* *ppc2-vstack*)
-             (*ppc2-top-vstack-lcell* *ppc2-top-vstack-lcell*))
-        (ppc2-multiple-value-body seg (%car forms))
-        (ppc2-open-undo $undostkblk)
-        (! save-values))
-      (dolist (form (cdr forms))
-        (ppc2-form seg nil nil form))
-      (ppc2-set-nargs seg 0)
-      (! recover-values)
-      (ppc2-close-undo)
-      (let* ((*ppc2-returning-values* t))
-        (^)))))
+    (if (null (cdr forms))
+      (ppc2-form seg vreg xfer(car forms))
+      (progn
+        (let* ((*ppc2-vstack* *ppc2-vstack*)
+               (*ppc2-top-vstack-lcell* *ppc2-top-vstack-lcell*))
+          (ppc2-multiple-value-body seg (%car forms))
+          (ppc2-open-undo $undostkblk)
+          (! save-values))
+        (dolist (form (cdr forms))
+          (ppc2-form seg nil nil form))
+        (ppc2-set-nargs seg 0)
+        (! recover-values)
+        (ppc2-close-undo)
+        (let* ((*ppc2-returning-values* t))
+          (^))))))
 
 (defppc2 ppc2-not not (seg vreg xfer cc form)