mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 04:02:25 +00:00
Use SYSTEM.INT64 for literal and related values.
This commit is contained in:
David Brown
parent
21964471d8
commit
210870f968
10 changed files with 150 additions and 102 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue