From 227106263600aa9e9082a2c40c30dcf88e174c00 Mon Sep 17 00:00:00 2001 From: David Brown Date: Thu, 18 Aug 2016 20:39:23 +0100 Subject: [PATCH] Implement fraction, IsInfinity and IsNaN in oocLowReal.Mod. --- src/library/ooc/oocLowReal.Mod | 62 ++++++++++-------- src/library/v4/Reals.Mod | 19 ++++-- src/test/confidence/library/TestLibrary.mod | 71 +++++++++++++++++---- src/test/confidence/library/expected | 24 +++++-- src/tools/make/vishap.make | 2 +- 5 files changed, 126 insertions(+), 52 deletions(-) diff --git a/src/library/ooc/oocLowReal.Mod b/src/library/ooc/oocLowReal.Mod index dbfb6ebe..83ae8e32 100644 --- a/src/library/ooc/oocLowReal.Mod +++ b/src/library/ooc/oocLowReal.Mod @@ -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; (* diff --git a/src/library/v4/Reals.Mod b/src/library/v4/Reals.Mod index e90aff71..f9e6617b 100644 --- a/src/library/v4/Reals.Mod +++ b/src/library/v4/Reals.Mod @@ -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) diff --git a/src/test/confidence/library/TestLibrary.mod b/src/test/confidence/library/TestLibrary.mod index d97db656..32f7c91b 100644 --- a/src/test/confidence/library/TestLibrary.mod +++ b/src/test/confidence/library/TestLibrary.mod @@ -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. \ No newline at end of file diff --git a/src/test/confidence/library/expected b/src/test/confidence/library/expected index a76636a8..3e361735 100644 --- a/src/test/confidence/library/expected +++ b/src/test/confidence/library/expected @@ -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. diff --git a/src/tools/make/vishap.make b/src/tools/make/vishap.make index 605485ad..a8b2912b 100644 --- a/src/tools/make/vishap.make +++ b/src/tools/make/vishap.make @@ -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