mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 09:52: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
|
|
@ -107,6 +107,12 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|
|||
BEGIN node.typ := OPT.IntType(OPT.IntSize(node.conval.intval))
|
||||
END SetIntType;
|
||||
|
||||
PROCEDURE SetSetType(node: OPT.Node);
|
||||
VAR i32: SYSTEM.INT32;
|
||||
BEGIN SYSTEM.GET(SYSTEM.ADR(node.conval.setval)+4, i32); (* See if upper 32 bits are zero *)
|
||||
IF i32 = 0 THEN node.typ := OPT.set32typ ELSE node.typ := OPT.set64typ END
|
||||
END SetSetType;
|
||||
|
||||
PROCEDURE NewIntConst*(intval: SYSTEM.INT64): OPT.Node;
|
||||
VAR x: OPT.Node;
|
||||
BEGIN
|
||||
|
|
@ -593,7 +599,10 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|
|||
VAR node: OPT.Node; f, g: INTEGER; k: SYSTEM.INT64; r: LONGREAL;
|
||||
BEGIN f := x^.typ^.form; g := typ^.form; (* f: old form, g: new form *)
|
||||
IF x^.class = OPT.Nconst THEN
|
||||
IF f = OPT.Int THEN
|
||||
IF (f = OPT.Set) & (g = OPT.Set) & (x.typ.size > typ.size) THEN
|
||||
SetSetType(x);
|
||||
IF x.typ.size > typ.size THEN err(203); x^.conval^.setval := {} END
|
||||
ELSIF f = OPT.Int THEN
|
||||
IF g = OPT.Int THEN
|
||||
IF x.typ.size > typ.size THEN SetIntType(x);
|
||||
IF x.typ.size > typ.size THEN err(203); x^.conval^.intval := 1 END
|
||||
|
|
@ -663,6 +672,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|
|||
ELSIF g IN {OPT.Int} + OPT.realSet THEN Convert(z, y.typ)
|
||||
ELSE err(100)
|
||||
END
|
||||
|OPT.Set: IF (g = OPT.Set) & (y.typ.size < z.typ.size) THEN Convert(y, z.typ)
|
||||
ELSE err(100)
|
||||
END
|
||||
|OPT.Real: IF g = OPT.Int THEN Convert(y, z^.typ)
|
||||
ELSIF g IN OPT.realSet THEN Convert(z, y^.typ)
|
||||
ELSE err(100)
|
||||
|
|
|
|||
|
|
@ -268,7 +268,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
|
|||
LogWStr(" -f Disable vt100 control characters in status output."); LogWLn;
|
||||
LogWStr(" -V Display compiler debugging messages."); LogWLn;
|
||||
LogWLn;
|
||||
LogWStr(" Size model for elementary types (default O2 on 32 bit builds, OV on 64 bits)"); LogWLn;
|
||||
LogWStr(" Size model for elementary types (default O2)"); LogWLn;
|
||||
LogWStr(" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET."); LogWLn;
|
||||
LogWStr(" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET."); LogWLn;
|
||||
LogWStr(" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET."); LogWLn;
|
||||
|
|
@ -597,10 +597,22 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
|
|||
BEGIN Files.ReadNum(oldSF, k); RETURN k
|
||||
END SymRInt;
|
||||
|
||||
(* todo
|
||||
PROCEDURE SymRInt64*(): SYSTEM.INT64;
|
||||
VAR k: SYSTEM.INT64;
|
||||
BEGIN Files.ReadNum64(oldSF, k); RETURN k
|
||||
BEGIN Files.ReadNum(oldSF, k); RETURN k
|
||||
END SymRInt64;
|
||||
*)
|
||||
|
||||
PROCEDURE SymRInt64*(): SYSTEM.INT64;
|
||||
BEGIN RETURN SymRInt()
|
||||
END SymRInt64;
|
||||
|
||||
(* todo
|
||||
PROCEDURE SymRSet*(VAR s: SYSTEM.SET64);
|
||||
BEGIN Files.ReadNum(oldSF, SYSTEM.VAL(SYSTEM.INT64, s))
|
||||
END SymRSet;
|
||||
*)
|
||||
|
||||
PROCEDURE SymRSet*(VAR s: SET);
|
||||
BEGIN Files.ReadNum(oldSF, SYSTEM.VAL(LONGINT, s))
|
||||
|
|
@ -644,9 +656,15 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
|
|||
END SymWCh;
|
||||
|
||||
PROCEDURE SymWInt*(i: SYSTEM.INT64);
|
||||
BEGIN Files.WriteNum64(newSF, i)
|
||||
BEGIN Files.WriteNum(newSF, i)
|
||||
END SymWInt;
|
||||
|
||||
(* todo
|
||||
PROCEDURE SymWSet*(s: SYSTEM.SET64);
|
||||
BEGIN Files.WriteNum(newSF, SYSTEM.VAL(SYSTEM.INT64, s))
|
||||
END SymWSet;
|
||||
*)
|
||||
|
||||
PROCEDURE SymWSet*(s: SET);
|
||||
BEGIN Files.WriteNum(newSF, SYSTEM.VAL(LONGINT, s))
|
||||
END SymWSet;
|
||||
|
|
|
|||
|
|
@ -15,6 +15,9 @@ TYPE
|
|||
ext*: ConstExt; (* string or code for code proc *)
|
||||
intval*: SYSTEM.INT64; (* constant value or adr, proc par size, text position or least case label *)
|
||||
intval2*: LONGINT; (* string length, proc var size or larger case label *)
|
||||
(* todo
|
||||
setval*: SYSTEM.SET64; (* constant value, procedure body present or "ELSE" present in case *)
|
||||
*)
|
||||
setval*: SET; (* constant value, procedure body present or "ELSE" present in case *)
|
||||
realval*: LONGREAL (* real or longreal constant value *)
|
||||
END;
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
|
||||
|
||||
IMPORT SYSTEM, Platform, Heap, Strings, Configuration, Console;
|
||||
IMPORT SYSTEM, Platform, Heap, Strings, Out := Console;
|
||||
|
||||
(* standard data type I/O
|
||||
|
||||
|
|
@ -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;
|
||||
|
||||
|
||||
|
|
@ -73,18 +73,19 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
|
|||
|
||||
|
||||
PROCEDURE -IdxTrap "__HALT(-1)";
|
||||
PROCEDURE -ToAdr(x: SYSTEM.INT64): SYSTEM.ADDRESS "(address)x";
|
||||
|
||||
PROCEDURE^ Finalize(o: SYSTEM.PTR);
|
||||
|
||||
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errcode: Platform.ErrorCode);
|
||||
BEGIN
|
||||
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
|
||||
Out.Ln; Out.String("-- "); Out.String(s); Out.String(": ");
|
||||
IF f # NIL THEN
|
||||
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END;
|
||||
IF f.fd # 0 THEN Console.String("f.fd = "); Console.Int(f.fd,1) END
|
||||
IF f.registerName # "" THEN Out.String(f.registerName) ELSE Out.String(f.workName) END;
|
||||
IF f.fd # 0 THEN Out.String("f.fd = "); Out.Int(f.fd,1) END
|
||||
END;
|
||||
IF errcode # 0 THEN Console.String(" errcode = "); Console.Int(errcode, 1) END;
|
||||
Console.Ln;
|
||||
IF errcode # 0 THEN Out.String(" errcode = "); Out.Int(errcode, 1) END;
|
||||
Out.Ln;
|
||||
HALT(99)
|
||||
END Err;
|
||||
|
||||
|
|
@ -124,11 +125,11 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
|
|||
err: ARRAY 32 OF CHAR;
|
||||
BEGIN
|
||||
(*
|
||||
Console.String("Files.Create fd = "); Console.Int(f.fd,1);
|
||||
Console.String(", registerName = "); Console.String(f.registerName);
|
||||
Console.String(", workName = "); Console.String(f.workName);
|
||||
Console.String(", state = "); Console.Int(f.state,1);
|
||||
Console.Ln;
|
||||
Out.String("Files.Create fd = "); Out.Int(f.fd,1);
|
||||
Out.String(", registerName = "); Out.String(f.registerName);
|
||||
Out.String(", workName = "); Out.String(f.workName);
|
||||
Out.String(", state = "); Out.Int(f.state,1);
|
||||
Out.Ln;
|
||||
*)
|
||||
IF f.fd = noDesc THEN
|
||||
IF f.state = create THEN
|
||||
|
|
@ -164,17 +165,17 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
|
|||
(* identity: Platform.FileIdentity; *)
|
||||
BEGIN
|
||||
(*
|
||||
Console.String("Files.Flush buf.f.registername = "); Console.String(buf.f.registerName);
|
||||
Console.String(", buf.f.fd = "); Console.Int(buf.f.fd,1);
|
||||
Console.String(", buffer at $"); Console.Hex(SYSTEM.ADR(buf.data));
|
||||
Console.String(", size "); Console.Int(buf.size,1); Console.Ln;
|
||||
Out.String("Files.Flush buf.f.registername = "); Out.String(buf.f.registerName);
|
||||
Out.String(", buf.f.fd = "); Out.Int(buf.f.fd,1);
|
||||
Out.String(", buffer at $"); Out.Hex(SYSTEM.ADR(buf.data));
|
||||
Out.String(", size "); Out.Int(buf.size,1); Out.Ln;
|
||||
*)
|
||||
IF buf.chg THEN f := buf.f; Create(f);
|
||||
IF buf.org # f.pos THEN
|
||||
error := Platform.Seek(f.fd, buf.org, Platform.SeekSet);
|
||||
(*
|
||||
Console.String("Seeking to "); Console.Int(buf.org,1);
|
||||
Console.String(", error code "); Console.Int(error,1); Console.Ln;
|
||||
Out.String("Seeking to "); Out.Int(buf.org,1);
|
||||
Out.String(", error code "); Out.Int(error,1); Out.Ln;
|
||||
*)
|
||||
END;
|
||||
error := Platform.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
|
||||
|
|
@ -295,7 +296,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
|
|||
error: Platform.ErrorCode;
|
||||
identity: Platform.FileIdentity;
|
||||
BEGIN
|
||||
(* Console.String("Files.Old "); Console.String(name); Console.Ln; *)
|
||||
(* Out.String("Files.Old "); Out.String(name); Out.Ln; *)
|
||||
IF name # "" THEN
|
||||
IF HasDir(name) THEN dir := ""; COPY(name, path)
|
||||
ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir)
|
||||
|
|
@ -307,11 +308,11 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
|
|||
error := Platform.OldRO(path, fd); done := error = 0;
|
||||
END;
|
||||
IF ~done & ~Platform.Absent(error) THEN
|
||||
Console.String("Warning: Files.Old "); Console.String(name);
|
||||
Console.String(" error = "); Console.Int(error, 0); Console.Ln;
|
||||
Out.String("Warning: Files.Old "); Out.String(name);
|
||||
Out.String(" error = "); Out.Int(error, 0); Out.Ln;
|
||||
END;
|
||||
IF done THEN
|
||||
(* Console.String(" fd = "); Console.Int(fd,1); Console.Ln; *)
|
||||
(* Out.String(" fd = "); Out.Int(fd,1); Out.Ln; *)
|
||||
error := Platform.Identify(fd, identity);
|
||||
f := CacheEntry(identity);
|
||||
IF f # NIL THEN
|
||||
|
|
@ -365,11 +366,11 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
|
|||
BEGIN
|
||||
IF f # NIL THEN
|
||||
(*
|
||||
Console.String("Files.Set rider on fd = "); Console.Int(f.fd,1);
|
||||
Console.String(", registerName = "); Console.String(f.registerName);
|
||||
Console.String(", workName = "); Console.String(f.workName);
|
||||
Console.String(", state = "); Console.Int(f.state,1);
|
||||
Console.Ln;
|
||||
Out.String("Files.Set rider on fd = "); Out.Int(f.fd,1);
|
||||
Out.String(", registerName = "); Out.String(f.registerName);
|
||||
Out.String(", workName = "); Out.String(f.workName);
|
||||
Out.String(", state = "); Out.Int(f.state,1);
|
||||
Out.Ln;
|
||||
*)
|
||||
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END;
|
||||
offset := pos MOD bufsize; org := pos - offset; i := 0;
|
||||
|
|
@ -427,7 +428,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
|
|||
restInBuf := buf.size - offset;
|
||||
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
|
||||
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END;
|
||||
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
|
||||
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + ToAdr(offset), SYSTEM.ADR(x) + ToAdr(xpos), min);
|
||||
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
|
||||
END;
|
||||
r.res := 0; r.eof := FALSE
|
||||
|
|
@ -465,7 +466,7 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
|
|||
END;
|
||||
restInBuf := bufsize - offset;
|
||||
IF n > restInBuf THEN min := restInBuf ELSE min := n END;
|
||||
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
|
||||
SYSTEM.MOVE(SYSTEM.ADR(x) + ToAdr(xpos), SYSTEM.ADR(buf.data) + ToAdr(offset), min);
|
||||
INC(offset, min); r.offset := offset;
|
||||
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END;
|
||||
INC(xpos, min); DEC(n, min); buf.chg := TRUE
|
||||
|
|
@ -518,8 +519,8 @@ Especially Length would become fairly complex.
|
|||
buf: ARRAY 4096 OF CHAR;
|
||||
BEGIN
|
||||
(*
|
||||
Console.String("Files.Rename old = "); Console.String(old);
|
||||
Console.String(", new = "); Console.String(new); Console.Ln;
|
||||
Out.String("Files.Rename old = "); Out.String(old);
|
||||
Out.String(", new = "); Out.String(new); Out.Ln;
|
||||
*)
|
||||
error := Platform.IdentifyByName(old, oldidentity);
|
||||
IF error = 0 THEN
|
||||
|
|
@ -528,7 +529,7 @@ Especially Length would become fairly complex.
|
|||
Delete(new, error); (* work around stale nfs handles *)
|
||||
END;
|
||||
error := Platform.Rename(old, new);
|
||||
(* Console.String("Platform.Rename error code "); Console.Int(error,1); Console.Ln; *)
|
||||
(* Out.String("Platform.Rename error code "); Out.Int(error,1); Out.Ln; *)
|
||||
IF ~Platform.DifferentFilesystems(error) THEN
|
||||
res := error; RETURN
|
||||
ELSE
|
||||
|
|
@ -564,18 +565,18 @@ Especially Length would become fairly complex.
|
|||
VAR idx, errcode: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
|
||||
BEGIN
|
||||
(*
|
||||
Console.String("Files.Register f.registerName = "); Console.String(f.registerName);
|
||||
Console.String(", fd = "); Console.Int(f.fd,1); Console.Ln;
|
||||
Out.String("Files.Register f.registerName = "); Out.String(f.registerName);
|
||||
Out.String(", fd = "); Out.Int(f.fd,1); Out.Ln;
|
||||
*)
|
||||
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END;
|
||||
Close(f);
|
||||
IF f.registerName # "" THEN
|
||||
Rename(f.workName, f.registerName, errcode);
|
||||
(*
|
||||
Console.String("Renamed (for register) f.fd = "); Console.Int(f.fd,1);
|
||||
Console.String(" from workname "); Console.String(f.workName);
|
||||
Console.String(" to registerName "); Console.String(f.registerName);
|
||||
Console.String(" errorcode = "); Console.Int(errcode,1); Console.Ln;
|
||||
Out.String("Renamed (for register) f.fd = "); Out.Int(f.fd,1);
|
||||
Out.String(" from workname "); Out.String(f.workName);
|
||||
Out.String(" to registerName "); Out.String(f.registerName);
|
||||
Out.String(" errorcode = "); Out.Int(errcode,1); Out.Ln;
|
||||
*)
|
||||
IF errcode # 0 THEN COPY(f.registerName, file); HALT(99) END;
|
||||
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
|
||||
|
|
@ -653,6 +654,17 @@ Especially Length would become fairly complex.
|
|||
UNTIL b
|
||||
END ReadLine;
|
||||
|
||||
(* todo
|
||||
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 ReadNum* (VAR R: Rider; VAR x: LONGINT);
|
||||
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
|
||||
BEGIN s := 0; n := 0; Read(R, ch);
|
||||
|
|
@ -661,18 +673,6 @@ Especially Length would become fairly complex.
|
|||
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 WriteBool* (VAR R: Rider; x: BOOLEAN);
|
||||
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
|
||||
END WriteBool;
|
||||
|
|
@ -714,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);
|
||||
|
|
@ -736,9 +730,9 @@ Especially Length would become fairly complex.
|
|||
BEGIN
|
||||
f := SYSTEM.VAL(File, o);
|
||||
(*
|
||||
Console.String("Files.Finalize f.fd = "); Console.Int(f.fd,1);
|
||||
Console.String(", f.registername = "); Console.String(f.registerName);
|
||||
Console.String(", f.workName = "); Console.String(f.workName); Console.Ln;
|
||||
Out.String("Files.Finalize f.fd = "); Out.Int(f.fd,1);
|
||||
Out.String(", f.registername = "); Out.String(f.registerName);
|
||||
Out.String(", f.workName = "); Out.String(f.workName); Out.Ln;
|
||||
*)
|
||||
IF f.fd >= 0 THEN
|
||||
CloseOSFile(f);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue