mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 04:02:25 +00:00
Implement Out.Real and Out.LongReal.
This commit is contained in:
David Brown
parent
b71526ff5c
commit
a828ff79a4
199 changed files with 1670 additions and 285 deletions
|
|
@ -271,7 +271,7 @@ END div;
|
|||
PROCEDURE^ arctan2* (xn, xd: REAL): REAL;
|
||||
PROCEDURE^ sincos* (x: REAL; VAR Sin, Cos: REAL);
|
||||
|
||||
PROCEDURE round * (x: REAL): LONGINT;
|
||||
PROCEDURE round* (x: REAL): LONGINT;
|
||||
(* Returns the value of x rounded to the nearest integer *)
|
||||
BEGIN
|
||||
IF x < ZERO THEN RETURN -ENTIER(HALF - x)
|
||||
|
|
@ -279,7 +279,7 @@ BEGIN
|
|||
END
|
||||
END round;
|
||||
|
||||
PROCEDURE sqrt * (x: REAL): REAL;
|
||||
PROCEDURE sqrt* (x: REAL): REAL;
|
||||
(* Returns the positive square root of x where x >= 0 *)
|
||||
CONST
|
||||
P0 = 0.41731; P1 = 0.59016;
|
||||
|
|
@ -306,7 +306,7 @@ BEGIN
|
|||
RETURN scale(yEst, xExp DIV 2)
|
||||
END sqrt;
|
||||
|
||||
PROCEDURE exp * (x: REAL): REAL;
|
||||
PROCEDURE exp* (x: REAL): REAL;
|
||||
(* Returns the exponential of x for x < Ln(MAX(REAL)) *)
|
||||
CONST
|
||||
ln2 = 0.6931471805599453094172321D0;
|
||||
|
|
@ -328,7 +328,7 @@ BEGIN
|
|||
RETURN scale(HALF + p/(q - p), SHORT(n + 1))
|
||||
END exp;
|
||||
|
||||
PROCEDURE ln * (x: REAL): REAL;
|
||||
PROCEDURE ln* (x: REAL): REAL;
|
||||
(* Returns the natural logarithm of x for x > 0 *)
|
||||
CONST
|
||||
c1 = 355.0/512.0; c2 = -2.121944400546905827679E-4;
|
||||
|
|
@ -354,7 +354,7 @@ END ln;
|
|||
|
||||
(* The angle in all trigonometric functions is measured in radians *)
|
||||
|
||||
PROCEDURE sin * (x: REAL): REAL;
|
||||
PROCEDURE sin* (x: REAL): REAL;
|
||||
(* Returns the sine of x for all x *)
|
||||
BEGIN
|
||||
IF x < ZERO THEN RETURN SinCos(x, -x, -ONE)
|
||||
|
|
@ -362,13 +362,13 @@ BEGIN
|
|||
END
|
||||
END sin;
|
||||
|
||||
PROCEDURE cos * (x: REAL): REAL;
|
||||
PROCEDURE cos* (x: REAL): REAL;
|
||||
(* Returns the cosine of x for all x *)
|
||||
BEGIN
|
||||
RETURN SinCos(x, ABS(x) + piByTwo, ONE)
|
||||
END cos;
|
||||
|
||||
PROCEDURE tan * (x: REAL): REAL;
|
||||
PROCEDURE tan* (x: REAL): REAL;
|
||||
(* Returns the tangent of x where x cannot be an odd multiple of pi/2 *)
|
||||
CONST
|
||||
ymax = 6434; (* ENTIER(2 * *(MantBits/2) * pi/2) *)
|
||||
|
|
@ -428,7 +428,7 @@ BEGIN
|
|||
END
|
||||
END asincos;
|
||||
|
||||
PROCEDURE arcsin * (x: REAL): REAL;
|
||||
PROCEDURE arcsin* (x: REAL): REAL;
|
||||
(* Returns the arcsine of x, in the range [ - pi/2, pi/2] where -1 <= x <= 1 *)
|
||||
VAR
|
||||
res: REAL; i: LONGINT;
|
||||
|
|
@ -442,7 +442,7 @@ BEGIN
|
|||
RETURN res
|
||||
END arcsin;
|
||||
|
||||
PROCEDURE arccos * (x: REAL): REAL;
|
||||
PROCEDURE arccos* (x: REAL): REAL;
|
||||
(* Returns the arccosine of x, in the range [0, pi] where -1 <= x <= 1 *)
|
||||
VAR
|
||||
res: REAL; i: LONGINT;
|
||||
|
|
@ -497,7 +497,7 @@ BEGIN
|
|||
RETURN res
|
||||
END atan;
|
||||
|
||||
PROCEDURE arctan * (x: REAL): REAL;
|
||||
PROCEDURE arctan* (x: REAL): REAL;
|
||||
(* Returns the arctangent of x, in the range [ - pi/2, pi/2] for all x *)
|
||||
BEGIN
|
||||
IF x < 0 THEN RETURN -atan( - x)
|
||||
|
|
@ -505,7 +505,7 @@ BEGIN
|
|||
END
|
||||
END arctan;
|
||||
|
||||
PROCEDURE power * (base, exp: REAL): REAL;
|
||||
PROCEDURE power* (base, exp: REAL): REAL;
|
||||
(* Returns the value of the number base raised to the power exponent
|
||||
for base > 0 *)
|
||||
CONST P1 = 0.83357541E-1; K = 0.4426950409;
|
||||
|
|
@ -558,7 +558,7 @@ BEGIN
|
|||
RETURN scale(z, SHORT(mp))
|
||||
END power;
|
||||
|
||||
PROCEDURE IsRMathException * (): BOOLEAN;
|
||||
PROCEDURE IsRMathException* (): BOOLEAN;
|
||||
(* Returns TRUE if the current coroutine is in the exceptional execution state
|
||||
because of the raising of the RealMath exception; otherwise returns FALSE.
|
||||
*)
|
||||
|
|
|
|||
|
|
@ -96,7 +96,7 @@ CONST
|
|||
ONE = 1.0D0;
|
||||
HALF = 0.5D0;
|
||||
TWO = 2.0D0;
|
||||
miny = ONE/large; (* Smallest number this package accepts *)
|
||||
miny = ONE/large; (* Smallest number this package accepts *)
|
||||
sqrtHalf = 0.70710678118654752440D0;
|
||||
Limit = 1.0536712D-8; (* 2**(-MantBits/2) *)
|
||||
eps = 5.5511151D-17; (* 2**(-MantBits-1) *)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
MODULE Out; (* D C W Brown. 2016-09-27 *)
|
||||
MODULE Out; (* DCW Brown. 2016-09-27 *)
|
||||
|
||||
IMPORT SYSTEM, Platform;
|
||||
IMPORT SYSTEM, Platform, Strings;
|
||||
|
||||
PROCEDURE Open*;
|
||||
BEGIN
|
||||
|
|
@ -40,16 +40,190 @@ BEGIN
|
|||
WHILE i > 0 DO DEC(i); Char(s[i]) END
|
||||
END Int;
|
||||
|
||||
PROCEDURE Real*(x: REAL; n: INTEGER);
|
||||
BEGIN
|
||||
END Real;
|
||||
|
||||
PROCEDURE LongReal*(x: LONGREAL; n: INTEGER);
|
||||
BEGIN
|
||||
END LongReal;
|
||||
|
||||
PROCEDURE Ln*;
|
||||
BEGIN String(Platform.NL)
|
||||
END Ln;
|
||||
|
||||
|
||||
(* Real and Longreal display *)
|
||||
|
||||
PROCEDURE digit(n: HUGEINT; VAR s: ARRAY OF CHAR; VAR i: INTEGER);
|
||||
BEGIN
|
||||
DEC(i); s[i] := CHR(n MOD 10 + 48);
|
||||
END digit;
|
||||
|
||||
PROCEDURE prepend(t: ARRAY OF CHAR; VAR s: ARRAY OF CHAR; VAR i: INTEGER);
|
||||
VAR j, l: INTEGER;
|
||||
BEGIN
|
||||
l := Strings.Length(t); IF l > i THEN l := i END;
|
||||
DEC(i, l); j := 0;
|
||||
WHILE j < l DO s[i+j] := t[j]; INC(j) END
|
||||
END prepend;
|
||||
|
||||
|
||||
PROCEDURE Ten*(e: INTEGER): REAL;
|
||||
VAR r, power: LONGREAL;
|
||||
BEGIN r := 1.0; power := 10.0;
|
||||
WHILE e > 0 DO
|
||||
IF ODD(e) THEN r := r*power END;
|
||||
power := power*power; e := e DIV 2
|
||||
END;
|
||||
RETURN SHORT(r)
|
||||
END Ten;
|
||||
|
||||
PROCEDURE -Entier32(x: REAL): SYSTEM.INT32 "(int32)(x)";
|
||||
|
||||
PROCEDURE Real*(x: REAL; n: INTEGER);
|
||||
|
||||
(* Real(x, n) writes the real number x to the end of the output stream using an
|
||||
exponential form. If the textual representation of x requires m characters (including a
|
||||
two-digit signed exponent), x is right adjusted in a field of Max(n, m) characters padded
|
||||
with blanks at the left end. A plus sign of the mantissa is not written.
|
||||
REAL is 1/sign, 8/exponent, 23/significand *)
|
||||
|
||||
CONST
|
||||
maxsigdigits = 8; (* Max significant digits to display from mantissa *)
|
||||
|
||||
VAR
|
||||
e: INTEGER; (* Exponent field *)
|
||||
f: SYSTEM.INT32; (* Fraction field *)
|
||||
s: ARRAY 30 OF CHAR; (* Buffer built backwards *)
|
||||
i: INTEGER; (* Index into s *)
|
||||
x0: REAL;
|
||||
nn: BOOLEAN; (* Number negative *)
|
||||
en: BOOLEAN; (* Exponent negative *)
|
||||
m: SYSTEM.INT32; (* Mantissa digits *)
|
||||
d: INTEGER; (* Significant digit count to display *)
|
||||
|
||||
BEGIN
|
||||
nn := SYSTEM.VAL(SYSTEM.INT32, x) < 0; IF nn THEN DEC(n) END;
|
||||
e := SYSTEM.VAL(INTEGER, (SYSTEM.VAL(SYSTEM.INT32, x) DIV 800000H) MOD 100H);
|
||||
f := SYSTEM.VAL(SYSTEM.INT32, x) MOD 800000H;
|
||||
|
||||
i := LEN(s);
|
||||
IF e = 0FFH THEN (* NaN / Infinity *)
|
||||
IF f = 0 THEN prepend("Infinity", s, i) ELSE prepend("NaN", s, i) END
|
||||
ELSE
|
||||
IF e = 0 THEN prepend("E+00", s, i); m := 0;
|
||||
ELSE
|
||||
IF nn THEN x := -x END;
|
||||
|
||||
(* Scale e to be an exponent of 10 rather than 2 *)
|
||||
e := (e - 127) * 77 DIV 256;
|
||||
IF e >= 0 THEN x := x / Ten(e) ELSE x := Ten(-e) * x END ;
|
||||
IF x >= 10.0 THEN x := 0.1 * x; INC(e) END;
|
||||
|
||||
(* Generate the exponent digits *)
|
||||
en := e < 0; IF en THEN e := - e END;
|
||||
d := 2; WHILE d > 0 DO digit(e, s, i); e := e DIV 10; DEC(d) END;
|
||||
IF en THEN prepend("E-", s, i) ELSE prepend("E+", s, i) END;
|
||||
|
||||
(* Scale x to 8 significant digits *)
|
||||
x0 := Ten(maxsigdigits-1); x := x0*x + 0.5;
|
||||
IF x >= 10.0*x0 THEN x := 0.1*x; INC(e) END;
|
||||
m := Entier32(x)
|
||||
END;
|
||||
|
||||
(* Drop trailing zeroes where we don't have room *)
|
||||
d := maxsigdigits;
|
||||
WHILE (d > 2) & (d > n-5) & (m MOD 10 = 0) DO m := m DIV 10; DEC(d) END;
|
||||
|
||||
(* Render significant digits *)
|
||||
WHILE d > 1 DO digit(m, s, i); m := m DIV 10; DEC(d) END;
|
||||
DEC(i); s[i] := '.';
|
||||
digit(m, s, i);
|
||||
END;
|
||||
|
||||
(* Generate leading padding *)
|
||||
DEC(n, LEN(s)-i); WHILE n > 0 DO Char(" "); DEC(n) END;
|
||||
|
||||
(* Render prepared number from right end of buffer s *)
|
||||
IF nn THEN Char("-") END;
|
||||
WHILE i < LEN(s) DO Char(s[i]); INC(i) END
|
||||
END Real;
|
||||
|
||||
|
||||
PROCEDURE TenL(e: INTEGER): LONGREAL;
|
||||
VAR r, power: LONGREAL;
|
||||
BEGIN r := 1.0; power := 10.0;
|
||||
WHILE e > 0 DO
|
||||
IF ODD(e) THEN r := r*power END;
|
||||
power := power*power; e := e DIV 2;
|
||||
END;
|
||||
RETURN r
|
||||
END TenL;
|
||||
|
||||
PROCEDURE -Entier64(x: LONGREAL): SYSTEM.INT64 "(int64)(x)";
|
||||
|
||||
PROCEDURE LongReal*(x: LONGREAL; n: INTEGER);
|
||||
|
||||
(* LongReal(x, n) writes the long real number x to the end of the output stream using an
|
||||
exponential form. If the textual representation of x requires m characters (including a
|
||||
three-digit signed exponent), x is right adjusted in a field of Max(n, m) characters padded
|
||||
with blanks at the left end. A plus sign of the mantissa is not written.
|
||||
LONGREAL is 1/sign, 11/exponent, 52/significand *)
|
||||
|
||||
CONST
|
||||
maxsigdigits = 16; (* Max significant digits to display from mantissa *)
|
||||
|
||||
VAR
|
||||
e: INTEGER; (* Exponent field *)
|
||||
f: HUGEINT; (* Fraction field *)
|
||||
s: ARRAY 30 OF CHAR; (* Buffer built backwards *)
|
||||
i: INTEGER; (* Index into s *)
|
||||
x0: LONGREAL;
|
||||
nn: BOOLEAN; (* Number negative *)
|
||||
en: BOOLEAN; (* Exponent negative *)
|
||||
m: HUGEINT; (* Mantissa digits *)
|
||||
d: INTEGER; (* Significant digit count to display *)
|
||||
|
||||
BEGIN
|
||||
nn := SYSTEM.VAL(HUGEINT, x) < 0; IF nn THEN DEC(n) END;
|
||||
e := SYSTEM.VAL(INTEGER, (SYSTEM.VAL(HUGEINT, x) DIV 10000000000000H) MOD 800H);
|
||||
f := SYSTEM.VAL(HUGEINT, x) MOD 10000000000000H;
|
||||
|
||||
i := LEN(s);
|
||||
IF e = 7FFH THEN (* NaN / Infinity *)
|
||||
IF f = 0 THEN prepend("Infinity", s, i) ELSE prepend("NaN", s, i) END
|
||||
ELSE
|
||||
IF e = 0 THEN prepend("D+000", s, i); m := 0;
|
||||
ELSE
|
||||
IF nn THEN x := -x END;
|
||||
|
||||
(* Scale e to be an exponent of 10 rather than 2 *)
|
||||
e := SHORT(LONG(e - 1023) * 77 DIV 256);
|
||||
IF e >= 0 THEN x := x / TenL(e) ELSE x := TenL(-e) * x END ;
|
||||
IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END;
|
||||
|
||||
(* Generate the exponent digits *)
|
||||
en := e < 0; IF en THEN e := - e END;
|
||||
d := 3; WHILE d > 0 DO digit(e, s, i); e := e DIV 10; DEC(d) END;
|
||||
IF en THEN prepend("D-", s, i) ELSE prepend("D+", s, i) END;
|
||||
|
||||
(* Scale x to 15 significant digits *)
|
||||
x0 := TenL(maxsigdigits-1);
|
||||
x := x0 * x + 0.5D0;
|
||||
IF x >= 10.0D0 * x0 THEN x := 0.1D0 * x; INC(e) END;
|
||||
m := Entier64(x)
|
||||
END;
|
||||
|
||||
(* Drop trailing zeroes where we don't have room *)
|
||||
d := maxsigdigits;
|
||||
WHILE (d > 2) & (d > n-6) & (m MOD 10 = 0) DO m := m DIV 10; DEC(d) END;
|
||||
|
||||
(* Render significant digits *)
|
||||
WHILE d > 1 DO digit(m, s, i); m := m DIV 10; DEC(d) END;
|
||||
DEC(i); s[i] := '.';
|
||||
digit(m, s, i);
|
||||
END;
|
||||
|
||||
(* Generate leading padding *)
|
||||
DEC(n, LEN(s)-i); WHILE n > 0 DO Char(" "); DEC(n) END;
|
||||
|
||||
(* Render prepared number from right end of buffer s *)
|
||||
IF nn THEN Char("-") END;
|
||||
WHILE i < LEN(s) DO Char(s[i]); INC(i) END
|
||||
END LongReal;
|
||||
|
||||
|
||||
END Out.
|
||||
|
|
|
|||
|
|
@ -104,8 +104,8 @@ translate:
|
|||
cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsfF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../Configuration.Mod
|
||||
cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsfF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Platform$(PLATFORM).Mod
|
||||
cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsfFapx -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Heap.Mod
|
||||
cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsfFapx -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Out.Mod
|
||||
cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsfF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Strings.Mod
|
||||
cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsfF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Out.Mod
|
||||
cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsfF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Modules.Mod
|
||||
cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsfFx -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Files.Mod
|
||||
cd $(BUILDDIR); $(ROOTDIR)/$(OBECOMP) -SsfF -A$(ADRSIZE)$(ALIGNMENT) -O$(MODEL) ../../src/runtime/Reals.Mod
|
||||
|
|
@ -195,9 +195,9 @@ runtime:
|
|||
cd $(BUILDDIR)/$(MODEL) && $(COMPILE) -c SYSTEM.c
|
||||
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Platform$(PLATFORM).Mod
|
||||
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Heap.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Out.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Modules.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Strings.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Out.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Files.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/Math.Mod
|
||||
cd $(BUILDDIR)/$(MODEL); $(ROOTDIR)/$(OBECOMP) -Ffs -O$(MODEL) ../../../src/runtime/MathL.Mod
|
||||
|
|
@ -387,6 +387,7 @@ RUNTEST = COMPILER=$(COMPILER) OBECOMP="$(OBECOMP) -O$(MODEL)" FLAVOUR=$(FLAVOUR
|
|||
|
||||
confidence:
|
||||
@printf "\n\n--- Confidence tests ---\n\n"
|
||||
# cd src/test/confidence/math; $(RUNTEST)
|
||||
cd src/test/confidence/hello; $(RUNTEST)
|
||||
cd src/test/confidence/intsyntax; $(RUNTEST)
|
||||
cd src/test/confidence/language; $(RUNTEST)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue