improved/speeded up using new ecvt

This commit is contained in:
ceriel 1988-08-10 11:12:57 +00:00
parent a1032b168c
commit 03610bb643

View file

@ -11,7 +11,6 @@ IMPLEMENTATION MODULE RealConversions;
Version: $Header$ Version: $Header$
*) *)
FROM EM IMPORT FIF;
PROCEDURE RealToString(arg: REAL; PROCEDURE RealToString(arg: REAL;
width, digits: INTEGER; width, digits: INTEGER;
@ -21,6 +20,15 @@ IMPLEMENTATION MODULE RealConversions;
LongRealToString(LONG(arg), width, digits, str, ok); LongRealToString(LONG(arg), width, digits, str, ok);
END RealToString; END RealToString;
TYPE
Powers = RECORD
pval: LONGREAL;
rpval: LONGREAL;
exp: INTEGER
END;
VAR Powers10: ARRAY[1..6] OF Powers;
PROCEDURE LongRealToString(arg: LONGREAL; PROCEDURE LongRealToString(arg: LONGREAL;
width, digits: INTEGER; width, digits: INTEGER;
VAR str: ARRAY OF CHAR; VAR str: ARRAY OF CHAR;
@ -28,12 +36,10 @@ IMPLEMENTATION MODULE RealConversions;
VAR pointpos: INTEGER; VAR pointpos: INTEGER;
i: CARDINAL; i: CARDINAL;
ecvtflag: BOOLEAN; ecvtflag: BOOLEAN;
r, intpart, fractpart: LONGREAL; r: LONGREAL;
ind1, ind2 : CARDINAL; ind1, ind2 : CARDINAL;
sign: BOOLEAN; sign: BOOLEAN;
tmp : CHAR;
ndigits: CARDINAL; ndigits: CARDINAL;
dummy, dig: LONGREAL;
BEGIN BEGIN
r := arg; r := arg;
@ -50,62 +56,37 @@ IMPLEMENTATION MODULE RealConversions;
pointpos := 0; pointpos := 0;
sign := r < 0.0D; sign := r < 0.0D;
IF sign THEN r := -r END; IF sign THEN r := -r END;
r := FIF(r, 1.0D, intpart); IF r # 0.0D THEN
fractpart := r; IF r >= 10.0D THEN
pointpos := 0; FOR i := 1 TO 6 DO
WITH Powers10[i] DO
WHILE r >= pval DO
r := r * rpval;
INC(pointpos, exp)
END;
END;
END;
END;
IF r < 1.0D THEN
FOR i := 1 TO 6 DO
WITH Powers10[i] DO
WHILE r*pval < 10.0D DO
r := r * pval;
DEC(pointpos, exp)
END;
END;
END;
END;
(* Now, we have r in [1.0, 10.0) *)
INC(pointpos);
END;
ind1 := 0; ind1 := 0;
ok := TRUE; ok := TRUE;
(* ind2 := ndigits+1;
Do integer part, which is now in "intpart". "r" now contains the
fraction part.
*)
IF intpart # 0.0D THEN
ind2 := 0;
WHILE intpart # 0.0D DO
IF ind2 > HIGH(str) THEN
IF NOT ecvtflag THEN
str[0] := 0C;
ok := FALSE;
RETURN;
END;
FOR ind1 := 1 TO HIGH(str) DO
str[ind1-1] := str[ind1];
END;
DEC(ind2);
END;
dummy := FIF(FIF(intpart, 0.1D, intpart),10.0D, dig);
IF (dummy > 0.5D) AND (dig < 9.0D) THEN
dig := dig + 1.0D;
END;
str[ind2] := CHR(TRUNC(dig+0.5D) + ORD('0'));
INC(ind2);
INC(pointpos);
END;
i := 0;
ind1 := ind2;
WHILE ind2 > i DO
DEC(ind2);
tmp := str[i];
str[i] := str[ind2];
str[ind2] := tmp;
INC(i);
END;
ELSE
INC(pointpos);
IF r > 0.0D THEN
WHILE r < 1.0D DO
fractpart := r;
r := r * 10.0D;
DEC(pointpos);
END;
END;
END;
ind2 := ndigits;
IF NOT ecvtflag THEN IF NOT ecvtflag THEN
IF INTEGER(ind2) + pointpos < 0 THEN IF INTEGER(ind2) + pointpos < 0 THEN
ind2 := ndigits; ind2 := 0;
FOR i := 0 TO ndigits DO str[i] := '0'; END;
ind1 := ndigits+1;
ELSE ELSE
ind2 := INTEGER(ind2) + pointpos ind2 := INTEGER(ind2) + pointpos
END; END;
@ -115,11 +96,13 @@ IMPLEMENTATION MODULE RealConversions;
str[0] := 0C; str[0] := 0C;
RETURN; RETURN;
END; END;
WHILE ind1 <= ind2 DO WHILE ind1 < ind2 DO
fractpart := FIF(fractpart, 10.0D, r);
str[ind1] := CHR(TRUNC(r)+ORD('0')); str[ind1] := CHR(TRUNC(r)+ORD('0'));
r := 10.0D * (r - FLOATD(TRUNC(r)));
INC(ind1); INC(ind1);
END; END;
IF ind2 > 0 THEN
DEC(ind2);
ind1 := ind2; ind1 := ind2;
str[ind2] := CHR(ORD(str[ind2])+5); str[ind2] := CHR(ORD(str[ind2])+5);
WHILE str[ind2] > '9' DO WHILE str[ind2] > '9' DO
@ -136,6 +119,7 @@ IMPLEMENTATION MODULE RealConversions;
END; END;
END; END;
END; END;
END;
IF ecvtflag THEN IF ecvtflag THEN
FOR i := ind1 TO 2 BY -1 DO FOR i := ind1 TO 2 BY -1 DO
str[i] := str[i-1]; str[i] := str[i-1];
@ -329,4 +313,11 @@ IMPLEMENTATION MODULE RealConversions;
IF (iB <= HIGH(str)) AND (ORD(ch) > ORD(' ')) THEN ok := FALSE; END IF (iB <= HIGH(str)) AND (ORD(ch) > ORD(' ')) THEN ok := FALSE; END
END StringToLongReal; END StringToLongReal;
BEGIN
WITH Powers10[1] DO pval := 1.0D32; rpval := 1.0D-32; exp := 32 END;
WITH Powers10[2] DO pval := 1.0D16; rpval := 1.0D-16; exp := 16 END;
WITH Powers10[3] DO pval := 1.0D8; rpval := 1.0D-8; exp := 8 END;
WITH Powers10[4] DO pval := 1.0D4; rpval := 1.0D-4; exp := 4 END;
WITH Powers10[5] DO pval := 1.0D2; rpval := 1.0D-2; exp := 2 END;
WITH Powers10[6] DO pval := 1.0D1; rpval := 1.0D-1; exp := 1 END;
END RealConversions. END RealConversions.