mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 00:32:24 +00:00
Implement fraction, IsInfinity and IsNaN in oocLowReal.Mod.
This commit is contained in:
David Brown
parent
c0d5b8dbfd
commit
2271062636
5 changed files with 126 additions and 52 deletions
|
|
@ -23,7 +23,7 @@ MODULE oocLowReal;
|
|||
*)
|
||||
|
||||
|
||||
IMPORT S := SYSTEM, Console;
|
||||
IMPORT S := SYSTEM, Console, Reals;
|
||||
|
||||
(*
|
||||
|
||||
|
|
@ -114,21 +114,6 @@ VAR
|
|||
|
||||
(* Error handler default stub which can be replaced *)
|
||||
|
||||
(* PROCEDURE power0(i, j : INTEGER) : REAL; (* used to calculate sml at runtime; -- noch *)
|
||||
VAR k : INTEGER;
|
||||
p : REAL;
|
||||
BEGIN
|
||||
k := 1;
|
||||
p := i;
|
||||
REPEAT
|
||||
p := p * i;
|
||||
INC(k);
|
||||
UNTIL k=j;
|
||||
RETURN p;
|
||||
END power0;*)
|
||||
|
||||
|
||||
|
||||
PROCEDURE DefaultHandler (errno : INTEGER);
|
||||
BEGIN
|
||||
err:=errno
|
||||
|
|
@ -140,8 +125,6 @@ BEGIN
|
|||
END ClearError;
|
||||
|
||||
|
||||
|
||||
(*** Refactor for 64 bit support.
|
||||
PROCEDURE exponent*(x: REAL): INTEGER;
|
||||
(*
|
||||
The value of the call exponent(x) shall be the exponent value of `x'
|
||||
|
|
@ -151,10 +134,9 @@ PROCEDURE exponent*(x: REAL): INTEGER;
|
|||
BEGIN
|
||||
(* NOTE: x=0.0 should raise exception *)
|
||||
IF x=ZERO THEN RETURN 0
|
||||
ELSE RETURN SHORT(S.LSH(S.VAL(LONGINT,x),-expBit) MOD 256)-expOffset
|
||||
ELSE RETURN Reals.Expo(x) - expOffset
|
||||
END
|
||||
END exponent;
|
||||
*)
|
||||
|
||||
PROCEDURE exponent10*(x: REAL): INTEGER;
|
||||
(*
|
||||
|
|
@ -171,34 +153,58 @@ BEGIN
|
|||
RETURN exp
|
||||
END exponent10;
|
||||
|
||||
(*** Refactor for 64 bit support.
|
||||
(* TYPE REAL: 1/sign, 8/exponent, 23/significand *)
|
||||
|
||||
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)).
|
||||
*)
|
||||
VAR c: CHAR;
|
||||
BEGIN
|
||||
IF x=ZERO THEN RETURN ZERO
|
||||
ELSE
|
||||
(* Set top 7 bits of exponent to 0111111 *)
|
||||
S.GET(S.ADR(x)+3, c);
|
||||
c := CHR(((ORD(c) DIV 128) * 128) + 63); (* Set X0111111 (X unchanged) *)
|
||||
S.PUT(S.ADR(x)+3, c);
|
||||
(* Set bottom bit of exponent to 0 *)
|
||||
S.GET(S.ADR(x)+2, c);
|
||||
c := CHR(ORD(c) MOD 128); (* Set 0XXXXXXX (X unchanged) *)
|
||||
S.PUT(S.ADR(x)+2, c);
|
||||
RETURN x * 2.0;
|
||||
END
|
||||
(*
|
||||
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};
|
||||
VAR c0, c1, c2, c3: CHAR;
|
||||
BEGIN
|
||||
RETURN S.VAL(SET,real)*signMask=expMask
|
||||
S.GET(S.ADR(real)+0, c3);
|
||||
S.GET(S.ADR(real)+1, c2);
|
||||
S.GET(S.ADR(real)+2, c1);
|
||||
S.GET(S.ADR(real)+3, c0);
|
||||
RETURN (ORD(c0) MOD 128 = 127) & (ORD(c1) = 128) & (ORD(c2) = 0) & (ORD(c3) = 0)
|
||||
END IsInfinity;
|
||||
|
||||
PROCEDURE IsNaN * (real: REAL) : BOOLEAN;
|
||||
CONST fracMask={0..hiBit};
|
||||
VAR sreal: SET;
|
||||
VAR c0, c1, c2, c3: CHAR;
|
||||
BEGIN
|
||||
sreal:=S.VAL(SET, real);
|
||||
RETURN (sreal*expMask=expMask) & (sreal*fracMask#{})
|
||||
S.GET(S.ADR(real)+0, c3);
|
||||
S.GET(S.ADR(real)+1, c2);
|
||||
S.GET(S.ADR(real)+2, c1);
|
||||
S.GET(S.ADR(real)+3, c0);
|
||||
RETURN (ORD(c0) MOD 128 = 127)
|
||||
& (ORD(c1) DIV 128 = 1)
|
||||
& ((ORD(c1) MOD 128 # 0) OR (ORD(c2) # 0) OR (ORD(c3) # 0))
|
||||
END IsNaN;
|
||||
*)
|
||||
|
||||
PROCEDURE sign*(x: REAL): REAL;
|
||||
(*
|
||||
|
|
|
|||
|
|
@ -46,21 +46,30 @@ MODULE Reals;
|
|||
|
||||
|
||||
PROCEDURE Expo*(x: REAL): INTEGER;
|
||||
VAR i: INTEGER;
|
||||
VAR i: INTEGER;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x)+2, i);
|
||||
RETURN (i DIV 127) MOD 256
|
||||
RETURN (i DIV 128) MOD 256
|
||||
END Expo;
|
||||
|
||||
PROCEDURE SetExpo*(VAR x: REAL; ex: INTEGER);
|
||||
VAR c: CHAR;
|
||||
BEGIN
|
||||
(* Replace exponent bits within top byte of REAL *)
|
||||
SYSTEM.GET(SYSTEM.ADR(x)+3, c);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x)+3, CHR(((ORD(c) DIV 128) * 128) + ((ex DIV 2) MOD 128)));
|
||||
(* Replace exponent bits within 2nd byte of REAL *)
|
||||
SYSTEM.GET(SYSTEM.ADR(x)+2, c);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x)+2, CHR((ORD(c) MOD 128) + ((ex MOD 2) * 128)))
|
||||
END SetExpo;
|
||||
|
||||
PROCEDURE ExpoL*(x: LONGREAL): INTEGER;
|
||||
VAR i: INTEGER; l: LONGINT;
|
||||
VAR i: INTEGER;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x)+6, i);
|
||||
RETURN (i DIV 16) MOD 2048
|
||||
END ExpoL;
|
||||
|
||||
|
||||
(* Convert LONGREAL: Write positive integer value of x into array d.
|
||||
The value is stored backwards, i.e. least significant digit
|
||||
first. n digits are written, with trailing zeros fill.
|
||||
|
|
@ -107,7 +116,7 @@ MODULE Reals;
|
|||
BEGIN
|
||||
i := 0; l := LEN(b);
|
||||
WHILE i < l DO
|
||||
by := SYSTEM.VAL(CHAR, d[i]);
|
||||
by := SYSTEM.VAL(CHAR, b[i]);
|
||||
d[i*2] := ToHex(ORD(by) DIV 16);
|
||||
d[i*2+1] := ToHex(ORD(by) MOD 16);
|
||||
INC(i)
|
||||
|
|
|
|||
|
|
@ -1,26 +1,53 @@
|
|||
MODULE TestLibrary;
|
||||
|
||||
IMPORT SYSTEM, Console, Reals;
|
||||
IMPORT SYSTEM, Oberon, Texts, Reals, oocLowReal;
|
||||
|
||||
VAR W: Texts.Writer;
|
||||
|
||||
PROCEDURE tc(c: CHAR); BEGIN Texts.Write(W, c) END tc;
|
||||
PROCEDURE ts(s: ARRAY OF CHAR); BEGIN Texts.WriteString(W, s) END ts;
|
||||
PROCEDURE ti(i, n: LONGINT); BEGIN Texts.WriteInt(W, i, n) END ti;
|
||||
PROCEDURE tr(r: LONGREAL; n: INTEGER); BEGIN Texts.WriteLongReal(W, r, n) END tr;
|
||||
PROCEDURE tn; BEGIN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END tn;
|
||||
|
||||
|
||||
PROCEDURE TestConvert(lr: LONGREAL);
|
||||
VAR str: ARRAY 20 OF CHAR; i: INTEGER;
|
||||
BEGIN
|
||||
Reals.ConvertL(lr, 6, str);
|
||||
i := 6; WHILE i > 0 DO DEC(i); Console.Char(str[i]) END;
|
||||
Console.Ln;
|
||||
i := 6; WHILE i > 0 DO DEC(i); tc(str[i]) END;
|
||||
tn;
|
||||
END TestConvert;
|
||||
|
||||
PROCEDURE TestHex(r: REAL);
|
||||
VAR str: ARRAY 20 OF CHAR;
|
||||
BEGIN
|
||||
Reals.ConvertH(r, str); str[8] := 0X; Console.String(str); Console.Ln;
|
||||
Reals.ConvertH(r, str); str[8] := 0X; ts(str); tn;
|
||||
END TestHex;
|
||||
|
||||
PROCEDURE TestSetExpo(r: REAL; i: INTEGER);
|
||||
BEGIN
|
||||
ts("r = "); tr(r,10);
|
||||
ts(", i = "); ti(Reals.Expo(r),1);
|
||||
Reals.SetExpo(r, i);
|
||||
ts(" -> r = "); tr(r,10);
|
||||
ts(", i = "); ti(Reals.Expo(r),1); tn;
|
||||
END TestSetExpo;
|
||||
|
||||
PROCEDURE TestFractionPart(r: REAL);
|
||||
BEGIN
|
||||
ts("r = "); tr(r,14);
|
||||
ts(", exp = "); ti(Reals.Expo(r),1);
|
||||
r := oocLowReal.fraction(r);
|
||||
ts(" -> r = "); tr(r,14);
|
||||
ts(", exp = "); ti(Reals.Expo(r),1); tn;
|
||||
END TestFractionPart;
|
||||
|
||||
PROCEDURE RealTests;
|
||||
VAR
|
||||
str: ARRAY 20 OF CHAR;
|
||||
(*
|
||||
r: REAL;
|
||||
(*
|
||||
lr: LONGREAL;
|
||||
*)
|
||||
BEGIN
|
||||
|
|
@ -36,15 +63,37 @@ BEGIN
|
|||
TestHex(2.99);
|
||||
TestHex(3.0);
|
||||
|
||||
Console.Int(Reals.Expo(0.5),1); Console.Ln; (* 126 *)
|
||||
Console.Int(Reals.Expo(1.0),1); Console.Ln; (* 128 *)
|
||||
Console.Int(Reals.Expo(2.0),1); Console.Ln; (* 129 *)
|
||||
Console.Int(Reals.Expo(3.0),1); Console.Ln; (* 129 *)
|
||||
Console.Int(Reals.Expo(4.0),1); Console.Ln; (* 130 *)
|
||||
ti(Reals.Expo(0.5),1); tn; (* 126 *)
|
||||
ti(Reals.Expo(1.0),1); tn; (* 127 *)
|
||||
ti(Reals.Expo(2.0),1); tn; (* 128 *)
|
||||
ti(Reals.Expo(3.0),1); tn; (* 128 *)
|
||||
ti(Reals.Expo(4.0),1); tn; (* 129 *)
|
||||
|
||||
TestSetExpo(1.0, 129);
|
||||
TestSetExpo(-1.0, 129);
|
||||
TestSetExpo(2.0, 129);
|
||||
TestSetExpo(-4.0, 129);
|
||||
TestSetExpo(1.5, 129);
|
||||
TestSetExpo(-1.5, 129);
|
||||
|
||||
TestFractionPart(1.234);
|
||||
TestFractionPart(-1.234);
|
||||
TestFractionPart(32.678);
|
||||
TestFractionPart(-32.678);
|
||||
|
||||
r := 0.0;
|
||||
ASSERT(~oocLowReal.IsInfinity(r), 3); ASSERT(~oocLowReal.IsNaN(r), 4);
|
||||
|
||||
r := 0.0; Reals.SetExpo(r, 255);
|
||||
ASSERT(oocLowReal.IsInfinity(r), 5); ASSERT(~oocLowReal.IsNaN(r), 6);
|
||||
|
||||
r := 0.123; Reals.SetExpo(r, 255);
|
||||
ASSERT(~oocLowReal.IsInfinity(r), 7); ASSERT(oocLowReal.IsNaN(r), 8);
|
||||
END RealTests;
|
||||
|
||||
|
||||
BEGIN
|
||||
Texts.OpenWriter(W);
|
||||
RealTests;
|
||||
Console.String("Library tests successful."); Console.Ln;
|
||||
ts("Library tests successful."); tn
|
||||
END TestLibrary.
|
||||
|
|
@ -3,14 +3,24 @@
|
|||
000002
|
||||
000002
|
||||
000003
|
||||
33333333
|
||||
33333333
|
||||
33333333
|
||||
33333333
|
||||
33333333
|
||||
0000803F
|
||||
0000C03F
|
||||
00000040
|
||||
295C3F40
|
||||
00004040
|
||||
126
|
||||
127
|
||||
128
|
||||
128
|
||||
129
|
||||
129
|
||||
130
|
||||
r = 1.0D+000, i = 127 -> r = 4.0D+000, i = 129
|
||||
r = -1.0D+000, i = 127 -> r = -4.0D+000, i = 129
|
||||
r = 2.0D+000, i = 128 -> r = 4.0D+000, i = 129
|
||||
r = -4.0D+000, i = 129 -> r = -4.0D+000, i = 129
|
||||
r = 1.5D+000, i = 127 -> r = 6.0D+000, i = 129
|
||||
r = -1.5D+000, i = 127 -> r = -6.0D+000, i = 129
|
||||
r = 1.23400D+000, exp = 127 -> r = 1.23400D+000, exp = 127
|
||||
r = -1.23400D+000, exp = 127 -> r = -1.23400D+000, exp = 127
|
||||
r = 3.26780D+001, exp = 132 -> r = 1.02119D+000, exp = 127
|
||||
r = -3.26780D+001, exp = 132 -> r = -1.02119D+000, exp = 127
|
||||
Library tests successful.
|
||||
|
|
|
|||
|
|
@ -221,7 +221,7 @@ TODO: Comment disabled lines contain use of VAL that reads beyond source variabl
|
|||
|
||||
ooc:
|
||||
@printf "\nMaking ooc library\n"
|
||||
# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLowReal.Mod
|
||||
cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLowReal.Mod
|
||||
# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocLowLReal.Mod
|
||||
# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocRealMath.Mod
|
||||
# cd $(BUILDDIR); $(ROOTDIR)/$(VISHAP) -Ffs ../../src/library/ooc/oocOakMath.Mod
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue