+	  (or (null k) (zerop k))

+     (format-fixed-ryu stream number w d (or k 0) ovf pad atsign))

+    (write-string (lisp::format-g number w d e (or k 1) ovf pad marker atsign)

+  ;; Dispatch to either the Burger and Dybvig implementation or the

+  ;; Ryu-based implementation.  The Ryu code only handles single- and

+  ;; double-float values, so any other float type (notably

+  ;; DOUBLE-DOUBLE-FLOAT) always falls through to the B&D path.

+  (cond

+    ((and *use-ryu-printer*

+	  (typep x '(or single-float double-float)))

+     (output-float-ryu x stream e-min e-max))

+    (t

+     (output-float-aux-bd x stream e-min e-max))))

+

+(defun output-float-ryu (x stream e-min e-max)

+  "Ryu-based implementation of free-format float printing.  Uses

+  FLOAT-TO-STRING (D2S/F2S) to obtain the shortest round-tripping digit

+  string, then dispatches on the exponent to either free or exponential

+  notation, matching the layout produced by OUTPUT-FLOAT-AUX-BD."

+  (multiple-value-bind (mantissa actual-exp)

+      (parsed-exp-form (float-to-string x))

+    ;; MANTISSA is "d.ddd"; strip the decimal point so STRING is just

+    ;; the digit run, matching the second value of FLONUM-TO-DIGITS.

+    ;; The B&D convention is that the value equals 0.STRING * 10^E,

+    ;; so E = ACTUAL-EXP + 1 (mantissa "d.ddd" has the point one

+    ;; position right of the implicit "0.").

+    (let* ((dot-pos (position #\. mantissa))

+	   (string (if dot-pos

+		       (concatenate 'string

+				    (subseq mantissa 0 dot-pos)

+				    (subseq mantissa (1+ dot-pos)))

+		       mantissa))

+	   (e (1+ actual-exp)))

+      (cond

+	((< e-min e e-max)

+	 ;; free format

+	 (cond ((plusp e)

+		(write-string string stream :end (min (length string) e))

+		(dotimes (i (- e (length string)))

+		  (write-char #\0 stream))

+		(write-char #\. stream)

+		(write-string string stream :start (min (length string) e))

+		(when (<= (length string) e)

+		  (write-char #\0 stream))

+		(print-float-exponent x 0 stream))

+	       (t

+		(write-string "0." stream)

+		(dotimes (i (- e))

+		  (write-char #\0 stream))

+		(write-string string stream)

+		(print-float-exponent x 0 stream))))

+	(t

+	 ;; Exponential format

+	 (write-string string stream :end 1)

+	 (write-char #\. stream)

+	 (write-string string stream :start 1)

+	 ;; CLHS 22.1.3.1.3 says at least one digit must be printed

+	 ;; after the decimal point.

+	 (when (= (length string) 1)

+	   (write-char #\0 stream))

+	 (print-float-exponent x (1- e) stream))))))

+

+(defun output-float-aux-bd (x stream e-min e-max)

+  "Burger and Dybvig based implementation of free-format float printing."

+    "target:code/print"

+(comf "target:code/print")

+;;; ----------------------------------------------------------------------

+;;; Tests that the float printer used by PRIN1/PRINC/PRINT/WRITE

+;;; (i.e. OUTPUT-FLOAT-AUX) dispatches through Ryu when

+;;; *use-ryu-printer* is set.  Both code paths should produce

+;;; round-trippable strings.  We don't assert character equality

+;;; between the two paths because the shortest round-tripping digit

+;;; sequence is allowed to differ in rounding of the tie case; we do

+;;; assert each path round-trips.

+

+(define-test output-float.dispatch.round-trip

+  (:tag :output-float :dispatch)

+  (let ((values '(3.14d0

+		  -3.14d0

+		  0.1d0

+		  1.0d100

+		  1.0d-100

+		  1.0d0

+		  3.14f0

+		  -3.14f0

+		  0.1f0)))

+    (dolist (v values)

+      (let ((with-ryu

+	      (let ((lisp::*use-ryu-printer* t))

+		(prin1-to-string v)))

+	    (without-ryu

+	      (let ((lisp::*use-ryu-printer* nil))

+		(prin1-to-string v))))

+	(assert-equal v (read-from-string with-ryu) v with-ryu)

+	(assert-equal v (read-from-string without-ryu) v without-ryu)))))

+

+(define-test output-float.dispatch.princ-matches-prin1

+  (:tag :output-float :dispatch)

+  ;; For floats, PRIN1 and PRINC produce the same string (floats don't

+  ;; have escape characters).  This should hold under both code paths.

+  (let ((lisp::*use-ryu-printer* t))

+    (assert-equal (prin1-to-string 3.14d0)

+                  (princ-to-string 3.14d0))

+    (assert-equal (prin1-to-string 3.14f0)

+                  (princ-to-string 3.14f0))))

+

+(define-test output-float.dispatch.zero

+  (:tag :output-float :dispatch)

+  ;; Zero is handled by OUTPUT-FLOAT itself (not OUTPUT-FLOAT-AUX), so

+  ;; the dispatch is never reached.  Still, make sure both settings

+  ;; produce identical output.

+  (let ((with-ryu

+	  (let ((lisp::*use-ryu-printer* t))

+	    (prin1-to-string 0.0d0)))

+	(without-ryu

+	  (let ((lisp::*use-ryu-printer* nil))

+	    (prin1-to-string 0.0d0))))

+    (assert-equal without-ryu with-ryu)))

+

+(define-test output-float.dispatch.special-values

+  (:tag :output-float :dispatch)

+  ;; Infinity and NaN are handled in OUTPUT-FLOAT itself, before the

+  ;; OUTPUT-FLOAT-AUX dispatch, so the Ryu path is not exercised.

+  ;; Verify no error.

+  (let ((lisp::*use-ryu-printer* t))

+    (assert-true (stringp (prin1-to-string

+                            ext:double-float-positive-infinity)))))

+

+(define-test output-float.dispatch.double-double

+  (:tag :output-float :dispatch)

+  ;; DOUBLE-DOUBLE-FLOAT is handled in OUTPUT-FLOAT itself when the

+  ;; feature is enabled (currently behind #+(and nil double-double),

+  ;; i.e. inactive), so it actually reaches OUTPUT-FLOAT-AUX.  Confirm

+  ;; the type-guard in the dispatch wrapper sends it to the B&D path.

+  #+double-double

+  (let ((lisp::*use-ryu-printer* t))

+    (assert-true (stringp (prin1-to-string 1w0)))))

+