mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 12:12:25 +00:00
414 lines
15 KiB
Modula-2
414 lines
15 KiB
Modula-2
(* $Id: LRealConv.Mod,v 1.7 1999/10/12 07:17:54 ooc-devel Exp $ *)
|
|
MODULE oocLRealConv;
|
|
|
|
(*
|
|
LRealConv - Low-level LONGREAL/string conversions.
|
|
Copyright (C) 1996 Michael Griebling
|
|
|
|
This module is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU Lesser General Public License as
|
|
published by the Free Software Foundation; either version 2 of the
|
|
License, or (at your option) any later version.
|
|
|
|
This module is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU Lesser General Public License for more details.
|
|
|
|
You should have received a copy of the GNU Lesser General Public
|
|
License along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
*)
|
|
|
|
IMPORT
|
|
Char := oocCharClass, Low := oocLowLReal, Str := oocStrings, Conv := oocConvTypes,
|
|
LInt := oocLongInts, SYSTEM;
|
|
|
|
CONST
|
|
ZERO=0.0D0;
|
|
SigFigs*=15; (* accuracy of LONGREALs *)
|
|
|
|
DEBUG = FALSE;
|
|
|
|
TYPE
|
|
ConvResults*= Conv.ConvResults; (* strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
|
|
LongInt=LInt.LongInt;
|
|
|
|
CONST
|
|
strAllRight*=Conv.strAllRight; (* the string format is correct for the corresponding conversion *)
|
|
strOutOfRange*=Conv.strOutOfRange; (* the string is well-formed but the value cannot be represented *)
|
|
strWrongFormat*=Conv.strWrongFormat; (* the string is in the wrong format for the conversion *)
|
|
strEmpty*=Conv.strEmpty; (* the given string is empty *)
|
|
|
|
VAR
|
|
RS, P, F, E, SE, WE, SR: Conv.ScanState;
|
|
|
|
|
|
PROCEDURE IsExponent (ch: CHAR) : BOOLEAN;
|
|
BEGIN
|
|
RETURN (ch="E") OR (ch="D")
|
|
END IsExponent;
|
|
|
|
PROCEDURE IsSign (ch: CHAR): BOOLEAN;
|
|
(* Return TRUE for '+' or '-' *)
|
|
BEGIN
|
|
RETURN (ch='+')OR(ch='-')
|
|
END IsSign;
|
|
|
|
|
|
(* internal state machine procedures *)
|
|
|
|
PROCEDURE RSState(inputCh: CHAR; VAR chClass: Conv.ScanClass; VAR nextState: Conv.ScanState);
|
|
BEGIN
|
|
IF Char.IsNumeric(inputCh) THEN chClass:=Conv.valid; nextState:=P
|
|
ELSE chClass:=Conv.invalid; nextState:=RS
|
|
END
|
|
END RSState;
|
|
|
|
PROCEDURE PState(inputCh: CHAR; VAR chClass: Conv.ScanClass; VAR nextState: Conv.ScanState);
|
|
BEGIN
|
|
IF Char.IsNumeric(inputCh) THEN chClass:=Conv.valid; nextState:=P
|
|
ELSIF inputCh="." THEN chClass:=Conv.valid; nextState:=F
|
|
ELSIF IsExponent(inputCh) THEN chClass:=Conv.valid; nextState:=E
|
|
ELSE chClass:=Conv.terminator; nextState:=NIL
|
|
END
|
|
END PState;
|
|
|
|
PROCEDURE FState(inputCh: CHAR; VAR chClass: Conv.ScanClass; VAR nextState: Conv.ScanState);
|
|
BEGIN
|
|
IF Char.IsNumeric(inputCh) THEN chClass:=Conv.valid; nextState:=F
|
|
ELSIF IsExponent(inputCh) THEN chClass:=Conv.valid; nextState:=E
|
|
ELSE chClass:=Conv.terminator; nextState:=NIL
|
|
END
|
|
END FState;
|
|
|
|
PROCEDURE EState(inputCh: CHAR; VAR chClass: Conv.ScanClass; VAR nextState: Conv.ScanState);
|
|
BEGIN
|
|
IF IsSign(inputCh) THEN chClass:=Conv.valid; nextState:=SE
|
|
ELSIF Char.IsNumeric(inputCh) THEN chClass:=Conv.valid; nextState:=WE
|
|
ELSE chClass:=Conv.invalid; nextState:=E
|
|
END
|
|
END EState;
|
|
|
|
PROCEDURE SEState(inputCh: CHAR; VAR chClass: Conv.ScanClass; VAR nextState: Conv.ScanState);
|
|
BEGIN
|
|
IF Char.IsNumeric(inputCh) THEN chClass:=Conv.valid; nextState:=WE
|
|
ELSE chClass:=Conv.invalid; nextState:=SE
|
|
END
|
|
END SEState;
|
|
|
|
PROCEDURE WEState(inputCh: CHAR; VAR chClass: Conv.ScanClass; VAR nextState: Conv.ScanState);
|
|
BEGIN
|
|
IF Char.IsNumeric(inputCh) THEN chClass:=Conv.valid; nextState:=WE
|
|
ELSE chClass:=Conv.terminator; nextState:=NIL
|
|
END
|
|
END WEState;
|
|
|
|
PROCEDURE Real (VAR x: LongInt; exp, digits: LONGINT; VAR outOfRange: BOOLEAN): LONGREAL;
|
|
CONST BR=LInt.B+ZERO; InvLOGB=0.221461873; (* real version *)
|
|
VAR cnt, len, scale, Bscale, start, bexp, max: LONGINT; r: LONGREAL;
|
|
BEGIN
|
|
(* scale by the exponent *)
|
|
scale:=exp+digits;
|
|
IF scale>=ABS(digits) THEN
|
|
Bscale:=0; LInt.TenPower(x, SHORT(scale))
|
|
ELSE
|
|
Bscale:=ENTIER(-scale*InvLOGB)+6;
|
|
LInt.BPower(x, SHORT(Bscale)); (* x*B^Bscale *)
|
|
LInt.TenPower(x, SHORT(scale)); (* x*B^BScale*10^scale *)
|
|
END;
|
|
|
|
(* prescale to left-justify the number *)
|
|
start:=LInt.MinDigit(x); bexp:=0; (* find starting digit *)
|
|
IF (start=LEN(x)-1)&(x[start]=0) THEN (* exit here for zero *)
|
|
outOfRange:=FALSE; RETURN ZERO
|
|
END;
|
|
WHILE x[start]<LInt.B DIV 2 DO
|
|
LInt.MultDigit(x, 2, 0); INC(bexp) (* normalize *)
|
|
END;
|
|
|
|
(* convert to a LONGREAL *)
|
|
r:=ZERO; len:=LEN(x)-1; max:=start+3;
|
|
IF max>len THEN max:=len END;
|
|
FOR cnt:=start TO max DO r:=r*BR+x[cnt] END;
|
|
|
|
(* post scaling *)
|
|
INC(bexp, (Bscale-len+max)*15);
|
|
|
|
(* quick check for overflow *)
|
|
max:=Low.exponent(r)-SHORT(bexp);
|
|
IF (max>Low.expoMax) OR (max<Low.expoMin) THEN
|
|
outOfRange:=TRUE;
|
|
RETURN ZERO
|
|
ELSE
|
|
outOfRange:=FALSE;
|
|
RETURN Low.scale(r, -SHORT(bexp))
|
|
END
|
|
END Real;
|
|
|
|
PROCEDURE ScanReal*(inputCh: CHAR; VAR chClass: Conv.ScanClass; VAR nextState: Conv.ScanState);
|
|
(*
|
|
Represents the start state of a finite state scanner for real numbers - assigns
|
|
class of inputCh to chClass and a procedure representing the next state to
|
|
nextState.
|
|
|
|
The call of ScanReal(inputCh,chClass,nextState) shall assign values to
|
|
`chClass' and `nextState' depending upon the value of `inputCh' as
|
|
shown in the following table.
|
|
|
|
Procedure inputCh chClass nextState (a procedure
|
|
with behaviour of)
|
|
--------- --------- -------- ---------
|
|
ScanReal space padding ScanReal
|
|
sign valid RSState
|
|
decimal digit valid PState
|
|
other invalid ScanReal
|
|
RSState decimal digit valid PState
|
|
other invalid RSState
|
|
PState decimal digit valid PState
|
|
"." valid FState
|
|
"E", "D" valid EState
|
|
other terminator --
|
|
FState decimal digit valid FState
|
|
"E", "D" valid EState
|
|
other terminator --
|
|
EState sign valid SEState
|
|
decimal digit valid WEState
|
|
other invalid EState
|
|
SEState decimal digit valid WEState
|
|
other invalid SEState
|
|
WEState decimal digit valid WEState
|
|
other terminator --
|
|
|
|
For examples of how to use ScanReal, refer to FormatReal and
|
|
ValueReal below.
|
|
*)
|
|
BEGIN
|
|
IF Char.IsWhiteSpace(inputCh) THEN chClass:=Conv.padding; nextState:=SR
|
|
ELSIF IsSign(inputCh) THEN chClass:=Conv.valid; nextState:=RS
|
|
ELSIF Char.IsNumeric(inputCh) THEN chClass:=Conv.valid; nextState:=P
|
|
ELSE chClass:=Conv.invalid; nextState:=SR
|
|
END
|
|
END ScanReal;
|
|
|
|
PROCEDURE FormatReal*(str: ARRAY OF CHAR): ConvResults;
|
|
(* Returns the format of the string value for conversion to LONGREAL. *)
|
|
VAR
|
|
ch: CHAR;
|
|
rn: LONGREAL;
|
|
len, index, digit, nexp, exp: INTEGER;
|
|
state: Conv.ScanState;
|
|
inExp, posExp, decExp, outOfRange: BOOLEAN;
|
|
prev, class: Conv.ScanClass;
|
|
int: LongInt;
|
|
BEGIN
|
|
state:=SR; rn:=0.0; exp:=0; nexp:= 0;
|
|
class:=Conv.padding; prev:=class;
|
|
inExp:=FALSE; posExp:=TRUE; decExp:=FALSE;
|
|
(*FOR len:=0 TO SHORT(LEN(int))-1 DO int[len]:=0 END;*)
|
|
FOR len:=0 TO (LEN(int))-1 DO int[len]:=0 END; (* I don't understand why to SHORT it. LEN(int) will return 170 (defined in LongInts as ARRAY 170 OF INTEGER) both with voc and oo2c the same way; -- noch *)
|
|
len:=Str.Length(str); index:=0;
|
|
LOOP
|
|
IF index=len THEN EXIT END;
|
|
ch:=str[index];
|
|
state.p(ch, class, state);
|
|
CASE class OF
|
|
| Conv.padding: (* nothing to do *)
|
|
| Conv.valid:
|
|
IF inExp THEN
|
|
IF IsSign(ch) THEN posExp:=ch="+"
|
|
ELSE (* must be digits *)
|
|
digit:=ORD(ch)-ORD("0");
|
|
IF posExp THEN exp:=exp*10+digit
|
|
ELSE exp:=exp*10-digit
|
|
END
|
|
END
|
|
ELSIF IsExponent(ch) THEN inExp:=TRUE
|
|
ELSIF ch="." THEN decExp:=TRUE
|
|
ELSE (* must be a digit *)
|
|
LInt.MultDigit(int, 10, ORD(ch)-ORD("0"));
|
|
IF decExp THEN DEC(nexp) END;
|
|
END
|
|
| Conv.invalid, Conv.terminator: EXIT
|
|
END;
|
|
prev:=class; INC(index)
|
|
END;
|
|
IF class IN {Conv.invalid, Conv.terminator} THEN
|
|
RETURN strWrongFormat
|
|
ELSIF prev=Conv.padding THEN
|
|
RETURN strEmpty
|
|
ELSE
|
|
rn:=Real(int, exp, nexp, outOfRange);
|
|
IF outOfRange THEN RETURN strOutOfRange
|
|
ELSE RETURN strAllRight
|
|
END
|
|
END
|
|
END FormatReal;
|
|
|
|
PROCEDURE ValueReal*(str: ARRAY OF CHAR): LONGREAL;
|
|
VAR
|
|
ch: CHAR;
|
|
rn: LONGREAL;
|
|
len, index, digit, nexp, exp: INTEGER;
|
|
state: Conv.ScanState;
|
|
inExp, positive, posExp, decExp, outOfRange: BOOLEAN;
|
|
prev, class: Conv.ScanClass;
|
|
int: LongInt;
|
|
BEGIN
|
|
state:=SR; rn:=0.0; exp:=0; nexp:= 0;
|
|
class:=Conv.padding; prev:=class;
|
|
positive:=TRUE; inExp:=FALSE; posExp:=TRUE; decExp:=FALSE;
|
|
(*FOR len:=0 TO SHORT(LEN(int))-1 DO int[len]:=0 END;*)
|
|
FOR len:=0 TO (LEN(int))-1 DO int[len]:=0 END; (* I don't understand why to SHORT it; -- noch *)
|
|
len:=Str.Length(str); index:=0;
|
|
LOOP
|
|
IF index=len THEN EXIT END;
|
|
ch:=str[index];
|
|
state.p(ch, class, state);
|
|
CASE class OF
|
|
| Conv.padding: (* nothing to do *)
|
|
| Conv.valid:
|
|
IF inExp THEN
|
|
IF IsSign(ch) THEN posExp:=ch="+"
|
|
ELSE (* must be digits *)
|
|
digit:=ORD(ch)-ORD("0");
|
|
IF posExp THEN exp:=exp*10+digit
|
|
ELSE exp:=exp*10-digit
|
|
END
|
|
END
|
|
ELSIF IsExponent(ch) THEN inExp:=TRUE
|
|
ELSIF IsSign(ch) THEN positive:=ch="+"
|
|
ELSIF ch="." THEN decExp:=TRUE
|
|
ELSE (* must be a digit *)
|
|
LInt.MultDigit(int, 10, ORD(ch)-ORD("0"));
|
|
IF decExp THEN DEC(nexp) END;
|
|
END
|
|
| Conv.invalid, Conv.terminator: EXIT
|
|
END;
|
|
prev:=class; INC(index)
|
|
END;
|
|
IF class IN {Conv.invalid, Conv.terminator} THEN
|
|
RETURN ZERO
|
|
ELSIF prev=Conv.padding THEN
|
|
RETURN ZERO
|
|
ELSE
|
|
rn:=Real(int, exp, nexp, outOfRange);
|
|
IF outOfRange THEN RETURN Low.large END
|
|
END;
|
|
IF ~positive THEN rn:=-rn END;
|
|
RETURN rn
|
|
END ValueReal;
|
|
|
|
PROCEDURE LengthFloatReal*(real: LONGREAL; sigFigs: INTEGER): INTEGER;
|
|
(*
|
|
Returns the number of characters in the floating-point string
|
|
representation of real with sigFigs significant figures.
|
|
This value corresponds to the capacity of an array `str' which
|
|
is of the minimum capacity needed to avoid truncation of the
|
|
result in the call LongStr.RealToFloat(real,sigFigs,str).
|
|
*)
|
|
VAR
|
|
len, exp: INTEGER;
|
|
BEGIN
|
|
IF Low.IsNaN(real) THEN RETURN 3
|
|
ELSIF Low.IsInfinity(real) THEN
|
|
IF real<ZERO THEN RETURN 9 ELSE RETURN 8 END
|
|
END;
|
|
IF sigFigs=0 THEN sigFigs:=SigFigs END; len:=sigFigs; (* default digits -- if none given *)
|
|
IF real<ZERO THEN INC(len); real:=-real END; (* account for the sign *)
|
|
exp:=Low.exponent10(real);
|
|
IF sigFigs>1 THEN INC(len) END; (* account for the decimal point *)
|
|
IF exp>10 THEN INC(len, 4) (* account for the exponent *)
|
|
ELSIF exp#0 THEN INC(len, 3)
|
|
END;
|
|
RETURN len
|
|
END LengthFloatReal;
|
|
|
|
PROCEDURE LengthEngReal*(real: LONGREAL; sigFigs: INTEGER): INTEGER;
|
|
(*
|
|
Returns the number of characters in the floating-point engineering
|
|
string representation of real with sigFigs significant figures.
|
|
This value corresponds to the capacity of an array `str' which is
|
|
of the minimum capacity needed to avoid truncation of the result in
|
|
the call LongStr.RealToEng(real,sigFigs,str).
|
|
*)
|
|
VAR
|
|
len, exp, off: INTEGER;
|
|
BEGIN
|
|
IF Low.IsNaN(real) THEN RETURN 3
|
|
ELSIF Low.IsInfinity(real) THEN
|
|
IF real<ZERO THEN RETURN 9 ELSE RETURN 8 END
|
|
END;
|
|
IF sigFigs=0 THEN sigFigs:=SigFigs END; len:=sigFigs; (* default digits -- if none given *)
|
|
IF real<ZERO THEN INC(len); real:=-real END; (* account for the sign *)
|
|
exp:=Low.exponent10(real); off:=exp MOD 3; (* account for the exponent *)
|
|
IF exp-off>10 THEN INC(len, 4)
|
|
ELSIF exp-off#0 THEN INC(len, 3)
|
|
END;
|
|
IF sigFigs>off+1 THEN INC(len) END; (* account for the decimal point *)
|
|
IF off+1-sigFigs>0 THEN INC(len, off+1-sigFigs) END; (* account for extra padding digits *)
|
|
RETURN len
|
|
END LengthEngReal;
|
|
|
|
PROCEDURE LengthFixedReal*(real: LONGREAL; place: INTEGER): INTEGER;
|
|
(* Returns the number of characters in the fixed-point string
|
|
representation of real rounded to the given place relative
|
|
to the decimal point.
|
|
This value corresponds to the capacity of an array `str' which
|
|
is of the minimum capacity needed to avoid truncation of the
|
|
result in the call LongStr.RealToFixed(real,sigFigs,str).
|
|
*)
|
|
VAR
|
|
len, exp: INTEGER; addDecPt: BOOLEAN;
|
|
BEGIN
|
|
IF Low.IsNaN(real) THEN RETURN 3
|
|
ELSIF Low.IsInfinity(real) THEN
|
|
IF real<ZERO THEN RETURN 9 ELSE RETURN 8 END
|
|
END;
|
|
exp:=Low.exponent10(real); addDecPt:=place>=0;
|
|
IF place<0 THEN INC(place, 2) ELSE INC(place) END;
|
|
IF exp<0 THEN (* account for digits *)
|
|
IF place<=0 THEN len:=1 ELSE len:=place END
|
|
ELSE len:=exp+place;
|
|
IF 1-place>0 THEN INC(len, 1-place) END
|
|
END;
|
|
IF real<ZERO THEN INC(len) END; (* account for the sign *)
|
|
IF addDecPt THEN INC(len) END; (* account for decimal point *)
|
|
RETURN len
|
|
END LengthFixedReal;
|
|
|
|
PROCEDURE IsRConvException*(): BOOLEAN;
|
|
(* Returns TRUE if the current coroutine is in the exceptional execution state because
|
|
of the raising of the RealConv exception; otherwise returns FALSE.
|
|
*)
|
|
BEGIN
|
|
RETURN FALSE
|
|
END IsRConvException;
|
|
|
|
PROCEDURE Test;
|
|
VAR res: INTEGER; f: LONGREAL;
|
|
BEGIN
|
|
f:=ValueReal("-1.8770465240919248E+246");
|
|
f:=ValueReal("5.1059259362558051E-111");
|
|
f:=ValueReal("2.4312432637500083E-88");
|
|
|
|
res:=LengthFixedReal(100, 0);
|
|
res:=LengthEngReal(100, 0);
|
|
res:=LengthFloatReal(100, 0);
|
|
|
|
res:=LengthFixedReal(-100.123, 0);
|
|
res:=LengthEngReal(-100.123, 0);
|
|
res:=LengthFloatReal(-100.123, 0);
|
|
|
|
res:=LengthFixedReal(-1.0D20, 0);
|
|
res:=LengthEngReal(-1.0D20, 0);
|
|
res:=LengthFloatReal(-1.0D20, 0)
|
|
END Test;
|
|
|
|
BEGIN
|
|
NEW(RS); NEW(P); NEW(F); NEW(E); NEW(SE); NEW(WE); NEW(SR);
|
|
RS.p:=RSState; P.p:=PState; F.p:=FState; E.p:=EState;
|
|
SE.p:=SEState; WE.p:=WEState; SR.p:=ScanReal;
|
|
IF DEBUG THEN Test END
|
|
END oocLRealConv.
|