From 210870f968fccfb8bfd5a9a4f059c2cf8b22f26a Mon Sep 17 00:00:00 2001 From: David Brown Date: Sun, 18 Sep 2016 11:06:16 +0100 Subject: [PATCH] Use SYSTEM.INT64 for literal and related values. --- src/compiler/OPB.Mod | 45 +++++++++++----------- src/compiler/OPC.Mod | 8 ++-- src/compiler/OPM.cmdln.Mod | 46 ++++++++++++++--------- src/compiler/OPP.Mod | 16 ++++---- src/compiler/OPS.Mod | 2 +- src/compiler/OPT.Mod | 76 ++++++++++++++++++++------------------ src/compiler/OPV.Mod | 19 ++++++---- src/compiler/Vishap.Mod | 17 +++++++-- src/system/Console.Mod | 5 ++- src/system/Files.Mod | 18 +++++++++ 10 files changed, 150 insertions(+), 102 deletions(-) diff --git a/src/compiler/OPB.Mod b/src/compiler/OPB.Mod index ee6dc10a..09805f14 100644 --- a/src/compiler/OPB.Mod +++ b/src/compiler/OPB.Mod @@ -10,8 +10,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) VAR typSize*: PROCEDURE(typ: OPT.Struct); - exp: INTEGER; (*side effect of log*) - maxExp: LONGINT; (* max n in ASH(1, n) on this machine *) + exp: INTEGER; (* side effect of log*) + maxExp: SYSTEM.INT64; (* max n in ASH(1, n) on this machine *) 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 END BoolToInt; - PROCEDURE IntToBool(i: LONGINT): BOOLEAN; - BEGIN - IF i = 0 THEN RETURN FALSE ELSE RETURN TRUE END + PROCEDURE IntToBool(i: SYSTEM.INT64): BOOLEAN; + BEGIN RETURN i # 0 END IntToBool; 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; PROCEDURE SetIntType(node: OPT.Node); - VAR b: INTEGER; n: LONGINT; + VAR b: INTEGER; n: SYSTEM.INT64; BEGIN (* 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; @@ -114,7 +113,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) node.typ := OPT.IntType(b) END SetIntType; - PROCEDURE NewIntConst*(intval: LONGINT): OPT.Node; + PROCEDURE NewIntConst*(intval: SYSTEM.INT64): OPT.Node; VAR x: OPT.Node; BEGIN 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 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; BEGIN 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; RETURN x END NewString; @@ -238,7 +237,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END TypTest; 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; 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 @@ -255,7 +254,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) x^.typ := OPT.booltyp END In; - PROCEDURE log(x: LONGINT): LONGINT; + PROCEDURE log(x: SYSTEM.INT64): SYSTEM.INT64; BEGIN exp := 0; IF x > 0 THEN 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 IF z^.class = OPT.Nconst 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) END 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 IF z^.class = OPT.Nconst 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) END 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; 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 *) PROCEDURE ConstCmp(): INTEGER; @@ -597,7 +596,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ConstOp; 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 *) IF x^.class = OPT.Nconst 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; 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); VAR node: OPT.Node; @@ -788,7 +787,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END Op; PROCEDURE SetRange*(VAR x: OPT.Node; y: OPT.Node); - VAR k, l: LONGINT; + VAR k, l: SYSTEM.INT64; BEGIN 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 @@ -814,7 +813,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END SetRange; PROCEDURE SetElem*(VAR x: OPT.Node); - VAR k: LONGINT; + VAR k: SYSTEM.INT64; BEGIN IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) 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*) IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) 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 END |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*) IF ~(f = OPT.Int) OR (x^.class # OPT.Nconst) THEN err(69) 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 ; IF (L # 0) OR ~(typ^.comp IN {OPT.DynArr, OPT.Array}) THEN err(132) 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 (-maxExp > x^.conval^.intval) OR (x^.conval^.intval > maxExp) THEN err(208); p^.conval^.intval := 1 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) ELSE err(208); p^.conval^.intval := 1 END ELSE p^.conval^.intval := ASH(p^.conval^.intval, x^.conval^.intval) END ; 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 ELSE err(111) END @@ -1482,5 +1481,5 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END Inittd; BEGIN - maxExp := log(MAX(LONGINT) DIV 2 + 1); maxExp := exp + maxExp := log(MAX(SYSTEM.INT64) DIV 2 + 1); maxExp := exp END OPB. diff --git a/src/compiler/OPC.Mod b/src/compiler/OPC.Mod index c5b16ad0..9febea62 100644 --- a/src/compiler/OPC.Mod +++ b/src/compiler/OPC.Mod @@ -1218,7 +1218,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END; END Cmp; - PROCEDURE CharacterLiteral(c: LONGINT); + PROCEDURE CharacterLiteral(c: SYSTEM.INT64); BEGIN IF (c < 32) OR (c > 126) THEN 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) END StringLiteral; - PROCEDURE Case*(caseVal: LONGINT; form: INTEGER); + PROCEDURE Case*(caseVal: SYSTEM.INT64; form: INTEGER); VAR ch: CHAR; BEGIN @@ -1286,7 +1286,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) Str1("__HALT(#)", n) END Halt; - PROCEDURE IntLiteral*(n, size: LONGINT); + PROCEDURE IntLiteral*(n: SYSTEM.INT64; size: LONGINT); BEGIN IF (size > OPM.CIntSize) & (n <= OPM.CIntMax) & (n > OPM.CIntMin) THEN 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 IntLiteral; - PROCEDURE Len* (obj: OPT.Object; array: OPT.Struct; dim: LONGINT); + PROCEDURE Len* (obj: OPT.Object; array: OPT.Struct; dim: SYSTEM.INT64); BEGIN IF array^.comp = OPT.DynArr THEN CompleteIdent(obj); OPM.WriteString(LenExt); diff --git a/src/compiler/OPM.cmdln.Mod b/src/compiler/OPM.cmdln.Mod index a7810f0c..b497829f 100644 --- a/src/compiler/OPM.cmdln.Mod +++ b/src/compiler/OPM.cmdln.Mod @@ -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 *) - lasterrpos: LONGINT; + lasterrpos: SYSTEM.INT64; inR: Texts.Reader; Log: Texts.Text; 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 ------------------------- *) - PROCEDURE LogW*(ch: CHAR); BEGIN Console.Char(ch) END LogW; - 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 LogWLn*; BEGIN Console.Ln END LogWLn; + PROCEDURE LogW*(ch: CHAR); BEGIN Console.Char(ch) END LogW; + PROCEDURE LogWStr*(s: ARRAY OF CHAR); BEGIN Console.String(s) END LogWStr; + PROCEDURE LogWNum*(i, len: SYSTEM.INT64); BEGIN Console.Int(i, len) END LogWNum; + 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 -------------------------*) 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; - 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 describe the line containing 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; - PROCEDURE ShowLine(pos: LONGINT); + PROCEDURE ShowLine(pos: SYSTEM.INT64); VAR f: Files.File; 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(" "); 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; 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; - PROCEDURE Mark*(n: INTEGER; pos: LONGINT); + PROCEDURE Mark*(n: INTEGER; pos: SYSTEM.INT64); BEGIN IF pos = -1 THEN pos := 0 END; 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; - PROCEDURE FPrint*(VAR fp: LONGINT; val: LONGINT); + PROCEDURE FPrint*(VAR fp: LONGINT; val: SYSTEM.INT64); BEGIN fp := SYSTEM.ROT(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, fp) / SYSTEM.VAL(SET, val)), 1) 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 END SymRInt; + PROCEDURE SymRInt64*(): SYSTEM.INT64; + VAR k: SYSTEM.INT64; + BEGIN Files.ReadNum64(oldSF, k); RETURN k + END SymRInt64; + PROCEDURE SymRSet*(VAR s: SET); BEGIN Files.ReadNum(oldSF, SYSTEM.VAL(LONGINT, s)) 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) END SymWCh; - PROCEDURE SymWInt*(i: LONGINT); - BEGIN Files.WriteNum(newSF, i) + PROCEDURE SymWInt*(i: SYSTEM.INT64); + BEGIN Files.WriteNum64(newSF, i) END SymWInt; 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) END WriteStringVar; - PROCEDURE WriteHex* (i: LONGINT); + PROCEDURE WriteHex* (i: SYSTEM.INT64); VAR s: ARRAY 3 OF CHAR; - digit : INTEGER; + digit : SYSTEM.INT32; BEGIN digit := SHORT(i) DIV 16; 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) END WriteHex; - PROCEDURE WriteInt* (i: LONGINT); - VAR s: ARRAY 20 OF CHAR; i1, k: LONGINT; + PROCEDURE WriteInt* (i: SYSTEM.INT64); + VAR s: ARRAY 24 OF CHAR; i1, k: SYSTEM.INT64; 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 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 diff --git a/src/compiler/OPP.Mod b/src/compiler/OPP.Mod index 84966442..72b6701d 100644 --- a/src/compiler/OPP.Mod +++ b/src/compiler/OPP.Mod @@ -1,7 +1,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) IMPORT - OPB, OPT, OPS, OPM; + OPB, OPT, OPS, OPM, SYSTEM; TYPE 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; PROCEDURE CheckSysFlag(VAR sysflag: INTEGER; default: INTEGER); - VAR x: OPT.Node; sf: LONGINT; + VAR x: OPT.Node; sf: SYSTEM.INT64; BEGIN IF sym = OPS.lbrak THEN OPS.Get(sym); 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 ELSE err(51); sf := 0 END ; - sysflag := SHORT(sf); CheckSym(OPS.rbrak) + sysflag := OPM.Integer(sf); CheckSym(OPS.rbrak) ELSE sysflag := default END END CheckSysFlag; @@ -141,7 +141,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END RecordType; 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); IF sym = OPS.of THEN (*dynamic array*) 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 ELSE err(51); n := 1 END ; - typ^.n := n; + typ^.n := OPM.Longint(n); IF sym = OPS.of THEN OPS.Get(sym); Type(typ^.BaseTyp, banned); 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; PROCEDURE GetCode; - VAR ext: OPT.ConstExt; n: INTEGER; c: LONGINT; + VAR ext: OPT.ConstExt; n: INTEGER; c: SYSTEM.INT64; BEGIN ext := OPT.NewExt(); proc^.conval^.ext := ext; n := 0; 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; BEGIN lab := NIL; lastlab := NIL; 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 END; 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) END ; 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 yval < xval THEN err(63); yval := xval END ELSE yval := xval diff --git a/src/compiler/OPS.Mod b/src/compiler/OPS.Mod index e386e538..909cdee2 100644 --- a/src/compiler/OPS.Mod +++ b/src/compiler/OPS.Mod @@ -52,7 +52,7 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *) name*: Name; str*: String; 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; lrlval*: LONGREAL; diff --git a/src/compiler/OPT.Mod b/src/compiler/OPT.Mod index cd1eae8b..a97b3876 100644 --- a/src/compiler/OPT.Mod +++ b/src/compiler/OPT.Mod @@ -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 *) -IMPORT OPS, OPM; +IMPORT OPS, OPM, SYSTEM; (* Constants - value of literals *) @@ -12,11 +12,11 @@ TYPE Const* = POINTER TO ConstDesc; ConstExt* = POINTER TO OPS.String; ConstDesc* = RECORD - ext*: ConstExt; (* string or code for code proc *) - intval*: LONGINT; (* constant value or adr, proc par size, text position or least 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 *) - realval*: LONGREAL (* real or longreal constant value *) + 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 *) + setval*: SET; (* constant value, procedure body present or "ELSE" present in case *) + realval*: LONGREAL (* real or longreal constant value *) END; CONST @@ -160,18 +160,18 @@ VAR realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*: Struct; + sintobj*, intobj*, lintobj*: Object; + nofGmod*: SHORTINT; (*nof imports*) GlbMod*: ARRAY maxImps OF Object; (* ^.right = first object, ^.name = module import name (not alias) *) SelfName*: OPS.Name; (* name of module being compiled *) SYSimported*: BOOLEAN; - IntTypes: ARRAY 20 OF Struct; (* Lists integer types in SHORT/LONG ordering *) + CONST - - (* Symbol file items *) Smname* = 16; Send* = 18; Stype* = 19; Salias* = 20; Svar* = 21; Srvar* = 22; Svalpar* = 23; Svarpar* = 24; Sfld* = 25; Srfld* = 26; @@ -215,28 +215,30 @@ END err; PROCEDURE IntType*(size: LONGINT): Struct; (* Selects smallest standard integer type for given size in bytes *) - VAR i: INTEGER; BEGIN - i := 1; WHILE i < LEN(IntTypes) - 1 DO (* First and last entries are always NIL *) - IF (IntTypes[i] # NIL) & (IntTypes[i].size >= size) THEN RETURN IntTypes[i] END; - INC(i) - END; + IF size <= int8typ.size THEN RETURN int8typ END; + IF size <= int16typ.size THEN RETURN int16typ END; + IF size <= int32typ.size THEN RETURN int32typ END; + RETURN int64typ END IntType; PROCEDURE ShorterOrLongerType*(x: Struct; dir: INTEGER): Struct; VAR i: INTEGER; BEGIN 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); - (* - WHILE x.BaseTyp # undftyp DO ASSERT(x # x.BaseTyp); ASSERT(x.BaseTyp # NIL); x := x.BaseTyp END; - *) - i := 0; WHILE (IntTypes[i] # x) & (i < LEN(IntTypes)) DO INC(i) END; - ASSERT(i < LEN(IntTypes)-1); - RETURN IntTypes[i+dir] + ASSERT((dir = 1) OR (dir = -1)); + IF dir > 0 THEN + IF x.size < sinttyp.size THEN RETURN sinttyp END; + IF x.size < inttyp.size THEN RETURN inttyp END; + IF x.size < linttyp.size THEN RETURN linttyp END; + 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; @@ -1175,6 +1177,13 @@ END Import; typ^.idfp := form; typ^.idfpdone := TRUE; res := typ 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); VAR obj: Object; BEGIN Insert(name, obj); @@ -1195,6 +1204,7 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; EnterTyp("INT16", Int, 2, int16typ); EnterTyp("INT32", Int, 4, int32typ); EnterTyp("INT64", Int, 8, int64typ); + EnterProc("ADR", adrfn); EnterProc("CC", ccfn); EnterProc("LSH", lshfn); @@ -1207,17 +1217,20 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; EnterProc("VAL", valfn); EnterProc("NEW", sysnewfn); EnterProc("MOVE", movefn); + syslink := topScope^.right; universe := topScope; topScope^.right := NIL; + EnterTyp("BOOLEAN", Bool, OPM.BoolSize, booltyp); EnterTyp("CHAR", Char, OPM.CharSize, chartyp); EnterTyp("SET", Set, OPM.SetSize, settyp); 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("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("TRUE", 1); @@ -1248,7 +1261,7 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; impCtxt.ref[Byte] := bytetyp; impCtxt.ref[Bool] := booltyp; impCtxt.ref[Char] := chartyp; - impCtxt.ref[Int] := inttyp; + impCtxt.ref[Int] := int32typ; impCtxt.ref[Real] := realtyp; impCtxt.ref[LReal] := lrltyp; impCtxt.ref[Set] := settyp; @@ -1257,15 +1270,6 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; impCtxt.ref[NoTyp] := notyp; 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. Objects: diff --git a/src/compiler/OPV.Mod b/src/compiler/OPV.Mod index f4a82ca5..d8486ca9 100644 --- a/src/compiler/OPV.Mod +++ b/src/compiler/OPV.Mod @@ -5,7 +5,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 various promotion rules changed (long) => (LONGINT), xxxL avoided *) - IMPORT OPT, OPC, OPM, OPS; + IMPORT OPT, OPC, OPM, OPS, SYSTEM; CONST 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); BEGIN + ASSERT(OPT.sinttyp # NIL); ASSERT(OPT.inttyp # NIL); ASSERT(OPT.linttyp # NIL); + OPM.errpos := topScope^.adr; (* text position of scope used if error *) topScope^.leaf := TRUE; 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.settyp^.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.linttyp^.strobj^.linkadr := PredefinedType; + *) OPT.adrtyp^.strobj^.linkadr := PredefinedType; OPT.int8typ^.strobj^.linkadr := PredefinedType; OPT.int16typ^.strobj^.linkadr := PredefinedType; OPT.int32typ^.strobj^.linkadr := PredefinedType; OPT.int64typ^.strobj^.linkadr := PredefinedType; OPT.lrltyp^.strobj^.linkadr := PredefinedType; - OPT.sinttyp^.strobj^.linkadr := PredefinedType; OPT.booltyp^.strobj^.linkadr := PredefinedType; OPT.bytetyp^.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^ design(n: OPT.Node; prec: INTEGER); - PROCEDURE Len(n: OPT.Node; dim: LONGINT); + PROCEDURE Len(n: OPT.Node; dim: SYSTEM.INT64); BEGIN 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 @@ -430,7 +435,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 IF prec > designPrec THEN OPM.Write(CloseParen) END END design; - PROCEDURE ParIntLiteral(n, size: LONGINT); + PROCEDURE ParIntLiteral(n: SYSTEM.INT64; size: LONGINT); BEGIN (* 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 @@ -723,7 +728,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 PROCEDURE CaseStat(n: OPT.Node; outerProc: OPT.Object); VAR switchCase, label: OPT.Node; - low, high: LONGINT; form, i: INTEGER; + low, high: SYSTEM.INT64; form, i: INTEGER; BEGIN OPM.WriteString("switch "); expr(n^.left, MaxPrec); 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; BEGIN 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; CASE n^.class OF | 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 | 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; END; IF ~(n^.class IN {OPT.Nenter, OPT.Ninittd, OPT.Nifelse, OPT.Nwith, OPT.Ncase, OPT.Nwhile, OPT.Nloop}) THEN OPC.EndStat END ; diff --git a/src/compiler/Vishap.Mod b/src/compiler/Vishap.Mod index 3323883d..33481260 100644 --- a/src/compiler/Vishap.Mod +++ b/src/compiler/Vishap.Mod @@ -56,12 +56,21 @@ MODULE Vishap; (* J. Templ 3.2.95 *) OPT.chartyp.size := OPM.CharSize; OPT.settyp.size := OPM.SetSize; OPT.realtyp.size := OPM.RealSize; - OPT.inttyp.size := OPM.IntSize; - OPT.linttyp.size := OPM.LIntSize; OPT.adrtyp.size := OPM.PointerSize; 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; diff --git a/src/system/Console.Mod b/src/system/Console.Mod index 430519df..6b35a090 100644 --- a/src/system/Console.Mod +++ b/src/system/Console.Mod @@ -27,7 +27,8 @@ MODULE Console; (* J. Templ, 29-June-96 *) WHILE s[i] # 0X DO Char(s[i]); INC(i) END 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; BEGIN 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 END ELSE - i1 := ABS(i); + i1 := ABS(SYSTEM.VAL(LONGINT,i)); 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 END ; diff --git a/src/system/Files.Mod b/src/system/Files.Mod index 7aeee5ac..fb9fc421 100644 --- a/src/system/Files.Mod +++ b/src/system/Files.Mod @@ -663,6 +663,18 @@ 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; @@ -710,6 +722,12 @@ Especially Length would become fairly complex. 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);