Imported Upstream version 9.5.0upstream/9.5.0upstream

1 files changed, 44 insertions, 89 deletions

diff --git a/ipl/procs/printf.icn b/ipl/procs/printf.icn
index b5f99b9..b264692 100644
--- a/ipl/procs/printf.icn
+++ b/ipl/procs/printf.icn
@@ -6,7 +6,7 @@
 #
 #	Author:   William H. Mitchell
 #
-#	Date:     July 20, 2005
+#	Date:     February 13, 2006
 #
 ############################################################################
 #
@@ -14,30 +14,19 @@
 #
 ############################################################################
 #
-#	Contributors:   Cheyenne Wills, Phillip Lee Thomas, Michael Glass
+#	Contributors:   Cheyenne Wills, Phillip Lee Thomas,
+#			Michael Glass, Gregg M. Townsend
 #
 ############################################################################
 #
 #     This procedure behaves somewhat like the standard printf.
 #  Supports d, e, s, o, and x formats like printf.  An "r" format
-#  prints real numbers in a manner similar to that of printf's "f",
-#  but will produce a result in an exponential format if the number
-#  is larger than the largest integer plus one.  Though "e" differs
-#  from printf in some details, it always produces exponential format.
+#  prints real numbers in a manner similar to that of printf's "f".
+#  Though "e" differs from printf in some details, it always produces
+#  exponential format.
 #
-#     Left or right justification and field width control are pro-
-#  vided as in printf.   %s, %r, and %e handle precision specifications.
-#
-#     The %r format is quite a bit of a hack, but it meets the
-#  author's requirements for accuracy and speed.  Code contributions
-#  for %f, %e, and %g formats that work like printf are welcome.
-#
-#     Possible new formats:
-#
-#	   %t -- print a real number as a time in hh:mm
-#	   %R -- roman numerals
-#	   %w -- integers in English
-#	   %b -- binary
+#     Left or right justification and field width control are provided
+#  as in printf.   %s, %r, and %e handle precision specifications.
 #
 ############################################################################
 
@@ -100,86 +89,52 @@ procedure _doprnt(format, args)
 end
 
 procedure hexstr(n)
-   local h, neg
-   static BigNeg, hexdigs, hexfix
-
-	initial {
-		BigNeg := -2147483647-1
-		hexdigs := "0123456789abcdef"
-		hexfix := "89abcdef"
-		}
-
-	n := integer(n)
-	if n = BigNeg then
-		return "80000000"
-	h := ""
-	if n < 0 then {
-		n := -(BigNeg - n)
-		neg := 1
-		}
-	repeat {
-		h := hexdigs[n%16+1]||h
-		if (n /:= 16) = 0 then
-			break
-		}
-	if \neg then {
-		h := right(h,8,"0")
-		h[1] := hexfix[h[1]+1]
-		}
-	return h
+   return _basestr(n, 4)
 end
+
 procedure octstr(n)
-   local h, neg
-   static BigNeg, octdigs, octfix
+   return _basestr(n, 3)
+end
 
-	initial {
-		BigNeg := -2147483647-1
-		octdigs := "01234567"
-		octfix := "23"
-		}
+procedure _basestr(n, b)
+   local s, mask
 
-	n := integer(n)
-	if n = BigNeg then
-		return "20000000000"
-	h := ""
-	if n < 0 then {
-		n := -(BigNeg - n)
-		neg := 1
-		}
-	repeat {
-		h := octdigs[n%8+1]||h
-		if (n /:= 8) = 0 then
-			break
-		}
-	if \neg then {
-		h := right(h,11,"0")
-		h[1] := octfix[h[1]+1]
+	n := integer(n) | return image(n)
+
+	if n = 0 then
+		return "0"
+
+	# backwards compatibility hack
+	# treat 31-bit negative integers as positive values
+	if -16r80000000 <= n <= -1 then
+		n +:= 16r100000000
+
+	s := ""
+	mask := ishift(1, b) - 1
+	while n ~= 0 & n ~= -1 do {
+		s := "0123456789abcdef" [1 + iand(n, mask)] || s
+		n := ishift(n, -b)
 		}
-	return h
+	return s
 end
 
 procedure fixnum(x, prec)
-   local int, frac, f1, f2, p10
+   local s
 
 	/prec := 6
 	x := real(x) | return image(x)
-	int := integer(x) | return image(x)
-	frac := image(x - int)
-	if find("e", frac) then {
-		frac ?:= {
-			f1 := tab(upto('.')) &
-			move(1) &
-			f2 := tab(upto('e')) &
-			move(1) &
-			p10 := -integer(tab(0)) &
-			repl("0",p10-1) || f1 || f2
-			}
-		}
+
+	if x < 0 then {
+	   s := "-"
+	   x := -x
+	   }
 	else
-		frac ?:= (tab(upto('.')) & move(1) & tab(0))
-        frac := adjustfracprec(frac, prec)
-        int +:= if int >= 0 then frac[2] else -frac[2]
-	return int || "." || frac[1]
+	   s := ""
+
+	x := string(integer(x * 10 ^ prec + 0.5))
+	if *x <= prec then
+	   x := right(x, prec + 1, "0")
+	return s || x[1:-prec] || "." || x[-prec:0]
 end
 
 
@@ -302,10 +257,10 @@ procedure adjustfracprec(fracpart, prec)
             carryout := 1
             }
          #  In the usual case, round up simply increments the
-         #     fractional part.  (We put back any trailing
+         #     fractional part.  (We put back any leading
          #     zeros that got lost.) 
          else {
-            fracpart := left(integer(fracpart)+1, prec, "0")
+            fracpart := right(integer(fracpart)+1, prec, "0")
             }
          }
       }