diff --git a/src/compiler/OPB.Mod b/src/compiler/OPB.Mod index 6da12c5e..cfb983b5 100644 --- a/src/compiler/OPB.Mod +++ b/src/compiler/OPB.Mod @@ -105,41 +105,13 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) x^.conval := OPT.NewConst(); x^.conval^.setval := {}; RETURN x END EmptySet; - - (* Integer size support *) - - PROCEDURE SignedByteSize(n: LONGINT): INTEGER; - (* Returns number of bytes required to represent signed value n *) - VAR b: INTEGER; - BEGIN - IF n < 0 THEN n := -(n+1) END; (* Positive value in the range 0 - 7F.. *) - b := 1; WHILE (b < 8) & (ASH(n, -(8*b-1)) # 0) DO INC(b) END; - RETURN b - END SignedByteSize; - - PROCEDURE ShorterSize(i: LONGINT): LONGINT; - BEGIN IF i >= OPM.LIntSize THEN RETURN OPM.IntSize ELSE RETURN OPM.SIntSize END - END ShorterSize; - - PROCEDURE LongerSize(i: LONGINT): LONGINT; - BEGIN IF i <= OPM.SIntSize THEN RETURN OPM.IntSize ELSE RETURN OPM.LIntSize END - END LongerSize; - - PROCEDURE IntType(size: LONGINT): OPT.Struct; - (* Selects smallest standard integer type for given size in bytes *) - VAR result: OPT.Struct; - BEGIN - IF size <= OPT.sinttyp.size THEN result := OPT.sinttyp - ELSIF size <= OPT.inttyp.size THEN result := OPT.inttyp - ELSE - result := OPT.linttyp - END; - IF size > OPT.linttyp.size THEN err(203) END; (* Number too large *) - RETURN result - END IntType; - PROCEDURE SetIntType(node: OPT.Node); - BEGIN node.typ := IntType(SignedByteSize(node.conval.intval)) + VAR b: INTEGER; n: LONGINT; + 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; + b := 1; WHILE (b < 8) & (ASH(n, -(8*b-1)) # 0) DO INC(b) END; + node.typ := OPT.IntType(b) END SetIntType; PROCEDURE NewIntConst*(intval: LONGINT): OPT.Node; @@ -494,7 +466,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) |OPT.SInt, OPT.Int, OPT.LInt: IF g IN OPT.intSet THEN - IF x.typ.size <= y.typ.size THEN x.typ := y.typ ELSE x.typ := IntType(x.typ.size) END + IF x.typ.size <= y.typ.size THEN x.typ := y.typ ELSE x.typ := OPT.IntType(x.typ.size) END ELSIF g = OPT.Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval ELSIF g = OPT.LReal THEN x^.typ := OPT.lrltyp; xval^.realval := xval^.intval ELSE err(100); y^.typ := x^.typ; yval^ := xval^ @@ -633,7 +605,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) IF f IN OPT.intSet THEN IF g IN OPT.intSet THEN IF f > g THEN SetIntType(x); - IF x^.typ^.form > g THEN err(203); x^.conval^.intval := 1 END + IF x.typ.size > typ.size THEN err(203); x^.conval^.intval := 1 END END ELSIF g IN OPT.realSet THEN x^.conval^.realval := x^.conval^.intval; x^.conval^.intval := OPM.ConstNotAlloc ELSE (*g = OPT.Char*) k := x^.conval^.intval; @@ -1034,13 +1006,17 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END |OPT.shortfn: (*SHORT*) IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) - ELSIF (f IN OPT.intSet) & (x.typ.size > OPM.SIntSize) THEN Convert(x, IntType(ShorterSize(x.typ.size))) + ELSIF f IN OPT.intSet THEN + typ := OPT.NextType(x.typ, -1); + IF typ = NIL THEN err(111) ELSE Convert(x, typ) END ELSIF f = OPT.LReal THEN Convert(x, OPT.realtyp) ELSE err(111) END |OPT.longfn: (*LONG*) IF (x^.class = OPT.Ntype) OR (x^.class = OPT.Nproc) THEN err(126) - ELSIF (f IN OPT.intSet) & (x.typ.size < OPM.LIntSize) THEN Convert(x, IntType(LongerSize(x.typ.size))) + ELSIF f IN OPT.intSet THEN + typ := OPT.NextType(x.typ, 1); + IF typ = NIL THEN err(111) ELSE Convert(x, typ) END ELSIF f = OPT.Real THEN Convert(x, OPT.lrltyp) ELSIF f = OPT.Char THEN Convert(x, OPT.linttyp) ELSE err(111) diff --git a/src/compiler/OPM.cmdln.Mod b/src/compiler/OPM.cmdln.Mod index 74c0f5dc..d7cb5c29 100644 --- a/src/compiler/OPM.cmdln.Mod +++ b/src/compiler/OPM.cmdln.Mod @@ -565,6 +565,11 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) END AlignSize; *) + + + + (* Integer size support *) + PROCEDURE SignedMaximum*(bytecount: LONGINT): LONGINT; VAR result: LONGINT; BEGIN @@ -580,6 +585,9 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) + + + PROCEDURE GetProperties(); (* VAR base: LONGINT; *) BEGIN diff --git a/src/compiler/OPP.Mod b/src/compiler/OPP.Mod index 56f2a3d0..4e53ad05 100644 --- a/src/compiler/OPP.Mod +++ b/src/compiler/OPP.Mod @@ -665,16 +665,16 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END END ProcedureDeclaration; - PROCEDURE CaseLabelList(VAR lab: OPT.Node; LabelForm: INTEGER; VAR n: INTEGER; VAR tab: CaseTable); + PROCEDURE CaseLabelList(VAR lab: OPT.Node; LabelTyp: OPT.Struct; VAR n: INTEGER; VAR tab: CaseTable); 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.intSet + {OPT.Char} THEN xval := x^.conval^.intval ELSE err(61); xval := 1 - END ; + END; IF f IN OPT.intSet THEN - IF LabelForm < f THEN err(60) END - ELSIF LabelForm # f THEN err(60) + IF ~(LabelTyp.form IN OPT.intSet) OR (LabelTyp.size < x.typ.size) THEN err(60) END + ELSIF LabelTyp.form # f THEN err(60) END ; IF sym = OPS.upto THEN OPS.Get(sym); ConstExpression(y); yval := y^.conval^.intval; @@ -719,7 +719,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) CheckSym(OPS.of); cases := NIL; lastcase := NIL; n := 0; LOOP IF sym < OPS.bar THEN - CaseLabelList(lab, x^.typ^.form, n, tab); + CaseLabelList(lab, x^.typ, n, tab); CheckSym(OPS.colon); StatSeq(y); OPB.Construct(OPT.Ncasedo, lab, y); OPB.Link(cases, lastcase, lab) END ; @@ -817,7 +817,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) END ; z := OPB.NewLeaf(t); OPB.Assign(z, y); SetPos(z); OPB.Link(stat, last, z); y := OPB.NewLeaf(t) - ELSIF (y^.typ^.form < OPT.SInt) OR (y^.typ^.form > x^.left^.typ^.form) THEN err(113) + ELSIF ~(y^.typ^.form IN OPT.intSet) OR (y.typ.size > x.left.typ.size) THEN err(113) END ; OPB.Link(stat, last, x); IF sym = OPS.by THEN OPS.Get(sym); ConstExpression(z) ELSE z := OPB.NewIntConst(1) END ; diff --git a/src/compiler/OPT.Mod b/src/compiler/OPT.Mod index cf4c39ac..65f51dd2 100644 --- a/src/compiler/OPT.Mod +++ b/src/compiler/OPT.Mod @@ -160,14 +160,14 @@ VAR realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*: Struct; - 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; + NextSize: ARRAY 20 OF Struct; (* Lists integer types in SHORT/LONG ordering *) + CONST @@ -206,10 +206,37 @@ VAR extsf, sfpresent: BOOLEAN; symExtended, symNew: BOOLEAN; + + + PROCEDURE err(n: INTEGER); BEGIN OPM.err(n) END err; +PROCEDURE IntType*(size: LONGINT): Struct; +(* Selects smallest standard integer type for given size in bytes *) + VAR i: INTEGER; +BEGIN + i := 1; WHILE (NextSize[i].size < size) & (NextSize[i+1] # NIL) DO INC(i) END; + RETURN NextSize[i]; +END IntType; + +PROCEDURE NextType*(x: Struct; dir: INTEGER): Struct; + VAR i: INTEGER; +BEGIN + ASSERT(x.form IN intSet); + 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 (NextSize[i] # x) & (i < LEN(NextSize)) DO INC(i) END; + ASSERT(i < LEN(NextSize)-1); + RETURN NextSize[i+dir] +END NextType; + + + PROCEDURE NewConst*(): Const; VAR const: Const; BEGIN NEW(const); RETURN const @@ -812,7 +839,12 @@ BEGIN ELSE obj := NewObj(); obj^.mnolev := -mno; obj^.vis := external; IF tag <= Pointer THEN (* Constant *) - obj^.mode := Con; obj^.typ := impCtxt.ref[tag]; obj^.conval := NewConst(); InConstant(tag, obj^.conval) + obj^.mode := Con; obj^.conval := NewConst(); InConstant(tag, obj^.conval); + IF tag IN intSet THEN + obj.typ := IntType(OPM.SymRInt()) + ELSE + obj^.typ := impCtxt.ref[tag]; + END ELSIF tag >= Sxpro THEN obj^.conval := NewConst(); obj^.conval^.intval := -1; @@ -1033,7 +1065,7 @@ END Import; Char: OPM.SymWCh(CHR(obj^.conval^.intval)) | SInt, Int, - LInt: OPM.SymWInt(obj^.conval^.intval) + LInt: OPM.SymWInt(obj^.conval^.intval); OPM.SymWInt(obj.typ.size) | Set: OPM.SymWSet(obj^.conval^.setval) | Real: rval := SHORT(obj^.conval^.realval); OPM.SymWReal(rval) | LReal: OPM.SymWLReal(obj^.conval^.realval) @@ -1138,13 +1170,6 @@ END Import; typ^.idfp := form; typ^.idfpdone := TRUE; res := typ END EnterTyp; - PROCEDURE EnterDerivedType(name: OPS.Name; typ: Struct; VAR obj: Object); - BEGIN - Insert(name, obj); - obj.mode := Typ; - obj.typ := typ; - END EnterDerivedType; - PROCEDURE EnterProc(name: OPS.Name; num: INTEGER); VAR obj: Object; BEGIN Insert(name, obj); @@ -1160,7 +1185,7 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; (*initialization of module SYSTEM*) EnterTyp("BYTE", Byte, OPM.ByteSize, bytetyp); EnterTyp("PTR", Pointer, OPM.PointerSize, sysptrtyp); - EnterTyp("ADRINT", Int, OPM.LIntSize, ainttyp); + EnterTyp("ADRINT", Int, OPM.PointerSize, ainttyp); EnterTyp("INT8", Int, 1, int8typ); EnterTyp("INT16", Int, 2, int16typ); EnterTyp("INT32", Int, 4, int32typ); @@ -1189,10 +1214,6 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; EnterTyp("LONGREAL", LReal, OPM.LRealSize, lrltyp); EnterTyp("SHORTINT", SInt, OPM.SIntSize, sinttyp); - (* Create LINT type as TYPE LINT = SYSTEM.INT64 *) - EnterDerivedType("LINT", int64typ, LIntObj); - - EnterBoolConst("FALSE", 0); (* 0 and 1 are compiler internal representation only *) EnterBoolConst("TRUE", 1); @@ -1231,7 +1252,17 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; impCtxt.ref[String] := stringtyp; impCtxt.ref[NilTyp] := niltyp; impCtxt.ref[NoTyp] := notyp; - impCtxt.ref[Pointer] := sysptrtyp + impCtxt.ref[Pointer] := sysptrtyp; + + NextSize[1] := sinttyp; + NextSize[2] := inttyp; + NextSize[3] := linttyp; + + NextSize[5] := int8typ; + NextSize[6] := int16typ; + NextSize[7] := int32typ; + NextSize[8] := int64typ + END OPT. Objects: diff --git a/src/compiler/Vishap.Mod b/src/compiler/Vishap.Mod index 25f0aa59..6d306e5e 100644 --- a/src/compiler/Vishap.Mod +++ b/src/compiler/Vishap.Mod @@ -6,7 +6,7 @@ MODULE Vishap; (* J. Templ 3.2.95 *) OPV, OPC, OPM, extTools, Strings, vt100; - VAR mname : ARRAY 256 OF CHAR; (* noch *) + VAR mname: ARRAY 256 OF CHAR; (* noch *) PROCEDURE Module*(VAR done: BOOLEAN); @@ -61,7 +61,7 @@ MODULE Vishap; (* J. Templ 3.2.95 *) OPT.ainttyp.size := OPM.PointerSize; OPT.lrltyp.size := OPM.LRealSize; OPT.sinttyp.size := OPM.SIntSize; - OPT.booltyp.size := OPM.BoolSize; + OPT.booltyp.size := OPM.BoolSize END PropagateElementaryTypeSizes; @@ -129,5 +129,7 @@ BEGIN Platform.SetInterruptHandler(Trap); Platform.SetQuitHandler(Trap); Platform.SetBadInstructionHandler(Trap); - OPB.typSize := OPV.TypSize; OPT.typSize := OPV.TypSize; Translate + OPB.typSize := OPV.TypSize; + OPT.typSize := OPV.TypSize; + Translate END Vishap. diff --git a/src/system/SYSTEM.h b/src/system/SYSTEM.h index 35620b9b..216af910 100644 --- a/src/system/SYSTEM.h +++ b/src/system/SYSTEM.h @@ -60,12 +60,6 @@ typedef float REAL; typedef double LONGREAL; typedef void* SYSTEM_PTR; -// Unsigned variants are for use by shift and rotate macros. - -typedef unsigned char U_SYSTEM_BYTE; -typedef unsigned char U_CHAR; -typedef unsigned char U_SHORTINT; - // For 32 bit builds, the size of LONGINT depends on a make option: #if (__SIZEOF_POINTER__ == 8) || defined(LARGE) || defined(_WIN64) @@ -80,9 +74,20 @@ typedef unsigned char U_SHORTINT; typedef unsigned long U_LONGINT; #endif +// Unsigned variants are for use by shift and rotate macros. + +typedef unsigned char U_SYSTEM_BYTE; +typedef unsigned char U_CHAR; +typedef unsigned char U_SHORTINT; + typedef U_LONGINT SET; typedef U_LONGINT U_SET; +typedef SYSTEM_CARD8 U_SYSTEM_INT8; +typedef SYSTEM_CARD16 U_SYSTEM_INT16; +typedef SYSTEM_CARD32 U_SYSTEM_INT32; +typedef SYSTEM_CARD64 U_SYSTEM_INT64; + // OS Memory allocation interfaces are in PlatformXXX.Mod