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

Record constant size in symbol tables, make full is now successful.

Browse source
This commit is contained in:
David Brown 2016-08-27 18:49:52 +01:00
parent 7df022d94e
commit 5033d09f32
6 changed files with 92 additions and 70 deletions
Download patch file Download diff file Expand all files Collapse all files

52
src/compiler/OPB.Mod
View file

@ -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)

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

@ -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

12
src/compiler/OPP.Mod
View file

@ -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 ;

65
src/compiler/OPT.Mod
View file

@ -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:

8
src/compiler/Vishap.Mod
View file

@ -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.

17
src/system/SYSTEM.h
View file

@ -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