base_format.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-- base_format.sa: Formatting a string a la printf
-- Author: Benedict A. Gomes <gomes@icsi.berkeley.edu>
-- Author: Holger Klawitter <holger@icsi.berkeley.edu>
-- Copyright (C) 1996, International Computer Science Institute
-- $Id: base_format.sa,v 1.7 1996/06/04 18:53:15 holger Exp $
-- For documentation see:
-- format.sa and
-- http://www.icsi.berkeley.edu/~holger/Sather/format.html
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- LICENSE contained in the file: Sather/Doc/License of the
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.
abstract class $FLT > FLT, FLTD
abstract class $FLT > FLT, FLTD
-- Classes formattable with the floating point algorithm.
-- FMT_NUMBERS typecases on them.
is
flt: FLT;
end; -- abstract class $FLT
class BASE_FORMAT
class BASE_FORMAT
-- Formats for the Basic types
is
include FMT_NUMBERS;
fmt_flt( f: $FLT, fmt: STR ): STR
-- Formatter for FLT and FLTD.
is
width,prec,exp,anchor,flags,last: INT;
dotch: CHAR;
case fmt_parse
( fmt, false, out width, out prec, out exp, out anchor,
out dotch, out flags, out last )
when parse_success then
-- ok
when parse_syntax_error then
raise #FMT_ERROR( "Unable to analyse format string '"
+ fmt.tail(fmt.length-last) +"'." );
when parse_illegal_anchor then
raise #FMT_ERROR( "Illegal anchor in '"+fmt+"'." );
when parse_dot_and_anchor then
raise #FMT_ERROR( "Decimal char and `^' cannot be used together." );
else
raise #FMT_ERROR( "Panic! Unknown error in '"+fmt+"'." );
end;
if flags.band(use_exponent)=0 then
if flags.band(use_width)=0 then
return flt_free( f, dotch, flags.band(force_sign)/=0 );
else
return flt_fixed
( f, width, prec, dotch,
flags.band(use_width)/=0,
flags.band(force_sign)/=0,
flags.band(use_precision)/=0 );
end
else
if flags.band(use_width)=0 then
return flt_free_exp
( f, dotch, flags.band(force_sign)/=0,
flags.band(force_exp_sign)/=0, exp );
else
return flt_fixed_exp
( f, width, prec,
flags.band(force_sign)/=0,
flags.band(use_precision)/=0, dotch,
flags.band(force_exp_sign)/=0,
exp );
end
end;
end; -- fmt_flt
fmt_int( i: INT, fmt: STR ): STR
-- Formatter for INT.
is
width,prec,exp,anchor,flags,last,base: INT;
dotch: CHAR;
base := 10;
if fmt.length>=3 then
case fmt.substring(0,3)
when "hex" then
base := 16;
fmt := fmt.substring(3);
when "bin" then
base := 2;
fmt := fmt.substring(3);
when "oct" then
base := 8;
fmt := fmt.substring(3);
else
end
end;
case fmt_parse
( fmt, true, out width, out prec, out exp, out anchor,
out dotch, out flags, out last )
when parse_success then
-- ok
when parse_syntax_error then
raise #FMT_ERROR( "Unable to analyse format string '"
+ fmt.tail(fmt.length-last) +"'." );
when parse_illegal_anchor then
raise #FMT_ERROR( "Duplicate anchor in '"+fmt+"'." );
when parse_dot_and_anchor then
raise #FMT_ERROR( "Decimal char and `^' cannot be used together." );
else
raise #FMT_ERROR( "Panic! Unknown error in '"+fmt+"'." );
end;
if flags.band(use_exponent)/=0 then
raise #FMT_ERROR( "Exponential integers are not supported yet." );
end;
if flags.band(use_precision)/=0 then
-- => flags.band(use_anchor)=0 !
return int_precision( i, width, prec, base,
flags.band(force_sign)/=0 );
else
return int_normal( i, width, anchor, base,
flags.band(force_sign)/=0,
flags.band(use_anchor)/=0 );
end;
end; -- fmt_int
fmt_char( c: CHAR, fmt: STR ): STR
-- Formatter for CHAR.
is
return fmt_str(c.str,fmt)
end;
fmt_bool( b: BOOL, fmt: STR ): STR
-- Formatter for BOOL.
is
return fmt_str(b.str,fmt)
end; -- fmt_bool
fmt_str( s: STR, fmt: STR ): STR
-- Formatter for STR.
is
width, anchor, last: INT;
filler: CHAR;
use_anchor: BOOL;
case fmt_parse_easy( fmt, out filler, out width,
out anchor, out use_anchor, out last )
when parse_success then
-- ok
when parse_syntax_error then
raise #FMT_ERROR( "Unable to analyse format string '"
+ fmt.tail(fmt.length-last) +"'." );
when parse_illegal_anchor then
raise #FMT_ERROR( "Illegal anchor in '"+fmt+"'." );
when parse_filler_expected then
raise #FMT_ERROR( "Filler expected in '"+fmt+"'." );
else
raise #FMT_ERROR( "Panic! Unknown error in '"+fmt+"'." );
end;
if ~ use_anchor then anchor := width end;
sl, len: INT;
len := s.length;
if len>width then return s end;
sl := anchor - 1 - len/2;
if sl>0 then
s := s.right(width.min(sl+len),filler)
end;
return s.left(width,filler)
end; -- fmt_str
fmt_cpx(c:CPX,fmt:STR): STR
-- Formatter for CPX.
is
comma: INT;
fmt1: STR;
comma := fmt.search(';');
if comma >= 0 then
fmt1 := fmt.head(comma);
fmt := fmt.substring(comma+1)
else
fmt1 := fmt
end;
if ~ fmt1.is_prefix("polar") then
return c.re.fmt(fmt1) + '+' + c.im.fmt(fmt) + 'i'
else
fmt1 := fmt1.substring(5);
return c.abs.fmt(fmt1) + "*e^" + c.phase.fmt(fmt) + 'i'
end;
end; -- fmt_cpx
fmt_cpxd( c: CPXD, fmt: STR ): STR
-- Formatter for CPXD.
is
comma: INT;
fmt1: STR;
comma := fmt.search(';');
if comma >= 0 then
fmt1 := fmt.head(comma);
fmt := fmt.substring(comma+1)
else
fmt1 := fmt
end;
if ~fmt1.is_prefix("polar") then
return c.re.fmt(fmt1) + '+' + c.im.fmt(fmt) + 'i'
else
fmt1 := fmt1.substring(5);
return c.abs.fmt(fmt1) + "*e^" + c.phase.fmt(fmt) + 'i'
end;
end; -- fmt_cpxd
-- Parsing the format string
-- Possible flag bits:
const use_width: INT := 1; -- There was a hash sign in the width part.
const use_precision: INT := 2; -- There was a dot in the format string.
const use_exponent: INT := 4; -- There was an 'e' in the format string.
const force_sign: INT := 8; -- The format expression started with '+'.
const force_exp_sign: INT := 16; -- Exponent 'e' was followed by a '+'.
const use_anchor: INT := 32; -- There was an anchor in the string.
-- Returnstati of num_parse:
const
parse_success, -- Parse successfully completed.
parse_syntax_error, -- Format string could not be parsed completely.
parse_illegal_anchor, -- Illegal or duplicate anchor.
parse_not_yet, -- Not yet implemented feature requested.
parse_dot_and_anchor, -- Dot and anchor dicovered.
parse_filler_expected; -- there was no filler behind an `F'.
-- Main parser for FLT und INT style number formats:
-- Returns `parse_success' when the parse was completely successful.
private fmt_parse
( s:STR,
allow_anchor: BOOL,
out width: INT, -- Least number of digits for integer part.
out prec: INT, -- Number of digits for fractional part.
out exp_width: INT, -- Least number of digits for exponent.
out anchor: INT, -- Position of anchor in width field.
out dotch: CHAR, -- Character being used as decimal char.
out flags: INT, -- Special bit-flags.
out pos: INT -- Next character position to read (for error msgs).
): INT
is
-- Setting parameters to default values.
width := 0;
prec := 0;
exp_width := 0;
anchor := 0;
dotch := '.';
flags := 0;
pos := 0;
sz ::= s.length;
if sz=0 then return parse_success end;
next ::= s[0];
-- Openig anchor
if next = '^' then
if allow_anchor then
width := 1;
anchor := 1;
flags := flags.bor(use_anchor);
allow_anchor := false
else return parse_illegal_anchor
end;
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
end;
-- Sign
case next
when '-' then
width := width + 1;
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
when '+' then
width := width + 1;
flags := flags.bor(force_sign);
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
else
-- do nothing
end;
-- Width padding
loop
if next = '^' then
if allow_anchor then
width := width + 1;
anchor := width;
flags := flags.bor(use_anchor);
allow_anchor := false
else return parse_illegal_anchor
end;
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
end;
while!( pos<sz and next = '#' );
flags := flags.bor(use_width);
width := width + 1;
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
end;
-- Precision
if next = '.' or next = ',' then
if flags.band(use_anchor)/=0 then return parse_dot_and_anchor end;
dotch := next;
allow_anchor := false;
flags := flags.bor(use_precision);
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
-- Precision padding.
loop
while!( next = '#' );
prec := prec + 1;
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
end;
end;
-- Closing anchor
if next = '^' then
if allow_anchor then
width := width + 1;
anchor := width;
flags := flags.bor(use_anchor);
allow_anchor := false
else return parse_illegal_anchor
end;
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
end;
-- Exponent
if next = 'e' then
flags := flags.bor(use_exponent);
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
-- Exponent sign
if next = '+' then
exp_width := 1;
flags := flags.bor(force_exp_sign);
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
elsif next = '-' then
exp_width := 1;
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
end;
-- Exponent padding
loop
while!( next = '#' );
exp_width := exp_width + 1;
pos:=pos+1;
if pos>=sz then return parse_success end;
next := s[pos];
end;
end;
-- -- Closing padding II
-- if next = '^' then
-- if allow_anchor then
-- width := width + 1;
-- anchor := width;
-- flags := flags.bor(use_anchor);
-- allow_anchor := false
-- else return parse_success
-- end;
-- pos:=pos+1;
-- if pos>=sz then return parse_success end;
-- next := s[pos];
-- end;
return parse_syntax_error;
end; -- fmt_parse
-- Main parser for STR, CHAR and BOOL
-- Disallowing dots and signs.
-- Returns `parse_success' when the parse was completely successful.
fmt_parse_easy(
s: STR,
out filler: CHAR, -- fill character
out width: INT, -- total number of padding chars
out anchor: INT, -- position of anchor
out use_anchor: BOOL, -- false if not existent
out pos: INT -- position at end of parse (for errors)
): INT
is
width := 0;
anchor := 0;
pos := 0;
use_anchor := false;
filler := ' ';
sz: INT := s.length;
if sz = 0 then return parse_success end;
next: CHAR := s[0];
if next = 'F' then
if 1>=sz then return parse_filler_expected end;
filler := s[1];
pos := 2;
if 2>=sz then return parse_success end;
next := s[2];
end;
-- before anchor
loop
until!( next /= '#' );
width := width + 1;
pos := pos + 1;
if pos>=sz then return parse_success end;
next := s[pos];
end;
if next /= '^' then return parse_syntax_error end;
width := width + 1;
use_anchor := true;
anchor := width;
pos := pos + 1;
if pos>=sz then return parse_success end;
next := s[pos];
-- after anchor
loop
until!( next /= '#' );
width := width + 1;
pos := pos + 1;
if pos>=sz then return parse_success end;
next := s[pos];
end;
if next = '^' then return parse_illegal_anchor end;
return parse_syntax_error;
end; -- fmt_parse_easy
end; -- class BASE_FMT
class FMT_NUMBERS
class FMT_NUMBERS
-- Formatting numbers.
is
-- FORMATTING INT:
int_normal( int: INT, width: INT, anchor: INT, base: INT,
force_sign: BOOL, use_anchor: BOOL ): STR
pre base.is_bet(2,16) and width>=0 and anchor>=0
-- Prints an INT reflecting anchor information.
is
res: STR;
l,sl: INT;
if ~ use_anchor then anchor := width; end;
if int>=0 and force_sign then
res := "+"+int.str_in(#FSTR,0,base,' ').str;
else
res := int.str_in(#FSTR,0,base,' ').str;
end;
l := res.length;
if l>=width then return res end; -- already big enough to fit
sl := anchor - 1 - l/2;
if sl>0 then
res := res.right(width.min(sl+l))
end; -- add spaces left
return res.left(width);
end; -- int_normal
int_precision( int: INT, width: INT, prec: INT, base: INT,
force_sign: BOOL ): STR
-- Prints an INT reflecting precision information.
is
if int>0 and force_sign then
-- A little bit of fiddling the `+' to the right place.
return ("+"+int.str_in(#FSTR,0,base,' ').str).right(width)
+ " ".repeat(prec+1);
else
return int.str_in(#FSTR,width,base,' ').str + " ".repeat(prec+1);
end;
end; -- int_precision
-- FORMATTING FLT:
-- Implementation of G. Steele, J. White:
-- How to Print Floating Point Numbers Accurately
-- Proceedings of the ACM SIGPLAN'90 in White Plains, New York
-- Simplifying assumptions:
-- b is 2, B is 10, INTs have 32 bits.
flt_free( f: $FLT, dotch: CHAR, force_sign: BOOL ): STR
-- Prints the number in standard representation as precise as
-- possible. Uses at least width digits for the integer part of
-- the number and prints a '+' sign if force_sign = true and the
-- number positive.
is
init;
s: BOOL;
e,maxexp,p: INT;
m: INTI;
res: STR;
flt_data(f, out s, out e, out m, out maxexp, out p );
if e=maxexp then
if m/=zero then
res := "NaN";
elsif s then
res := "-Inf";
elsif force_sign then
res := "+Inf";
else
res := "Inf";
end;
return res
end;
if force_sign then
res := "+";
elsif s then
res := "-"
else
res := ""
end;
k: INT;
first: BOOL := true;
loop
next ::= dragon4!( e,m,p,co_nrm,0,inout k );
while!( first or (next /= -1 or k>=-1) );
if first and k<0 then
res := res + "0" + dotch + "0".repeat(-k-1);
end;
first := false;
res := res + digit(next);
if k=0 then res := res + dotch end;
end;
if k=-1 then res := res + '0' end;
-- one zero behind the dot.
return res;
end; -- flt_free
flt_fixed( f: $FLT, w: INT, d: INT, dotch: CHAR,
force_zero: BOOL, force_sign: BOOL, use_dot: BOOL ): STR
-- Prints 'f' with 'd' digits precision and uses 'w' digits for
-- the integer part.
-- 'use_dot' => forcing a dot to be printed
-- 'force_sign' => prints a sign even when f is positive
-- 'force_zero' => numbers smaller than 1 get a leading zero.
pre d >= 0 and w >= 0
is
init;
s: BOOL;
e,maxexp,p: INT;
m: INTI;
res: STR;
total: INT := w + d;
if use_dot then total := total + 1 end;
flt_data( f, out s, out e, out m, out maxexp, out p );
if e=maxexp then
if m/=zero then
res := "NaN";
elsif s then
res := "-Inf";
elsif force_sign then
res := "+Inf";
else
res := "Inf";
end;
return res.right(total);
end;
if s then
res := "-"
elsif force_sign then
res := "+"
else
res := ""
end;
k: INT;
first: BOOL := true;
loop
next ::= dragon4!( e,m,p,co_abs,-d,inout k );
if first then
if k<w then
-- There is something to padd or no integer part at all
if k>=0 then
res := res.right(w-k-1);
else
-- no integer part
if w>0 then
if force_zero then
res := (res+'0').right(w)
else
res := res.right(w);
end;
end;
if use_dot then res := res + dotch end;
-- leading fractional zeros.
res := res + "0".repeat( d.min(-k-1) );
end;
end;
first := false;
end; -- if first
while!( k >= -d );
res := res + digit(next);
if k=0 and use_dot then res := res + dotch end
end;
return res;
end; -- flt_fixed
flt_free_exp( f: $FLT, dotch: CHAR, force_sign: BOOL,
force_exp_sign: BOOL, exp_width: INT ): STR
-- Prints `f' in exponential notation until exhaustion of the precision.
-- Uses at least `exp_width' digits for the exponent. Prints a sign
-- always if `force_sign' is true. Prints always a sign for exponent,
-- if `force_exp_sign' is true.
is
expt,k,j: INT;
res: STR;
init;
s: BOOL;
e,maxexp,p: INT;
m: INTI;
flt_data(f, out s, out e, out m, out maxexp, out p );
if e=maxexp then
if m/=zero then
res := "NaN";
elsif s then
res := "-Inf";
elsif force_sign then
res := "+Inf";
else
res := "Inf";
end;
return res
end;
if force_sign then
res := "+";
elsif s then
res := "-"
else
res := ""
end;
first: BOOL := true;
loop
next ::= dragon4!( e,m,p,co_nrm,0,inout k );
if first then
expt := k;
res := res + digit(next) + dotch;
first := false;
else
until!( next < 0 );
res := res + digit(next);
end;
end;
if k=expt-1 then res := res + '0'; end;
return res + make_exp( expt, force_exp_sign, exp_width )
end; -- flt_free_exp
flt_fixed_exp( f: $FLT, w: INT, d: INT, force_sign: BOOL,
use_dot: BOOL, dotch: CHAR,
force_exp_sign: BOOL, exp_width: INT ): STR
-- Combines flt_free_exp and flt_fixed.
is
init;
s: BOOL;
e,maxexp,p: INT;
m: INTI;
res: STR;
total: INT := w + d + exp_width;
if use_dot then total := total + 1; end;
flt_data( f, out s, out e, out m, out maxexp, out p );
if e=maxexp then
if m/=zero then
res := "NaN";
elsif s then
res := "-Inf";
elsif force_sign then
res := "+Inf";
else
res := "Inf";
end;
return res.right(total);
end;
if s then
res := "-"
elsif force_sign then
res := "+"
else
res := ""
end;
k,expt: INT;
first: BOOL := true;
loop
(d+1).times!;
next ::= dragon4!( e, m, p, co_rel, -d, inout k );
if first then
expt := k;
res := res.right(w-1) + digit(next);
if use_dot then res := res + dotch; end;
first := false;
else
res := res + digit(next)
end;
end;
return res + make_exp( expt, force_exp_sign, exp_width );
end; -- flt_fixed_exp
private make_exp( expt: INT, force_exp_sign: BOOL, exp_width: INT ): STR
-- Prints the exponent `expt'.
is
res: STR;
if expt < 0 then
res := "-";
expt := -expt
elsif force_exp_sign then
res := "+";
else
res := "";
end;
digits,x: INT;
digits := 0; -- number of digits in exponent
x := 1; -- 10^edigits
loop
x := x * 10;
digits := digits + 1;
until!( x > expt )
end;
if digits <= exp_width then
res := "e" + res.left(exp_width-digits,'0')
else
res := "e" + res
end;
loop
x := x / 10;
res := res + digit(expt/x);
expt := expt % x;
while!(x>1);
end;
return res;
end; -- make_exp
-- Internal routines and constants
private const co_rel, co_nrm, co_abs;
-- Rounding modes for formatter.
private shared zero,one,two,nine,ten: INTI;
-- Predefined infinite integers.
private const INTsize := INT::asize;
-- Number of bits in an INT.
private init
-- Initalizing shareds only once.
is
if ~void(one) then return end; -- zero might be void, so use one.
zero := #INTI(0);
one := #INTI(1);
two := #INTI(2);
nine := #INTI(9);
ten := #INTI(10);
end; -- init
private lshift( i: INTI, n: INT ): INTI
-- Shift infinte integer 'i' 'n' binary positions to the left.
-- Poor implementation as bitshift operations of INTI are not implemented.
pre n>=0
is
return i * #INTI(n).exp2
end;
private flt_data( f: $FLT, out s: BOOL, out e: INT, out m: INTI,
out maxexp: INT, out p: INT )
-- Gets the data out of the floating point number and does the unbiasing.
is
typecase f
when FLT then
mm: INT;
maxexp := 255;
p := 23;
rep ::= f.get_representation;
e := 0x7f800000.band(rep).rshift(23);
mm := 0x007fffff.band(rep);
s := rep.rshift(31) /= 0;
if e=0 then
-- subnormal
e := e - 126;
elsif e<255 then
-- normal
e := e - 127;
mm := mm.bor( 0x00800000 );
end;
m := #INTI(mm);
assert e>=-126 and (e=255 or e<=127)
when FLTD then
rephi,replo: INT;
maxexp := 2047;
p := 52;
f.get_representation( out rephi, out replo );
e := 0x7ff00000.band(rephi).rshift(20);
s := rephi.rshift(31) /= 0;
mhi ::= 0x000fffff.band(rephi);
if e=0 then
-- subnormal
e := e - 1022;
elsif e/=2047 then
-- normal
e := e - 1023;
mhi := mhi.bor( 0x00100000 );
end;
if replo>=0 then
m := lshift( #INTI(mhi), 32 ) + #INTI( replo );
else
-- Treat negative replo as unsigned.
-- Note that mhi will stay positive.
m := lshift( #INTI(mhi.lshift(1)+1), 31 )
+ #INTI( 0x7fffffff.band(replo) )
end;
assert e>=-1022 and (e<=1023 or e=2047)
end;
end; -- flt_data
private dragon4!(once e: INT,once f: INTI,once p: INT,
once cutoff: INT,once cutplace: INT, inout k: INT): INT
-- Core iterator of the FLT printout algorithms, gets the
-- exponent and the mantissa of the number and emits a stream
-- of digits representing the number to print. The out
-- parameter 'k' specifies the current position of the digit.
pre ~ (cutoff = co_rel) or cutplace <= 0
is
U: INT;
roundup: BOOL := false;
if f = zero then
k := 0;
yield 0
else
R ::= lshift( f, 0.max(e-p) );
S ::= lshift( one, 0.max(-(e-p)) );
Mm ::= lshift( one, 0.max(e-p) );
Mp ::= Mm;
-- FIXUP
if f = lshift( one, p-1 ) then
-- unequal gaps
Mp := Mp * two;
R := R * two;
S := S * two;
end;
k := 0;
loop
while!( R < (S+nine) / ten );
k := k - 1;
R := R * ten;
Mm := Mm * ten;
Mp := Mp * ten;
end;
loop
loop
while!( two * R + Mp >= two * S );
S := S * ten;
k := k + 1;
end;
-- adjustment for formatting requirements
case cutoff
when co_nrm then
cutplace := k;
when co_abs then
cutoffadj( inout Mm, inout Mp, inout roundup, S, k, cutplace );
when co_rel then
cutplace := k + cutplace - 1;
cutoffadj( inout Mm, inout Mp, inout roundup, S, k, cutplace );
else
raise "dragon4 error"
end;
while!( two * R + Mp >= two * S );
end;
-- END FIXUP
low,high: BOOL;
loop
k := k - 1;
U := (( R * ten ) / S).int;
R := ( R * ten ) % S;
Mm := Mm * ten;
Mp := Mp * ten;
low := two * R < Mm;
if roundup then
high := two * R >= ( two * S ) - Mp
else
high := two * R > ( two * S ) - Mp;
end;
while!( ~low and ~high and k /= cutplace );
yield U
end;
if low and ~high then
yield U
elsif high and ~low then
yield U+1
else
if two * R <= S then
yield U;
else
yield U+1;
end
end
end; -- if
loop
k := k - 1;
yield -1;
end;
end; -- dragon4
private cutoffadj( inout Mm: INTI, inout Mp: INTI, inout roundup: BOOL,
S: INTI, k: INT, cutplace: INT )
-- Internal routine to do some calculation reducing rounding errors.
is
a ::= cutplace - k - 1;
y ::= S;
if a >= 0 then
loop j ::= 1.upto!(a); y := y * ten; end;
else
loop j ::= -1.downto!(a); y := (y+nine) / ten; end;
end;
Mm := y.max( Mm );
Mp := y.max( Mp );
if Mp = y then roundup := true end;
end; -- cutoffadj
digit( i: INT ): CHAR
-- Print the digit represented be 'i'. Negative digits are considered
-- as 'insignificant' digits and printed as zeros.
pre i<16
is
if i<0 then return '0' end;
return "0123456789ABCDEF"[i];
end; -- aschar
end; -- class FMT_NUMBERS