X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-format.lisp;h=d05cb9883c0e997b4928bc144b0b52a0a48b4fb2;hb=558e7ce44e6a8305474dc55adbdbc1f7119c9a5e;hp=a31bc5166c785438d8c2dbf86a8c83c61fd1813e;hpb=e1d8ec7c0f8cdbc1652a3b66530e7292a2289925;p=sbcl.git

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index a31bc51..d05cb98 100644
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -76,8 +76,11 @@
 	   (multiple-value-bind (new-directives new-args)
 	       (let* ((character (format-directive-character directive))
 		      (function
+                       (typecase character
+                         (base-char 
 		       (svref *format-directive-interpreters*
 			      (char-code character)))
+                         (character nil)))
 		      (*default-format-error-offset*
 		       (1- (format-directive-end directive))))
 		 (unless function
@@ -299,20 +302,21 @@
   (interpret-format-integer 16))
 
 (def-format-interpreter #\R (colonp atsignp params)
-  (if params
-      (interpret-bind-defaults
-	  ((base 10) (mincol 0) (padchar #\space) (commachar #\,)
-	   (commainterval 3))
-	  params
-	(format-print-integer stream (next-arg) colonp atsignp base mincol
-			      padchar commachar commainterval))
-      (if atsignp
-	  (if colonp
-	      (format-print-old-roman stream (next-arg))
-	      (format-print-roman stream (next-arg)))
-	  (if colonp
-	      (format-print-ordinal stream (next-arg))
-	      (format-print-cardinal stream (next-arg))))))
+  (interpret-bind-defaults
+      ((base nil) (mincol 0) (padchar #\space) (commachar #\,)
+       (commainterval 3))
+      params
+    (let ((arg (next-arg)))
+      (if base
+          (format-print-integer stream arg colonp atsignp base mincol
+                                padchar commachar commainterval)
+          (if atsignp
+              (if colonp
+                  (format-print-old-roman stream arg)
+                  (format-print-roman stream arg))
+              (if colonp
+                  (format-print-ordinal stream arg)
+                  (format-print-cardinal stream arg)))))))
 
 (defparameter *cardinal-ones*
   #(nil "one" "two" "three" "four" "five" "six" "seven" "eight" "nine"))
@@ -835,7 +839,7 @@
 		(setf args (nthcdr posn orig-args))
 		(error 'format-error
 		       :complaint "Index ~W is out of bounds. (It should ~
-				   have been between 0 and ~W.)"
+                                   have been between 0 and ~W.)"
 		       :args (list posn (length orig-args))))))
       (if colonp
 	  (interpret-bind-defaults ((n 1)) params
@@ -848,7 +852,7 @@
 		       (error 'format-error
 			      :complaint
 			      "Index ~W is out of bounds. (It should 
-			       have been between 0 and ~W.)"
+                               have been between 0 and ~W.)"
 			      :args
 			      (list new-posn (length orig-args))))))))
 	  (interpret-bind-defaults ((n 1)) params
@@ -970,16 +974,13 @@
   (when (and colonp (not *up-up-and-out-allowed*))
     (error 'format-error
 	   :complaint "attempt to use ~~:^ outside a ~~:{...~~} construct"))
-  (when (case (length params)
-	  (0 (if colonp
-		 (null *outside-args*)
-		 (null args)))
-	  (1 (interpret-bind-defaults ((count 0)) params
-	       (zerop count)))
-	  (2 (interpret-bind-defaults ((arg1 0) (arg2 0)) params
-	       (= arg1 arg2)))
-	  (t (interpret-bind-defaults ((arg1 0) (arg2 0) (arg3 0)) params
-	       (<= arg1 arg2 arg3))))
+  (when (interpret-bind-defaults ((arg1 nil) (arg2 nil) (arg3 nil)) params
+          (cond (arg3 (<= arg1 arg2 arg3))
+                (arg2 (eql arg1 arg2))
+                (arg1 (eql arg1 0))
+                (t (if colonp
+                       (null *outside-args*)
+                       (null args)))))
     (throw (if colonp 'up-up-and-out 'up-and-out)
 	   args)))