From a1eff0b339d57158f48ae7983d22f5f1621b7769 Mon Sep 17 00:00:00 2001 From: norayr Date: Thu, 19 Mar 2015 15:33:10 +0400 Subject: [PATCH] reverted system type changes, added warning for absent else in case, -- noch Former-commit-id: 929f688a9e0d5f6b3d962537fa4fe5249b6ef1f1 --- src/voc/OPB.Mod | 78 ++-- src/voc/OPC.Mod | 41 +- src/voc/OPM.cmdln.Mod | 36 +- src/voc/OPP.Mod | 21 +- src/voc/OPT.Mod | 482 ++++++++++++---------- src/voc/OPV.Mod | 47 ++- src/voc/errors.Mod | 3 +- src/voc/voc.Mod | 4 +- vocstatic.linux.gcc.x86_64.REMOVED.git-id | 2 +- 9 files changed, 410 insertions(+), 304 deletions(-) diff --git a/src/voc/OPB.Mod b/src/voc/OPB.Mod index fb706845..1bf703a4 100644 --- a/src/voc/OPB.Mod +++ b/src/voc/OPB.Mod @@ -20,16 +20,20 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) (* Structure forms *) Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; - (*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10; + Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; + Pointer = 13; ProcTyp = 14; + Comp = 15; +(* Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10; Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; Pointer = 17; ProcTyp = 18; - Comp = 19;*) - Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; + Comp = 19; + *) + (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Pointer = 13; ProcTyp = 14; - Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; - Comp = (*15*)20; + Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; + Comp = (*15*)19;*) - intSet = {SInt..LInt, Int8..Int64}; realSet = {Real, LReal}; + intSet = {SInt..LInt(*, Int8..Int64*)}; realSet = {Real, LReal}; (* composite structure forms *) Basic = 1; Array = 2; DynArr = 3; Record = 4; @@ -416,7 +420,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ; z^.typ := OPT.booltyp ELSE - OPM.WriteString("/* this should not happen. handle this. OPB.MOp(); -- noch */"); OPM.WriteLn; + OPM.LogWStr("unhandled case in OPB.MOp, op = "); OPM.LogWNum(op, 0); OPM.LogWLn; END END ; x := z @@ -488,7 +492,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) CASE f OF Undef: res := eql - | Byte, Char..LInt,Int8..Int64: + | Byte, Char..LInt(*,Int8..Int64*): IF xval^.intval < yval^.intval THEN res := lss ELSIF xval^.intval > yval^.intval THEN res := gtr ELSE res := eql @@ -516,7 +520,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSE res := eql END ELSE - OPM.LogWStr("/* this should not happen. handle this. OPB.ConstCmp(); -- noch */"); OPM.LogWLn; + OPM.LogWStr("unhandled case in OPB.ConstCmp, f = "); OPM.LogWNum(f, 0); OPM.LogWLn; END ; x^.typ := OPT.booltyp; RETURN res END ConstCmp; @@ -529,13 +533,13 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) IF g = String THEN CharToString(x) ELSE err(100); y^.typ := x^.typ; yval^ := xval^ END ; - | SInt, Int8: + | SInt(*, Int8*): IF g IN intSet THEN x^.typ := y^.typ ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval ELSIF g = LReal THEN x^.typ := OPT.lrltyp; xval^.realval := xval^.intval ELSE err(100); y^.typ := x^.typ; yval^ := xval^ END - | Int, Int16, Int32, Int64: + | Int(*, Int16, Int32, Int64*): IF g = SInt THEN y^.typ := OPT.inttyp ELSIF g IN intSet THEN x^.typ := y^.typ ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval @@ -691,7 +695,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSE xval^.intval := BoolToInt(ConstCmp() # lss) END ELSE - OPM.LogWStr("this should not happen. handle this. OPB.ConstOp(); -- noch "); OPM.LogWLn; + OPM.LogWStr("unhandled case in OPB.ConstOp, op = "); OPM.LogWNum(op, 0); OPM.LogWLn; END END ConstOp; @@ -766,7 +770,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) CASE z^.typ^.form OF Char: IF z^.class = Nconst THEN CharToString(z) ELSE err(100) END - | SInt, Int8: + | SInt(*, Int8*): IF g IN intSet + realSet THEN Convert(z, y^.typ) ELSE err(100) END @@ -775,7 +779,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSIF g IN intSet + realSet THEN Convert(z, y^.typ) ELSE err(100) END - | LInt, Int16, Int32, Int64: + | LInt(*, Int16, Int32, Int64*): IF g IN intSet THEN Convert(y, z^.typ) ELSIF g IN realSet THEN Convert(z, y^.typ) ELSE err(100) @@ -870,7 +874,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSIF f # Undef THEN err(94); z^.typ := OPT.undftyp END | plus: - IF ~(f IN {Undef, SInt..Set, Int8..Int64}) THEN err(105); typ := OPT.undftyp END ; + IF ~(f IN {Undef, SInt..Set(*, Int8..Int64*)}) THEN err(105); typ := OPT.undftyp END ; do := TRUE; IF f IN intSet THEN IF (z^.class = Nconst) & (z^.conval^.intval = 0) THEN do := FALSE; z := y END ; @@ -878,7 +882,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ; IF do THEN NewOp(op, typ, z, y) END | minus: - IF ~(f IN {Undef, SInt..Set, Int8..Int64}) THEN err(106); typ := OPT.undftyp END ; + IF ~(f IN {Undef, SInt..Set(*, Int8..Int64*)}) THEN err(106); typ := OPT.undftyp END ; IF ~(f IN intSet) OR (y^.class # Nconst) OR (y^.conval^.intval # 0) THEN NewOp(op, typ, z, y) END | or: IF f = Bool THEN @@ -892,19 +896,19 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSIF f # Undef THEN err(95); z^.typ := OPT.undftyp END | eql, neq: - IF (f IN {Undef..Set, NilTyp, Pointer, ProcTyp, Int8..Int64}) OR strings(z, y) THEN typ := OPT.booltyp + IF (f IN {Undef..Set, NilTyp, Pointer, ProcTyp(*, Int8..Int64*)}) OR strings(z, y) THEN typ := OPT.booltyp ELSE err(107); typ := OPT.undftyp END ; NewOp(op, typ, z, y) | lss, leq, gtr, geq: - IF (f IN {Undef, Char..LReal, Int8..Int64}) OR strings(z, y) THEN typ := OPT.booltyp + IF (f IN {Undef, Char..LReal(*, Int8..Int64*)}) OR strings(z, y) THEN typ := OPT.booltyp ELSE OPM.LogWLn; OPM.LogWStr("ELSE in Op()"); OPM.LogWLn; err(108); typ := OPT.undftyp END ; NewOp(op, typ, z, y) ELSE - OPM.LogWStr(" OPB.Op(), not handled case possibility; -- noch"); OPM.LogWLn; + OPM.LogWStr("unhandled case in OPB.Op, op = "); OPM.LogWNum(op, 0); OPM.LogWLn; END END ; x := z @@ -968,7 +972,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) IF (ynode^.class = Ntype) OR (ynode^.class = Nproc) & (f # ProcTyp) THEN err(126) END ; CASE f OF Undef, String: - | Int8: + (* | Int8: IF (ynode.typ.size > OPM.Int8Size) THEN IF OPM.Verbose THEN OPM.LogWStr("f of int8"); OPM.LogWLn END; err(113) @@ -987,7 +991,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) IF ynode.typ.size > OPM.Int64Size THEN IF OPM.Verbose THEN OPM.LogWStr("f of int64"); OPM.LogWLn END; err(113) - END + END*) | Byte: IF ~(g IN {Byte, Char, SInt}) THEN err(113) END | Bool, Char, SInt, Set: @@ -996,9 +1000,9 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) IF ~(g IN {SInt, Int}) THEN err(113) END | LInt: IF OPM.LIntSize = 4 THEN - IF ~(g IN {SInt, Int, LInt, Int8, Int16, Int32}) THEN err(113) END + IF ~(g IN {SInt, Int, LInt(*, Int8, Int16, Int32*)}) THEN err(113) END ELSE (* assume OPM.LIntSize = 8 *) - IF ~(g IN {SInt, Int, LInt, Int8, Int16, Int32, Int64}) THEN err(113) END + IF ~(g IN {SInt, Int, LInt(*, Int8, Int16, Int32, Int64*)}) THEN err(113) END END; | Real: IF ~(g IN {SInt..Real}) THEN err(113) END @@ -1042,7 +1046,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSE (*DynArr*) err(113) END ELSE (* In case of not estimated f it would crash -- noch *) - OPM.WriteString("/* this should not happen. handle this. OPB.CheckAssign function -- noch */"); OPM.WriteLn; + OPM.LogWStr("unhandled case in OPB.CheckAssign, f = "); OPM.LogWNum(f, 0); OPM.LogWLn; END ; IF (ynode^.class = Nconst) & (g < f) & (g IN {SInt..Real}) & (f IN {Int..LReal}) THEN Convert(ynode, x) @@ -1114,10 +1118,10 @@ avoid unnecessary intermediate variables in voc | SInt: x := NewIntConst(OPM.MinSInt) | Int: x := NewIntConst(OPM.MinInt) | LInt: x := NewIntConst(OPM.MinLInt) - | Int8: x := NewIntConst(OPM.MinInt8) + (* | Int8: x := NewIntConst(OPM.MinInt8) | Int16: x := NewIntConst(OPM.MinInt16) | Int32: x := NewIntConst(OPM.MinInt32) - | Int64: err(111)(*x := NewIntConst(OPM.MinInt64)*) (* int64 constants not implemented yet *) + | Int64: err(111)(*x := NewIntConst(OPM.MinInt64)*) (* int64 constants not implemented yet *)*) | Set: x := NewIntConst(0); x^.typ := OPT.inttyp | Real: x := NewRealConst(OPM.MinReal, OPT.realtyp) | LReal: x := NewRealConst(OPM.MinLReal, OPT.lrltyp) @@ -1133,10 +1137,10 @@ avoid unnecessary intermediate variables in voc | SInt: x := NewIntConst(OPM.MaxSInt) | Int: x := NewIntConst(OPM.MaxInt) | LInt: x := NewIntConst(OPM.MaxLInt) - | Int8: x := NewIntConst(OPM.MaxInt8) + (* | Int8: x := NewIntConst(OPM.MaxInt8) | Int16: x := NewIntConst(OPM.MaxInt16) | Int32: x := NewIntConst(OPM.MaxInt32) - | Int64: err(111); (*x := NewIntConst(OPM.MaxInt64)*) (* int64 contstants not implemented yet *) + | Int64: err(111); (*x := NewIntConst(OPM.MaxInt64)*) (* int64 contstants not implemented yet *)*) | Set: x := NewIntConst(OPM.MaxSet); x^.typ := OPT.inttyp | Real: x := NewRealConst(OPM.MaxReal, OPT.realtyp) | LReal: x := NewRealConst(OPM.MaxLReal, OPT.lrltyp) @@ -1146,16 +1150,16 @@ avoid unnecessary intermediate variables in voc END | chrfn: (*CHR*) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) - ELSIF f IN {Undef, SInt..LInt, Int8..Int64} THEN Convert(x, OPT.chartyp) + ELSIF f IN {Undef, SInt..LInt(*, Int8..Int64*)} THEN Convert(x, OPT.chartyp) ELSE err(111); x^.typ := OPT.chartyp END | shortfn: (*SHORT*) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) ELSIF f = Int THEN Convert(x, OPT.sinttyp) ELSIF f = LInt THEN Convert(x, OPT.inttyp) - ELSIF f = Int64 THEN Convert(x, OPT.int32typ) + (*ELSIF f = Int64 THEN Convert(x, OPT.int32typ) ELSIF f = Int32 THEN Convert(x, OPT.int16typ) - ELSIF f = Int16 THEN Convert(x, OPT.int8typ) + ELSIF f = Int16 THEN Convert(x, OPT.int8typ)*) ELSIF f = LReal THEN Convert(x, OPT.realtyp) ELSE err(111) END @@ -1163,9 +1167,9 @@ avoid unnecessary intermediate variables in voc IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) ELSIF f = SInt THEN Convert(x, OPT.inttyp) ELSIF f = Int THEN Convert(x, OPT.linttyp) - ELSIF f = Int8 THEN Convert(x, OPT.int16typ) + (*ELSIF f = Int8 THEN Convert(x, OPT.int16typ) ELSIF f = Int16 THEN Convert(x, OPT.int32typ) - ELSIF f = Int32 THEN Convert(x, OPT.int64typ) + ELSIF f = Int32 THEN Convert(x, OPT.int64typ)*) ELSIF f = Real THEN Convert(x, OPT.lrltyp) ELSIF f = Char THEN Convert(x, OPT.linttyp) ELSE err(111) @@ -1198,7 +1202,7 @@ avoid unnecessary intermediate variables in voc CheckLeaf(x, FALSE); MOp(adr, x) | sizefn: (*SIZE*) IF x^.class # Ntype THEN err(110); x := NewIntConst(1) - ELSIF (f IN {Byte..Set, Int8..Int64, Pointer, ProcTyp}) OR (x^.typ^.comp IN {Array, Record}) THEN + ELSIF (f IN {Byte..Set(*, Int8..Int64*), Pointer, ProcTyp}) OR (x^.typ^.comp IN {Array, Record}) THEN typSize(x^.typ); x^.typ^.pvused := TRUE; x := NewIntConst(x^.typ^.size) ELSE err(111); x := NewIntConst(1) END @@ -1206,7 +1210,7 @@ avoid unnecessary intermediate variables in voc MOp(cc, x) | lshfn, rotfn: (*SYSTEM.LSH, SYSTEM.ROT*) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) - ELSIF ~(f IN intSet + {Byte, Char, Set, Int8, Int16, Int32, Int64}) THEN err(111) + ELSIF ~(f IN intSet + {Byte, Char, Set(*, Int8, Int16, Int32, Int64*)}) THEN err(111) END | getfn, putfn, bitfn, movefn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.BIT, SYSTEM.MOVE*) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) @@ -1234,7 +1238,7 @@ avoid unnecessary intermediate variables in voc ELSE MOp(not, x) END ELSE - OPM.WriteString("/* this should not happen, needs to be handled. procedure StPar0; -- noch */"); OPM.WriteLn; + OPM.LogWStr("unhandled case in OPB.StPar0, fctno = "); OPM.LogWNum(fctno, 0); OPM.LogWLn; END ; par0 := x END StPar0; @@ -1464,7 +1468,7 @@ avoid unnecessary intermediate variables in voc BEGIN (* ftyp^.comp = DynArr *) f := atyp^.comp; ftyp := ftyp^.BaseTyp; atyp := atyp^.BaseTyp; IF fvarpar & (ftyp = OPT.bytetyp) THEN (* ok, but ... *) - IF ~(f IN {Array, DynArr}) OR ~(atyp^.form IN {Byte..SInt, Int8..Int64}) THEN err(-301) END (* ... warning 301 *) + IF ~(f IN {Array, DynArr}) OR ~(atyp^.form IN {Byte..SInt(*, Int8..Int64*)}) THEN err(-301) END (* ... warning 301 *) ELSIF f IN {Array, DynArr} THEN IF ftyp^.comp = DynArr THEN DynArrParCheck(ftyp, atyp, fvarpar) ELSIF ftyp # atyp THEN diff --git a/src/voc/OPC.Mod b/src/voc/OPC.Mod index 0bfc8e48..77547af9 100644 --- a/src/voc/OPC.Mod +++ b/src/voc/OPC.Mod @@ -10,17 +10,22 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) CONST demoVersion = FALSE; CONST - (* structure forms *) - Byte = 1; Bool = 2; Char = 3; - SInt = 4; Int = 5; LInt = 6; - (*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10; + (* structure forms *) + Byte = 1; Bool = 2; Char = 3; + SInt = 4; Int = 5; LInt = 6; + Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; + Pointer = 13; ProcTyp = 14; + Comp = 15; +(* + Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10; Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; Pointer = 17; ProcTyp = 18; - Comp = 19;*) - Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; + Comp = 19; +*) + (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Pointer = 13; ProcTyp = 14; - Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; - Comp = (*15*)20; + Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; + Comp = (*15*)19;*) (* composite structure forms *) Array = 2; DynArr = 3; Record = 4; @@ -177,7 +182,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) ELSE OPM.WriteStringVar(OPM.modName) END ; OPM.Write(Underscore) - ELSIF (obj = OPT.sysptrtyp^.strobj) OR (obj = OPT.bytetyp^.strobj) OR (obj = OPT.int8typ^.strobj) OR (obj = OPT.int16typ^.strobj) OR (obj = OPT.int32typ^.strobj) OR (obj = OPT.int64typ^.strobj) THEN + ELSIF (obj = OPT.sysptrtyp^.strobj) OR (obj = OPT.bytetyp^.strobj) (*OR (obj = OPT.int8typ^.strobj) OR (obj = OPT.int16typ^.strobj) OR (obj = OPT.int32typ^.strobj) OR (obj = OPT.int64typ^.strobj)*) THEN OPM.WriteString("SYSTEM_") END ; @@ -610,6 +615,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) | 8: INC(adr, (-adr) MOD 8) |16: INC(adr, (-adr) MOD 16) ELSE (*1*) + (*OPM.LogWStr("unhandled case at OPC.Align, base = "); OPM.LogWNum(base, 0); OPM.LogWLn;*) END END Align; @@ -622,10 +628,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) | SInt: RETURN OPM.SIntAlign | Int: RETURN OPM.IntAlign | LInt: RETURN OPM.LIntAlign - | Int8: RETURN OPM.Int8Align + (* | Int8: RETURN OPM.Int8Align | Int16: RETURN OPM.Int16Align | Int32: RETURN OPM.Int32Align - | Int64: RETURN OPM.Int64Align + | Int64: RETURN OPM.Int64Align*) | Real: RETURN OPM.RealAlign | LReal: RETURN OPM.LRealAlign | Set: RETURN OPM.SetAlign @@ -635,6 +641,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) IF typ^.comp = Record THEN RETURN typ^.align MOD 10000H ELSE RETURN Base(typ^.BaseTyp) END + ELSE OPM.LogWStr("unhandled case in OPC.Base, typ^form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn; END END Base; @@ -877,7 +884,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) if option is passed this will generate __CASECHK and cause Halt, noch *) - OPM.WriteString ("( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg"); + OPM.LogWStr ("( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg"); OPM.LogWLn; END END END; @@ -1223,6 +1230,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) OPM.WriteString(" > "); | geq : OPM.WriteString(" >= "); + ELSE + OPM.LogWStr("unhandled case in OPC.Cmp, rel = "); OPM.LogWNum(rel, 0); OPM.LogWLn; END; END Cmp; @@ -1245,6 +1254,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END; | SInt, Int, LInt : OPM.WriteInt (caseVal); + ELSE + OPM.LogWStr("unhandled case in OPC.Case, form = "); OPM.LogWNum(form, 0); OPM.LogWLn; END; OPM.WriteString(Colon); END Case; @@ -1296,8 +1307,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) END | SInt, Int, LInt: OPM.WriteInt(con^.intval) - | Int8, Int16, Int32, Int64: - OPM.WriteInt(con^.intval) +(* | Int8, Int16, Int32, Int64: + OPM.WriteInt(con^.intval)*) | Real: OPM.WriteReal(con^.realval, "f") @@ -1329,6 +1340,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) OPM.Write(Quotes) | NilTyp: OPM.WriteString(NilConst); + ELSE + OPM.LogWStr("unhandled case in OPC.Constant, form = "); OPM.LogWNum(form, 0); OPM.LogWLn; END; END Constant; diff --git a/src/voc/OPM.cmdln.Mod b/src/voc/OPM.cmdln.Mod index 5326db35..3f995c90 100644 --- a/src/voc/OPM.cmdln.Mod +++ b/src/voc/OPM.cmdln.Mod @@ -97,14 +97,14 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) SourceFileName : ARRAY 256 OF CHAR; ByteSize*, CharSize*, BoolSize*, SIntSize*, IntSize*, LIntSize*, SetSize*, RealSize*, LRealSize*, PointerSize*, ProcSize*, RecSize*, - Int8Size*, Int16Size*, Int32Size*, Int64Size*, (* these are constants actually, we need it to pass to GetProperty function; -- noch *) + (*Int8Size*, Int16Size*, Int32Size*, Int64Size*,*) (* these are constants actually, we need it to pass to GetProperty function; -- noch *) CharAlign*, BoolAlign*, SIntAlign*, IntAlign*, - Int8Align*, Int16Align*, Int32Align*, Int64Align*, (* need this for SYSTEM types; -- noch *) + (*Int8Align*, Int16Align*, Int32Align*, Int64Align*,*) (* need this for SYSTEM types; -- noch *) LIntAlign*, SetAlign*, RealAlign*, LRealAlign*, PointerAlign*, ProcAlign*, RecAlign*, ByteOrder*, BitOrder*, MaxSet*: INTEGER; MinSInt*, MinInt*, MinLInt*, MaxSInt*, MaxInt*, MaxLInt*, MaxIndex*: LONGINT; - MinInt8*, MaxInt8*, MinInt16*, MaxInt16*, MinInt32*, MaxInt32* : LONGINT; - MinInt64*, MaxInt64* : SYSTEM.INT64; + (*MinInt8*, MaxInt8*, MinInt16*, MaxInt16*, MinInt32*, MaxInt32* : LONGINT; + MinInt64*, MaxInt64* : SYSTEM.INT64;*) MinReal*, MaxReal*, MinLReal*, MaxLReal*: LONGREAL; noerr*: BOOLEAN; @@ -611,17 +611,20 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) Console.String("PTR "); Console.Int(PointerSize, 0); Console.Int(PointerAlign, 5); Console.Ln; Console.String("PROC "); Console.Int(ProcSize, 0); Console.Int(ProcAlign, 5); Console.Ln; Console.String("RECORD "); Console.Int(RecSize, 0); Console.Int(RecAlign, 5); Console.Ln; - Console.String("ENDIAN "); Console.Int(ByteOrder, 0); Console.Int(BitOrder, 5); Console.Ln; + Console.String("ENDIAN "); Console.Int(ByteOrder, 0); Console.Int(BitOrder, 5); Console.Ln; + (* Console.String("SYSTEM.INT8 "); Console.Int(Int8Size, 0); Console.Int(Int8Align, 5); Console.Ln; Console.String("SYSTEM.INT16 "); Console.Int(Int16Size, 0); Console.Int(Int16Align, 5); Console.Ln; Console.String("SYSTEM.INT32 "); Console.Int(Int32Size, 0); Console.Int(Int32Align, 5); Console.Ln; Console.String("SYSTEM.INT64 "); Console.Int(Int64Size, 0); Console.Int(Int64Align, 5); Console.Ln; + *) Console.Ln; Console.String("Min shortint "); Console.Int(MinSInt, 0); Console.Ln; Console.String("Max shortint "); Console.Int(MaxSInt, 0); Console.Ln; Console.String("Min integer "); Console.Int(MinInt, 0); Console.Ln; Console.String("Max integer "); Console.Int(MaxInt, 0); Console.Ln; Console.String("Min longint "); Console.Int(MinLInt, 0); Console.Ln; + (* Console.String("Max longint "); Console.Int(MaxLInt, 0); Console.Ln; Console.String("Min int8 "); Console.Int(MinInt8, 0); Console.Ln; Console.String("Max int8 "); Console.Int(MaxInt8, 0); Console.Ln; @@ -629,7 +632,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) Console.String("Max int16 "); Console.Int(MaxInt16, 0); Console.Ln; Console.String("Min int32 "); Console.Int(MinInt32, 0); Console.Ln; Console.String("Max int32 "); Console.Int(MaxInt32, 0); Console.Ln; - + *) END VerboseListSizes; @@ -645,7 +648,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) ByteSize := 1; CharSize := 1; BoolSize := 1; SIntSize := 1; IntSize := 4; LIntSize := 8; SetSize := 8; RealSize := 4; LRealSize := 8; ProcSize := 8; PointerSize := 8; RecSize := 1; CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 4; LIntAlign := 8; - Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 8; + (*Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 8;*) SetAlign := 8; RealAlign := 4; LRealAlign := 8; ProcAlign := 8; PointerAlign := 8; RecAlign := 1; (* not necessary, we will calculate values later MinSInt := -80H; MaxSInt := 7FH; @@ -662,7 +665,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) ByteSize := 1; CharSize := 1; BoolSize := 1; SIntSize := 1; IntSize := 2; LIntSize := 4; SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1; CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; - Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4; + (*Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4;*) SetAlign := 4; RealAlign := 4; LRealAlign := 8; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; (* not necessary, we will calculate values later @@ -677,7 +680,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1; CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; - Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4; + (*Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4;*) SetAlign := 4; RealAlign := 4; LRealAlign := 8; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; @@ -687,7 +690,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1; CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; - Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4; + (*Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4;*) SetAlign := 4; RealAlign := 4; LRealAlign := 4; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; ELSE (* this should suite any gnu x86 system *) @@ -696,7 +699,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1; CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; - Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4; + (*Int8Align := 1; Int16Align := 2; Int32Align := 4; Int64Align := 4;*) SetAlign := 4; RealAlign := 4; LRealAlign := 4; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; (* LRealAlign should be checked and confirmed *) (* not necessary, will be calculated later @@ -730,10 +733,11 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) *) GetProperty(S, "ENDIAN", ByteOrder, BitOrder); (*currently not used*) - GetProperty(S, "SYSTEM.INT8", Int8Size, Int8Align); + (* + GetProperty(S, "SYSTEM.INT8", Int8Size, Int8Align); GetProperty(S, "SYSTEM.INT16", Int16Size, Int16Align); GetProperty(S, "SYSTEM.INT32", Int32Size, Int32Align); - GetProperty(S, "SYSTEM.INT64", Int64Size, Int64Align); + GetProperty(S, "SYSTEM.INT64", Int64Size, Int64Align);*) (* add here Max and Min sizes, noch *) ByteSize := CharSize; @@ -745,7 +749,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) END END; (* if useParFile , noch *) - Int8Size := 1; Int16Size := 2; Int32Size := 4; Int64Size := 8; + (*Int8Size := 1; Int16Size := 2; Int32Size := 4; Int64Size := 8;*) (* commenting this by replacing with faster way; -- noch * MinSInt := power0(-2, (SIntSize*8-1)); (* -2^(SIntSize*8-1)*) @@ -770,13 +774,13 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) MinLInt := ASH(base, LIntSize*8-2); MaxLInt := minus(MinLInt +1); - + (* MinInt8 := -80H; MinInt16 := -8000H; MinInt32 := 80000000H; (*-2147483648*) MaxInt8 := 7FH; MaxInt16 := 7FFFH; MaxInt32 := 7FFFFFFFH; (*2147483647*) MinInt64 := ASH(base, Int64Size*8-2); MaxInt64 := minus(ASH(base, Int64Size*8-2) + 1); - +*) IF RealSize = 4 THEN MaxReal := 3.40282346D38 ELSIF RealSize = 8 THEN MaxReal := 1.7976931348623157D307 * 9.999999 (*should be 1.7976931348623157D308 *) diff --git a/src/voc/OPP.Mod b/src/voc/OPP.Mod index 3348a9af..160cfec6 100644 --- a/src/voc/OPP.Mod +++ b/src/voc/OPP.Mod @@ -29,16 +29,19 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) (* Structure forms *) Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; + Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; + Pointer = 13; ProcTyp = 14; + Comp = 15; (*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10; Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; Pointer = 17; ProcTyp = 18; Comp = 19;*) - Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; + (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Pointer = 13; ProcTyp = 14; - Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; - Comp = (*15*)20; + Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; + Comp = (*15*)19;*) - intSet = {SInt..LInt, Int8..Int64}; + intSet = {SInt..LInt(*, Int8..Int64*)}; (* composite structure forms *) Basic = 1; Array = 2; DynArr = 3; Record = 4; @@ -289,7 +292,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) OPS.Get(sym); resTyp := OPT.undftyp; IF sym = ident THEN qualident(res); IF res^.mode = Typ THEN - IF (res^.typ^.form < Comp) OR (res^.typ^.form >= Int8) & (res^.typ^.form <= Int64) THEN resTyp := res^.typ; + IF (res^.typ^.form < Comp) (*OR (res^.typ^.form >= Int8) & (res^.typ^.form <= Int64)*) THEN resTyp := res^.typ; ELSE err(54) END ELSE err(52) @@ -487,6 +490,8 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) | integer: x := OPB.NewIntConst(OPS.intval) | real: x := OPB.NewRealConst(OPS.realval, OPT.realtyp) | longreal: x := OPB.NewRealConst(OPS.lrlval, OPT.lrltyp) + ELSE + OPM.LogWStr("unhandled case in OPP.Factor, OPS.numtyp = "); OPM.LogWNum(OPS.numtyp, 0); OPM.LogWLn; END ; OPS.Get(sym) ELSIF sym = string THEN @@ -779,7 +784,11 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) ELSE low := 1; high := 0 END ; e := sym = else; - IF e THEN OPS.Get(sym); StatSeq(y) ELSE y := NIL END ; + IF e THEN OPS.Get(sym); StatSeq(y) + ELSE + y := NIL; + OPM.Mark(-307, OPM.curpos); (* notice about no else symbol; -- noch *) + END ; OPB.Construct(Ncaselse, cases, y); OPB.Construct(Ncase, x, cases); cases^.conval := OPT.NewConst(); cases^.conval^.intval := low; cases^.conval^.intval2 := high; diff --git a/src/voc/OPT.Mod b/src/voc/OPT.Mod index 2270a143..34a57061 100644 --- a/src/voc/OPT.Mod +++ b/src/voc/OPT.Mod @@ -62,14 +62,14 @@ END ; CONST maxImps = 64; (* must be <= MAX(SHORTINT) *) maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *) -FirstRef = 16; +FirstRef = (*20*)16; (* comp + 1 *) VAR typSize*: PROCEDURE(typ: Struct); topScope*: Object; undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*, -realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*, -int8typ*, int16typ*, int32typ*, int64typ*: Struct; +realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*(*, +int8typ*, int16typ*, int32typ*, int64typ* *): Struct; 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 *) @@ -83,14 +83,18 @@ SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13; (* structure forms *) Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; +Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; +Pointer = 13; ProcTyp = 14; +Comp = 15; + (*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10; Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; Pointer = 17; ProcTyp = 18; Comp = 19;*) -Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; +(*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Pointer = 13; ProcTyp = 14; -Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; -Comp = 20; +Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; +Comp = 19;*) (* composite structure forms *) Basic = 1; Array = 2; DynArr = 3; Record = 4; @@ -200,7 +204,7 @@ VAR i: INTEGER; BEGIN (* garbage collection *) CloseScope; i := 0; WHILE i < maxImps DO GlbMod[i] := NIL; INC(i) END ; -i := (*FirstRef*)Comp + 1; WHILE i < maxStruct DO impCtxt.ref[i] := NIL; impCtxt.old[i] := NIL; INC(i) END +i := FirstRef; WHILE i < maxStruct DO impCtxt.ref[i] := NIL; impCtxt.old[i] := NIL; INC(i) END END Close; PROCEDURE FindImport*(mod: Object; VAR res: Object); @@ -282,34 +286,52 @@ END FPrintName; PROCEDURE ^IdFPrint*(typ: Struct); +PROCEDURE DebugStruct(btyp: Struct); +BEGIN + + OPM.LogWLn; + IF btyp = NIL THEN OPM.LogWStr("btyp is nil"); OPM.LogWLn END; + OPM.LogWStr("btyp^.strobji^.name = "); OPM.LogWStr(btyp^.strobj^.name); OPM.LogWLn; + OPM.LogWStr("btyp^.form = "); OPM.LogWNum(btyp^.form, 0); OPM.LogWLn; + OPM.LogWStr("btyp^.comp = "); OPM.LogWNum(btyp^.comp, 0); OPM.LogWLn; + OPM.LogWStr("btyp^.mno = "); OPM.LogWNum(btyp^.mno, 0); OPM.LogWLn; + OPM.LogWStr("btyp^.extlev = "); OPM.LogWNum(btyp^.extlev, 0); OPM.LogWLn; + OPM.LogWStr("btyp^.size = "); OPM.LogWNum(btyp^.size, 0); OPM.LogWLn; + OPM.LogWStr("btyp^.align = "); OPM.LogWNum(btyp^.align, 0); OPM.LogWLn; + OPM.LogWStr("btyp^.txtpos = "); OPM.LogWNum(btyp^.txtpos, 0); OPM.LogWLn; +END DebugStruct; + PROCEDURE FPrintSign(VAR fp: LONGINT; result: Struct; par: Object); (* depends on assignment compatibility of params only *) BEGIN -IdFPrint(result); OPM.FPrint(fp, result^.idfp); -WHILE par # NIL DO -OPM.FPrint(fp, par^.mode); IdFPrint(par^.typ); OPM.FPrint(fp, par^.typ^.idfp); -(* par^.name and par^.adr not considered *) -par := par^.link -END + IdFPrint(result); OPM.FPrint(fp, result^.idfp); + WHILE (par # NIL) (*& (par^.typ # NIL)*) DO (* !!! *) + OPM.FPrint(fp, par^.mode); + IdFPrint(par^.typ); + OPM.FPrint(fp, par^.typ^.idfp); + (* par^.name and par^.adr not considered *) + par := par^.link + END END FPrintSign; PROCEDURE IdFPrint*(typ: Struct); (* idfp codifies assignment compatibility *) VAR btyp: Struct; strobj: Object; idfp: LONGINT; f, c: INTEGER; BEGIN -IF ~typ^.idfpdone THEN -typ^.idfpdone := TRUE; (* may be recursive, temporary idfp is 0 in that case *) -idfp := 0; f := typ^.form; c := typ^.comp; OPM.FPrint(idfp, f); OPM.FPrint(idfp, c); -btyp := typ^.BaseTyp; strobj := typ^.strobj; -IF (strobj # NIL) & (strobj^.name # "") THEN -FPrintName(idfp, GlbMod[typ^.mno]^.name); FPrintName(idfp, strobj^.name) -END ; -IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN -IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp) -ELSIF c = Array THEN IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp); OPM.FPrint(idfp, typ^.n) -ELSIF f = ProcTyp THEN FPrintSign(idfp, btyp, typ^.link) -END ; -typ^.idfp := idfp -END + IF ~typ^.idfpdone THEN + typ^.idfpdone := TRUE; (* may be recursive, temporary idfp is 0 in that case *) + idfp := 0; f := typ^.form; c := typ^.comp; OPM.FPrint(idfp, f); OPM.FPrint(idfp, c); + btyp := typ^.BaseTyp; strobj := typ^.strobj; + IF (strobj # NIL) & (strobj^.name # "") THEN + FPrintName(idfp, GlbMod[typ^.mno]^.name); FPrintName(idfp, strobj^.name) + END ; + IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN + IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp) + ELSIF c = Array THEN + IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp); OPM.FPrint(idfp, typ^.n) + ELSIF f = ProcTyp THEN FPrintSign(idfp, btyp, typ^.link) + END ; + typ^.idfp := idfp + END END IdFPrint; PROCEDURE FPrintStr*(typ: Struct); @@ -328,7 +350,7 @@ IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN IF j # nofhdfld THEN i := 1; WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO INC(adr, btyp^.size); FPrintHdFld(btyp, fld, adr); INC(i) - END + END; END END ELSIF OPM.ExpHdPtrFld & ((typ^.form = Pointer) OR (fld^.name = OPM.HdPtrName)) THEN @@ -341,93 +363,94 @@ END FPrintHdFld; PROCEDURE FPrintFlds(fld: Object; adr: LONGINT; visible: BOOLEAN); (* modifies pbfp and pvfp *) BEGIN WHILE (fld # NIL) & (fld^.mode = Fld) DO -IF (fld^.vis # internal) & visible THEN - OPM.FPrint(pbfp, fld^.vis); FPrintName(pbfp, fld^.name); OPM.FPrint(pbfp, fld^.adr); - FPrintStr(fld^.typ); OPM.FPrint(pbfp, fld^.typ^.pbfp); OPM.FPrint(pvfp, fld^.typ^.pvfp) -ELSE FPrintHdFld(fld^.typ, fld, fld^.adr + adr) -END ; -fld := fld^.link -END + IF (fld^.vis # internal) & visible THEN + OPM.FPrint(pbfp, fld^.vis); FPrintName(pbfp, fld^.name); OPM.FPrint(pbfp, fld^.adr); + FPrintStr(fld^.typ); OPM.FPrint(pbfp, fld^.typ^.pbfp); OPM.FPrint(pvfp, fld^.typ^.pvfp) + ELSE + FPrintHdFld(fld^.typ, fld, fld^.adr + adr) + END ; + fld := fld^.link +END; END FPrintFlds; PROCEDURE FPrintTProcs(obj: Object); (* modifies pbfp and pvfp *) BEGIN -IF obj # NIL THEN -FPrintTProcs(obj^.left); -IF obj^.mode = TProc THEN - IF obj^.vis # internal THEN - OPM.FPrint(pbfp, TProc); OPM.FPrint(pbfp, obj^.adr DIV 10000H); - FPrintSign(pbfp, obj^.typ, obj^.link); FPrintName(pbfp, obj^.name) - ELSIF OPM.ExpHdTProc THEN - OPM.FPrint(pvfp, TProc); OPM.FPrint(pvfp, obj^.adr DIV 10000H) - END -END ; -FPrintTProcs(obj^.right) -END + IF obj # NIL THEN + FPrintTProcs(obj^.left); + IF obj^.mode = TProc THEN + IF obj^.vis # internal THEN + OPM.FPrint(pbfp, TProc); OPM.FPrint(pbfp, obj^.adr DIV 10000H); + FPrintSign(pbfp, obj^.typ, obj^.link); FPrintName(pbfp, obj^.name) + ELSIF OPM.ExpHdTProc THEN + OPM.FPrint(pvfp, TProc); OPM.FPrint(pvfp, obj^.adr DIV 10000H) + END + END ; + FPrintTProcs(obj^.right) + END; END FPrintTProcs; BEGIN -IF ~typ^.fpdone THEN -IdFPrint(typ); pbfp := typ^.idfp; -IF typ^.sysflag # 0 THEN OPM.FPrint(pbfp, typ^.sysflag) END ; -pvfp := pbfp; typ^.pbfp := pbfp; typ^.pvfp := pvfp; (* initial fprints may be used recursively *) -typ^.fpdone := TRUE; -f := typ^.form; c := typ^.comp; btyp := typ^.BaseTyp; -IF f = Pointer THEN -strobj := typ^.strobj; bstrobj := btyp^.strobj; -IF (strobj = NIL) OR (strobj^.name = "") OR (bstrobj = NIL) OR (bstrobj^.name = "") THEN - FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); pvfp := pbfp -(* else use idfp as pbfp and as pvfp, do not call FPrintStr(btyp) here, else cycle not broken *) -END -ELSIF f = ProcTyp THEN (* use idfp as pbfp and as pvfp *) -ELSIF c IN {Array, DynArr} THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pvfp); pvfp := pbfp -ELSE (* c = Record *) -IF btyp # NIL THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); OPM.FPrint(pvfp, btyp^.pvfp) END ; -OPM.FPrint(pvfp, typ^.size); OPM.FPrint(pvfp, typ^.align); OPM.FPrint(pvfp, typ^.n); -nofhdfld := 0; FPrintFlds(typ^.link, 0, TRUE); -IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(225, typ^.txtpos) END ; -FPrintTProcs(typ^.link); OPM.FPrint(pvfp, pbfp); strobj := typ^.strobj; -IF (strobj = NIL) OR (strobj^.name = "") THEN pbfp := pvfp END -END ; -typ^.pbfp := pbfp; typ^.pvfp := pvfp -END + IF ~typ^.fpdone THEN + IdFPrint(typ); pbfp := typ^.idfp; + IF typ^.sysflag # 0 THEN OPM.FPrint(pbfp, typ^.sysflag) END ; + pvfp := pbfp; typ^.pbfp := pbfp; typ^.pvfp := pvfp; (* initial fprints may be used recursively *) + typ^.fpdone := TRUE; + f := typ^.form; c := typ^.comp; btyp := typ^.BaseTyp; + IF f = Pointer THEN + strobj := typ^.strobj; bstrobj := btyp^.strobj; + IF (strobj = NIL) OR (strobj^.name = "") OR (bstrobj = NIL) OR (bstrobj^.name = "") THEN + FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); pvfp := pbfp + (* else use idfp as pbfp and as pvfp, do not call FPrintStr(btyp) here, else cycle not broken *) + END + ELSIF f = ProcTyp THEN (* use idfp as pbfp and as pvfp *) + ELSIF c IN {Array, DynArr} THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pvfp); pvfp := pbfp + ELSE (* c = Record *) + IF btyp # NIL THEN FPrintStr(btyp); OPM.FPrint(pbfp, btyp^.pbfp); OPM.FPrint(pvfp, btyp^.pvfp) END ; + OPM.FPrint(pvfp, typ^.size); OPM.FPrint(pvfp, typ^.align); OPM.FPrint(pvfp, typ^.n); + nofhdfld := 0; FPrintFlds(typ^.link, 0, TRUE); + IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(225, typ^.txtpos) END ; + FPrintTProcs(typ^.link); OPM.FPrint(pvfp, pbfp); strobj := typ^.strobj; + IF (strobj = NIL) OR (strobj^.name = "") THEN pbfp := pvfp END + END ; + typ^.pbfp := pbfp; typ^.pvfp := pvfp + END; END FPrintStr; PROCEDURE FPrintObj*(obj: Object); VAR fprint: LONGINT; f, m: INTEGER; rval: REAL; ext: ConstExt; BEGIN -IF ~obj^.fpdone THEN -fprint := 0; obj^.fpdone := TRUE; -OPM.FPrint(fprint, obj^.mode); -IF obj^.mode = Con THEN -f := obj^.typ^.form; OPM.FPrint(fprint, f); -CASE f OF -| Bool, Char, SInt, Int, LInt, Int8, Int16, Int32, Int64: - OPM.FPrint(fprint, obj^.conval^.intval) -| Set: - OPM.FPrintSet(fprint, obj^.conval^.setval) -| Real: - rval := SHORT(obj^.conval^.realval); OPM.FPrintReal(fprint, rval) -| LReal: - OPM.FPrintLReal(fprint, obj^.conval^.realval) -| String: - FPrintName(fprint, obj^.conval^.ext^) -| NilTyp: -ELSE err(127) -END -ELSIF obj^.mode = Var THEN -OPM.FPrint(fprint, obj^.vis); FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp) -ELSIF obj^.mode IN {XProc, IProc} THEN -FPrintSign(fprint, obj^.typ, obj^.link) -ELSIF obj^.mode = CProc THEN -FPrintSign(fprint, obj^.typ, obj^.link); ext := obj^.conval^.ext; -m := ORD(ext^[0]); f := 1; OPM.FPrint(fprint, m); -WHILE f <= m DO OPM.FPrint(fprint, ORD(ext^[f])); INC(f) END -ELSIF obj^.mode = Typ THEN -FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp) -END ; -obj^.fprint := fprint -END + IF ~obj^.fpdone THEN + fprint := 0; obj^.fpdone := TRUE; + OPM.FPrint(fprint, obj^.mode); + IF obj^.mode = Con THEN + f := obj^.typ^.form; OPM.FPrint(fprint, f); + CASE f OF + | Bool, Char, SInt, Int, LInt(*, Int8, Int16, Int32, Int64*): + OPM.FPrint(fprint, obj^.conval^.intval) + | Set: + OPM.FPrintSet(fprint, obj^.conval^.setval) + | Real: + rval := SHORT(obj^.conval^.realval); OPM.FPrintReal(fprint, rval) + | LReal: + OPM.FPrintLReal(fprint, obj^.conval^.realval) + | String: + FPrintName(fprint, obj^.conval^.ext^) + | NilTyp: + ELSE err(127) + END + ELSIF obj^.mode = Var THEN + OPM.FPrint(fprint, obj^.vis); FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp) + ELSIF obj^.mode IN {XProc, IProc} THEN + FPrintSign(fprint, obj^.typ, obj^.link) + ELSIF obj^.mode = CProc THEN + FPrintSign(fprint, obj^.typ, obj^.link); ext := obj^.conval^.ext; + m := ORD(ext^[0]); f := 1; OPM.FPrint(fprint, m); + WHILE f <= m DO OPM.FPrint(fprint, ORD(ext^[f])); INC(f) END; + ELSIF obj^.mode = Typ THEN + FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp) + END ; + obj^.fprint := fprint + END END FPrintObj; PROCEDURE FPrintErr*(obj: Object; errno: INTEGER); @@ -517,10 +540,10 @@ PROCEDURE InConstant(f: LONGINT; conval: Const); VAR ch: CHAR; i: INTEGER; ext: ConstExt; rval: REAL; BEGIN CASE f OF -| Byte, Char, Bool: +| (*Int8,*) Byte, Char, Bool: OPM.SymRCh(ch); conval^.intval := ORD(ch) -| Int8, Int16, Int32, Int64: -conval^.intval := OPM.SymRInt() +(*| Int8, Int16, Int32, Int64: +conval^.intval := OPM.SymRInt()*) | SInt, Int, LInt: conval^.intval := OPM.SymRInt() | Set: @@ -541,7 +564,7 @@ conval^.intval := OPM.ConstNotAlloc | NilTyp: conval^.intval := OPM.nilval ELSE -OPM.WriteString(" /* function OPT.InConstant(); unhandled case; -- noch */ "); OPM.WriteLn; +OPM.LogWStr("unhandled case in OPT.InConstant(), f = "); OPM.LogWNum(f, 0); OPM.LogWLn; END END InConstant; @@ -601,104 +624,132 @@ PROCEDURE InStruct(VAR typ: Struct); VAR mno: SHORTINT; ref: INTEGER; tag: LONGINT; name: OPS.Name; t: Struct; obj, last, fld, old, dummy: Object; BEGIN -tag := OPM.SymRInt(); -IF tag # Sstruct THEN typ := impCtxt.ref[-tag] -ELSE -ref := impCtxt.nofr; INC(impCtxt.nofr); -IF ref < impCtxt.minr THEN impCtxt.minr := ref END ; -InMod(mno); InName(name); obj := NewObj(); -IF name = "" THEN -IF impCtxt.self THEN old := NIL (* do not insert type desc anchor here, but in OPL *) -ELSE obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := "" + tag := OPM.SymRInt(); + IF tag # Sstruct THEN + typ := impCtxt.ref[-tag] + ELSE + ref := impCtxt.nofr; INC(impCtxt.nofr); + IF ref < impCtxt.minr THEN impCtxt.minr := ref END ; + InMod(mno); InName(name); obj := NewObj(); + IF name = "" THEN + IF impCtxt.self THEN + old := NIL (* do not insert type desc anchor here, but in OPL *) + ELSE + obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := "" + END ; + typ := NewStr(Undef, Basic) + ELSE + obj^.name := name; InsertImport(obj, GlbMod[mno].right, old); + IF old # NIL THEN (* recalculate fprints to compare with old fprints *) + FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp; + IF impCtxt.self THEN (* do not overwrite old typ *) + typ := NewStr(Undef, Basic) + ELSE (* overwrite old typ for compatibility reason *) + typ := old^.typ; typ^.link := NIL; typ^.sysflag := 0; + typ^.fpdone := FALSE; typ^.idfpdone := FALSE + END + ELSE + typ := NewStr(Undef, Basic) + END + END ; + impCtxt.ref[ref] := typ; impCtxt.old[ref] := old; + typ^.ref := ref + maxStruct; + (* ref >= maxStruct: not exported yet, ref used for err 155 *) + typ^.mno := mno; typ^.allocated := TRUE; + typ^.strobj := obj; obj^.mode := Typ; obj^.typ := typ; + obj^.mnolev := -mno; obj^.vis := internal; (* name not visible here *) + tag := OPM.SymRInt(); + IF tag = Ssys THEN typ^.sysflag := SHORT(OPM.SymRInt()); tag := OPM.SymRInt() END ; + CASE tag OF + | Sptr: + typ^.form := Pointer; typ^.size := OPM.PointerSize; + typ^.n := 0; InStruct(typ^.BaseTyp) + | Sarr: + typ^.form := Comp; typ^.comp := Array; + InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt(); + typSize(typ) (* no bounds address !! *) + | Sdarr: + typ^.form := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp); + IF typ^.BaseTyp^.comp = DynArr THEN + typ^.n := typ^.BaseTyp^.n + 1 + ELSE + typ^.n := 0 + END ; + typSize(typ) + | Srec: + typ^.form := Comp; typ^.comp := Record; + InStruct(typ^.BaseTyp); + IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END; + typ.extlev := 0; t := typ.BaseTyp; + (* do not take extlev from base type due to possible cycles! *) + WHILE (t # NIL) (*& (t^.BaseTyp # t)*)(*(t^.(*BaseTyp^.*)form # 0)*) DO INC(typ^.extlev); t := t.BaseTyp END; (* !!! *) + typ^.size := OPM.SymRInt(); typ^.align := OPM.SymRInt(); + typ^.n := OPM.SymRInt(); + impCtxt.nextTag := OPM.SymRInt(); last := NIL; + WHILE (impCtxt.nextTag >= Sfld) & (impCtxt.nextTag <= Shdpro) DO + fld := InFld(); fld^.mnolev := -mno; + IF last # NIL THEN last^.link := fld END ; + last := fld; InsertImport(fld, typ^.link, dummy); + impCtxt.nextTag := OPM.SymRInt() + END ; + WHILE impCtxt.nextTag # Send DO + fld := InTProc(mno); + InsertImport(fld, typ^.link, dummy); + impCtxt.nextTag := OPM.SymRInt() + END + | Spro: + typ^.form := ProcTyp; typ^.size := OPM.ProcSize; + InSign(mno, typ^.BaseTyp, typ^.link) + ELSE + OPM.LogWStr("unhandled case at OPT.InStruct, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn; END ; -typ := NewStr(Undef, Basic) -ELSE obj^.name := name; InsertImport(obj, GlbMod[mno].right, old); -IF old # NIL THEN (* recalculate fprints to compare with old fprints *) - FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp; - IF impCtxt.self THEN (* do not overwrite old typ *) - typ := NewStr(Undef, Basic) - ELSE (* overwrite old typ for compatibility reason *) - typ := old^.typ; typ^.link := NIL; typ^.sysflag := 0; - typ^.fpdone := FALSE; typ^.idfpdone := FALSE - END -ELSE typ := NewStr(Undef, Basic) -END -END ; -impCtxt.ref[ref] := typ; impCtxt.old[ref] := old; typ^.ref := ref + maxStruct; -(* ref >= maxStruct: not exported yet, ref used for err 155 *) -typ^.mno := mno; typ^.allocated := TRUE; -typ^.strobj := obj; obj^.mode := Typ; obj^.typ := typ; -obj^.mnolev := -mno; obj^.vis := internal; (* name not visible here *) -tag := OPM.SymRInt(); -IF tag = Ssys THEN typ^.sysflag := SHORT(OPM.SymRInt()); tag := OPM.SymRInt() END ; -CASE tag OF -| Sptr: -typ^.form := Pointer; typ^.size := OPM.PointerSize; typ^.n := 0; InStruct(typ^.BaseTyp) -| Sarr: -typ^.form := Comp; typ^.comp := Array; InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt(); -typSize(typ) (* no bounds address !! *) -| Sdarr: -typ^.form := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp); -IF typ^.BaseTyp^.comp = DynArr THEN typ^.n := typ^.BaseTyp^.n + 1 -ELSE typ^.n := 0 -END ; -typSize(typ) -| Srec: -typ^.form := Comp; typ^.comp := Record; InStruct(typ^.BaseTyp); -IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END; -typ.extlev := 0; t := typ.BaseTyp; -(* do not take extlev from base type due to possible cycles! *) -WHILE t # NIL DO INC(typ^.extlev); t := t.BaseTyp END; -typ^.size := OPM.SymRInt(); typ^.align := OPM.SymRInt(); -typ^.n := OPM.SymRInt(); -impCtxt.nextTag := OPM.SymRInt(); last := NIL; -WHILE (impCtxt.nextTag >= Sfld) & (impCtxt.nextTag <= Shdpro) DO - fld := InFld(); fld^.mnolev := -mno; - IF last # NIL THEN last^.link := fld END ; - last := fld; InsertImport(fld, typ^.link, dummy); - impCtxt.nextTag := OPM.SymRInt() -END ; -WHILE impCtxt.nextTag # Send DO fld := InTProc(mno); - InsertImport(fld, typ^.link, dummy); - impCtxt.nextTag := OPM.SymRInt() -END -| Spro: -typ^.form := ProcTyp; typ^.size := OPM.ProcSize; InSign(mno, typ^.BaseTyp, typ^.link) -END ; -IF ref = impCtxt.minr THEN -WHILE ref < impCtxt.nofr DO - t := impCtxt.ref[ref]; FPrintStr(t); - obj := t^.strobj; (* obj^.typ^.strobj = obj, else obj^.fprint differs (alias) *) - IF obj^.name # "" THEN FPrintObj(obj) END ; - old := impCtxt.old[ref]; - IF old # NIL THEN t^.strobj := old; (* restore strobj *) - IF impCtxt.self THEN - IF old^.mnolev < 0 THEN - IF old^.history # inconsistent THEN - IF old^.fprint # obj^.fprint THEN old^.history := pbmodified - ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN old^.history := pvmodified - END + IF ref = impCtxt.minr THEN + WHILE (ref < impCtxt.nofr) (*OR ((ref >= Int8) & (ref <= Int64))*) DO + t := impCtxt.ref[ref]; FPrintStr(t); + obj := t^.strobj; (* obj^.typ^.strobj = obj, else obj^.fprint differs (alias) *) + IF obj^.name # "" THEN FPrintObj(obj) END ; + old := impCtxt.old[ref]; + IF old # NIL THEN + t^.strobj := old; (* restore strobj *) + IF impCtxt.self THEN + IF old^.mnolev < 0 THEN + IF old^.history # inconsistent THEN + IF old^.fprint # obj^.fprint THEN + old^.history := pbmodified + ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN + old^.history := pvmodified + END (* ELSE remain inconsistent *) - END - ELSIF old^.fprint # obj^.fprint THEN old^.history := pbmodified - ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN old^.history := pvmodified - ELSIF old^.vis = internal THEN old^.history := same (* may be changed to "removed" in InObj *) - ELSE old^.history := inserted (* may be changed to "same" in InObj *) + END + ELSIF old^.fprint # obj^.fprint THEN + old^.history := pbmodified + ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN + old^.history := pvmodified + ELSIF old^.vis = internal THEN + old^.history := same (* may be changed to "removed" in InObj *) + ELSE + old^.history := inserted (* may be changed to "same" in InObj *) + END + ELSE + (* check private part, delay error message until really used *) + IF impCtxt.pvfp[ref] # t^.pvfp THEN + old^.history := inconsistent + END ; + IF old^.fprint # obj^.fprint THEN + FPrintErr(old, 249) + END + END + ELSIF impCtxt.self THEN + obj^.history := removed + ELSE + obj^.history := same + END ; + INC(ref) + END ; + impCtxt.minr := maxStruct END - ELSE - (* check private part, delay error message until really used *) - IF impCtxt.pvfp[ref] # t^.pvfp THEN old^.history := inconsistent END ; - IF old^.fprint # obj^.fprint THEN FPrintErr(old, 249) END - END - ELSIF impCtxt.self THEN obj^.history := removed - ELSE obj^.history := same - END ; - INC(ref) - END ; - impCtxt.minr := maxStruct - END - END - END InStruct; + END +END InStruct; PROCEDURE InObj(mno: SHORTINT): Object; (* first number in impCtxt.nextTag *) VAR i, s: INTEGER; ch: CHAR; obj, old: Object; typ: Struct; @@ -723,6 +774,8 @@ WHILE ref < impCtxt.nofr DO ext := NewExt(); obj^.conval^.ext := ext; s := SHORT(OPM.SymRInt()); ext^[0] := CHR(s); i := 1; WHILE i <= s DO OPM.SymRCh(ext^[i]); INC(i) END + ELSE + OPM.LogWStr("unhandled case at OPT.InObj, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn; END ELSIF tag = Salias THEN obj^.mode := Typ; InStruct(obj^.typ) @@ -771,7 +824,7 @@ WHILE ref < impCtxt.nofr DO IF name = "SYSTEM" THEN SYSimported := TRUE; Insert(aliasName, obj); obj^.mode := Mod; obj^.mnolev := 0; obj^.scope := syslink; obj^.typ := notyp ELSE - impCtxt.nofr := FirstRef; impCtxt.minr := maxStruct; impCtxt.nofm := 0; + impCtxt.nofr := FirstRef(*Comp+1*); impCtxt.minr := maxStruct; impCtxt.nofm := 0; impCtxt.self := aliasName = "@self"; impCtxt.reffp := 0; OPM.OldSym(name, done); IF done THEN @@ -884,18 +937,20 @@ WHILE ref < impCtxt.nofr DO PROCEDURE OutStr(typ: Struct); (* OPV.TypeAlloc already applied *) VAR strobj: Object; BEGIN - IF (typ^.ref < expCtxt.ref) OR (typ^.ref >= Int8) & (typ^.ref <= Int64) THEN OPM.SymWInt(-typ^.ref) + IF (typ^.ref < expCtxt.ref) (*OR (typ^.ref >= Int8) & (typ^.ref <= Int64)*) THEN OPM.SymWInt(-typ^.ref) ELSE OPM.SymWInt(Sstruct); typ^.ref := expCtxt.ref; INC(expCtxt.ref); IF expCtxt.ref >= maxStruct THEN err(228) END ; OutMod(typ^.mno); strobj := typ^.strobj; + IF (strobj # NIL) & (strobj^.name # "") THEN OutName(strobj^.name); CASE strobj^.history OF | pbmodified: FPrintErr(strobj, 252) | pvmodified: FPrintErr(strobj, 251) | inconsistent: FPrintErr(strobj, 249) ELSE (* checked in OutObj or correct indirect export *) + (* OPM.LogWStr("unhandled case at OPT.OutStr, strobj^.history = "); OPM.LogWNum(strobj^.history, 0); OPM.LogWLn;*) END ELSE OPM.SymWCh(0X) (* anonymous => never inconsistent, pvfp influences the client fp *) END ; @@ -919,7 +974,10 @@ WHILE ref < impCtxt.nofr DO nofhdfld := 0; OutFlds(typ^.link, 0, TRUE); IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(223, typ^.txtpos) END ; OutTProcs(typ, typ^.link); OPM.SymWInt(Send) + ELSE + OPM.LogWStr("unhandled case at OPT.OutStr, typ^.comp = "); OPM.LogWNum(typ^.comp, 0); OPM.LogWLn; END + ELSE OPM.LogWStr("unhandled case at OPT.OutStr, typ^.form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn; END END END OutStr; @@ -931,7 +989,7 @@ WHILE ref < impCtxt.nofr DO CASE f OF | Bool, Char: OPM.SymWCh(CHR(obj^.conval^.intval)) - | SInt, Int, LInt, Int8, Int16, Int32, Int64: + | SInt, Int, LInt(*, Int8, Int16, Int32, Int64*): OPM.SymWInt(obj^.conval^.intval) | Set: OPM.SymWSet(obj^.conval^.setval) @@ -959,6 +1017,8 @@ WHILE ref < impCtxt.nofr DO | same: (* ok *) | pbmodified: FPrintErr(obj, 252) | pvmodified: FPrintErr(obj, 251) + ELSE + OPM.LogWStr("unhandled case at OPT.OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn; END ; CASE obj^.mode OF | Con: @@ -983,6 +1043,8 @@ WHILE ref < impCtxt.nofr DO j := ORD(ext^[0]); i := 1; OPM.SymWInt(j); WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END ; OutName(obj^.name) + ELSE + OPM.LogWStr("unhandled case at OPT.OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn; END END END ; @@ -999,7 +1061,7 @@ WHILE ref < impCtxt.nofr DO OPM.NewSym(SelfName); IF OPM.noerr THEN OPM.SymWInt(Smname); OutName(SelfName); - expCtxt.reffp := 0; expCtxt.ref := FirstRef; + expCtxt.reffp := 0; expCtxt.ref := FirstRef(*Comp+1*); expCtxt.nofm := 1; expCtxt.locmno[0] := 0; i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END ; OutObj(topScope^.right); @@ -1058,12 +1120,12 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; (*initialization of module SYSTEM*) EnterTyp("BYTE", Byte, OPM.ByteSize, bytetyp); - +(* EnterTyp("INT8", Int8, OPM.Int8Size, int8typ); EnterTyp("INT16", Int16, OPM.Int16Size, int16typ); EnterTyp("INT32", Int32, OPM.Int32Size, int32typ); EnterTyp("INT64", Int64, OPM.Int64Size, int64typ); - +*) EnterTyp("PTR", Pointer, OPM.PointerSize, sysptrtyp); EnterProc("ADR", adrfn); EnterProc("CC", ccfn); @@ -1112,8 +1174,8 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0; EnterProc("ASH", ashfn); EnterProc("ASSERT", assertfn); impCtxt.ref[Undef] := undftyp; impCtxt.ref[Byte] := bytetyp; - impCtxt.ref[Int8] := int8typ; impCtxt.ref[Int16] := int16typ; - impCtxt.ref[Int32] := int32typ; impCtxt.ref[Int64] := int64typ; +(* impCtxt.ref[Int8] := int8typ; impCtxt.ref[Int16] := int16typ; + impCtxt.ref[Int32] := int32typ; impCtxt.ref[Int64] := int64typ;*) impCtxt.ref[Bool] := booltyp; impCtxt.ref[Char] := chartyp; impCtxt.ref[SInt] := sinttyp; impCtxt.ref[Int] := inttyp; impCtxt.ref[LInt] := linttyp; impCtxt.ref[Real] := realtyp; diff --git a/src/voc/OPV.Mod b/src/voc/OPV.Mod index e16b35b6..8e00879f 100644 --- a/src/voc/OPV.Mod +++ b/src/voc/OPV.Mod @@ -24,13 +24,16 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 (* structure forms *) Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; + Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; + Pointer = 13; ProcTyp = 14; + Comp = 15; (*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10; Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; Pointer = 17; ProcTyp = 18; Comp = 19;*) - Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; Pointer = 13; ProcTyp = 14; - Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; - Comp = (*15*)20; + (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; Pointer = 13; ProcTyp = 14; + Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18; + Comp = (*15*)19;*) (* composite structure forms *) Array = 2; DynArr = 3; Record = 4; @@ -124,7 +127,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 f := typ^.form; c := typ^.comp; IF c = Record THEN btyp := typ^.BaseTyp; IF btyp = NIL THEN offset := 0; base := OPM.RecAlign; - ELSE TypSize(btyp); offset := btyp^.size - btyp^.sysflag DIV 100H; base := btyp^.align + ELSE TypSize(btyp); offset := btyp^.size - btyp^.sysflag DIV 100H; base := btyp^.align; END; fld := typ^.link; WHILE (fld # NIL) & (fld^.mode = Fld) DO @@ -256,10 +259,10 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 OPT.sinttyp^.strobj^.linkadr := PredefinedType; OPT.booltyp^.strobj^.linkadr := PredefinedType; OPT.bytetyp^.strobj^.linkadr := PredefinedType; - OPT.int8typ^.strobj^.linkadr := PredefinedType; + (*OPT.int8typ^.strobj^.linkadr := PredefinedType; OPT.int16typ^.strobj^.linkadr := PredefinedType; OPT.int32typ^.strobj^.linkadr := PredefinedType; - OPT.int64typ^.strobj^.linkadr := PredefinedType; + OPT.int64typ^.strobj^.linkadr := PredefinedType;*) OPT.sysptrtyp^.strobj^.linkadr := PredefinedType; END AdrAndSize; @@ -304,11 +307,15 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 RETURN 0 | len, in, ash, msk, bit, lsh, rot: RETURN 10 + ELSE + OPM.LogWStr("unhandled case in OPV.Precedence, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; END; | Nupto: RETURN 10 | Ntype, Neguard: (* ignored anyway *) RETURN MaxPrec + ELSE + OPM.LogWStr("unhandled case in OPV.Precedence, class = "); OPM.LogWNum(class, 0); OPM.LogWLn; END; END Precedence; @@ -347,9 +354,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 ELSIF form = LInt THEN IF from < LInt THEN OPM.WriteString("(LONGINT)") END ; Entier(n, 9) - ELSIF form = Int64 THEN + (*ELSIF form = Int64 THEN IF (from >= SInt) & (from <= LInt) OR (from >= Int8) & (from < Int64) THEN OPM.WriteString("(SYSTEM_INT64)") END; - Entier(n, 9); + Entier(n, 9);*) ELSIF form = Int THEN IF from < Int THEN OPM.WriteString("(int)"); expr(n, 9) ELSE @@ -499,6 +506,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 END | Nmop: IF n^.subcl = val THEN design(n^.left, prec) END + ELSE + OPM.LogWStr("unhandled case in OPV.design, class = "); OPM.LogWNum(class, 0); OPM.LogWLn; END ; IF prec > designPrec THEN OPM.Write(CloseParen) END END design; @@ -523,12 +532,12 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 OPM.WriteString("(void*)") (* type extension *) END ELSE - IF (form IN {Real, LReal}) & (n^.typ^.form IN {SInt, Int, LInt, Int8, Int16, Int32, Int64}) THEN (* real promotion *) + IF (form IN {Real, LReal}) & (n^.typ^.form IN {SInt, Int, LInt(*, Int8, Int16, Int32, Int64*)}) THEN (* real promotion *) OPM.WriteString("(double)"); prec := 9 ELSIF (form = LInt) & (n^.typ^.form < LInt) THEN (* integral promotion *) OPM.WriteString("(LONGINT)"); prec := 9 - ELSIF (form = Int64) & (n^.typ^.form < Int64) THEN - OPM.WriteString("(SYSTEM_INT64)"); prec := 9; + (*ELSIF (form = Int64) & (n^.typ^.form < Int64) THEN + OPM.WriteString("(SYSTEM_INT64)"); prec := 9;*) END END ELSIF ansi THEN @@ -690,7 +699,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 IF form < LInt THEN OPM.WriteString("(int)") END ; IF SideEffects(n) THEN OPM.WriteString("__MODF(") ELSE OPM.WriteString("__MOD(") - END + END; + ELSE + OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; END ; expr(l, MinPrec); OPM.WriteString(Comma); @@ -724,7 +735,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 | slash: IF form = Set THEN OPM.WriteString(" ^ ") ELSE OPM.WriteString(" / "); - IF (r^.obj = NIL) OR (r^.obj^.typ^.form IN {SInt, Int, LInt, Int8, Int16, Int32, Int64}) THEN + IF (r^.obj = NIL) OR (r^.obj^.typ^.form IN {SInt, Int, LInt(*, Int8, Int16, Int32, Int64*)}) THEN OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen) END END @@ -739,7 +750,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 ELSE OPM.WriteString(" - ") END; | or: - OPM.WriteString(" || ") + OPM.WriteString(" || "); + ELSE + OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn; END; expr(r, exprPrec); IF (subclass = and) OR ((form = Set) & ((subclass = times) OR (subclass = minus))) THEN OPM.Write(CloseParen) END; (* to silence clang warnings, -- noch*) @@ -968,6 +981,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 design(n^.left, MinPrec); OPM.WriteString(", "); expr(n^.right, MinPrec); OPM.Write(")") + ELSE + OPM.LogWStr("unhandled case in OPV.expr, n^.subcl = "); OPM.LogWNum(n^.subcl, 0); OPM.LogWLn; END | Ncall: IF (n^.left^.obj # NIL) & (n^.left^.obj^.mode = TProc) THEN @@ -1035,9 +1050,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 when compiling Texts0.Mod on raspberry pi it generates __CASECHK and cause Halt, noch *) - - OPM.WriteString ("/*n^class = "); OPM.WriteInt(n^.class); OPM.WriteString(" and this is not handled, please investigate */"); - + OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn; END ; IF ~(n^.class IN {Nenter, Ninittd, Nifelse, Nwith, Ncase, Nwhile, Nloop}) THEN OPC.EndStat END ; n := n^.link diff --git a/src/voc/errors.Mod b/src/voc/errors.Mod index 1cf1269f..1ccdcc92 100644 --- a/src/voc/errors.Mod +++ b/src/voc/errors.Mod @@ -6,7 +6,7 @@ VAR errors- : ARRAY 350 OF string; BEGIN -(* Incorroct use of the language Oberon *) +(* Incorrect use of the language Oberon *) errors[0] := "undeclared identifier"; errors[1] := "multiply defined identifier"; errors[2] := "illegal character in number"; @@ -187,6 +187,7 @@ errors[245] := "guarded pointer variable may be manipulated by non-local operati errors[301] := "implicit type cast"; errors[306] := "inappropriate symbol file ignored"; +errors[307] := "no ELSE symbol after CASE statement sequence may lead to trap"; (* new warning, -- noch *) END errors. (* diff --git a/src/voc/voc.Mod b/src/voc/voc.Mod index a109762a..a375af43 100644 --- a/src/voc/voc.Mod +++ b/src/voc/voc.Mod @@ -80,10 +80,10 @@ VAR mname : ARRAY 256 OF CHAR; (* noch *) modulesobj := ""; OPM.OpenPar; (* gclock(); slightly faste rtranslation but may lead to opening "too many files" *) OPT.bytetyp.size := OPM.ByteSize; - OPT.int8typ.size := 1; + (*OPT.int8typ.size := 1; OPT.int16typ.size := 2; OPT.int32typ.size := 4; - OPT.int64typ.size := 8; + OPT.int64typ.size := 8;*) OPT.sysptrtyp.size := OPM.PointerSize; OPT.chartyp.size := OPM.CharSize; OPT.settyp.size := OPM.SetSize; diff --git a/vocstatic.linux.gcc.x86_64.REMOVED.git-id b/vocstatic.linux.gcc.x86_64.REMOVED.git-id index 80dbc8fa..8a6ca190 100644 --- a/vocstatic.linux.gcc.x86_64.REMOVED.git-id +++ b/vocstatic.linux.gcc.x86_64.REMOVED.git-id @@ -1 +1 @@ -6c417bc6b34eabba2b7ca560a01c15ddd9a43a29 \ No newline at end of file +924b37cbff137a08805e86eb63403bda0495cf16 \ No newline at end of file