fixed Reals.Mod, see comments there, git rid of libc dependency, becaus ecvt call caused crash when running ./showdef oocLowLReal.sym file.

added oocLowReal.Mod and oocLowLReal.Mod

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

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

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

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

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

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

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 x<ZERO THEN RETURN -ONE ELSE RETURN ONE END
+END sign;
+
+PROCEDURE scale*(x: LONGREAL; n: INTEGER): LONGREAL;
+(*
+  The value of the call scale(x,n) shall be the value x*radix^n if such
+  a value exists; otherwise an exception shall occur and may be raised.
+*)
+  VAR exp: LONGINT; lexp: SET; ra: LongInt;
+BEGIN
+  IF x=ZERO THEN RETURN ZERO END;                     (* can't scale zero *)
+  exp:= exponent(x)+n;                                (* new exponent *)
+  IF exp>expoMax THEN RETURN large*sign(x)            (* exception raised here *)
+  ELSIF exp<expoMin THEN RETURN small*sign(x)         (* exception here as well *)
+  END;
+  lexp:=S.VAL(SET,S.LSH(exp+expOffset,expBit));       (* shifted exponent bits *)
+  Move(x, ra);
+  ra[0]:=S.VAL(LONGINT, S.VAL(SET,ra[0])*nMask+lexp); (* insert new exponent *)
+  RETURN Real(ra)
+END scale;
+ 
+PROCEDURE ulp*(x: LONGREAL): LONGREAL;
+(*
+   The value of the call ulp(x) shall be the value of the corresponding
+   real number type equal to a unit in the last place of `x', if such a
+   value exists; otherwise an exception shall occur and may be raised. 
+*)
+BEGIN
+  RETURN scale(ONE, exponent(x)-places+1)
+END ulp;
+  
+PROCEDURE succ*(x: LONGREAL): LONGREAL;
+(*
+   The value of the call succ(x) shall be the next value of the
+   corresponding real number type greater than `x', if such a type
+   exists; otherwise an exception shall occur and may be raised.
+*)
+BEGIN
+  RETURN x+ulp(x)*sign(x)
+END succ;
+ 
+PROCEDURE pred*(x: LONGREAL): LONGREAL;
+(*
+   The value of the call pred(x) shall be the next value of the
+   corresponding real number type less than `x', if such a type exists;
+   otherwise an exception shall occur and may be raised.
+*)
+BEGIN
+  RETURN x-ulp(x)*sign(x)
+END pred;
+
+PROCEDURE MaskReal(x: LONGREAL; lo: INTEGER): LONGREAL;
+VAR ra: LongSet;
+BEGIN
+  MoveSet(x, ra);                            (* type-cast into sets for masking *) 
+  IF lo<32 THEN ra[1]:=ra[1]*{lo..31}        (* just need to mask lower word *)      
+  ELSE ra[0]:=ra[0]*{lo-32..31}; ra[1]:={}   (* mask upper word & clear lower word *)    
+  END;
+  RETURN ToReal(ra)  
+END MaskReal;
+
+PROCEDURE intpart*(x: LONGREAL): LONGREAL;
+(*
+   The value of the call intpart(x) shall be the integral part of `x'.
+   For negative values, this shall be -intpart(abs(x)). 
+*)
+  VAR lo, hi: INTEGER; 
+BEGIN hi:=hiBit+32;                          (* account for low 32-bits as well *)
+  lo:=(hi+1)-exponent(x); 
+  IF lo<=0 THEN RETURN x                     (* no fractional part *)
+  ELSIF lo<=hi+1 THEN RETURN MaskReal(x, lo) (* integer part is extracted *)                            
+  ELSE RETURN 0                              (* no whole part *)
+  END
+END intpart;
+ 
+PROCEDURE fractpart*(x: LONGREAL): LONGREAL;
+(* 
+   The value of the call fractpart(x) shall be the fractional part of
+   `x'.  This satifies the relationship fractpart(x)+intpart(x)=x.
+*)
+BEGIN
+  RETURN x-intpart(x)
+END fractpart;
+ 
+PROCEDURE trunc*(x: LONGREAL; n: INTEGER): LONGREAL;
+(*
+   The value of the call trunc(x,n) shall be the value of the most
+   significant `n' places of `x'.  An exception shall occur and may be
+   raised if `n' is less than or equal to zero.
+*)
+  VAR loBit: INTEGER;
+BEGIN loBit:=places-n;
+  IF n<=0 THEN RETURN ZERO                   (* exception should be raised *)
+  ELSIF loBit<=0 THEN RETURN x               (* nothing was truncated *) 
+  ELSE RETURN MaskReal(x, loBit)             (* clear all lower bits *)
+  END
+END trunc;
+
+PROCEDURE In (bit: INTEGER; x: LONGREAL): BOOLEAN;
+VAR ra: LongSet;
+BEGIN
+  MoveSet(x, ra);                            (* type-cast into sets for masking *)
+  IF bit<32 THEN RETURN bit IN ra[1]         (* check bit in lower word *)      
+  ELSE RETURN bit-32 IN ra[0]                (* check bit in upper word *)    
+  END 
+END In;
+  
+PROCEDURE round*(x: LONGREAL; n: INTEGER): LONGREAL;
+(* 
+   The value of the call round(x,n) shall be the value of `x' rounded to
+   the most significant `n' places.  An exception shall occur and may be
+   raised if such a value does not exist, or if `n' is less than or equal
+   to zero.
+*)
+  VAR loBit: INTEGER; t, r: LONGREAL;
+BEGIN loBit:=places-n;
+  IF n<=0 THEN RETURN ZERO                   (* exception should be raised *)
+  ELSIF loBit<=0 THEN RETURN x               (* nothing was rounded *) 
+  ELSE t:=MaskReal(x, loBit);                (* truncated result *)
+    IF In(loBit-1, x) THEN                   (* check if result should be rounded *)
+      r:=scale(ONE,exponent(x)-n+1);         (* rounding fraction *)
+      IF In(31+32, x) THEN RETURN t-r        (* negative rounding toward -infinity *)
+      ELSE RETURN t+r                        (* positive rounding toward +infinity *)
+      END
+    ELSE RETURN t                            (* return truncated result *)
+    END
+  END
+END round;
+ 
+PROCEDURE synthesize*(expart: INTEGER; frapart: LONGREAL): LONGREAL;
+(*
+   The value of the call synthesize(expart,frapart) shall be a value of
+   the corresponding real number type contructed from the value of
+   `expart' and `frapart'.  This value shall satisfy the relationship
+   synthesize(exponent(x),fraction(x)) = x.
+*)
+BEGIN
+  RETURN scale(frapart, expart)
+END synthesize;
+
+PROCEDURE setMode*(m: Modes);
+(*
+   The call setMode(m) shall set status flags from the value of `m',
+   appropriate to the underlying implementation of the corresponding real
+   number type.  
+  
+   NOTES
+   3 -- Many implementations of floating point provide options for
+   setting flags within the system which control details of the handling
+   of the type.  Although two procedures are provided, one for each real
+   number type, the effect may be the same.  Typical effects that can be
+   obtained by this means are:
+     a) Ensuring that overflow will raise an exception;
+     b) Allowing underflow to raise an exception;
+     c) Controlling the rounding;
+     d) Allowing special values to be produced (e.g. NaNs in
+        implementations conforming to IEC 559:1989 (IEEE 754:1987));
+     e) Ensuring that special valu access will raise an exception;
+   Since these effects are so varied, the values of type `Modes' that may
+   be used are not specified by this International Standard.
+   4 -- The effects of `setMode' on operation on values of the
+   corresponding real number type in coroutines other than the calling
+   coroutine is not defined.  Implementations are not require to preserve
+   the status flags (if any) with the coroutine state. 
+*)
+BEGIN
+  (* hardware dependent mode setting of coprocessor *)
+END setMode;
+ 
+PROCEDURE currentMode*(): Modes;
+(*
+   The value of the call currentMode() shall be the current status flags
+   (in the form set by `setMode'), or the default status flags (if
+   `setMode' is not used).
+
+   NOTE 5 -- The value of the call currentMode() is not necessarily the
+   value of set by `setMode', since a call of `setMode' might attempt to
+   set flags that cannot be set by the program.
+*)
+BEGIN
+  RETURN {}
+END currentMode;
+ 
+PROCEDURE IsLowException*(): BOOLEAN;
+  (* Returns TRUE if the current coroutine is in the exceptional execution state
+     because of the raising of the LowReal exception; otherwise returns FALSE.
+  *)
+BEGIN
+  RETURN FALSE
+END IsLowException;
+
+PROCEDURE InitEndian;
+  VAR endianTest: INTEGER; c: CHAR;
+BEGIN
+  endianTest:=1;
+  S.GET(S.ADR(endianTest), c);
+  isBigEndian:=c#1X
+END InitEndian;
+
+PROCEDURE Test;
+  CONST n1=1.234D39; n2=-1.23343D-20; n3=123.456;
+  VAR n: LONGREAL; exp: INTEGER;
+BEGIN
+  exp:=exponent(n1); exp:=exponent(n2);
+  n:=fraction(n1); n:=fraction(n2);
+  n:=scale(ONE, -8); n:=scale(ONE, 8);
+  n:=succ(10);
+  n:=intpart(n3); 
+  n:=trunc(n3, 5);  (* n=120 *)
+  n:=trunc(n3, 7);  (* n=123 *)
+  n:=trunc(n3, 12); (* n=123.4375 *)
+  n:=round(n3, 5);  (* n=124 *)
+  n:=round(n3, 7);  (* n=123 *) 
+  n:=round(n3, 12); (* n=123.46875 *)
+END Test; 
+
+BEGIN         
+  InitEndian;   (* check whether target is big endian *)
+(*
+    tmp := power0(10,308); (* this is test to calculate small as a variable at runtime; -- noch *)
+    sml := 2.2250738585072014/tmp;
+      sml := 2.2250738585072014/power0(10, 308);
+  *)     
+
+
+  IF DEBUG THEN Test END
+END oocLowLReal.

src/lib/ooc/oocLowReal.Mod

@@ -0,0 +1,387 @@
+(*	$Id: LowReal.Mod,v 1.5 1999/09/02 13:17:38 acken Exp $	*)
+MODULE oocLowReal;
+
+(*
+    LowReal -  Gives access to the underlying properties of the type REAL 
+    for IEEE single-precision numbers. 
+    Copyright (C) 1995 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 S := SYSTEM, Console;
+ 
+(*
+   
+   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*=     24;
+  expoMax*=    127;  
+  expoMin*=    1-expoMax;
+  large*=      MAX(REAL);(*3.40282347E+38;*) (* MAX(REAL) *)
+  (*small*=      1.17549435E-38; (* 2^(-126) *)*)
+  small* =         1/8.50705917E37; (* don't know better way; -- noch *)
+  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;
+  
+  TEN=10.0;             (* some commonly-used constants *)
+  ONE=1.0;             
+  ZERO=0.0;
+    
+  expOffset=expoMax; 
+  hiBit=22;  
+  expBit=hiBit+1;
+  nMask={0..hiBit,31};  (* number mask *)
+  expMask={expBit..30}; (* exponent mask *)
+ 
+TYPE
+  Modes*= SET;
+  
+VAR
+  (*small* : REAL; tmp: REAL;*) (* this was a test to get small as a variable at runtime. obviously, compile time preferred; -- noch *)
+  ErrorHandler*: PROCEDURE (errno : INTEGER);
+  err-: INTEGER;
+
+(* 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
+END DefaultHandler; 
+
+PROCEDURE ClearError*;
+BEGIN
+  err:=0
+END ClearError; 
+ 
+PROCEDURE exponent*(x: REAL): 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.
+ *)
+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 
+  END
+END exponent;
+
+PROCEDURE exponent10*(x: REAL): 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
+  exp:=0; x:=ABS(x);
+  IF x=ZERO THEN RETURN exp END;  (* exception could be raised here *)
+  WHILE x>=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 x<ZERO THEN RETURN -ONE ELSE RETURN ONE END
+END sign;
+
+PROCEDURE scale*(x: REAL; n: INTEGER): REAL;
+(*
+  The value of the call scale(x,n) shall be the value x*radix^n if such
+  a value exists; otherwise an execption shall occur and may be raised.
+*)
+  VAR exp: LONGINT; lexp: SET;
+BEGIN
+  IF x=ZERO THEN RETURN ZERO END;
+  exp:= exponent(x)+n;                          (* new exponent *)
+  IF exp>expoMax THEN RETURN large*sign(x)      (* exception raised here *)
+  ELSIF exp<expoMin THEN RETURN small*sign(x)   (* exception here as well *)
+  END;
+  lexp:=S.VAL(SET,S.LSH(exp+expOffset,expBit)); (* shifted exponent bits *)
+  RETURN S.VAL(REAL,(S.VAL(SET,x)*nMask)+lexp)  (* insert new exponent *)
+END scale;
+ 
+PROCEDURE ulp*(x: REAL): REAL;
+(*
+   The value of the call ulp(x) shall be the value of the corresponding
+   real number type equal to a unit in the last place of `x', if such a
+   value exists; otherwise an exception shall occur and may be raised. 
+*)
+BEGIN
+  RETURN scale(ONE, exponent(x)-places+1)
+END ulp;
+  
+PROCEDURE succ*(x: REAL): REAL;
+(*
+   The value of the call succ(x) shall be the next value of the
+   corresponding real number type greater than `x', if such a type
+   exists; otherwise an exception shall occur and may be raised.
+*)  
+BEGIN
+  RETURN x+ulp(x)*sign(x)
+END succ;
+ 
+PROCEDURE pred*(x: REAL): REAL;
+(*
+   The value of the call pred(x) shall be the next value of the
+   corresponding real number type less than `x', if such a type exists;
+   otherwise an exception shall occur and may be raised.
+*)
+BEGIN
+  RETURN x-ulp(x)*sign(x)
+END pred;
+ 
+PROCEDURE intpart*(x: REAL): REAL;
+(*
+   The value of the call intpart(x) shall be the integral part of `x'.
+   For negative values, this shall be -intpart(abs(x)). 
+*)
+  VAR loBit: INTEGER;
+BEGIN
+  loBit:=(hiBit+1)-exponent(x);
+  IF loBit<=0 THEN RETURN x                     (* no fractional part *)
+  ELSIF loBit<=hiBit+1 THEN 
+    RETURN S.VAL(REAL,S.VAL(SET,x)*{loBit..31}) (* integer part is extracted *)
+  ELSE RETURN ZERO                              (* no whole part *)
+  END
+END intpart;
+ 
+PROCEDURE fractpart*(x: REAL): REAL;
+(* 
+   The value of the call fractpart(x) shall be the fractional part of
+   `x'.  This satifies the relationship fractpart(x)+intpart(x)=x.
+*)
+BEGIN
+  RETURN x-intpart(x)
+END fractpart;
+ 
+PROCEDURE trunc*(x: REAL; n: INTEGER): REAL;
+(*
+   The value of the call trunc(x,n) shall be the value of the most
+   significant `n' places of `x'.  An exception shall occur and may be
+   raised if `n' is less than or equal to zero.
+*)
+  VAR loBit: INTEGER; mask: SET;
+BEGIN loBit:=places-n;
+  IF n<=0 THEN RETURN ZERO                   (* exception should be raised *)
+  ELSIF loBit<=0 THEN RETURN x               (* nothing was truncated *) 
+  ELSE mask:={loBit..31};                    (* truncation bit mask *)
+    RETURN S.VAL(REAL,S.VAL(SET,x)*mask)
+  END
+END trunc;
+ 
+PROCEDURE round*(x: REAL; n: INTEGER): REAL;
+(* 
+   The value of the call round(x,n) shall be the value of `x' rounded to
+   the most significant `n' places.  An exception shall occur and may be
+   raised if such a value does not exist, or if `n' is less than or equal
+   to zero.
+*)
+  VAR loBit: INTEGER; num, mask: SET; r: REAL;
+BEGIN loBit:=places-n;
+  IF n<=0 THEN RETURN ZERO                   (* exception should be raised *)
+  ELSIF loBit<=0 THEN RETURN x               (* nothing was rounded *) 
+  ELSE mask:={loBit..31}; num:=S.VAL(SET,x); (* truncation bit mask and number as SET *)
+    x:=S.VAL(REAL,num*mask);                 (* truncated result *)
+    IF loBit-1 IN num THEN                   (* check if result should be rounded *)
+      r:=scale(ONE,exponent(x)-n+1);         (* rounding fraction *)
+      IF 31 IN num THEN RETURN x-r           (* negative rounding toward -infinity *)
+      ELSE RETURN x+r                        (* positive rounding toward +infinity *)
+      END
+    ELSE RETURN x                            (* return truncated result *)
+    END
+  END
+END round;
+ 
+PROCEDURE synthesize*(expart: INTEGER; frapart: REAL): REAL;
+(*
+   The value of the call synthesize(expart,frapart) shall be a value of
+   the corresponding real number type contructed from the value of
+   `expart' and `frapart'.  This value shall satisfy the relationship
+   synthesize(exponent(x),fraction(x)) = x.
+*)
+BEGIN
+  RETURN scale(frapart, expart)
+END synthesize;
+
+PROCEDURE setMode*(m: Modes);
+(*
+   The call setMode(m) shall set status flags from the value of `m',
+   appropriate to the underlying implementation of the corresponding real
+   number type.  
+  
+   NOTES
+   3 -- Many implementations of floating point provide options for
+   setting flags within the system which control details of the handling
+   of the type.  Although two procedures are provided, one for each real
+   number type, the effect may be the same.  Typical effects that can be
+   obtained by this means are:
+     a) Ensuring that overflow will raise an exception;
+     b) Allowing underflow to raise an exception;
+     c) Controlling the rounding;
+     d) Allowing special values to be produced (e.g. NaNs in
+        implementations conforming to IEC 559:1989 (IEEE 754:1987));
+     e) Ensuring that special valu access will raise an exception;
+   Since these effects are so varied, the values of type `Modes' that may
+   be used are not specified by this International Standard.
+   4 -- The effects of `setMode' on operation on values of the
+   corresponding real number type in coroutines other than the calling
+   coroutine is not defined.  Implementations are not require to preserve
+   the status flags (if any) with the coroutine state. 
+*)
+BEGIN
+  (* hardware dependent mode setting of coprocessor *)
+END setMode;
+ 
+PROCEDURE currentMode*(): Modes;
+(*
+   The value of the call currentMode() shall be the current status flags
+   (in the form set by `setMode'), or the default status flags (if
+   `setMode' is not used).
+
+   NOTE 5 -- The value of the call currentMode() is not necessarily the
+   value of set by `setMode', since a call of `setMode' might attempt to
+   set flags that cannot be set by the program.
+*)
+BEGIN
+  RETURN {}
+END currentMode;
+ 
+PROCEDURE IsLowException*(): BOOLEAN;
+(* 
+   Returns TRUE if the current coroutine is in the exceptional execution state
+   because of the raising of the LowReal exception; otherwise returns FALSE.
+*)
+BEGIN
+  RETURN FALSE
+END IsLowException;
+
+BEGIN
+  (* install the default error handler -- just sets err variable *)
+  ErrorHandler:=DefaultHandler;
+(*  tmp := power0(2,126); (* this is test to calculate small as a variable at runtime; -- noch *)
+  small := sml;
+  small := 1/power0(2,126);
+  *)
+END oocLowReal.
+
+

src/lib/v4/Reals.Mod

@@ -3,10 +3,10 @@ MODULE Reals;
 
   IMPORT S := SYSTEM;
 
-
+(*
   PROCEDURE -ecvt (x: LONGREAL; ndigit, decpt, sign: LONGINT): LONGINT
       "ecvt (x, ndigit, decpt, sign)";
-
+*)
   PROCEDURE Ten*(e: INTEGER): REAL;
     VAR r, power: LONGREAL;
   BEGIN r := 1.0;
@@ -66,17 +66,27 @@ MODULE Reals;
     END
   END Convert;
 
+  PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
+    VAR i, k: LONGINT;
+  BEGIN
+    i := ENTIER(x); k := 0;
+    WHILE k < n DO
+      d[k] := CHR(i MOD 10 + 48); i := i DIV 10; INC(k)
+    END
+  END ConvertL;
+ 
+(* (*commented because ecvt returns smth strange on x86_64, may be types must be checked, but anyway, getting rid of libc dependency is good *)
   PROCEDURE ConvertL*(x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
     VAR decpt, sign, i: LONGINT; buf: LONGINT;
   BEGIN
     (*x := x - 0.5; already rounded in ecvt*)
     buf := ecvt(x, n+2, S.ADR(decpt), S.ADR(sign));
     i := 0;
-    WHILE i < decpt DO S.GET(buf + i, d[n - i -1]); INC(i) END ;
+    WHILE i < decpt DO S.GET(buf + i, d[n - i -1]); INC(i) END ; (* showdef was crashing here on oocLowLReal.sym because of ecvt *)
     i := n - i - 1;
     WHILE i >= 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);