vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 04:02:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Use SYSTEM.INT64 for literal and related values.

Browse source
This commit is contained in:
David Brown 2016-09-18 11:06:16 +01:00
parent 21964471d8
commit 210870f968
10 changed files with 150 additions and 102 deletions
Download patch file Download diff file Expand all files Collapse all files

45
src/compiler/OPB.Mod
View file

@ -10,8 +10,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
VAR VAR
typSize*: PROCEDURE(typ: OPT.Struct); typSize*: PROCEDURE(typ: OPT.Struct);
exp: INTEGER; (*side effect of log*) exp: INTEGER; (* side effect of log*)
maxExp: LONGINT; (* max n in ASH(1, n) on this machine *) maxExp: SYSTEM.INT64; (* max n in ASH(1, n) on this machine *)
PROCEDURE err(n: INTEGER); PROCEDURE err(n: INTEGER);
@ -57,9 +57,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF b THEN RETURN 1 ELSE RETURN 0 END IF b THEN RETURN 1 ELSE RETURN 0 END
END BoolToInt; END BoolToInt;
PROCEDURE IntToBool(i: LONGINT): BOOLEAN; PROCEDURE IntToBool(i: SYSTEM.INT64): BOOLEAN;
BEGIN BEGIN RETURN i # 0
IF i = 0 THEN RETURN FALSE ELSE RETURN TRUE END
END IntToBool; END IntToBool;
PROCEDURE NewBoolConst*(boolval: BOOLEAN): OPT.Node; PROCEDURE NewBoolConst*(boolval: BOOLEAN): OPT.Node;
@ -106,7 +105,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END EmptySet; END EmptySet;
PROCEDURE SetIntType(node: OPT.Node); PROCEDURE SetIntType(node: OPT.Node);
VAR b: INTEGER; n: LONGINT; VAR b: INTEGER; n: SYSTEM.INT64;
BEGIN BEGIN
(* Determine number of bytes required to represent constant value *) (* Determine number of bytes required to represent constant value *)
IF node.conval.intval >= 0 THEN n := node.conval.intval ELSE n := -(node.conval.intval+1) END; IF node.conval.intval >= 0 THEN n := node.conval.intval ELSE n := -(node.conval.intval+1) END;
@ -114,7 +113,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
node.typ := OPT.IntType(b) node.typ := OPT.IntType(b)
END SetIntType; END SetIntType;
PROCEDURE NewIntConst*(intval: LONGINT): OPT.Node; PROCEDURE NewIntConst*(intval: SYSTEM.INT64): OPT.Node;
VAR x: OPT.Node; VAR x: OPT.Node;
BEGIN BEGIN
x := OPT.NewNode(OPT.Nconst); x^.conval := OPT.NewConst(); x := OPT.NewNode(OPT.Nconst); x^.conval := OPT.NewConst();
@ -129,11 +128,11 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
RETURN x RETURN x
END NewRealConst; END NewRealConst;
PROCEDURE NewString*(VAR str: OPS.String; len: LONGINT): OPT.Node; PROCEDURE NewString*(VAR str: OPS.String; len: SYSTEM.INT64): OPT.Node;
VAR x: OPT.Node; VAR x: OPT.Node;
BEGIN BEGIN
x := OPT.NewNode(OPT.Nconst); x^.conval := OPT.NewConst(); x^.typ := OPT.stringtyp; x := OPT.NewNode(OPT.Nconst); x^.conval := OPT.NewConst(); x^.typ := OPT.stringtyp;
x^.conval^.intval := OPM.ConstNotAlloc; x^.conval^.intval2 := len; x^.conval^.intval := OPM.ConstNotAlloc; x^.conval^.intval2 := OPM.Longint(len);
x^.conval^.ext := OPT.NewExt(); x^.conval^.ext^ := str; x^.conval^.ext := OPT.NewExt(); x^.conval^.ext^ := str;
RETURN x RETURN x
END NewString; END NewString;
@ -238,7 +237,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END TypTest; END TypTest;
PROCEDURE In*(VAR x: OPT.Node; y: OPT.Node); PROCEDURE In*(VAR x: OPT.Node; y: OPT.Node);
VAR f: INTEGER; k: LONGINT; VAR f: INTEGER; k: SYSTEM.INT64;
BEGIN f := x^.typ^.form; BEGIN f := x^.typ^.form;
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) OR (y^.class = OPT.Ntype) OR (y^.class = OPT.Nproc) THEN err(126) IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) OR (y^.class = OPT.Ntype) OR (y^.class = OPT.Nproc) THEN err(126)
ELSIF (f = OPT.Int) & (y^.typ^.form = OPT.Set) THEN ELSIF (f = OPT.Int) & (y^.typ^.form = OPT.Set) THEN
@ -255,7 +254,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
x^.typ := OPT.booltyp x^.typ := OPT.booltyp
END In; END In;
PROCEDURE log(x: LONGINT): LONGINT; PROCEDURE log(x: SYSTEM.INT64): SYSTEM.INT64;
BEGIN exp := 0; BEGIN exp := 0;
IF x > 0 THEN IF x > 0 THEN
WHILE ~ODD(x) DO x := x DIV 2; INC(exp) END WHILE ~ODD(x) DO x := x DIV 2; INC(exp) END
@ -302,7 +301,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|OPS.minus: IF f IN {OPT.Int, OPT.Set} + OPT.realSet THEN |OPS.minus: IF f IN {OPT.Int, OPT.Set} + OPT.realSet THEN
IF z^.class = OPT.Nconst THEN IF z^.class = OPT.Nconst THEN
IF f = OPT.Int THEN IF f = OPT.Int THEN
IF z^.conval^.intval = MIN(LONGINT) THEN err(203) IF z^.conval^.intval = MIN(SYSTEM.INT64) THEN err(203)
ELSE z^.conval^.intval := -z^.conval^.intval; SetIntType(z) ELSE z^.conval^.intval := -z^.conval^.intval; SetIntType(z)
END END
ELSIF f IN OPT.realSet THEN z^.conval^.realval := -z^.conval^.realval ELSIF f IN OPT.realSet THEN z^.conval^.realval := -z^.conval^.realval
@ -316,7 +315,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|OPT.abs: IF f IN {OPT.Int} + OPT.realSet THEN |OPT.abs: IF f IN {OPT.Int} + OPT.realSet THEN
IF z^.class = OPT.Nconst THEN IF z^.class = OPT.Nconst THEN
IF f = OPT.Int THEN IF f = OPT.Int THEN
IF z^.conval^.intval = MIN(LONGINT) THEN err(203) IF z^.conval^.intval = MIN(SYSTEM.INT64) THEN err(203)
ELSE z^.conval^.intval := ABS(z^.conval^.intval); SetIntType(z) ELSE z^.conval^.intval := ABS(z^.conval^.intval); SetIntType(z)
END END
ELSE z^.conval^.realval := ABS(z^.conval^.realval) ELSE z^.conval^.realval := ABS(z^.conval^.realval)
@ -416,7 +415,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END CheckProc; END CheckProc;
PROCEDURE ConstOp(op: INTEGER; x, y: OPT.Node); PROCEDURE ConstOp(op: INTEGER; x, y: OPT.Node);
VAR f, g: INTEGER; xval, yval: OPT.Const; xv, yv: LONGINT; VAR f, g: INTEGER; xval, yval: OPT.Const; xv, yv: SYSTEM.INT64;
temp: BOOLEAN; (* temp avoids err 215 *) temp: BOOLEAN; (* temp avoids err 215 *)
PROCEDURE ConstCmp(): INTEGER; PROCEDURE ConstCmp(): INTEGER;
@ -597,7 +596,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END ConstOp; END ConstOp;
PROCEDURE Convert(VAR x: OPT.Node; typ: OPT.Struct); (* Convert node x to new type typ *) PROCEDURE Convert(VAR x: OPT.Node; typ: OPT.Struct); (* Convert node x to new type typ *)
VAR node: OPT.Node; f, g: INTEGER; k: LONGINT; r: LONGREAL; 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 *) BEGIN f := x^.typ^.form; g := typ^.form; (* f: old form, g: new form *)
IF x^.class = OPT.Nconst THEN IF x^.class = OPT.Nconst THEN
IF f = OPT.Int THEN IF f = OPT.Int THEN
@ -628,7 +627,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END Convert; END Convert;
PROCEDURE Op*(op: SHORTINT; VAR x: OPT.Node; y: OPT.Node); PROCEDURE Op*(op: SHORTINT; VAR x: OPT.Node; y: OPT.Node);
VAR f, g: INTEGER; t, z: OPT.Node; typ: OPT.Struct; do: BOOLEAN; val: LONGINT; VAR f, g: INTEGER; t, z: OPT.Node; typ: OPT.Struct; do: BOOLEAN; val: SYSTEM.INT64;
PROCEDURE NewOp(op: SHORTINT; typ: OPT.Struct; VAR x: OPT.Node; y: OPT.Node); PROCEDURE NewOp(op: SHORTINT; typ: OPT.Struct; VAR x: OPT.Node; y: OPT.Node);
VAR node: OPT.Node; VAR node: OPT.Node;
@ -788,7 +787,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END Op; END Op;
PROCEDURE SetRange*(VAR x: OPT.Node; y: OPT.Node); PROCEDURE SetRange*(VAR x: OPT.Node; y: OPT.Node);
VAR k, l: LONGINT; VAR k, l: SYSTEM.INT64;
BEGIN BEGIN
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) OR (y^.class = OPT.Ntype) OR (y^.class = OPT.Nproc) THEN err(126) IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) OR (y^.class = OPT.Ntype) OR (y^.class = OPT.Nproc) THEN err(126)
ELSIF (x^.typ^.form = OPT.Int) & (y^.typ^.form = OPT.Int) THEN ELSIF (x^.typ^.form = OPT.Int) & (y^.typ^.form = OPT.Int) THEN
@ -814,7 +813,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END SetRange; END SetRange;
PROCEDURE SetElem*(VAR x: OPT.Node); PROCEDURE SetElem*(VAR x: OPT.Node);
VAR k: LONGINT; VAR k: SYSTEM.INT64;
BEGIN BEGIN
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
ELSIF x^.typ^.form # OPT.Int THEN err(93) ELSIF x^.typ^.form # OPT.Int THEN err(93)
@ -1034,7 +1033,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|OPT.ashfn: (*ASH*) |OPT.ashfn: (*ASH*)
IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126)
ELSIF f = OPT.Int THEN ELSIF f = OPT.Int THEN
IF x.typ.size # OPT.linttyp.size THEN Convert(x, OPT.linttyp) END IF x.typ.size < OPT.linttyp.size THEN Convert(x, OPT.linttyp) END
ELSE err(111); x^.typ := OPT.linttyp ELSE err(111); x^.typ := OPT.linttyp
END END
|OPT.adrfn: (*SYSTEM.ADR*) |OPT.adrfn: (*SYSTEM.ADR*)
@ -1124,7 +1123,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
|OPT.lenfn: (*LEN*) |OPT.lenfn: (*LEN*)
IF ~(f = OPT.Int) OR (x^.class # OPT.Nconst) THEN err(69) IF ~(f = OPT.Int) OR (x^.class # OPT.Nconst) THEN err(69)
ELSIF x.typ.size = 1 THEN (* Hard limit of 127 dimensions *) ELSIF x.typ.size = 1 THEN (* Hard limit of 127 dimensions *)
L := SHORT(x^.conval^.intval); typ := p^.typ; L := OPM.Integer(x^.conval^.intval); typ := p^.typ;
WHILE (L > 0) & (typ^.comp IN {OPT.DynArr, OPT.Array}) DO typ := typ^.BaseTyp; DEC(L) END ; WHILE (L > 0) & (typ^.comp IN {OPT.DynArr, OPT.Array}) DO typ := typ^.BaseTyp; DEC(L) END ;
IF (L # 0) OR ~(typ^.comp IN {OPT.DynArr, OPT.Array}) THEN err(132) IF (L # 0) OR ~(typ^.comp IN {OPT.DynArr, OPT.Array}) THEN err(132)
ELSE x^.obj := NIL; ELSE x^.obj := NIL;
@ -1150,14 +1149,14 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
IF (p^.class = OPT.Nconst) & (x^.class = OPT.Nconst) THEN IF (p^.class = OPT.Nconst) & (x^.class = OPT.Nconst) THEN
IF (-maxExp > x^.conval^.intval) OR (x^.conval^.intval > maxExp) THEN err(208); p^.conval^.intval := 1 IF (-maxExp > x^.conval^.intval) OR (x^.conval^.intval > maxExp) THEN err(208); p^.conval^.intval := 1
ELSIF x^.conval^.intval >= 0 THEN ELSIF x^.conval^.intval >= 0 THEN
IF ABS(p^.conval^.intval) <= MAX(LONGINT) DIV ASH(1, x^.conval^.intval) THEN IF ABS(p^.conval^.intval) <= MAX(SYSTEM.INT64) DIV ASH(1, x^.conval^.intval) THEN
p^.conval^.intval := p^.conval^.intval * ASH(1, x^.conval^.intval) p^.conval^.intval := p^.conval^.intval * ASH(1, x^.conval^.intval)
ELSE err(208); p^.conval^.intval := 1 ELSE err(208); p^.conval^.intval := 1
END END
ELSE p^.conval^.intval := ASH(p^.conval^.intval, x^.conval^.intval) ELSE p^.conval^.intval := ASH(p^.conval^.intval, x^.conval^.intval)
END ; END ;
p^.obj := NIL p^.obj := NIL
ELSE p := NewOp(OPT.Ndop, OPT.ash, p, x); p^.typ := OPT.linttyp ELSE p := NewOp(OPT.Ndop, OPT.ash, p, x); p^.typ := p.left.typ (* LONGINT, or INT64 if larger *)
END END
ELSE err(111) ELSE err(111)
END END
@ -1482,5 +1481,5 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
END Inittd; END Inittd;
BEGIN BEGIN
maxExp := log(MAX(LONGINT) DIV 2 + 1); maxExp := exp maxExp := log(MAX(SYSTEM.INT64) DIV 2 + 1); maxExp := exp
END OPB. END OPB.

8
src/compiler/OPC.Mod
View file

@ -1218,7 +1218,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END; END;
END Cmp; END Cmp;
PROCEDURE CharacterLiteral(c: LONGINT); PROCEDURE CharacterLiteral(c: SYSTEM.INT64);
BEGIN BEGIN
IF (c < 32) OR (c > 126) THEN IF (c < 32) OR (c > 126) THEN
OPM.WriteString("0x"); OPM.WriteHex(c) OPM.WriteString("0x"); OPM.WriteHex(c)
@ -1258,7 +1258,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.Write(DoubleQuote) OPM.Write(DoubleQuote)
END StringLiteral; END StringLiteral;
PROCEDURE Case*(caseVal: LONGINT; form: INTEGER); PROCEDURE Case*(caseVal: SYSTEM.INT64; form: INTEGER);
VAR VAR
ch: CHAR; ch: CHAR;
BEGIN BEGIN
@ -1286,7 +1286,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
Str1("__HALT(#)", n) Str1("__HALT(#)", n)
END Halt; END Halt;
PROCEDURE IntLiteral*(n, size: LONGINT); PROCEDURE IntLiteral*(n: SYSTEM.INT64; size: LONGINT);
BEGIN BEGIN
IF (size > OPM.CIntSize) & (n <= OPM.CIntMax) & (n > OPM.CIntMin) THEN IF (size > OPM.CIntSize) & (n <= OPM.CIntMax) & (n > OPM.CIntMin) THEN
OPM.WriteString("((int"); OPM.WriteInt(size*8); OPM.WriteString(")("); OPM.WriteString("((int"); OPM.WriteInt(size*8); OPM.WriteString(")(");
@ -1296,7 +1296,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END END
END IntLiteral; END IntLiteral;
PROCEDURE Len* (obj: OPT.Object; array: OPT.Struct; dim: LONGINT); PROCEDURE Len* (obj: OPT.Object; array: OPT.Struct; dim: SYSTEM.INT64);
BEGIN BEGIN
IF array^.comp = OPT.DynArr THEN IF array^.comp = OPT.DynArr THEN
CompleteIdent(obj); OPM.WriteString(LenExt); CompleteIdent(obj); OPM.WriteString(LenExt);

46
src/compiler/OPM.cmdln.Mod
View file

@ -110,7 +110,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
ErrorLineStartPos, ErrorLineLimitPos, ErrorLineNumber: LONGINT; (* Limit = start of next line *) ErrorLineStartPos, ErrorLineLimitPos, ErrorLineNumber: LONGINT; (* Limit = start of next line *)
lasterrpos: LONGINT; lasterrpos: SYSTEM.INT64;
inR: Texts.Reader; inR: Texts.Reader;
Log: Texts.Text; Log: Texts.Text;
W: Texts.Writer; W: Texts.Writer;
@ -129,12 +129,17 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
(* ------------------------- Log Output ------------------------- *) (* ------------------------- Log Output ------------------------- *)
PROCEDURE LogW*(ch: CHAR); BEGIN Console.Char(ch) END LogW; PROCEDURE LogW*(ch: CHAR); BEGIN Console.Char(ch) END LogW;
PROCEDURE LogWStr*(s: ARRAY OF CHAR); BEGIN Console.String(s) END LogWStr; PROCEDURE LogWStr*(s: ARRAY OF CHAR); BEGIN Console.String(s) END LogWStr;
PROCEDURE LogWNum*(i, len: LONGINT); BEGIN Console.Int(i, len) END LogWNum; PROCEDURE LogWNum*(i, len: SYSTEM.INT64); BEGIN Console.Int(i, len) END LogWNum;
PROCEDURE LogWLn*; BEGIN Console.Ln END LogWLn; PROCEDURE LogWLn*; BEGIN Console.Ln END LogWLn;
PROCEDURE Longint* (n: SYSTEM.INT64): LONGINT; BEGIN RETURN SYSTEM.VAL(LONGINT, n) END Longint;
PROCEDURE Integer* (n: SYSTEM.INT64): INTEGER; BEGIN RETURN SYSTEM.VAL(INTEGER, n) END Integer;
(* ------------------------- parameter handling -------------------------*) (* ------------------------- parameter handling -------------------------*)
PROCEDURE ScanOptions(VAR s: ARRAY OF CHAR; VAR opt: SET); PROCEDURE ScanOptions(VAR s: ARRAY OF CHAR; VAR opt: SET);
@ -354,7 +359,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END LogErrMsg; END LogErrMsg;
PROCEDURE FindLine(f: Files.File; VAR r: Files.Rider; pos: LONGINT); PROCEDURE FindLine(f: Files.File; VAR r: Files.Rider; pos: SYSTEM.INT64);
(* Updates ErrorLineStartPos, ErrorLineLimitPos, ErrorLineNumber to (* Updates ErrorLineStartPos, ErrorLineLimitPos, ErrorLineNumber to
describe the line containing pos. describe the line containing pos.
Exits with the rider set to the start of the line conaining pos. *) Exits with the rider set to the start of the line conaining pos. *)
@ -386,7 +391,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END FindLine; END FindLine;
PROCEDURE ShowLine(pos: LONGINT); PROCEDURE ShowLine(pos: SYSTEM.INT64);
VAR VAR
f: Files.File; f: Files.File;
r: Files.Rider; r: Files.Rider;
@ -408,7 +413,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
LogWStr(" "); LogWStr(" ");
IF pos >= ErrorLineLimitPos THEN pos := ErrorLineLimitPos-1 END; IF pos >= ErrorLineLimitPos THEN pos := ErrorLineLimitPos-1 END;
i := SHORT(pos - ErrorLineStartPos); i := SHORT(Longint(pos - ErrorLineStartPos));
WHILE i > 0 DO LogW(" "); DEC(i) END; WHILE i > 0 DO LogW(" "); DEC(i) END;
IF ~notColorOutput THEN vt100.SetAttr(vt100.Green) END; IF ~notColorOutput THEN vt100.SetAttr(vt100.Green) END;
@ -419,7 +424,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END ShowLine; END ShowLine;
PROCEDURE Mark*(n: INTEGER; pos: LONGINT); PROCEDURE Mark*(n: INTEGER; pos: SYSTEM.INT64);
BEGIN BEGIN
IF pos = -1 THEN pos := 0 END; IF pos = -1 THEN pos := 0 END;
IF n >= 0 THEN IF n >= 0 THEN
@ -450,7 +455,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END err; END err;
PROCEDURE FPrint*(VAR fp: LONGINT; val: LONGINT); PROCEDURE FPrint*(VAR fp: LONGINT; val: SYSTEM.INT64);
BEGIN BEGIN
fp := SYSTEM.ROT(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, fp) / SYSTEM.VAL(SET, val)), 1) fp := SYSTEM.ROT(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, fp) / SYSTEM.VAL(SET, val)), 1)
END FPrint; END FPrint;
@ -612,6 +617,11 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
BEGIN Files.ReadNum(oldSF, k); RETURN k BEGIN Files.ReadNum(oldSF, k); RETURN k
END SymRInt; END SymRInt;
PROCEDURE SymRInt64*(): SYSTEM.INT64;
VAR k: SYSTEM.INT64;
BEGIN Files.ReadNum64(oldSF, k); RETURN k
END SymRInt64;
PROCEDURE SymRSet*(VAR s: SET); PROCEDURE SymRSet*(VAR s: SET);
BEGIN Files.ReadNum(oldSF, SYSTEM.VAL(LONGINT, s)) BEGIN Files.ReadNum(oldSF, SYSTEM.VAL(LONGINT, s))
END SymRSet; END SymRSet;
@ -653,8 +663,8 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
BEGIN Files.Write(newSF, ch) BEGIN Files.Write(newSF, ch)
END SymWCh; END SymWCh;
PROCEDURE SymWInt*(i: LONGINT); PROCEDURE SymWInt*(i: SYSTEM.INT64);
BEGIN Files.WriteNum(newSF, i) BEGIN Files.WriteNum64(newSF, i)
END SymWInt; END SymWInt;
PROCEDURE SymWSet*(s: SET); PROCEDURE SymWSet*(s: SET);
@ -709,9 +719,9 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
Files.WriteBytes(R[currFile], s, i) Files.WriteBytes(R[currFile], s, i)
END WriteStringVar; END WriteStringVar;
PROCEDURE WriteHex* (i: LONGINT); PROCEDURE WriteHex* (i: SYSTEM.INT64);
VAR s: ARRAY 3 OF CHAR; VAR s: ARRAY 3 OF CHAR;
digit : INTEGER; digit : SYSTEM.INT32;
BEGIN BEGIN
digit := SHORT(i) DIV 16; digit := SHORT(i) DIV 16;
IF digit < 10 THEN s[0] := CHR (ORD ("0") + digit); ELSE s[0] := CHR (ORD ("a") - 10 + digit ); END; IF digit < 10 THEN s[0] := CHR (ORD ("0") + digit); ELSE s[0] := CHR (ORD ("a") - 10 + digit ); END;
@ -721,10 +731,12 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
WriteString(s) WriteString(s)
END WriteHex; END WriteHex;
PROCEDURE WriteInt* (i: LONGINT); PROCEDURE WriteInt* (i: SYSTEM.INT64);
VAR s: ARRAY 20 OF CHAR; i1, k: LONGINT; VAR s: ARRAY 24 OF CHAR; i1, k: SYSTEM.INT64;
BEGIN BEGIN
IF (i = SignedMinimum(IntSize)) OR (i = SignedMinimum(LIntSize)) THEN IF (i = SignedMinimum(IntSize))
OR (i = SignedMinimum(LIntSize))
OR (i = SignedMinimum(8)) THEN
(* abs(minint) is one more than maxint, causing problems representing the value as a minus sign (* abs(minint) is one more than maxint, causing problems representing the value as a minus sign
followed by absoute value. Therefore represent as -maxint - 1. For INTEGER this avoids a followed by absoute value. Therefore represent as -maxint - 1. For INTEGER this avoids a
compiler warning 'this decimal constant is unsigned only in ISO C90', for LONGINT it is the compiler warning 'this decimal constant is unsigned only in ISO C90', for LONGINT it is the

16
src/compiler/OPP.Mod
View file

@ -1,7 +1,7 @@
MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
IMPORT IMPORT
OPB, OPT, OPS, OPM; OPB, OPT, OPS, OPM, SYSTEM;
TYPE TYPE
CaseTable = ARRAY OPM.MaxCases OF CaseTable = ARRAY OPM.MaxCases OF
@ -69,7 +69,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END CheckMark; END CheckMark;
PROCEDURE CheckSysFlag(VAR sysflag: INTEGER; default: INTEGER); PROCEDURE CheckSysFlag(VAR sysflag: INTEGER; default: INTEGER);
VAR x: OPT.Node; sf: LONGINT; VAR x: OPT.Node; sf: SYSTEM.INT64;
BEGIN BEGIN
IF sym = OPS.lbrak THEN OPS.Get(sym); IF sym = OPS.lbrak THEN OPS.Get(sym);
IF ~OPT.SYSimported THEN err(135) END; IF ~OPT.SYSimported THEN err(135) END;
@ -78,7 +78,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
IF (sf < 0) OR (sf > OPM.MaxSysFlag) THEN err(220); sf := 0 END IF (sf < 0) OR (sf > OPM.MaxSysFlag) THEN err(220); sf := 0 END
ELSE err(51); sf := 0 ELSE err(51); sf := 0
END ; END ;
sysflag := SHORT(sf); CheckSym(OPS.rbrak) sysflag := OPM.Integer(sf); CheckSym(OPS.rbrak)
ELSE sysflag := default ELSE sysflag := default
END END
END CheckSysFlag; END CheckSysFlag;
@ -141,7 +141,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
END RecordType; END RecordType;
PROCEDURE ArrayType(VAR typ, banned: OPT.Struct); PROCEDURE ArrayType(VAR typ, banned: OPT.Struct);
VAR x: OPT.Node; n: LONGINT; sysflag: INTEGER; VAR x: OPT.Node; n: SYSTEM.INT64; sysflag: INTEGER;
BEGIN CheckSysFlag(sysflag, 0); BEGIN CheckSysFlag(sysflag, 0);
IF sym = OPS.of THEN (*dynamic array*) IF sym = OPS.of THEN (*dynamic array*)
typ := OPT.NewStr(OPT.Comp, OPT.DynArr); typ^.mno := 0; typ^.sysflag := sysflag; typ := OPT.NewStr(OPT.Comp, OPT.DynArr); typ^.mno := 0; typ^.sysflag := sysflag;
@ -156,7 +156,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
IF (n <= 0) OR (n > OPM.MaxIndex) THEN err(63); n := 1 END IF (n <= 0) OR (n > OPM.MaxIndex) THEN err(63); n := 1 END
ELSE err(51); n := 1 ELSE err(51); n := 1
END ; END ;
typ^.n := n; typ^.n := OPM.Longint(n);
IF sym = OPS.of THEN IF sym = OPS.of THEN
OPS.Get(sym); Type(typ^.BaseTyp, banned); OPS.Get(sym); Type(typ^.BaseTyp, banned);
typ^.BaseTyp^.pvused := TRUE typ^.BaseTyp^.pvused := TRUE
@ -530,7 +530,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
forward: BOOLEAN; forward: BOOLEAN;
PROCEDURE GetCode; PROCEDURE GetCode;
VAR ext: OPT.ConstExt; n: INTEGER; c: LONGINT; VAR ext: OPT.ConstExt; n: INTEGER; c: SYSTEM.INT64;
BEGIN BEGIN
ext := OPT.NewExt(); proc^.conval^.ext := ext; n := 0; ext := OPT.NewExt(); proc^.conval^.ext := ext; n := 0;
IF sym = OPS.string THEN IF sym = OPS.string THEN
@ -669,7 +669,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
VAR x, y, lastlab: OPT.Node; i, f: INTEGER; xval, yval: LONGINT; VAR x, y, lastlab: OPT.Node; i, f: INTEGER; xval, yval: LONGINT;
BEGIN lab := NIL; lastlab := NIL; BEGIN lab := NIL; lastlab := NIL;
LOOP ConstExpression(x); f := x^.typ^.form; LOOP ConstExpression(x); f := x^.typ^.form;
IF f IN {OPT.Int, OPT.Char} THEN xval := x^.conval^.intval IF f IN {OPT.Int, OPT.Char} THEN xval := OPM.Longint(x^.conval^.intval)
ELSE err(61); xval := 1 ELSE err(61); xval := 1
END; END;
IF f = OPT.Int THEN IF f = OPT.Int THEN
@ -677,7 +677,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
ELSIF LabelTyp.form # f THEN err(60) ELSIF LabelTyp.form # f THEN err(60)
END ; END ;
IF sym = OPS.upto THEN IF sym = OPS.upto THEN
OPS.Get(sym); ConstExpression(y); yval := y^.conval^.intval; OPS.Get(sym); ConstExpression(y); yval := OPM.Longint(y^.conval^.intval);
IF (y^.typ^.form # f) & ~((f = OPT.Int) & (y^.typ^.form = OPT.Int)) THEN err(60) END ; IF (y^.typ^.form # f) & ~((f = OPT.Int) & (y^.typ^.form = OPT.Int)) THEN err(60) END ;
IF yval < xval THEN err(63); yval := xval END IF yval < xval THEN err(63); yval := xval END
ELSE yval := xval ELSE yval := xval

2
src/compiler/OPS.Mod
View file

@ -52,7 +52,7 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
name*: Name; name*: Name;
str*: String; str*: String;
numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *) numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal *)
intval*: LONGINT (* todo SYSTEM.INT64 *); (* integer value or string length *) intval*: SYSTEM.INT64; (* integer value or string length *)
realval*: REAL; realval*: REAL;
lrlval*: LONGREAL; lrlval*: LONGREAL;

76
src/compiler/OPT.Mod
View file

@ -4,7 +4,7 @@ MODULE OPT; (* NW, RC 6.3.89 / 23.1.92 *) (* object model 24.2.94 *)
2002-08-20 jt: NewStr: txtpos remains 0 for structs read from symbol file 2002-08-20 jt: NewStr: txtpos remains 0 for structs read from symbol file
*) *)
IMPORT OPS, OPM; IMPORT OPS, OPM, SYSTEM;
(* Constants - value of literals *) (* Constants - value of literals *)
@ -12,11 +12,11 @@ TYPE
Const* = POINTER TO ConstDesc; Const* = POINTER TO ConstDesc;
ConstExt* = POINTER TO OPS.String; ConstExt* = POINTER TO OPS.String;
ConstDesc* = RECORD ConstDesc* = RECORD
ext*: ConstExt; (* string or code for code proc *) ext*: ConstExt; (* string or code for code proc *)
intval*: LONGINT; (* constant value or adr, proc par size, text position or least case label *) 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 *) intval2*: LONGINT; (* string length, proc var size or larger case label *)
setval*: SET; (* 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 *) realval*: LONGREAL (* real or longreal constant value *)
END; END;
CONST CONST
@ -160,18 +160,18 @@ VAR
realtyp*, lrltyp*, settyp*, stringtyp*, realtyp*, lrltyp*, settyp*, stringtyp*,
niltyp*, notyp*, sysptrtyp*: Struct; niltyp*, notyp*, sysptrtyp*: Struct;
sintobj*, intobj*, lintobj*: Object;
nofGmod*: SHORTINT; (*nof imports*) nofGmod*: SHORTINT; (*nof imports*)
GlbMod*: ARRAY maxImps OF Object; (* ^.right = first object, ^.name = module import name (not alias) *) GlbMod*: ARRAY maxImps OF Object; (* ^.right = first object, ^.name = module import name (not alias) *)
SelfName*: OPS.Name; (* name of module being compiled *) SelfName*: OPS.Name; (* name of module being compiled *)
SYSimported*: BOOLEAN; SYSimported*: BOOLEAN;
IntTypes: ARRAY 20 OF Struct; (* Lists integer types in SHORT/LONG ordering *)
CONST CONST
(* Symbol file items *) (* Symbol file items *)
Smname* = 16; Send* = 18; Stype* = 19; Salias* = 20; Svar* = 21; Smname* = 16; Send* = 18; Stype* = 19; Salias* = 20; Svar* = 21;
Srvar* = 22; Svalpar* = 23; Svarpar* = 24; Sfld* = 25; Srfld* = 26; Srvar* = 22; Svalpar* = 23; Svarpar* = 24; Sfld* = 25; Srfld* = 26;
@ -215,28 +215,30 @@ END err;
PROCEDURE IntType*(size: LONGINT): Struct; PROCEDURE IntType*(size: LONGINT): Struct;
(* Selects smallest standard integer type for given size in bytes *) (* Selects smallest standard integer type for given size in bytes *)
VAR i: INTEGER;
BEGIN BEGIN
i := 1; WHILE i < LEN(IntTypes) - 1 DO (* First and last entries are always NIL *) IF size <= int8typ.size THEN RETURN int8typ END;
IF (IntTypes[i] # NIL) & (IntTypes[i].size >= size) THEN RETURN IntTypes[i] END; IF size <= int16typ.size THEN RETURN int16typ END;
INC(i) IF size <= int32typ.size THEN RETURN int32typ END;
END; RETURN int64typ
END IntType; END IntType;
PROCEDURE ShorterOrLongerType*(x: Struct; dir: INTEGER): Struct; PROCEDURE ShorterOrLongerType*(x: Struct; dir: INTEGER): Struct;
VAR i: INTEGER; VAR i: INTEGER;
BEGIN BEGIN
ASSERT(x.form = Int); ASSERT(x.form = Int);
ASSERT((dir = 1) OR (dir = -1));
(* Not sure if StPar0 (which calls this) always gets the baseiest type. This
ASSERT will tell me. *)
ASSERT(x.BaseTyp = undftyp); ASSERT(x.BaseTyp = undftyp);
(* ASSERT((dir = 1) OR (dir = -1));
WHILE x.BaseTyp # undftyp DO ASSERT(x # x.BaseTyp); ASSERT(x.BaseTyp # NIL); x := x.BaseTyp END; IF dir > 0 THEN
*) IF x.size < sinttyp.size THEN RETURN sinttyp END;
i := 0; WHILE (IntTypes[i] # x) & (i < LEN(IntTypes)) DO INC(i) END; IF x.size < inttyp.size THEN RETURN inttyp END;
ASSERT(i < LEN(IntTypes)-1); IF x.size < linttyp.size THEN RETURN linttyp END;
RETURN IntTypes[i+dir] RETURN int64typ
ELSE
IF x.size > linttyp.size THEN RETURN linttyp END;
IF x.size > inttyp.size THEN RETURN inttyp END;
IF x.size > sinttyp.size THEN RETURN sinttyp END;
RETURN int8typ
END
END ShorterOrLongerType; END ShorterOrLongerType;
@ -1175,6 +1177,13 @@ END Import;
typ^.idfp := form; typ^.idfpdone := TRUE; res := typ typ^.idfp := form; typ^.idfpdone := TRUE; res := typ
END EnterTyp; END EnterTyp;
PROCEDURE EnterTypeAlias(name: OPS.Name; VAR res: Object);
VAR obj: Object;
BEGIN
Insert(name, obj); obj^.mode := Typ; obj^.typ := NIL; obj^.vis := external;
res := obj
END EnterTypeAlias;
PROCEDURE EnterProc(name: OPS.Name; num: INTEGER); PROCEDURE EnterProc(name: OPS.Name; num: INTEGER);
VAR obj: Object; VAR obj: Object;
BEGIN Insert(name, obj); BEGIN Insert(name, obj);
@ -1195,6 +1204,7 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0;
EnterTyp("INT16", Int, 2, int16typ); EnterTyp("INT16", Int, 2, int16typ);
EnterTyp("INT32", Int, 4, int32typ); EnterTyp("INT32", Int, 4, int32typ);
EnterTyp("INT64", Int, 8, int64typ); EnterTyp("INT64", Int, 8, int64typ);
EnterProc("ADR", adrfn); EnterProc("ADR", adrfn);
EnterProc("CC", ccfn); EnterProc("CC", ccfn);
EnterProc("LSH", lshfn); EnterProc("LSH", lshfn);
@ -1207,17 +1217,20 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0;
EnterProc("VAL", valfn); EnterProc("VAL", valfn);
EnterProc("NEW", sysnewfn); EnterProc("NEW", sysnewfn);
EnterProc("MOVE", movefn); EnterProc("MOVE", movefn);
syslink := topScope^.right; syslink := topScope^.right;
universe := topScope; topScope^.right := NIL; universe := topScope; topScope^.right := NIL;
EnterTyp("BOOLEAN", Bool, OPM.BoolSize, booltyp); EnterTyp("BOOLEAN", Bool, OPM.BoolSize, booltyp);
EnterTyp("CHAR", Char, OPM.CharSize, chartyp); EnterTyp("CHAR", Char, OPM.CharSize, chartyp);
EnterTyp("SET", Set, OPM.SetSize, settyp); EnterTyp("SET", Set, OPM.SetSize, settyp);
EnterTyp("REAL", Real, OPM.RealSize, realtyp); EnterTyp("REAL", Real, OPM.RealSize, realtyp);
EnterTyp("INTEGER", Int, OPM.IntSize, inttyp);
EnterTyp("LONGINT", Int, OPM.LIntSize, linttyp);
EnterTyp("LONGREAL", LReal, OPM.LRealSize, lrltyp); EnterTyp("LONGREAL", LReal, OPM.LRealSize, lrltyp);
EnterTyp("SHORTINT", Int, OPM.SIntSize, sinttyp);
EnterTypeAlias("SHORTINT", sintobj);
EnterTypeAlias("INTEGER", intobj);
EnterTypeAlias("LONGINT", lintobj);
EnterBoolConst("FALSE", 0); (* 0 and 1 are compiler internal representation only *) EnterBoolConst("FALSE", 0); (* 0 and 1 are compiler internal representation only *)
EnterBoolConst("TRUE", 1); EnterBoolConst("TRUE", 1);
@ -1248,7 +1261,7 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0;
impCtxt.ref[Byte] := bytetyp; impCtxt.ref[Byte] := bytetyp;
impCtxt.ref[Bool] := booltyp; impCtxt.ref[Bool] := booltyp;
impCtxt.ref[Char] := chartyp; impCtxt.ref[Char] := chartyp;
impCtxt.ref[Int] := inttyp; impCtxt.ref[Int] := int32typ;
impCtxt.ref[Real] := realtyp; impCtxt.ref[Real] := realtyp;
impCtxt.ref[LReal] := lrltyp; impCtxt.ref[LReal] := lrltyp;
impCtxt.ref[Set] := settyp; impCtxt.ref[Set] := settyp;
@ -1257,15 +1270,6 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0;
impCtxt.ref[NoTyp] := notyp; impCtxt.ref[NoTyp] := notyp;
impCtxt.ref[Pointer] := sysptrtyp; impCtxt.ref[Pointer] := sysptrtyp;
IntTypes[1] := sinttyp;
IntTypes[2] := inttyp;
IntTypes[3] := linttyp;
IntTypes[5] := int8typ;
IntTypes[6] := int16typ;
IntTypes[7] := int32typ;
IntTypes[8] := int64typ
END OPT. END OPT.
Objects: Objects:

19
src/compiler/OPV.Mod
View file

@ -5,7 +5,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
various promotion rules changed (long) => (LONGINT), xxxL avoided various promotion rules changed (long) => (LONGINT), xxxL avoided
*) *)
IMPORT OPT, OPC, OPM, OPS; IMPORT OPT, OPC, OPM, OPS, SYSTEM;
CONST CONST
UndefinedType = 0; (* named type not yet defined *) UndefinedType = 0; (* named type not yet defined *)
@ -181,6 +181,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE AdrAndSize* (topScope: OPT.Object); PROCEDURE AdrAndSize* (topScope: OPT.Object);
BEGIN BEGIN
ASSERT(OPT.sinttyp # NIL); ASSERT(OPT.inttyp # NIL); ASSERT(OPT.linttyp # NIL);
OPM.errpos := topScope^.adr; (* text position of scope used if error *) OPM.errpos := topScope^.adr; (* text position of scope used if error *)
topScope^.leaf := TRUE; topScope^.leaf := TRUE;
Traverse(topScope^.right, topScope, TRUE); (* first pass only on exported types and procedures *) Traverse(topScope^.right, topScope, TRUE); (* first pass only on exported types and procedures *)
@ -189,15 +191,18 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPT.chartyp^.strobj^.linkadr := PredefinedType; OPT.chartyp^.strobj^.linkadr := PredefinedType;
OPT.settyp^.strobj^.linkadr := PredefinedType; OPT.settyp^.strobj^.linkadr := PredefinedType;
OPT.realtyp^.strobj^.linkadr := PredefinedType; OPT.realtyp^.strobj^.linkadr := PredefinedType;
(* SHORTINT, INTEGER and LONGINT are alternate names for INT8, INT16, INT32 and INT64 and have not been set up yet.
OPT.sinttyp^.strobj^.linkadr := PredefinedType;
OPT.inttyp^.strobj^.linkadr := PredefinedType; OPT.inttyp^.strobj^.linkadr := PredefinedType;
OPT.linttyp^.strobj^.linkadr := PredefinedType; OPT.linttyp^.strobj^.linkadr := PredefinedType;
*)
OPT.adrtyp^.strobj^.linkadr := PredefinedType; OPT.adrtyp^.strobj^.linkadr := PredefinedType;
OPT.int8typ^.strobj^.linkadr := PredefinedType; OPT.int8typ^.strobj^.linkadr := PredefinedType;
OPT.int16typ^.strobj^.linkadr := PredefinedType; OPT.int16typ^.strobj^.linkadr := PredefinedType;
OPT.int32typ^.strobj^.linkadr := PredefinedType; OPT.int32typ^.strobj^.linkadr := PredefinedType;
OPT.int64typ^.strobj^.linkadr := PredefinedType; OPT.int64typ^.strobj^.linkadr := PredefinedType;
OPT.lrltyp^.strobj^.linkadr := PredefinedType; OPT.lrltyp^.strobj^.linkadr := PredefinedType;
OPT.sinttyp^.strobj^.linkadr := PredefinedType;
OPT.booltyp^.strobj^.linkadr := PredefinedType; OPT.booltyp^.strobj^.linkadr := PredefinedType;
OPT.bytetyp^.strobj^.linkadr := PredefinedType; OPT.bytetyp^.strobj^.linkadr := PredefinedType;
OPT.sysptrtyp^.strobj^.linkadr := PredefinedType; OPT.sysptrtyp^.strobj^.linkadr := PredefinedType;
@ -256,7 +261,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE^ expr (n: OPT.Node; prec: INTEGER); PROCEDURE^ expr (n: OPT.Node; prec: INTEGER);
PROCEDURE^ design(n: OPT.Node; prec: INTEGER); PROCEDURE^ design(n: OPT.Node; prec: INTEGER);
PROCEDURE Len(n: OPT.Node; dim: LONGINT); PROCEDURE Len(n: OPT.Node; dim: SYSTEM.INT64);
BEGIN BEGIN
WHILE (n^.class = OPT.Nindex) & (n^.typ^.comp = OPT.DynArr(*26.7.2002*)) DO INC(dim); n := n^.left END ; WHILE (n^.class = OPT.Nindex) & (n^.typ^.comp = OPT.DynArr(*26.7.2002*)) DO INC(dim); n := n^.left END ;
IF (n^.class = OPT.Nderef) & (n^.typ^.comp = OPT.DynArr) THEN IF (n^.class = OPT.Nderef) & (n^.typ^.comp = OPT.DynArr) THEN
@ -430,7 +435,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
IF prec > designPrec THEN OPM.Write(CloseParen) END IF prec > designPrec THEN OPM.Write(CloseParen) END
END design; END design;
PROCEDURE ParIntLiteral(n, size: LONGINT); PROCEDURE ParIntLiteral(n: SYSTEM.INT64; size: LONGINT);
BEGIN BEGIN
(* Literal parameters (other than varargs) do not need an explicit size cast on ansi C compilers. *) (* Literal parameters (other than varargs) do not need an explicit size cast on ansi C compilers. *)
IF ansi THEN OPM.WriteInt(n) ELSE OPC.IntLiteral(n, size) END IF ansi THEN OPM.WriteInt(n) ELSE OPC.IntLiteral(n, size) END
@ -723,7 +728,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
PROCEDURE CaseStat(n: OPT.Node; outerProc: OPT.Object); PROCEDURE CaseStat(n: OPT.Node; outerProc: OPT.Object);
VAR switchCase, label: OPT.Node; VAR switchCase, label: OPT.Node;
low, high: LONGINT; form, i: INTEGER; low, high: SYSTEM.INT64; form, i: INTEGER;
BEGIN BEGIN
OPM.WriteString("switch "); expr(n^.left, MaxPrec); OPM.WriteString("switch "); expr(n^.left, MaxPrec);
OPM.Write(Blank); OPC.BegBlk; OPM.Write(Blank); OPC.BegBlk;
@ -812,7 +817,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
VAR proc: OPT.Object; saved: ExitInfo; l, r: OPT.Node; VAR proc: OPT.Object; saved: ExitInfo; l, r: OPT.Node;
BEGIN BEGIN
WHILE (n # NIL) & OPM.noerr DO WHILE (n # NIL) & OPM.noerr DO
OPM.errpos := n^.conval^.intval; OPM.errpos := OPM.Longint(n^.conval^.intval);
IF n^.class # OPT.Ninittd THEN OPC.BegStat END; IF n^.class # OPT.Ninittd THEN OPC.BegStat END;
CASE n^.class OF CASE n^.class OF
| OPT.Nenter: IF n^.obj = NIL THEN (* enter module *) | OPT.Nenter: IF n^.obj = NIL THEN (* enter module *)
@ -942,7 +947,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
END END
END END
| OPT.Nwith: IfStat(n, n^.subcl = 0, outerProc) | OPT.Nwith: IfStat(n, n^.subcl = 0, outerProc)
| OPT.Ntrap: OPC.Halt(n^.right^.conval^.intval) | OPT.Ntrap: OPC.Halt(OPM.Longint(n^.right^.conval^.intval))
ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn; ELSE OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn;
END; END;
IF ~(n^.class IN {OPT.Nenter, OPT.Ninittd, OPT.Nifelse, OPT.Nwith, OPT.Ncase, OPT.Nwhile, OPT.Nloop}) THEN OPC.EndStat END ; IF ~(n^.class IN {OPT.Nenter, OPT.Ninittd, OPT.Nifelse, OPT.Nwith, OPT.Ncase, OPT.Nwhile, OPT.Nloop}) THEN OPC.EndStat END ;

17
src/compiler/Vishap.Mod
View file

@ -56,12 +56,21 @@ MODULE Vishap; (* J. Templ 3.2.95 *)
OPT.chartyp.size := OPM.CharSize; OPT.chartyp.size := OPM.CharSize;
OPT.settyp.size := OPM.SetSize; OPT.settyp.size := OPM.SetSize;
OPT.realtyp.size := OPM.RealSize; OPT.realtyp.size := OPM.RealSize;
OPT.inttyp.size := OPM.IntSize;
OPT.linttyp.size := OPM.LIntSize;
OPT.adrtyp.size := OPM.PointerSize; OPT.adrtyp.size := OPM.PointerSize;
OPT.lrltyp.size := OPM.LRealSize; OPT.lrltyp.size := OPM.LRealSize;
OPT.sinttyp.size := OPM.SIntSize; OPT.booltyp.size := OPM.BoolSize;
OPT.booltyp.size := OPM.BoolSize
OPT.sinttyp := OPT.int8typ;
IF OPM.IntSize = 2 THEN
OPT.inttyp := OPT.int16typ;
OPT.linttyp := OPT.int32typ
ELSE
OPT.inttyp := OPT.int32typ;
OPT.linttyp := OPT.int64typ
END;
OPT.sintobj.typ := OPT.sinttyp;
OPT.intobj.typ := OPT.inttyp;
OPT.lintobj.typ := OPT.linttyp
END PropagateElementaryTypeSizes; END PropagateElementaryTypeSizes;

5
src/system/Console.Mod
View file

@ -27,7 +27,8 @@ MODULE Console; (* J. Templ, 29-June-96 *)
WHILE s[i] # 0X DO Char(s[i]); INC(i) END WHILE s[i] # 0X DO Char(s[i]); INC(i) END
END String; END String;
PROCEDURE Int*(i, n: LONGINT); (* todo. support int64 properly *)
PROCEDURE Int*(i, n: SYSTEM.INT64);
VAR s: ARRAY 32 OF CHAR; i1, k: LONGINT; VAR s: ARRAY 32 OF CHAR; i1, k: LONGINT;
BEGIN BEGIN
IF i = SYSTEM.LSH(LONG(LONG(1)), SIZE(LONGINT)*8 - 1) THEN IF i = SYSTEM.LSH(LONG(LONG(1)), SIZE(LONGINT)*8 - 1) THEN
@ -35,7 +36,7 @@ MODULE Console; (* J. Templ, 29-June-96 *)
ELSE s := "8463847412"; k := 10 ELSE s := "8463847412"; k := 10
END END
ELSE ELSE
i1 := ABS(i); i1 := ABS(SYSTEM.VAL(LONGINT,i));
s[0] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; k := 1; s[0] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; k := 1;
WHILE i1 > 0 DO s[k] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; INC(k) END WHILE i1 > 0 DO s[k] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; INC(k) END
END ; END ;

18
src/system/Files.Mod
View file

@ -663,6 +663,18 @@ Especially Length would become fairly complex.
x := n x := n
END ReadNum; 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); PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
BEGIN Write(R, SYSTEM.VAL(CHAR, x)) BEGIN Write(R, SYSTEM.VAL(CHAR, x))
END WriteBool; END WriteBool;
@ -710,6 +722,12 @@ Especially Length would become fairly complex.
Write(R, CHR(x MOD 128)) Write(R, CHR(x MOD 128))
END WriteNum; 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); PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
BEGIN BEGIN
COPY (f.workName, name); COPY (f.workName, name);