mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 14:32:24 +00:00
SET32 and SET64 compatibility and bootstrap update.
This commit is contained in:
David Brown
parent
08bf8d2fc3
commit
6dedf34785
202 changed files with 1650 additions and 1272 deletions
|
|
@ -58,8 +58,8 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
|
|||
res*: LONGINT;
|
||||
eof*: BOOLEAN;
|
||||
buf: Buffer;
|
||||
org: LONGINT;
|
||||
offset: LONGINT
|
||||
org: LONGINT; (* File offset of block containing current position *)
|
||||
offset: LONGINT (* Current position offset within block at org. *)
|
||||
END;
|
||||
|
||||
|
||||
|
|
@ -654,6 +654,7 @@ Especially Length would become fairly complex.
|
|||
UNTIL b
|
||||
END ReadLine;
|
||||
|
||||
(*
|
||||
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
|
||||
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
|
||||
BEGIN s := 0; n := 0; Read(R, ch);
|
||||
|
|
@ -661,18 +662,16 @@ Especially Length would become fairly complex.
|
|||
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
|
||||
x := n
|
||||
END ReadNum;
|
||||
|
||||
PROCEDURE ReadNum64* (VAR R: Rider; VAR x: SYSTEM.INT64);
|
||||
(* todo. use proper code when INC/ASH properly support INT64 on 32 bit platforms
|
||||
VAR s: SHORTINT; ch: CHAR; n: SYSTEM.INT64;
|
||||
BEGIN s := 0; n := 0; Read(R, ch);
|
||||
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
|
||||
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
|
||||
x := n
|
||||
*)
|
||||
VAR n: LONGINT;
|
||||
BEGIN ReadNum(R, n); x := n
|
||||
END ReadNum64;
|
||||
|
||||
PROCEDURE ReadNum*(VAR R: Rider; VAR x: ARRAY OF SYSTEM.BYTE);
|
||||
VAR s, b: SYSTEM.INT8; q: SYSTEM.INT64;
|
||||
BEGIN s := 0; q := 0; Read(R, b);
|
||||
WHILE b >= 128 DO INC(q, ASH(b-128, s)); INC(s, 7); Read(R, b) END;
|
||||
INC(q, ASH(b MOD 64 - b DIV 64 * 64, s));
|
||||
ASSERT(LEN(x) <= 8);
|
||||
SYSTEM.MOVE(SYSTEM.ADR(q), SYSTEM.ADR(x), LEN(x)) (* Assumes little endian representation of q and x. *)
|
||||
END ReadNum;
|
||||
|
||||
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
|
||||
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
|
||||
|
|
@ -715,18 +714,12 @@ Especially Length would become fairly complex.
|
|||
WriteBytes(R, x, i+1)
|
||||
END WriteString;
|
||||
|
||||
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
|
||||
PROCEDURE WriteNum* (VAR R: Rider; x: SYSTEM.INT64);
|
||||
BEGIN
|
||||
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
|
||||
Write(R, CHR(x MOD 128))
|
||||
END WriteNum;
|
||||
|
||||
PROCEDURE WriteNum64* (VAR R: Rider; x: SYSTEM.INT64);
|
||||
BEGIN
|
||||
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
|
||||
Write(R, CHR(x MOD 128))
|
||||
END WriteNum64;
|
||||
|
||||
PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
COPY (f.workName, name);
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ MODULE LowReal;
|
|||
*)
|
||||
|
||||
|
||||
IMPORT S := SYSTEM, Reals;
|
||||
IMPORT SYSTEM;
|
||||
|
||||
(*
|
||||
|
||||
|
|
@ -99,13 +99,13 @@ CONST
|
|||
ZERO = 0.0;
|
||||
|
||||
expOffset = expoMax;
|
||||
hiBit = 22;
|
||||
expBit = hiBit+1;
|
||||
nMask = {0..hiBit,31}; (* number mask *)
|
||||
expMask = {expBit..30}; (* exponent mask *)
|
||||
(*hiBit = 22;*)
|
||||
(*expBit = hiBit+1;*)
|
||||
nMask = {0..22,31}; (* number mask *)
|
||||
expMask = {23..30}; (* exponent mask *)
|
||||
|
||||
TYPE
|
||||
Modes*= SET;
|
||||
Modes* = SET;
|
||||
|
||||
VAR
|
||||
(*small* : REAL; tmp: REAL;*) (* this was a test to get small as a variable at runtime. obviously, compile time preferred; -- noch *)
|
||||
|
|
@ -131,15 +131,24 @@ PROCEDURE exponent*(x: REAL): INTEGER;
|
|||
that lies between `expoMin' and `expoMax'. An exception shall occur
|
||||
and may be raised if `x' is equal to 0.0.
|
||||
*)
|
||||
VAR w: SYSTEM.INT16;
|
||||
BEGIN
|
||||
(* NOTE: x=0.0 should raise exception *)
|
||||
IF x = ZERO THEN RETURN 0
|
||||
ELSE RETURN Reals.Expo(x) - expOffset
|
||||
END
|
||||
IF x = ZERO THEN RETURN 0 END;
|
||||
|
||||
RETURN SYSTEM.VAL(INTEGER, SYSTEM.LSH((SYSTEM.VAL(SYSTEM.SET32, x) * expMask), -23));
|
||||
|
||||
|
||||
SYSTEM.GET(SYSTEM.ADR(x)+2, w); (* Load most significant word *)
|
||||
RETURN ((w DIV 128) MOD 256) - expOffset
|
||||
END exponent;
|
||||
|
||||
PROCEDURE SetExponent(VAR x: REAL; ex: INTEGER);
|
||||
BEGIN Reals.SetExpo(x, ex + expOffset)
|
||||
PROCEDURE SetExponent(VAR x: REAL; ex: SYSTEM.INT32);
|
||||
VAR s: SYSTEM.SET32;
|
||||
BEGIN
|
||||
ex := SYSTEM.LSH(ex + expOffset, 23);
|
||||
s := SYSTEM.VAL(SYSTEM.SET32, s) * nMask + SYSTEM.VAL(SYSTEM.SET32, ex) * expMask;
|
||||
SYSTEM.PUT(SYSTEM.ADR(x), s)
|
||||
END SetExponent;
|
||||
|
||||
PROCEDURE exponent10*(x: REAL): INTEGER;
|
||||
|
|
@ -170,20 +179,20 @@ BEGIN
|
|||
IF x=ZERO THEN RETURN ZERO
|
||||
ELSE
|
||||
(* Set top 7 bits of exponent to 0111111 *)
|
||||
S.GET(S.ADR(x)+3, c);
|
||||
SYSTEM.GET(SYSTEM.ADR(x)+3, c);
|
||||
c := CHR(((ORD(c) DIV 128) * 128) + 63); (* Set X0111111 (X unchanged) *)
|
||||
S.PUT(S.ADR(x)+3, c);
|
||||
SYSTEM.PUT(SYSTEM.ADR(x)+3, c);
|
||||
(* Set bottom bit of exponent to 0 *)
|
||||
S.GET(S.ADR(x)+2, c);
|
||||
SYSTEM.GET(SYSTEM.ADR(x)+2, c);
|
||||
c := CHR(ORD(c) MOD 128); (* Set 0XXXXXXX (X unchanged) *)
|
||||
S.PUT(S.ADR(x)+2, c);
|
||||
SYSTEM.PUT(SYSTEM.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 *)
|
||||
ELSE RETURN SYSTEM.VAL(REAL,(SYSTEM.VAL(SET,x)*nMask)+eZero)*2.0 (* set the mantissa's exponent to zero *)
|
||||
END
|
||||
*)
|
||||
END fraction;
|
||||
|
|
@ -191,20 +200,20 @@ END fraction;
|
|||
PROCEDURE IsInfinity * (real: REAL) : BOOLEAN;
|
||||
VAR c0, c1, c2, c3: CHAR;
|
||||
BEGIN
|
||||
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);
|
||||
SYSTEM.GET(SYSTEM.ADR(real)+0, c3);
|
||||
SYSTEM.GET(SYSTEM.ADR(real)+1, c2);
|
||||
SYSTEM.GET(SYSTEM.ADR(real)+2, c1);
|
||||
SYSTEM.GET(SYSTEM.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;
|
||||
VAR c0, c1, c2, c3: CHAR;
|
||||
BEGIN
|
||||
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);
|
||||
SYSTEM.GET(SYSTEM.ADR(real)+0, c3);
|
||||
SYSTEM.GET(SYSTEM.ADR(real)+1, c2);
|
||||
SYSTEM.GET(SYSTEM.ADR(real)+2, c1);
|
||||
SYSTEM.GET(SYSTEM.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))
|
||||
|
|
@ -235,8 +244,8 @@ BEGIN
|
|||
END;
|
||||
SetExponent(x, SHORT(exp));
|
||||
(* SetExponent replaces these 2 lines:
|
||||
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 *)
|
||||
lexp := SYSTEM.VAL(SET, SYSTEM.LSH(exp + expOffset, expBit)); (* shifted exponent bits *)
|
||||
RETURN SYSTEM.VAL(REAL, (SYSTEM.VAL(SET, x) * nMask) + lexp) (* insert new exponent *)
|
||||
*)
|
||||
END scale;
|
||||
|
||||
|
|
@ -280,7 +289,7 @@ 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 *)
|
||||
RETURN SYSTEM.VAL(REAL,SYSTEM.VAL(SET,x)*{loBit..31}) (* integer part is extracted *)
|
||||
ELSE RETURN ZERO (* no whole part *)
|
||||
END
|
||||
END intpart;
|
||||
|
|
@ -305,7 +314,7 @@ 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)
|
||||
RETURN SYSTEM.VAL(REAL,SYSTEM.VAL(SET,x)*mask)
|
||||
END
|
||||
END trunc;
|
||||
|
||||
|
|
@ -320,8 +329,8 @@ PROCEDURE round*(x: REAL; n: INTEGER): 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 *)
|
||||
ELSE mask:={loBit..31}; num:=SYSTEM.VAL(SET,x); (* truncation bit mask and number as SET *)
|
||||
x:=SYSTEM.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 *)
|
||||
|
|
|
|||
|
|
@ -573,6 +573,10 @@ BEGIN t:=ABS(x);
|
|||
RETURN arcsinh(x/sqrt(ONE-x*x))
|
||||
END arctanh;
|
||||
|
||||
PROCEDURE ToREAL(h: HUGEINT): REAL;
|
||||
BEGIN RETURN SYSTEM.VAL(REAL, h)
|
||||
END ToREAL;
|
||||
|
||||
BEGIN
|
||||
(* determine some fundamental constants used by hyperbolic trig functions *)
|
||||
em:=l.ulp(ONE);
|
||||
|
|
@ -582,31 +586,31 @@ BEGIN
|
|||
t:=l.pred(ONE)/sqrt(em); TanhMax:=ln(t+sqrt(t*t+ONE));
|
||||
|
||||
(* initialize some tables for the power() function a1[i]=2**((1-i)/16) *)
|
||||
a1[1] :=ONE;
|
||||
a1[2] :=S.VAL(REAL, 3F75257DH);
|
||||
a1[3] :=S.VAL(REAL, 3F6AC0C7H);
|
||||
a1[4] :=S.VAL(REAL, 3F60CCDFH);
|
||||
a1[5] :=S.VAL(REAL, 3F5744FDH);
|
||||
a1[6] :=S.VAL(REAL, 3F4E248CH);
|
||||
a1[7] :=S.VAL(REAL, 3F45672AH);
|
||||
a1[8] :=S.VAL(REAL, 3F3D08A4H);
|
||||
a1[9] :=S.VAL(REAL, 3F3504F3H);
|
||||
a1[10]:=S.VAL(REAL, 3F2D583FH);
|
||||
a1[11]:=S.VAL(REAL, 3F25FED7H);
|
||||
a1[12]:=S.VAL(REAL, 3F1EF532H);
|
||||
a1[13]:=S.VAL(REAL, 3F1837F0H);
|
||||
a1[14]:=S.VAL(REAL, 3F11C3D3H);
|
||||
a1[15]:=S.VAL(REAL, 3F0B95C2H);
|
||||
a1[16]:=S.VAL(REAL, 3F05AAC3H);
|
||||
a1[17]:=HALF;
|
||||
a1[1] := ONE;
|
||||
a1[2] := ToREAL(3F75257DH);
|
||||
a1[3] := ToREAL(3F6AC0C7H);
|
||||
a1[4] := ToREAL(3F60CCDFH);
|
||||
a1[5] := ToREAL(3F5744FDH);
|
||||
a1[6] := ToREAL(3F4E248CH);
|
||||
a1[7] := ToREAL(3F45672AH);
|
||||
a1[8] := ToREAL(3F3D08A4H);
|
||||
a1[9] := ToREAL(3F3504F3H);
|
||||
a1[10] := ToREAL(3F2D583FH);
|
||||
a1[11] := ToREAL(3F25FED7H);
|
||||
a1[12] := ToREAL(3F1EF532H);
|
||||
a1[13] := ToREAL(3F1837F0H);
|
||||
a1[14] := ToREAL(3F11C3D3H);
|
||||
a1[15] := ToREAL(3F0B95C2H);
|
||||
a1[16] := ToREAL(3F05AAC3H);
|
||||
a1[17] := HALF;
|
||||
|
||||
(* a2[i]=2**[(1-2i)/16] - a1[2i]; delta resolution *)
|
||||
a2[1]:=S.VAL(REAL, 31A92436H);
|
||||
a2[2]:=S.VAL(REAL, 336C2A95H);
|
||||
a2[3]:=S.VAL(REAL, 31A8FC24H);
|
||||
a2[4]:=S.VAL(REAL, 331F580CH);
|
||||
a2[5]:=S.VAL(REAL, 336A42A1H);
|
||||
a2[6]:=S.VAL(REAL, 32C12342H);
|
||||
a2[7]:=S.VAL(REAL, 32E75624H);
|
||||
a2[8]:=S.VAL(REAL, 32CF9890H)
|
||||
a2[1] := ToREAL(31A92436H);
|
||||
a2[2] := ToREAL(336C2A95H);
|
||||
a2[3] := ToREAL(31A8FC24H);
|
||||
a2[4] := ToREAL(331F580CH);
|
||||
a2[5] := ToREAL(336A42A1H);
|
||||
a2[6] := ToREAL(32C12342H);
|
||||
a2[7] := ToREAL(32E75624H);
|
||||
a2[8] := ToREAL(32CF9890H)
|
||||
END oocRealMath.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue