vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 15:42:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

ported four more modules from ooc lib

Browse source 
Former-commit-id: c6a299a1fe
This commit is contained in:
Norayr Chilingarian 2013-10-18 18:43:15 +04:00
parent 3b0d8c163c
commit 8f020aa94b
10 changed files with 1539 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

414
src/lib/ooc/oocLRealConv.Mod Normal file
View file

@ -0,0 +1,414 @@
(* $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.