mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 14:32:24 +00:00
Norayr Chilingarian
parent
4a7dc4b549
commit
6a1eccd316
119 changed files with 30400 additions and 0 deletions
447
src/lib/ooc2/ooc2Real0.Mod
Normal file
447
src/lib/ooc2/ooc2Real0.Mod
Normal file
|
|
@ -0,0 +1,447 @@
|
|||
(* $Id: Real0.Mod,v 1.3 2002/08/12 18:11:30 mva Exp $ *)
|
||||
MODULE ooc2Real0;
|
||||
(* Helper functions used by the real conversion modules.
|
||||
Copyright (C) 2002 Michael van Acken
|
||||
|
||||
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 OOC. If not, write to the Free Software Foundation,
|
||||
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
*)
|
||||
|
||||
IMPORT
|
||||
CharClass := ooc2CharClass, ConvTypes := ooc2ConvTypes, Strings := ooc2Strings;
|
||||
|
||||
|
||||
TYPE
|
||||
ConvResults = ConvTypes.ConvResults;
|
||||
|
||||
CONST
|
||||
strAllRight=ConvTypes.strAllRight;
|
||||
strOutOfRange=ConvTypes.strOutOfRange;
|
||||
strWrongFormat=ConvTypes.strWrongFormat;
|
||||
strEmpty=ConvTypes.strEmpty;
|
||||
|
||||
CONST
|
||||
padding=ConvTypes.padding;
|
||||
valid=ConvTypes.valid;
|
||||
invalid=ConvTypes.invalid;
|
||||
terminator=ConvTypes.terminator;
|
||||
|
||||
TYPE
|
||||
ScanClass = ConvTypes.ScanClass;
|
||||
ScanState = ConvTypes.ScanState;
|
||||
|
||||
CONST
|
||||
expChar* = "E";
|
||||
|
||||
VAR
|
||||
RS-, P-, F-, E-, SE-, WE-, SR-: ScanState;
|
||||
|
||||
|
||||
(* internal state machine procedures *)
|
||||
|
||||
PROCEDURE IsSign (ch: CHAR): BOOLEAN;
|
||||
(* Return TRUE for '+' or '-' *)
|
||||
BEGIN
|
||||
RETURN (ch='+') OR (ch='-')
|
||||
END IsSign;
|
||||
|
||||
PROCEDURE RSState(inputCh: CHAR;
|
||||
VAR chClass: ScanClass; VAR nextState: ScanState);
|
||||
BEGIN
|
||||
IF CharClass.IsNumeric(inputCh) THEN
|
||||
chClass:=valid; nextState:=P
|
||||
ELSE
|
||||
chClass:=invalid; nextState:=RS
|
||||
END
|
||||
END RSState;
|
||||
|
||||
PROCEDURE PState(inputCh: CHAR;
|
||||
VAR chClass: ScanClass; VAR nextState: ScanState);
|
||||
BEGIN
|
||||
IF CharClass.IsNumeric(inputCh) THEN
|
||||
chClass:=valid; nextState:=P
|
||||
ELSIF inputCh="." THEN
|
||||
chClass:=valid; nextState:=F
|
||||
ELSIF inputCh=expChar THEN
|
||||
chClass:=valid; nextState:=E
|
||||
ELSE
|
||||
chClass:=terminator; nextState:=NIL
|
||||
END
|
||||
END PState;
|
||||
|
||||
PROCEDURE FState(inputCh: CHAR;
|
||||
VAR chClass: ScanClass; VAR nextState: ScanState);
|
||||
BEGIN
|
||||
IF CharClass.IsNumeric(inputCh) THEN
|
||||
chClass:=valid; nextState:=F
|
||||
ELSIF inputCh=expChar THEN
|
||||
chClass:=valid; nextState:=E
|
||||
ELSE
|
||||
chClass:=terminator; nextState:=NIL
|
||||
END
|
||||
END FState;
|
||||
|
||||
PROCEDURE EState(inputCh: CHAR;
|
||||
VAR chClass: ScanClass; VAR nextState: ScanState);
|
||||
BEGIN
|
||||
IF IsSign(inputCh) THEN
|
||||
chClass:=valid; nextState:=SE
|
||||
ELSIF CharClass.IsNumeric(inputCh) THEN
|
||||
chClass:=valid; nextState:=WE
|
||||
ELSE
|
||||
chClass:=invalid; nextState:=E
|
||||
END
|
||||
END EState;
|
||||
|
||||
PROCEDURE SEState(inputCh: CHAR;
|
||||
VAR chClass: ScanClass; VAR nextState: ScanState);
|
||||
BEGIN
|
||||
IF CharClass.IsNumeric(inputCh) THEN
|
||||
chClass:=valid; nextState:=WE
|
||||
ELSE
|
||||
chClass:=invalid; nextState:=SE
|
||||
END
|
||||
END SEState;
|
||||
|
||||
PROCEDURE WEState(inputCh: CHAR;
|
||||
VAR chClass: ScanClass; VAR nextState: ScanState);
|
||||
BEGIN
|
||||
IF CharClass.IsNumeric(inputCh) THEN
|
||||
chClass:=valid; nextState:=WE
|
||||
ELSE
|
||||
chClass:=terminator; nextState:=NIL
|
||||
END
|
||||
END WEState;
|
||||
|
||||
PROCEDURE ScanReal*(inputCh: CHAR;
|
||||
VAR chClass: ScanClass; VAR nextState: ScanState);
|
||||
BEGIN
|
||||
IF CharClass.IsWhiteSpace(inputCh) THEN
|
||||
chClass:=padding; nextState:=SR
|
||||
ELSIF IsSign(inputCh) THEN
|
||||
chClass:=valid; nextState:=RS
|
||||
ELSIF CharClass.IsNumeric(inputCh) THEN
|
||||
chClass:=valid; nextState:=P
|
||||
ELSE
|
||||
chClass:=invalid; nextState:=SR
|
||||
END
|
||||
END ScanReal;
|
||||
|
||||
PROCEDURE FormatReal* (str: ARRAY OF CHAR; maxExp: LONGINT;
|
||||
maxValue: ARRAY OF CHAR): ConvResults;
|
||||
VAR
|
||||
i: LONGINT;
|
||||
ch: CHAR;
|
||||
state: ConvTypes.ScanState;
|
||||
class: ConvTypes.ScanClass;
|
||||
wSigFigs, fLeadingZeros, exp, startOfExp: LONGINT;
|
||||
expNegative, allZeroDigit: BOOLEAN;
|
||||
|
||||
CONST
|
||||
expCutoff = 100000000;
|
||||
(* assume overflow if the value of the exponent is larger than this *)
|
||||
|
||||
PROCEDURE NonZeroDigit (): LONGINT;
|
||||
(* locate first non-zero digit in str *)
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (i # startOfExp) & ((str[i] < "1") OR (str[i] > "9")) DO
|
||||
INC (i);
|
||||
END;
|
||||
RETURN i;
|
||||
END NonZeroDigit;
|
||||
|
||||
PROCEDURE LessOrEqual (upperBound: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR
|
||||
i, j: LONGINT;
|
||||
BEGIN
|
||||
i := NonZeroDigit();
|
||||
IF (i # startOfExp) THEN (* str[i] is non-zero digit *)
|
||||
j := 0;
|
||||
WHILE (i # startOfExp) & (upperBound[j] # 0X) DO
|
||||
IF (str[i] < upperBound[j]) THEN
|
||||
RETURN TRUE;
|
||||
ELSIF (str[i] > upperBound[j]) THEN
|
||||
RETURN FALSE;
|
||||
ELSE
|
||||
INC (j); INC (i);
|
||||
IF (str[i] = ".") THEN (* skip decimal point *)
|
||||
INC (i);
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
|
||||
IF (upperBound[j] = 0X) THEN
|
||||
(* any trailing zeros don't change the outcome: skip them *)
|
||||
WHILE (str[i] = "0") OR (str[i] = ".") DO
|
||||
INC (i);
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
RETURN (i = startOfExp);
|
||||
END LessOrEqual;
|
||||
|
||||
BEGIN
|
||||
(* normalize exponent character *)
|
||||
i := 0;
|
||||
WHILE (str[i] # 0X) & (str[i] # "e") DO
|
||||
INC (i);
|
||||
END;
|
||||
IF (str[i] = "e") THEN
|
||||
str[i] := expChar;
|
||||
END;
|
||||
|
||||
(* move index `i' over padding characters *)
|
||||
i := 0;
|
||||
state := SR;
|
||||
REPEAT
|
||||
ch := str[i];
|
||||
state.p(ch, class, state);
|
||||
INC (i);
|
||||
UNTIL (class # ConvTypes.padding);
|
||||
|
||||
IF (ch = 0X) THEN
|
||||
RETURN strEmpty;
|
||||
ELSE
|
||||
(* scan part before decimal point or exponent *)
|
||||
WHILE (class = ConvTypes.valid) & (state # F) & (state # E) &
|
||||
((ch < "1") OR (ch > "9")) DO
|
||||
ch := str[i];
|
||||
state.p(ch, class, state);
|
||||
INC (i);
|
||||
END;
|
||||
wSigFigs := 0;
|
||||
WHILE (class = ConvTypes.valid) & (state # F) & (state # E) DO
|
||||
INC (wSigFigs);
|
||||
ch := str[i];
|
||||
state.p(ch, class, state);
|
||||
INC (i);
|
||||
END;
|
||||
(* here holds: wSigFigs is the number of significant digits in
|
||||
the whole number part of the number; 0 means there are only
|
||||
zeros before the decimal point *)
|
||||
|
||||
(* scan fractional part exponent *)
|
||||
fLeadingZeros := 0; allZeroDigit := TRUE;
|
||||
WHILE (class = ConvTypes.valid) & (state # E) DO
|
||||
ch := str[i];
|
||||
IF allZeroDigit THEN
|
||||
IF (ch = "0") THEN
|
||||
INC (fLeadingZeros);
|
||||
ELSIF (ch # ".") THEN
|
||||
allZeroDigit := FALSE;
|
||||
END;
|
||||
END;
|
||||
state.p(ch, class, state);
|
||||
INC (i);
|
||||
END;
|
||||
(* here holds: fLeadingZeros holds the number of zeros after
|
||||
the decimal point *)
|
||||
|
||||
(* scan exponent *)
|
||||
startOfExp := i-1; exp := 0; expNegative := FALSE;
|
||||
WHILE (class = ConvTypes.valid) DO
|
||||
ch := str[i];
|
||||
IF (ch = "-") THEN
|
||||
expNegative := TRUE;
|
||||
ELSIF ("0" <= ch) & (ch <= "9") & (exp < expCutoff) THEN
|
||||
exp := exp*10 + (ORD(ch)-ORD("0"));
|
||||
END;
|
||||
state.p(ch, class, state);
|
||||
INC (i);
|
||||
END;
|
||||
IF expNegative THEN
|
||||
exp := -exp;
|
||||
END;
|
||||
(* here holds: exp holds the value of the exponent; if it's absolute
|
||||
value is larger than expCutoff, then there has been an overflow *)
|
||||
|
||||
IF (class = ConvTypes.invalid) OR (ch # 0X) THEN
|
||||
RETURN strWrongFormat;
|
||||
ELSE (* (class = ConvTypes.terminator) & (ch = 0X) *)
|
||||
(* normalize the number: calculate the exponent if the number would
|
||||
start with a non-zero digit, immediately followed by the
|
||||
decimal point *)
|
||||
IF (wSigFigs > 0) THEN
|
||||
exp := exp+wSigFigs-1;
|
||||
ELSE
|
||||
exp := exp-fLeadingZeros-1;
|
||||
END;
|
||||
|
||||
IF (exp > maxExp) & (NonZeroDigit() # startOfExp) OR
|
||||
(exp = maxExp) & ~LessOrEqual (maxValue) THEN
|
||||
RETURN strOutOfRange;
|
||||
ELSE
|
||||
RETURN strAllRight;
|
||||
END;
|
||||
END;
|
||||
END;
|
||||
END FormatReal;
|
||||
|
||||
PROCEDURE NormalizeFloat* (VAR s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, d: INTEGER;
|
||||
BEGIN
|
||||
(* massage the output of sprintf to match our requirements; note: this
|
||||
code should also handle "Inf", "Infinity", "NaN", etc., gracefully
|
||||
but this is untested *)
|
||||
IF (s[0] = "+") THEN d := 1; ELSE d := 0; END; (* erase "+" sign *)
|
||||
i := 1;
|
||||
WHILE (s[i] # 0X) DO
|
||||
IF (s[i] = ".") & (s[i+1] = expChar) THEN
|
||||
INC (d); (* eliminate "." if no digits follow *)
|
||||
ELSIF (s[i] = "0") & (i-d-1 >= 0) & IsSign (s[i-d-1]) THEN
|
||||
INC (d); (* eliminate zeros after exponent sign *)
|
||||
ELSE
|
||||
s[i-d] := s[i];
|
||||
END;
|
||||
INC (i);
|
||||
END;
|
||||
IF (s[i-d-2] = "E") THEN
|
||||
s[i-d-2] := 0X; (* remove "E+" or "E-" *)
|
||||
ELSE
|
||||
s[i-d] := 0X;
|
||||
END;
|
||||
END NormalizeFloat;
|
||||
|
||||
PROCEDURE FormatForEng* (VAR s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, d, fract, exp, posExp, offset: INTEGER;
|
||||
BEGIN
|
||||
(* find out how large the exponent is, and how many digits are in the
|
||||
fractional part *)
|
||||
fract := 0; exp := 0; posExp := 0;
|
||||
IF CharClass.IsNumeric (s[1]) THEN (* skip for NaN, Inf *)
|
||||
i := 0; d := 0;
|
||||
WHILE (s[i] # "E") DO
|
||||
fract := fract + d;
|
||||
IF (s[i] = ".") THEN d := 1; END;
|
||||
INC (i);
|
||||
END;
|
||||
INC (i);
|
||||
IF (s[i] = "-") THEN d := -1; ELSE d := 1; END;
|
||||
posExp := i;
|
||||
INC (i);
|
||||
WHILE (s[i] # 0X) DO
|
||||
exp := exp*10 + d*(ORD (s[i]) - ORD ("0"));
|
||||
INC (i);
|
||||
END;
|
||||
END;
|
||||
|
||||
offset := exp MOD 3;
|
||||
IF (offset # 0) THEN
|
||||
WHILE (fract < offset) DO (* need more zeros before "E" *)
|
||||
Strings.Insert ("0", posExp-1, s); INC (fract); INC (posExp);
|
||||
END;
|
||||
i := 2;
|
||||
WHILE (i < offset+2) DO (* move "." offset places to right *)
|
||||
s[i] := s[i+1]; INC (i);
|
||||
END;
|
||||
s[i] := ".";
|
||||
|
||||
(* write new exponent *)
|
||||
exp := exp-offset;
|
||||
IF (exp < 0) THEN
|
||||
exp := -exp; s[posExp] := "-";
|
||||
ELSE
|
||||
s[posExp] := "+";
|
||||
END;
|
||||
s[posExp+1] := CHR (exp DIV 100 + ORD("0"));
|
||||
s[posExp+2] := CHR (exp DIV 10 MOD 10 + ORD("0"));
|
||||
s[posExp+3] := CHR (exp MOD 10 + ORD("0"));
|
||||
s[posExp+4] := 0X;
|
||||
END;
|
||||
NormalizeFloat (s);
|
||||
END FormatForEng;
|
||||
|
||||
PROCEDURE FormatForFixed* (VAR s: ARRAY OF CHAR; place: INTEGER);
|
||||
VAR
|
||||
i, d, c, fract, point, suffix: INTEGER;
|
||||
|
||||
PROCEDURE NotZero (VAR s: ARRAY OF CHAR; pos: INTEGER): BOOLEAN;
|
||||
BEGIN
|
||||
WHILE (s[pos] # 0X) DO
|
||||
IF (s[pos] # "0") & (s[pos] # ".") THEN
|
||||
RETURN TRUE;
|
||||
END;
|
||||
INC (pos);
|
||||
END;
|
||||
RETURN FALSE;
|
||||
END NotZero;
|
||||
|
||||
BEGIN
|
||||
IF (place < 0) THEN
|
||||
(* locate position of decimal point in string *)
|
||||
point := 1;
|
||||
WHILE (s[point] # ".") DO INC (point); END;
|
||||
|
||||
(* number of digits before point is `point-1'; position in string
|
||||
of the first digit that will be converted to zero due to rounding:
|
||||
`point+place+1'; rightmost digit that may be incremented because
|
||||
of rounding: `point+place' *)
|
||||
IF (point+place >= 0) THEN
|
||||
suffix := point+place+1; IF (s[suffix] = ".") THEN INC (suffix); END;
|
||||
IF (s[suffix] > "5") OR
|
||||
(s[suffix] = "5") &
|
||||
(NotZero (s, suffix+1) OR
|
||||
(point+place # 0) & ODD (ORD (s[point+place]))) THEN
|
||||
(* we are rounding up *)
|
||||
i := point+place;
|
||||
WHILE (s[i] = "9") DO s[i] := "0"; DEC (i); END;
|
||||
IF (i = 0) THEN (* looking at sign *)
|
||||
Strings.Insert ("1", 1, s); INC (point);
|
||||
ELSE
|
||||
s[i] := CHR (ORD (s[i])+1); (* increment non-"9" digit by one *)
|
||||
END;
|
||||
END;
|
||||
|
||||
(* zero everything after the digit at `place' *)
|
||||
i := point+place+1;
|
||||
IF (i = 1) THEN (* all zero *)
|
||||
s[1] := "0"; s[2] := 0X;
|
||||
ELSE
|
||||
WHILE (s[i] # ".") DO s[i] := "0"; INC (i); END;
|
||||
END;
|
||||
ELSE (* round to zero *)
|
||||
s[1] := "0"; s[2] := 0X;
|
||||
END;
|
||||
s[point] := 0X;
|
||||
END;
|
||||
|
||||
(* correct sign, and add trailing zeros if necessary *)
|
||||
IF (s[0] = "+") THEN d := 1; ELSE d := 0; END; (* erase "+" sign *)
|
||||
i := 1; fract := 0; c := 0;
|
||||
WHILE (s[i] # 0X) DO
|
||||
s[i-d] := s[i];
|
||||
fract := fract+c;
|
||||
IF (s[i] = ".") THEN
|
||||
c := 1;
|
||||
END;
|
||||
INC (i);
|
||||
END;
|
||||
WHILE (fract < place) DO
|
||||
s[i-d] := "0"; INC (fract); INC (i);
|
||||
END;
|
||||
s[i-d] := 0X;
|
||||
END FormatForFixed;
|
||||
|
||||
BEGIN
|
||||
NEW(RS); RS.p:=RSState;
|
||||
NEW(P); P.p:=PState;
|
||||
NEW(F); F.p:=FState;
|
||||
NEW(E); E.p:=EState;
|
||||
NEW(SE); SE.p:=SEState;
|
||||
NEW(WE); WE.p:=WEState;
|
||||
NEW(SR); SR.p:=ScanReal;
|
||||
END ooc2Real0.
|
||||
Loading…
Add table
Add a link
Reference in a new issue