Implement fraction, IsInfinity and IsNaN in oocLowReal.Mod.

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 c0, c1, c2, c3: CHAR;
-  VAR sreal: SET;
 BEGIN
-  sreal:=S.VAL(SET, real);
+  S.GET(S.ADR(real)+0, c3);
-  RETURN (sreal*expMask=expMask) & (sreal*fracMask#{})
+  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;
 (*

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)

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;
+  i := 6; WHILE i > 0 DO DEC(i); tc(str[i]) END;
-  Console.Ln;
+  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 *)
+  ti(Reals.Expo(0.5),1); tn; (* 126 *)
-  Console.Int(Reals.Expo(1.0),1); Console.Ln; (* 128 *)
+  ti(Reals.Expo(1.0),1); tn; (* 127 *)
-  Console.Int(Reals.Expo(2.0),1); Console.Ln; (* 129 *)
+  ti(Reals.Expo(2.0),1); tn; (* 128 *)
-  Console.Int(Reals.Expo(3.0),1); Console.Ln; (* 129 *)
+  ti(Reals.Expo(3.0),1); tn; (* 128 *)
-  Console.Int(Reals.Expo(4.0),1); Console.Ln; (* 130 *)
+  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.

src/test/confidence/library/expected

@@ -3,14 +3,24 @@
 000002
 000002
 000003
-33333333
+0000803F
-33333333
+0000C03F
-33333333
+00000040
-33333333
+295C3F40
-33333333
+00004040
 126
+127
+128
 128
 129
-129
+r =   1.0D+000, i = 127 -> r =   4.0D+000, i = 129
-130
+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.

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