From 685137ca7db8493acea6015213c6ee997e6eff23 Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Fri, 19 Jun 1998 15:09:22 +0000
Subject: [PATCH] Fix the argument passing to the '/ format directive function;
 problem noticed by Sam Steingold.

---
 code/format.lisp | 41 ++++++++++++++++++++++-------------------
 1 file changed, 22 insertions(+), 19 deletions(-)

diff --git a/code/format.lisp b/code/format.lisp
index 1673ddca5..a15b6e984 100644
--- a/code/format.lisp
+++ b/code/format.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/format.lisp,v 1.38 1998/06/18 07:09:47 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.39 1998/06/19 15:09:22 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2351,28 +2351,31 @@
 (def-format-directive #\/ (string start end colonp atsignp params)
   (let ((symbol (extract-user-function-name string start end)))
     (collect ((param-names) (bindings))
-      (dolist (param params)
-	(let ((param-name (gensym)))
-	  (param-names param-name)
-	  (bindings `(,param-name
-		      ,(case param
-			 (:arg (expand-next-arg))
-			 (:remaining '(length args))
-			 (t param))))))
-	     `(let ,(bindings)
-		(,symbol stream ,(expand-next-arg) ,colonp ,atsignp
-			 ,@(param-names))))))
+      (dolist (param-and-offset params)
+	(let ((offset (car param-and-offset))
+	      (param (cdr param-and-offset)))
+	  (let ((param-name (gensym)))
+	    (param-names param-name)
+	    (bindings `(,param-name
+			,(case param
+			   (:arg (expand-next-arg))
+			   (:remaining '(length args))
+			   (t param)))))))
+      `(let ,(bindings)
+	 (,symbol stream ,(expand-next-arg) ,colonp ,atsignp
+		  ,@(param-names))))))
 
 (def-format-interpreter #\/ (string start end colonp atsignp params)
   (let ((symbol (extract-user-function-name string start end)))
     (collect ((args))
-      (dolist (param params)
-	(case param
-	  (:arg (args (next-arg)))
-	  (:remaining (args (length args)))
-	  (t (args param))))
-      (apply (fdefinition symbol) stream (next-arg)
-	     colonp atsignp (args)))))
+      (dolist (param-and-offset params)
+	(let ((offset (car param-and-offset))
+	      (param (cdr param-and-offset)))
+	  (case param
+	    (:arg (args (next-arg)))
+	    (:remaining (args (length args)))
+	    (t (args param)))))
+      (apply (fdefinition symbol) stream (next-arg) colonp atsignp (args)))))
 
 (defun extract-user-function-name (string start end)
   (let ((slash (position #\/ string :start start :end (1- end)
-- 
GitLab