diff --git a/makefile b/makefile index 1382a97d..b862560d 100644 --- a/makefile +++ b/makefile @@ -132,6 +132,7 @@ stage6: $(VOCSTATIC) -sP ooc2IntConv.Mod $(VOCSTATIC) -sP ooc2IntStr.Mod $(VOCSTATIC) -sP ooc2Real0.Mod + $(VOCSTATIC) -sP oocLowReal.Mod oocLowLReal.Mod $(VOCSTATIC) -sP oocwrapperlibc.Mod $(VOCSTATIC) -sP ulmSYSTEM.Mod $(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod diff --git a/makefile.gnuc.armv6j b/makefile.gnuc.armv6j index adf4893b..1a1b9d70 100644 --- a/makefile.gnuc.armv6j +++ b/makefile.gnuc.armv6j @@ -132,6 +132,7 @@ stage6: $(VOCSTATIC) -sP ooc2IntConv.Mod $(VOCSTATIC) -sP ooc2IntStr.Mod $(VOCSTATIC) -sP ooc2Real0.Mod + $(VOCSTATIC) -sP oocLowReal.Mod oocLowLReal.Mod $(VOCSTATIC) -sP oocwrapperlibc.Mod $(VOCSTATIC) -sP ulmSYSTEM.Mod $(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod diff --git a/makefile.gnuc.armv6j_hardfp b/makefile.gnuc.armv6j_hardfp index 1e0d4646..7e9ce7dc 100644 --- a/makefile.gnuc.armv6j_hardfp +++ b/makefile.gnuc.armv6j_hardfp @@ -132,6 +132,7 @@ stage6: $(VOCSTATIC) -sP ooc2IntConv.Mod $(VOCSTATIC) -sP ooc2IntStr.Mod $(VOCSTATIC) -sP ooc2Real0.Mod + $(VOCSTATIC) -sP oocLowReal.Mod oocLowLReal.Mod $(VOCSTATIC) -sP oocwrapperlibc.Mod $(VOCSTATIC) -sP ulmSYSTEM.Mod $(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod diff --git a/makefile.gnuc.armv7a_hardfp b/makefile.gnuc.armv7a_hardfp index 810d4222..2a7b60bd 100644 --- a/makefile.gnuc.armv7a_hardfp +++ b/makefile.gnuc.armv7a_hardfp @@ -132,6 +132,7 @@ stage6: $(VOCSTATIC) -sP ooc2IntConv.Mod $(VOCSTATIC) -sP ooc2IntStr.Mod $(VOCSTATIC) -sP ooc2Real0.Mod + $(VOCSTATIC) -sP oocLowReal.Mod oocLowLReal.Mod $(VOCSTATIC) -sP oocwrapperlibc.Mod $(VOCSTATIC) -sP ulmSYSTEM.Mod $(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod diff --git a/makefile.gnuc.x86 b/makefile.gnuc.x86 index 4e8bf28a..c6b7ebf8 100644 --- a/makefile.gnuc.x86 +++ b/makefile.gnuc.x86 @@ -132,6 +132,7 @@ stage6: $(VOCSTATIC) -sP ooc2IntConv.Mod $(VOCSTATIC) -sP ooc2IntStr.Mod $(VOCSTATIC) -sP ooc2Real0.Mod + $(VOCSTATIC) -sP oocLowReal.Mod oocLowLReal.Mod $(VOCSTATIC) -sP oocwrapperlibc.Mod $(VOCSTATIC) -sP ulmSYSTEM.Mod $(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod diff --git a/makefile.gnuc.x86_64 b/makefile.gnuc.x86_64 index 1382a97d..b862560d 100644 --- a/makefile.gnuc.x86_64 +++ b/makefile.gnuc.x86_64 @@ -132,6 +132,7 @@ stage6: $(VOCSTATIC) -sP ooc2IntConv.Mod $(VOCSTATIC) -sP ooc2IntStr.Mod $(VOCSTATIC) -sP ooc2Real0.Mod + $(VOCSTATIC) -sP oocLowReal.Mod oocLowLReal.Mod $(VOCSTATIC) -sP oocwrapperlibc.Mod $(VOCSTATIC) -sP ulmSYSTEM.Mod $(VOCSTATIC) -sP ulmASCII.Mod ulmSets.Mod diff --git a/ocat b/ocat index 993ef40b..443db97c 100755 Binary files a/ocat and b/ocat differ diff --git a/showdef b/showdef index 6c2495d4..fdd63e86 100755 Binary files a/showdef and b/showdef differ diff --git a/src/lib/ooc/oocLowLReal.Mod b/src/lib/ooc/oocLowLReal.Mod new file mode 100644 index 00000000..0a15f6dd --- /dev/null +++ b/src/lib/ooc/oocLowLReal.Mod @@ -0,0 +1,484 @@ +(* $Id: LowLReal.Mod,v 1.6 1999/09/02 13:15:35 acken Exp $ *) +MODULE oocLowLReal; + +(* + LowLReal - Gives access to the underlying properties of the type LONGREAL + for IEEE double-precision numbers. + 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 Low := oocLowReal, S := SYSTEM; + +(* + + Real number properties are defined as follows: + + radix--The whole number value of the radix used to represent the + corresponding read number values. + + places--The whole number value of the number of radix places used + to store values of the corresponding real number type. + + expoMin--The whole number value of the exponent minimum. + + expoMax--The whole number value of the exponent maximum. + + large--The largest value of the corresponding real number type. + + small--The smallest positive value of the corresponding real number + type, represented to maximal precision. + + IEC559--A Boolean value that is TRUE if and only if the implementation + of the corresponding real number type conforms to IEC 559:1989 + (IEEE 754:1987) in all regards. + + NOTES + 6 -- If `IEC559' is TRUE, the value of `radix' is 2. + 7 -- If LowReal.IEC559 is TRUE, the 32-bit format of IEC 559:1989 + is used for the type REAL. + 7 -- If LowLong.IEC559 is TRUE, the 64-bit format of IEC 559:1989 + is used for the type REAL. + + LIA1--A Boolean value that is TRUE if and only if the implementation of + the corresponding real number type conforms to ISO/IEC 10967-1:199x + (LIA-1) in all regards: parameters, arithmetic, exceptions, and + notification. + + rounds--A Boolean value that is TRUE if and only if each operation produces + a result that is one of the values of the corresponding real number + type nearest to the mathematical result. + + gUnderflow--A Boolean value that is TRUE if and only if there are values of + the corresponding real number type between 0.0 and `small'. + + exception--A Boolean value that is TRUE if and only if every operation that + attempts to produce a real value out of range raises an exception. + + extend--A Boolean value that is TRUE if and only if expressions of the + corresponding real number type are computed to higher precision than + the stored values. + + nModes--The whole number value giving the number of bit positions needed for + the status flags for mode control. + +*) + +CONST + radix*= 2; + places*= 53; + expoMax*= 1023; + expoMin*= 1-expoMax; + large*= MAX(LONGREAL); (*1.7976931348623157D+308;*) (* MAX(LONGREAL) *) + (*small*= 2.2250738585072014D-308;*) + small*= 2.2250738585072014/9.9999999999999981D307(*/10^308)*); + IEC559*= TRUE; + LIA1*= FALSE; + rounds*= FALSE; + gUnderflow*= TRUE; (* there are IEEE numbers smaller than `small' *) + exception*= FALSE; (* at least in the default implementation *) + extend*= FALSE; + nModes*= 0; + ONE=1.0D0; (* some commonly-used constants *) + ZERO=0.0D0; + TEN=1.0D1; + + DEBUG = TRUE; + + expOffset=expoMax; + hiBit=19; + expBit=hiBit+1; + nMask={0..hiBit,31}; (* number mask *) + expMask={expBit..30}; (* exponent mask *) + +TYPE + Modes*= SET; + LongInt=ARRAY 2 OF LONGINT; + LongSet=ARRAY 2 OF SET; + +VAR + (*sml* : LONGREAL; tmp: LONGREAL;*) (* this was a test to get small as a variable at runtime. obviously, compile time preferred; -- noch *) + isBigEndian-: BOOLEAN; (* set when target is big endian *) + (* + PROCEDURE power0(i, j : INTEGER) : LONGREAL; (* used to calculate sml at runtime; -- noch *) + VAR k : INTEGER; + p : LONGREAL; + BEGIN + k := 1; + p := i; + REPEAT + p := p * i; + INC(k); + UNTIL k=j; + RETURN p; + END power0; +*) + +(* Errors are handled through the LowReal module *) + +PROCEDURE err*(): INTEGER; +BEGIN + RETURN Low.err +END err; + +PROCEDURE ClearError*; +BEGIN + Low.ClearError +END ClearError; + +PROCEDURE ErrorHandler*(err: INTEGER); +BEGIN + Low.ErrorHandler(err) +END ErrorHandler; + +(* type-casting utilities *) + +PROCEDURE Move (VAR x: LONGREAL; VAR ra: ARRAY OF LONGINT); +(* typecast a LONGREAL to an array of LONGINTs *) + VAR t: LONGINT; +BEGIN + S.MOVE(S.ADR(x),S.ADR(ra),SIZE(LONGREAL)); + IF ~isBigEndian THEN t:=ra[0]; ra[0]:=ra[1]; ra[1]:=t END +END Move; + +PROCEDURE MoveSet (VAR x: LONGREAL; VAR ra: ARRAY OF SET); +(* typecast a LONGREAL to an array of LONGINTs *) + VAR t: SET; +BEGIN + S.MOVE(S.ADR(x),S.ADR(ra),SIZE(LONGREAL)); + IF ~isBigEndian THEN t:=ra[0]; ra[0]:=ra[1]; ra[1]:=t END +END MoveSet; + +(* Note: The below should be done with a type cast -- + once the compiler supports such things. *) +(*<* PUSH; Warnings := FALSE *>*) +PROCEDURE Real * (ra: ARRAY OF LONGINT): LONGREAL; +(* typecast an array of big endian LONGINTs to a LONGREAL *) + VAR t: LONGINT; x: LONGREAL; +BEGIN + IF ~isBigEndian THEN t:=ra[0]; ra[0]:=ra[1]; ra[1]:=t END; + S.MOVE(S.ADR(ra),S.ADR(x),SIZE(LONGREAL)); + RETURN x +END Real; + +PROCEDURE ToReal (ra: ARRAY OF SET): LONGREAL; +(* typecast an array of LONGINTs to a LONGREAL *) + VAR t: SET; x: LONGREAL; +BEGIN + IF ~isBigEndian THEN t:=ra[0]; ra[0]:=ra[1]; ra[1]:=t END; + S.MOVE(S.ADR(ra),S.ADR(x),SIZE(LONGREAL)); + RETURN x +END ToReal; +(*<* POP *> *) + +PROCEDURE exponent*(x: LONGREAL): INTEGER; +(* + The value of the call exponent(x) shall be the exponent value of `x' + that lies between `expoMin' and `expoMax'. An exception shall occur + and may be raised if `x' is equal to 0.0. + *) + VAR ra: LongInt; +BEGIN + (* NOTE: x=0.0 should raise exception *) + IF x=ZERO THEN RETURN 0 + ELSE Move(x, ra); + RETURN SHORT(S.LSH(ra[0],-expBit) MOD 2048)-expOffset + END +END exponent; + +PROCEDURE exponent10*(x: LONGREAL): INTEGER; +(* + The value of the call exponent10(x) shall be the base 10 exponent + value of `x'. An exception shall occur and may be raised if `x' is + equal to 0.0. + *) +VAR exp: INTEGER; +BEGIN + IF x=ZERO THEN RETURN 0 END; (* exception could be raised here *) + exp:=0; x:=ABS(x); + WHILE x>=TEN DO x:=x/TEN; INC(exp) END; + WHILE x<1 DO x:=x*TEN; DEC(exp) END; + RETURN exp +END exponent10; + +PROCEDURE fraction*(x: LONGREAL): LONGREAL; +(* + The value of the call fraction(x) shall be the significand (or + significant) part of `x'. Hence the following relationship shall + hold: x = scale(fraction(x), exponent(x)). +*) + CONST eZero={(hiBit+2)..29}; + VAR ra: LongInt; +BEGIN + IF x=ZERO THEN RETURN ZERO + ELSE Move(x, ra); + ra[0]:=S.VAL(LONGINT, S.VAL(SET,ra[0])*nMask+eZero); + RETURN Real(ra)*2.0D0 + END +END fraction; + +PROCEDURE IsInfinity * (real: LONGREAL) : BOOLEAN; + CONST signMask={0..30}; + VAR ra: LongSet; +BEGIN + MoveSet(real, ra); + RETURN (ra[0]*signMask=expMask) & (ra[1]={}) +END IsInfinity; + +PROCEDURE IsNaN * (real: LONGREAL) : BOOLEAN; + CONST fracMask={0..hiBit}; + VAR ra: LongSet; +BEGIN + MoveSet(real, ra); + RETURN (ra[0]*expMask=expMask) & ((ra[1]#{}) OR (ra[0]*fracMask#{})) +END IsNaN; + +PROCEDURE sign*(x: LONGREAL): LONGREAL; +(* + The value of the call sign(x) shall be 1.0 if `x' is greater than 0.0, + or shall be -1.0 if `x' is less than 0.0, or shall be either 1.0 or + -1.0 if `x' is equal to 0.0. +*) +BEGIN + IF xexpoMax THEN RETURN large*sign(x) (* exception raised here *) + ELSIF exp=TEN DO x:=x/TEN; INC(exp) END; + WHILE (x>ZERO) & (x<1.0) DO x:=x*TEN; DEC(exp) END; + RETURN exp +END exponent10; + +PROCEDURE fraction*(x: REAL): REAL; +(* + The value of the call fraction(x) shall be the significand (or + significant) part of `x'. Hence the following relationship shall + hold: x = scale(fraction(x), exponent(x)). +*) + CONST eZero={(hiBit+2)..29}; +BEGIN + IF x=ZERO THEN RETURN ZERO + ELSE RETURN S.VAL(REAL,(S.VAL(SET,x)*nMask)+eZero)*2.0 (* set the mantissa's exponent to zero *) + END +END fraction; + +PROCEDURE IsInfinity * (real: REAL) : BOOLEAN; + CONST signMask={0..30}; +BEGIN + RETURN S.VAL(SET,real)*signMask=expMask +END IsInfinity; + +PROCEDURE IsNaN * (real: REAL) : BOOLEAN; + CONST fracMask={0..hiBit}; + VAR sreal: SET; +BEGIN + sreal:=S.VAL(SET, real); + RETURN (sreal*expMask=expMask) & (sreal*fracMask#{}) +END IsNaN; + +PROCEDURE sign*(x: REAL): REAL; +(* + The value of the call sign(x) shall be 1.0 if `x' is greater than 0.0, + or shall be -1.0 if `x' is less than 0.0, or shall be either 1.0 or + -1.0 if `x' is equal to 0.0. +*) +BEGIN + IF xexpoMax THEN RETURN large*sign(x) (* exception raised here *) + ELSIF exp= 0 DO d[i] := "0"; DEC(i) END ; END ConvertL; - +*) PROCEDURE Unpack(VAR b, d: ARRAY OF S.BYTE); VAR i, k: SHORTINT; len: LONGINT; BEGIN i := 0; len := LEN(b); diff --git a/voc b/voc index c9ceee10..fa4f5696 100755 Binary files a/voc and b/voc differ diff --git a/vocstatic b/vocstatic index 9cdb3e11..fa4f5696 100755 Binary files a/vocstatic and b/vocstatic differ