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

reverted system type changes, added warning for absent else in case, -- noch

Browse source 
Former-commit-id: 929f688a9e
This commit is contained in:
norayr 2015-03-19 15:33:10 +04:00
parent b0b0a3b546
commit a1eff0b339
9 changed files with 410 additions and 304 deletions
Download patch file Download diff file Expand all files Collapse all files

76
src/voc/OPB.Mod
View file

@ -20,16 +20,20 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
(* Structure forms *) (* Structure forms *)
Undef = 0; Byte = 1; Bool = 2; Char = 3; Undef = 0; Byte = 1; Bool = 2; Char = 3;
SInt = 4; Int = 5; LInt = 6; 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; (* Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10;
Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16;
Pointer = 17; ProcTyp = 18; Pointer = 17; ProcTyp = 18;
Comp = 19;*) 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; Pointer = 13; ProcTyp = 14;
Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18;
Comp = (*15*)20; Comp = (*15*)19;*)
intSet = {SInt..LInt, Int8..Int64}; realSet = {Real, LReal}; intSet = {SInt..LInt(*, Int8..Int64*)}; realSet = {Real, LReal};
(* composite structure forms *) (* composite structure forms *)
Basic = 1; Array = 2; DynArr = 3; Record = 4; 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 ; END ;
z^.typ := OPT.booltyp z^.typ := OPT.booltyp
ELSE 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
END ; END ;
x := z x := z
@ -488,7 +492,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
CASE f OF CASE f OF
Undef: Undef:
res := eql res := eql
| Byte, Char..LInt,Int8..Int64: | Byte, Char..LInt(*,Int8..Int64*):
IF xval^.intval < yval^.intval THEN res := lss IF xval^.intval < yval^.intval THEN res := lss
ELSIF xval^.intval > yval^.intval THEN res := gtr ELSIF xval^.intval > yval^.intval THEN res := gtr
ELSE res := eql ELSE res := eql
@ -516,7 +520,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *)
ELSE res := eql ELSE res := eql
END END
ELSE 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 ; END ;
x^.typ := OPT.booltyp; RETURN res x^.typ := OPT.booltyp; RETURN res
END ConstCmp; 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) IF g = String THEN CharToString(x)
ELSE err(100); y^.typ := x^.typ; yval^ := xval^ ELSE err(100); y^.typ := x^.typ; yval^ := xval^
END ; END ;
| SInt, Int8: | SInt(*, Int8*):
IF g IN intSet THEN x^.typ := y^.typ IF g IN intSet THEN x^.typ := y^.typ
ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval
ELSIF g = LReal THEN x^.typ := OPT.lrltyp; 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^ ELSE err(100); y^.typ := x^.typ; yval^ := xval^
END END
| Int, Int16, Int32, Int64: | Int(*, Int16, Int32, Int64*):
IF g = SInt THEN y^.typ := OPT.inttyp IF g = SInt THEN y^.typ := OPT.inttyp
ELSIF g IN intSet THEN x^.typ := y^.typ ELSIF g IN intSet THEN x^.typ := y^.typ
ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval 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) ELSE xval^.intval := BoolToInt(ConstCmp() # lss)
END END
ELSE 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
END ConstOp; 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 CASE z^.typ^.form OF
Char: Char:
IF z^.class = Nconst THEN CharToString(z) ELSE err(100) END 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) IF g IN intSet + realSet THEN Convert(z, y^.typ)
ELSE err(100) ELSE err(100)
END 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) ELSIF g IN intSet + realSet THEN Convert(z, y^.typ)
ELSE err(100) ELSE err(100)
END END
| LInt, Int16, Int32, Int64: | LInt(*, Int16, Int32, Int64*):
IF g IN intSet THEN Convert(y, z^.typ) IF g IN intSet THEN Convert(y, z^.typ)
ELSIF g IN realSet THEN Convert(z, y^.typ) ELSIF g IN realSet THEN Convert(z, y^.typ)
ELSE err(100) 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 ELSIF f # Undef THEN err(94); z^.typ := OPT.undftyp
END END
| plus: | 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; do := TRUE;
IF f IN intSet THEN IF f IN intSet THEN
IF (z^.class = Nconst) & (z^.conval^.intval = 0) THEN do := FALSE; z := y END ; 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 ; END ;
IF do THEN NewOp(op, typ, z, y) END IF do THEN NewOp(op, typ, z, y) END
| minus: | 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 IF ~(f IN intSet) OR (y^.class # Nconst) OR (y^.conval^.intval # 0) THEN NewOp(op, typ, z, y) END
| or: | or:
IF f = Bool THEN 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 ELSIF f # Undef THEN err(95); z^.typ := OPT.undftyp
END END
| eql, neq: | 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 ELSE err(107); typ := OPT.undftyp
END ; END ;
NewOp(op, typ, z, y) NewOp(op, typ, z, y)
| lss, leq, gtr, geq: | 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 ELSE
OPM.LogWLn; OPM.LogWStr("ELSE in Op()"); OPM.LogWLn; OPM.LogWLn; OPM.LogWStr("ELSE in Op()"); OPM.LogWLn;
err(108); typ := OPT.undftyp err(108); typ := OPT.undftyp
END ; END ;
NewOp(op, typ, z, y) NewOp(op, typ, z, y)
ELSE 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
END ; END ;
x := z 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 ; IF (ynode^.class = Ntype) OR (ynode^.class = Nproc) & (f # ProcTyp) THEN err(126) END ;
CASE f OF CASE f OF
Undef, String: Undef, String:
| Int8: (* | Int8:
IF (ynode.typ.size > OPM.Int8Size) THEN IF (ynode.typ.size > OPM.Int8Size) THEN
IF OPM.Verbose THEN OPM.LogWStr("f of int8"); OPM.LogWLn END; IF OPM.Verbose THEN OPM.LogWStr("f of int8"); OPM.LogWLn END;
err(113) 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 ynode.typ.size > OPM.Int64Size THEN
IF OPM.Verbose THEN OPM.LogWStr("f of int64"); OPM.LogWLn END; IF OPM.Verbose THEN OPM.LogWStr("f of int64"); OPM.LogWLn END;
err(113) err(113)
END END*)
| Byte: | Byte:
IF ~(g IN {Byte, Char, SInt}) THEN err(113) END IF ~(g IN {Byte, Char, SInt}) THEN err(113) END
| Bool, Char, SInt, Set: | 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 IF ~(g IN {SInt, Int}) THEN err(113) END
| LInt: | LInt:
IF OPM.LIntSize = 4 THEN 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 *) 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; END;
| Real: | Real:
IF ~(g IN {SInt..Real}) THEN err(113) END 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) ELSE (*DynArr*) err(113)
END END
ELSE (* In case of not estimated f it would crash -- noch *) 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 ; END ;
IF (ynode^.class = Nconst) & (g < f) & (g IN {SInt..Real}) & (f IN {Int..LReal}) THEN IF (ynode^.class = Nconst) & (g < f) & (g IN {SInt..Real}) & (f IN {Int..LReal}) THEN
Convert(ynode, x) Convert(ynode, x)
@ -1114,10 +1118,10 @@ avoid unnecessary intermediate variables in voc
| SInt: x := NewIntConst(OPM.MinSInt) | SInt: x := NewIntConst(OPM.MinSInt)
| Int: x := NewIntConst(OPM.MinInt) | Int: x := NewIntConst(OPM.MinInt)
| LInt: x := NewIntConst(OPM.MinLInt) | LInt: x := NewIntConst(OPM.MinLInt)
| Int8: x := NewIntConst(OPM.MinInt8) (* | Int8: x := NewIntConst(OPM.MinInt8)
| Int16: x := NewIntConst(OPM.MinInt16) | Int16: x := NewIntConst(OPM.MinInt16)
| Int32: x := NewIntConst(OPM.MinInt32) | 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 | Set: x := NewIntConst(0); x^.typ := OPT.inttyp
| Real: x := NewRealConst(OPM.MinReal, OPT.realtyp) | Real: x := NewRealConst(OPM.MinReal, OPT.realtyp)
| LReal: x := NewRealConst(OPM.MinLReal, OPT.lrltyp) | LReal: x := NewRealConst(OPM.MinLReal, OPT.lrltyp)
@ -1133,10 +1137,10 @@ avoid unnecessary intermediate variables in voc
| SInt: x := NewIntConst(OPM.MaxSInt) | SInt: x := NewIntConst(OPM.MaxSInt)
| Int: x := NewIntConst(OPM.MaxInt) | Int: x := NewIntConst(OPM.MaxInt)
| LInt: x := NewIntConst(OPM.MaxLInt) | LInt: x := NewIntConst(OPM.MaxLInt)
| Int8: x := NewIntConst(OPM.MaxInt8) (* | Int8: x := NewIntConst(OPM.MaxInt8)
| Int16: x := NewIntConst(OPM.MaxInt16) | Int16: x := NewIntConst(OPM.MaxInt16)
| Int32: x := NewIntConst(OPM.MaxInt32) | 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 | Set: x := NewIntConst(OPM.MaxSet); x^.typ := OPT.inttyp
| Real: x := NewRealConst(OPM.MaxReal, OPT.realtyp) | Real: x := NewRealConst(OPM.MaxReal, OPT.realtyp)
| LReal: x := NewRealConst(OPM.MaxLReal, OPT.lrltyp) | LReal: x := NewRealConst(OPM.MaxLReal, OPT.lrltyp)
@ -1146,16 +1150,16 @@ avoid unnecessary intermediate variables in voc
END END
| chrfn: (*CHR*) | chrfn: (*CHR*)
IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) 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 ELSE err(111); x^.typ := OPT.chartyp
END END
| shortfn: (*SHORT*) | shortfn: (*SHORT*)
IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
ELSIF f = Int THEN Convert(x, OPT.sinttyp) ELSIF f = Int THEN Convert(x, OPT.sinttyp)
ELSIF f = LInt THEN Convert(x, OPT.inttyp) 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 = 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) ELSIF f = LReal THEN Convert(x, OPT.realtyp)
ELSE err(111) ELSE err(111)
END END
@ -1163,9 +1167,9 @@ avoid unnecessary intermediate variables in voc
IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
ELSIF f = SInt THEN Convert(x, OPT.inttyp) ELSIF f = SInt THEN Convert(x, OPT.inttyp)
ELSIF f = Int THEN Convert(x, OPT.linttyp) 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 = 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 = Real THEN Convert(x, OPT.lrltyp)
ELSIF f = Char THEN Convert(x, OPT.linttyp) ELSIF f = Char THEN Convert(x, OPT.linttyp)
ELSE err(111) ELSE err(111)
@ -1198,7 +1202,7 @@ avoid unnecessary intermediate variables in voc
CheckLeaf(x, FALSE); MOp(adr, x) CheckLeaf(x, FALSE); MOp(adr, x)
| sizefn: (*SIZE*) | sizefn: (*SIZE*)
IF x^.class # Ntype THEN err(110); x := NewIntConst(1) 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) typSize(x^.typ); x^.typ^.pvused := TRUE; x := NewIntConst(x^.typ^.size)
ELSE err(111); x := NewIntConst(1) ELSE err(111); x := NewIntConst(1)
END END
@ -1206,7 +1210,7 @@ avoid unnecessary intermediate variables in voc
MOp(cc, x) MOp(cc, x)
| lshfn, rotfn: (*SYSTEM.LSH, SYSTEM.ROT*) | lshfn, rotfn: (*SYSTEM.LSH, SYSTEM.ROT*)
IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) 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 END
| getfn, putfn, bitfn, movefn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.BIT, SYSTEM.MOVE*) | getfn, putfn, bitfn, movefn: (*SYSTEM.GET, SYSTEM.PUT, SYSTEM.BIT, SYSTEM.MOVE*)
IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) 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) ELSE MOp(not, x)
END END
ELSE 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 ; END ;
par0 := x par0 := x
END StPar0; END StPar0;
@ -1464,7 +1468,7 @@ avoid unnecessary intermediate variables in voc
BEGIN (* ftyp^.comp = DynArr *) BEGIN (* ftyp^.comp = DynArr *)
f := atyp^.comp; ftyp := ftyp^.BaseTyp; atyp := atyp^.BaseTyp; f := atyp^.comp; ftyp := ftyp^.BaseTyp; atyp := atyp^.BaseTyp;
IF fvarpar & (ftyp = OPT.bytetyp) THEN (* ok, but ... *) 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 ELSIF f IN {Array, DynArr} THEN
IF ftyp^.comp = DynArr THEN DynArrParCheck(ftyp, atyp, fvarpar) IF ftyp^.comp = DynArr THEN DynArrParCheck(ftyp, atyp, fvarpar)
ELSIF ftyp # atyp THEN ELSIF ftyp # atyp THEN

37
src/voc/OPC.Mod
View file

@ -13,14 +13,19 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
(* structure forms *) (* structure forms *)
Byte = 1; Bool = 2; Char = 3; Byte = 1; Bool = 2; Char = 3;
SInt = 4; Int = 5; LInt = 6; SInt = 4; Int = 5; LInt = 6;
(*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; Pointer = 13; ProcTyp = 14;
Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; Comp = 15;
Comp = (*15*)20; (*
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;
Pointer = 13; ProcTyp = 14;
Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18;
Comp = (*15*)19;*)
(* composite structure forms *) (* composite structure forms *)
Array = 2; DynArr = 3; Record = 4; 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) ELSE OPM.WriteStringVar(OPM.modName)
END ; END ;
OPM.Write(Underscore) 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_") OPM.WriteString("SYSTEM_")
END ; END ;
@ -610,6 +615,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
| 8: INC(adr, (-adr) MOD 8) | 8: INC(adr, (-adr) MOD 8)
|16: INC(adr, (-adr) MOD 16) |16: INC(adr, (-adr) MOD 16)
ELSE (*1*) ELSE (*1*)
(*OPM.LogWStr("unhandled case at OPC.Align, base = "); OPM.LogWNum(base, 0); OPM.LogWLn;*)
END END
END Align; END Align;
@ -622,10 +628,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
| SInt: RETURN OPM.SIntAlign | SInt: RETURN OPM.SIntAlign
| Int: RETURN OPM.IntAlign | Int: RETURN OPM.IntAlign
| LInt: RETURN OPM.LIntAlign | LInt: RETURN OPM.LIntAlign
| Int8: RETURN OPM.Int8Align (* | Int8: RETURN OPM.Int8Align
| Int16: RETURN OPM.Int16Align | Int16: RETURN OPM.Int16Align
| Int32: RETURN OPM.Int32Align | Int32: RETURN OPM.Int32Align
| Int64: RETURN OPM.Int64Align | Int64: RETURN OPM.Int64Align*)
| Real: RETURN OPM.RealAlign | Real: RETURN OPM.RealAlign
| LReal: RETURN OPM.LRealAlign | LReal: RETURN OPM.LRealAlign
| Set: RETURN OPM.SetAlign | 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 IF typ^.comp = Record THEN RETURN typ^.align MOD 10000H
ELSE RETURN Base(typ^.BaseTyp) ELSE RETURN Base(typ^.BaseTyp)
END END
ELSE OPM.LogWStr("unhandled case in OPC.Base, typ^form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn;
END END
END Base; END Base;
@ -877,7 +884,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
if option is passed this will if option is passed this will
generate __CASECHK and cause Halt, generate __CASECHK and cause Halt,
noch *) 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 END
END; END;
@ -1223,6 +1230,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.WriteString(" > "); OPM.WriteString(" > ");
| geq : | geq :
OPM.WriteString(" >= "); OPM.WriteString(" >= ");
ELSE
OPM.LogWStr("unhandled case in OPC.Cmp, rel = "); OPM.LogWNum(rel, 0); OPM.LogWLn;
END; END;
END Cmp; END Cmp;
@ -1245,6 +1254,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END; END;
| SInt, Int, LInt : | SInt, Int, LInt :
OPM.WriteInt (caseVal); OPM.WriteInt (caseVal);
ELSE
OPM.LogWStr("unhandled case in OPC.Case, form = "); OPM.LogWNum(form, 0); OPM.LogWLn;
END; END;
OPM.WriteString(Colon); OPM.WriteString(Colon);
END Case; END Case;
@ -1296,8 +1307,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
END END
| SInt, Int, LInt: | SInt, Int, LInt:
OPM.WriteInt(con^.intval) OPM.WriteInt(con^.intval)
| Int8, Int16, Int32, Int64: (* | Int8, Int16, Int32, Int64:
OPM.WriteInt(con^.intval) OPM.WriteInt(con^.intval)*)
| Real: | Real:
OPM.WriteReal(con^.realval, "f") OPM.WriteReal(con^.realval, "f")
@ -1329,6 +1340,8 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *)
OPM.Write(Quotes) OPM.Write(Quotes)
| NilTyp: | NilTyp:
OPM.WriteString(NilConst); OPM.WriteString(NilConst);
ELSE
OPM.LogWStr("unhandled case in OPC.Constant, form = "); OPM.LogWNum(form, 0); OPM.LogWLn;
END; END;
END Constant; END Constant;

32
src/voc/OPM.cmdln.Mod
View file

@ -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; SourceFileName : ARRAY 256 OF CHAR;
ByteSize*, CharSize*, BoolSize*, SIntSize*, IntSize*, ByteSize*, CharSize*, BoolSize*, SIntSize*, IntSize*,
LIntSize*, SetSize*, RealSize*, LRealSize*, PointerSize*, ProcSize*, RecSize*, 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*, 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*, LIntAlign*, SetAlign*, RealAlign*, LRealAlign*, PointerAlign*, ProcAlign*, RecAlign*,
ByteOrder*, BitOrder*, MaxSet*: INTEGER; ByteOrder*, BitOrder*, MaxSet*: INTEGER;
MinSInt*, MinInt*, MinLInt*, MaxSInt*, MaxInt*, MaxLInt*, MaxIndex*: LONGINT; MinSInt*, MinInt*, MinLInt*, MaxSInt*, MaxInt*, MaxLInt*, MaxIndex*: LONGINT;
MinInt8*, MaxInt8*, MinInt16*, MaxInt16*, MinInt32*, MaxInt32* : LONGINT; (*MinInt8*, MaxInt8*, MinInt16*, MaxInt16*, MinInt32*, MaxInt32* : LONGINT;
MinInt64*, MaxInt64* : SYSTEM.INT64; MinInt64*, MaxInt64* : SYSTEM.INT64;*)
MinReal*, MaxReal*, MinLReal*, MaxLReal*: LONGREAL; MinReal*, MaxReal*, MinLReal*, MaxLReal*: LONGREAL;
noerr*: BOOLEAN; noerr*: BOOLEAN;
@ -612,16 +612,19 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
Console.String("PROC "); Console.Int(ProcSize, 0); Console.Int(ProcAlign, 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("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.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.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.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.String("SYSTEM.INT64 "); Console.Int(Int64Size, 0); Console.Int(Int64Align, 5); Console.Ln;
*)
Console.Ln; Console.Ln;
Console.String("Min shortint "); Console.Int(MinSInt, 0); Console.Ln; Console.String("Min shortint "); Console.Int(MinSInt, 0); Console.Ln;
Console.String("Max shortint "); Console.Int(MaxSInt, 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("Min integer "); Console.Int(MinInt, 0); Console.Ln;
Console.String("Max integer "); Console.Int(MaxInt, 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("Min longint "); Console.Int(MinLInt, 0); Console.Ln;
(*
Console.String("Max longint "); Console.Int(MaxLInt, 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("Min int8 "); Console.Int(MinInt8, 0); Console.Ln;
Console.String("Max int8 "); Console.Int(MaxInt8, 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("Max int16 "); Console.Int(MaxInt16, 0); Console.Ln;
Console.String("Min int32 "); Console.Int(MinInt32, 0); Console.Ln; Console.String("Min int32 "); Console.Int(MinInt32, 0); Console.Ln;
Console.String("Max int32 "); Console.Int(MaxInt32, 0); Console.Ln; Console.String("Max int32 "); Console.Int(MaxInt32, 0); Console.Ln;
*)
END VerboseListSizes; 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; ByteSize := 1; CharSize := 1; BoolSize := 1; SIntSize := 1; IntSize := 4; LIntSize := 8;
SetSize := 8; RealSize := 4; LRealSize := 8; ProcSize := 8; PointerSize := 8; RecSize := 1; SetSize := 8; RealSize := 4; LRealSize := 8; ProcSize := 8; PointerSize := 8; RecSize := 1;
CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 4; LIntAlign := 8; 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; SetAlign := 8; RealAlign := 4; LRealAlign := 8; ProcAlign := 8; PointerAlign := 8; RecAlign := 1;
(* not necessary, we will calculate values later (* not necessary, we will calculate values later
MinSInt := -80H; MaxSInt := 7FH; 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; ByteSize := 1; CharSize := 1; BoolSize := 1; SIntSize := 1; IntSize := 2; LIntSize := 4;
SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1; SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1;
CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; 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; SetAlign := 4; RealAlign := 4; LRealAlign := 8; ProcAlign := 4; PointerAlign := 4; RecAlign := 1;
(* not necessary, we will calculate values later (* 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; SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1;
CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; 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; 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; SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1;
CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; 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; SetAlign := 4; RealAlign := 4; LRealAlign := 4; ProcAlign := 4; PointerAlign := 4; RecAlign := 1;
ELSE (* this should suite any gnu x86 system *) 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; SetSize := 4; RealSize := 4; LRealSize := 8; ProcSize := 4; PointerSize := 4; RecSize := 1;
CharAlign := 1; BoolAlign := 1; SIntAlign := 1; IntAlign := 2; LIntAlign := 4; 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; SetAlign := 4; RealAlign := 4; LRealAlign := 4; ProcAlign := 4; PointerAlign := 4; RecAlign := 1;
(* LRealAlign should be checked and confirmed *) (* LRealAlign should be checked and confirmed *)
(* not necessary, will be calculated later (* 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, "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.INT16", Int16Size, Int16Align);
GetProperty(S, "SYSTEM.INT32", Int32Size, Int32Align); 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 *) (* add here Max and Min sizes, noch *)
ByteSize := CharSize; 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
END; (* if useParFile , noch *) 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 * (* commenting this by replacing with faster way; -- noch *
MinSInt := power0(-2, (SIntSize*8-1)); (* -2^(SIntSize*8-1)*) 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); MinLInt := ASH(base, LIntSize*8-2);
MaxLInt := minus(MinLInt +1); MaxLInt := minus(MinLInt +1);
(*
MinInt8 := -80H; MinInt16 := -8000H; MinInt32 := 80000000H; (*-2147483648*) MinInt8 := -80H; MinInt16 := -8000H; MinInt32 := 80000000H; (*-2147483648*)
MaxInt8 := 7FH; MaxInt16 := 7FFFH; MaxInt32 := 7FFFFFFFH; (*2147483647*) MaxInt8 := 7FH; MaxInt16 := 7FFFH; MaxInt32 := 7FFFFFFFH; (*2147483647*)
MinInt64 := ASH(base, Int64Size*8-2); MinInt64 := ASH(base, Int64Size*8-2);
MaxInt64 := minus(ASH(base, Int64Size*8-2) + 1); MaxInt64 := minus(ASH(base, Int64Size*8-2) + 1);
*)
IF RealSize = 4 THEN MaxReal := 3.40282346D38 IF RealSize = 4 THEN MaxReal := 3.40282346D38
ELSIF RealSize = 8 THEN MaxReal := 1.7976931348623157D307 * 9.999999 ELSIF RealSize = 8 THEN MaxReal := 1.7976931348623157D307 * 9.999999
(*should be 1.7976931348623157D308 *) (*should be 1.7976931348623157D308 *)

21
src/voc/OPP.Mod
View file

@ -29,16 +29,19 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
(* Structure forms *) (* Structure forms *)
Undef = 0; Byte = 1; Bool = 2; Char = 3; Undef = 0; Byte = 1; Bool = 2; Char = 3;
SInt = 4; Int = 5; LInt = 6; 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; (*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10;
Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16;
Pointer = 17; ProcTyp = 18; Pointer = 17; ProcTyp = 18;
Comp = 19;*) 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; Pointer = 13; ProcTyp = 14;
Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18;
Comp = (*15*)20; Comp = (*15*)19;*)
intSet = {SInt..LInt, Int8..Int64}; intSet = {SInt..LInt(*, Int8..Int64*)};
(* composite structure forms *) (* composite structure forms *)
Basic = 1; Array = 2; DynArr = 3; Record = 4; 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; OPS.Get(sym); resTyp := OPT.undftyp;
IF sym = ident THEN qualident(res); IF sym = ident THEN qualident(res);
IF res^.mode = Typ THEN 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) ELSE err(54)
END END
ELSE err(52) 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) | integer: x := OPB.NewIntConst(OPS.intval)
| real: x := OPB.NewRealConst(OPS.realval, OPT.realtyp) | real: x := OPB.NewRealConst(OPS.realval, OPT.realtyp)
| longreal: x := OPB.NewRealConst(OPS.lrlval, OPT.lrltyp) | 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 ; END ;
OPS.Get(sym) OPS.Get(sym)
ELSIF sym = string THEN 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 ELSE low := 1; high := 0
END ; END ;
e := sym = else; 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); OPB.Construct(Ncaselse, cases, y); OPB.Construct(Ncase, x, cases);
cases^.conval := OPT.NewConst(); cases^.conval := OPT.NewConst();
cases^.conval^.intval := low; cases^.conval^.intval2 := high; cases^.conval^.intval := low; cases^.conval^.intval2 := high;

172
src/voc/OPT.Mod
View file

@ -62,14 +62,14 @@ END ;
CONST CONST
maxImps = 64; (* must be <= MAX(SHORTINT) *) maxImps = 64; (* must be <= MAX(SHORTINT) *)
maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *) maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *)
FirstRef = 16; FirstRef = (*20*)16; (* comp + 1 *)
VAR VAR
typSize*: PROCEDURE(typ: Struct); typSize*: PROCEDURE(typ: Struct);
topScope*: Object; topScope*: Object;
undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*, undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*,
realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*, realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*(*,
int8typ*, int16typ*, int32typ*, int64typ*: Struct; int8typ*, int16typ*, int32typ*, int64typ* *): Struct;
nofGmod*: SHORTINT; (*nof imports*) nofGmod*: SHORTINT; (*nof imports*)
GlbMod*: ARRAY maxImps OF Object; (* ^.right = first object, ^.name = module import name (not alias) *) GlbMod*: ARRAY maxImps OF Object; (* ^.right = first object, ^.name = module import name (not alias) *)
SelfName*: OPS.Name; (* name of module being compiled *) 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 *) (* structure forms *)
Undef = 0; Byte = 1; Bool = 2; Char = 3; Undef = 0; Byte = 1; Bool = 2; Char = 3;
SInt = 4; Int = 5; LInt = 6; 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; (*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10;
Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16;
Pointer = 17; ProcTyp = 18; Pointer = 17; ProcTyp = 18;
Comp = 19;*) 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; Pointer = 13; ProcTyp = 14;
Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18;
Comp = 20; Comp = 19;*)
(* composite structure forms *) (* composite structure forms *)
Basic = 1; Array = 2; DynArr = 3; Record = 4; Basic = 1; Array = 2; DynArr = 3; Record = 4;
@ -200,7 +204,7 @@ VAR i: INTEGER;
BEGIN (* garbage collection *) BEGIN (* garbage collection *)
CloseScope; CloseScope;
i := 0; WHILE i < maxImps DO GlbMod[i] := NIL; INC(i) END ; 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; END Close;
PROCEDURE FindImport*(mod: Object; VAR res: Object); PROCEDURE FindImport*(mod: Object; VAR res: Object);
@ -282,12 +286,29 @@ END FPrintName;
PROCEDURE ^IdFPrint*(typ: Struct); 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); PROCEDURE FPrintSign(VAR fp: LONGINT; result: Struct; par: Object);
(* depends on assignment compatibility of params only *) (* depends on assignment compatibility of params only *)
BEGIN BEGIN
IdFPrint(result); OPM.FPrint(fp, result^.idfp); IdFPrint(result); OPM.FPrint(fp, result^.idfp);
WHILE par # NIL DO WHILE (par # NIL) (*& (par^.typ # NIL)*) DO (* !!! *)
OPM.FPrint(fp, par^.mode); IdFPrint(par^.typ); OPM.FPrint(fp, par^.typ^.idfp); OPM.FPrint(fp, par^.mode);
IdFPrint(par^.typ);
OPM.FPrint(fp, par^.typ^.idfp);
(* par^.name and par^.adr not considered *) (* par^.name and par^.adr not considered *)
par := par^.link par := par^.link
END END
@ -305,7 +326,8 @@ FPrintName(idfp, GlbMod[typ^.mno]^.name); FPrintName(idfp, strobj^.name)
END ; END ;
IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN IF (f = Pointer) OR (c = Record) & (btyp # NIL) OR (c = DynArr) THEN
IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp) IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp)
ELSIF c = Array THEN IdFPrint(btyp); OPM.FPrint(idfp, btyp^.idfp); OPM.FPrint(idfp, typ^.n) 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) ELSIF f = ProcTyp THEN FPrintSign(idfp, btyp, typ^.link)
END ; END ;
typ^.idfp := idfp typ^.idfp := idfp
@ -328,7 +350,7 @@ IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN
IF j # nofhdfld THEN i := 1; IF j # nofhdfld THEN i := 1;
WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO WHILE (i < n) & (nofhdfld <= OPM.MaxHdFld) DO
INC(adr, btyp^.size); FPrintHdFld(btyp, fld, adr); INC(i) INC(adr, btyp^.size); FPrintHdFld(btyp, fld, adr); INC(i)
END END;
END END
END END
ELSIF OPM.ExpHdPtrFld & ((typ^.form = Pointer) OR (fld^.name = OPM.HdPtrName)) THEN ELSIF OPM.ExpHdPtrFld & ((typ^.form = Pointer) OR (fld^.name = OPM.HdPtrName)) THEN
@ -344,10 +366,11 @@ WHILE (fld # NIL) & (fld^.mode = Fld) DO
IF (fld^.vis # internal) & visible THEN IF (fld^.vis # internal) & visible THEN
OPM.FPrint(pbfp, fld^.vis); FPrintName(pbfp, fld^.name); OPM.FPrint(pbfp, fld^.adr); 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) FPrintStr(fld^.typ); OPM.FPrint(pbfp, fld^.typ^.pbfp); OPM.FPrint(pvfp, fld^.typ^.pvfp)
ELSE FPrintHdFld(fld^.typ, fld, fld^.adr + adr) ELSE
FPrintHdFld(fld^.typ, fld, fld^.adr + adr)
END ; END ;
fld := fld^.link fld := fld^.link
END END;
END FPrintFlds; END FPrintFlds;
PROCEDURE FPrintTProcs(obj: Object); (* modifies pbfp and pvfp *) PROCEDURE FPrintTProcs(obj: Object); (* modifies pbfp and pvfp *)
@ -363,7 +386,7 @@ IF obj^.mode = TProc THEN
END END
END ; END ;
FPrintTProcs(obj^.right) FPrintTProcs(obj^.right)
END END;
END FPrintTProcs; END FPrintTProcs;
BEGIN BEGIN
@ -390,7 +413,7 @@ FPrintTProcs(typ^.link); OPM.FPrint(pvfp, pbfp); strobj := typ^.strobj;
IF (strobj = NIL) OR (strobj^.name = "") THEN pbfp := pvfp END IF (strobj = NIL) OR (strobj^.name = "") THEN pbfp := pvfp END
END ; END ;
typ^.pbfp := pbfp; typ^.pvfp := pvfp typ^.pbfp := pbfp; typ^.pvfp := pvfp
END END;
END FPrintStr; END FPrintStr;
PROCEDURE FPrintObj*(obj: Object); PROCEDURE FPrintObj*(obj: Object);
@ -402,7 +425,7 @@ OPM.FPrint(fprint, obj^.mode);
IF obj^.mode = Con THEN IF obj^.mode = Con THEN
f := obj^.typ^.form; OPM.FPrint(fprint, f); f := obj^.typ^.form; OPM.FPrint(fprint, f);
CASE f OF CASE f OF
| Bool, Char, SInt, Int, LInt, Int8, Int16, Int32, Int64: | Bool, Char, SInt, Int, LInt(*, Int8, Int16, Int32, Int64*):
OPM.FPrint(fprint, obj^.conval^.intval) OPM.FPrint(fprint, obj^.conval^.intval)
| Set: | Set:
OPM.FPrintSet(fprint, obj^.conval^.setval) OPM.FPrintSet(fprint, obj^.conval^.setval)
@ -422,7 +445,7 @@ FPrintSign(fprint, obj^.typ, obj^.link)
ELSIF obj^.mode = CProc THEN ELSIF obj^.mode = CProc THEN
FPrintSign(fprint, obj^.typ, obj^.link); ext := obj^.conval^.ext; FPrintSign(fprint, obj^.typ, obj^.link); ext := obj^.conval^.ext;
m := ORD(ext^[0]); f := 1; OPM.FPrint(fprint, m); m := ORD(ext^[0]); f := 1; OPM.FPrint(fprint, m);
WHILE f <= m DO OPM.FPrint(fprint, ORD(ext^[f])); INC(f) END WHILE f <= m DO OPM.FPrint(fprint, ORD(ext^[f])); INC(f) END;
ELSIF obj^.mode = Typ THEN ELSIF obj^.mode = Typ THEN
FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp) FPrintStr(obj^.typ); OPM.FPrint(fprint, obj^.typ^.pbfp)
END ; END ;
@ -517,10 +540,10 @@ PROCEDURE InConstant(f: LONGINT; conval: Const);
VAR ch: CHAR; i: INTEGER; ext: ConstExt; rval: REAL; VAR ch: CHAR; i: INTEGER; ext: ConstExt; rval: REAL;
BEGIN BEGIN
CASE f OF CASE f OF
| Byte, Char, Bool: | (*Int8,*) Byte, Char, Bool:
OPM.SymRCh(ch); conval^.intval := ORD(ch) OPM.SymRCh(ch); conval^.intval := ORD(ch)
| Int8, Int16, Int32, Int64: (*| Int8, Int16, Int32, Int64:
conval^.intval := OPM.SymRInt() conval^.intval := OPM.SymRInt()*)
| SInt, Int, LInt: | SInt, Int, LInt:
conval^.intval := OPM.SymRInt() conval^.intval := OPM.SymRInt()
| Set: | Set:
@ -541,7 +564,7 @@ conval^.intval := OPM.ConstNotAlloc
| NilTyp: | NilTyp:
conval^.intval := OPM.nilval conval^.intval := OPM.nilval
ELSE 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
END InConstant; END InConstant;
@ -602,17 +625,21 @@ VAR mno: SHORTINT; ref: INTEGER; tag: LONGINT; name: OPS.Name;
t: Struct; obj, last, fld, old, dummy: Object; t: Struct; obj, last, fld, old, dummy: Object;
BEGIN BEGIN
tag := OPM.SymRInt(); tag := OPM.SymRInt();
IF tag # Sstruct THEN typ := impCtxt.ref[-tag] IF tag # Sstruct THEN
typ := impCtxt.ref[-tag]
ELSE ELSE
ref := impCtxt.nofr; INC(impCtxt.nofr); ref := impCtxt.nofr; INC(impCtxt.nofr);
IF ref < impCtxt.minr THEN impCtxt.minr := ref END ; IF ref < impCtxt.minr THEN impCtxt.minr := ref END ;
InMod(mno); InName(name); obj := NewObj(); InMod(mno); InName(name); obj := NewObj();
IF name = "" THEN IF name = "" THEN
IF impCtxt.self THEN old := NIL (* do not insert type desc anchor here, but in OPL *) IF impCtxt.self THEN
ELSE obj^.name := "@"; InsertImport(obj, GlbMod[mno].right, old(*=NIL*)); obj^.name := "" 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 ; END ;
typ := NewStr(Undef, Basic) typ := NewStr(Undef, Basic)
ELSE obj^.name := name; InsertImport(obj, GlbMod[mno].right, old); ELSE
obj^.name := name; InsertImport(obj, GlbMod[mno].right, old);
IF old # NIL THEN (* recalculate fprints to compare with old fprints *) IF old # NIL THEN (* recalculate fprints to compare with old fprints *)
FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp; FPrintObj(old); impCtxt.pvfp[ref] := old^.typ^.pvfp;
IF impCtxt.self THEN (* do not overwrite old typ *) IF impCtxt.self THEN (* do not overwrite old typ *)
@ -621,10 +648,12 @@ IF old # NIL THEN (* recalculate fprints to compare with old fprints *)
typ := old^.typ; typ^.link := NIL; typ^.sysflag := 0; typ := old^.typ; typ^.link := NIL; typ^.sysflag := 0;
typ^.fpdone := FALSE; typ^.idfpdone := FALSE typ^.fpdone := FALSE; typ^.idfpdone := FALSE
END END
ELSE typ := NewStr(Undef, Basic) ELSE
typ := NewStr(Undef, Basic)
END END
END ; END ;
impCtxt.ref[ref] := typ; impCtxt.old[ref] := old; typ^.ref := ref + maxStruct; impCtxt.ref[ref] := typ; impCtxt.old[ref] := old;
typ^.ref := ref + maxStruct;
(* ref >= maxStruct: not exported yet, ref used for err 155 *) (* ref >= maxStruct: not exported yet, ref used for err 155 *)
typ^.mno := mno; typ^.allocated := TRUE; typ^.mno := mno; typ^.allocated := TRUE;
typ^.strobj := obj; obj^.mode := Typ; obj^.typ := typ; typ^.strobj := obj; obj^.mode := Typ; obj^.typ := typ;
@ -633,22 +662,27 @@ tag := OPM.SymRInt();
IF tag = Ssys THEN typ^.sysflag := SHORT(OPM.SymRInt()); tag := OPM.SymRInt() END ; IF tag = Ssys THEN typ^.sysflag := SHORT(OPM.SymRInt()); tag := OPM.SymRInt() END ;
CASE tag OF CASE tag OF
| Sptr: | Sptr:
typ^.form := Pointer; typ^.size := OPM.PointerSize; typ^.n := 0; InStruct(typ^.BaseTyp) typ^.form := Pointer; typ^.size := OPM.PointerSize;
typ^.n := 0; InStruct(typ^.BaseTyp)
| Sarr: | Sarr:
typ^.form := Comp; typ^.comp := Array; InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt(); typ^.form := Comp; typ^.comp := Array;
InStruct(typ^.BaseTyp); typ^.n := OPM.SymRInt();
typSize(typ) (* no bounds address !! *) typSize(typ) (* no bounds address !! *)
| Sdarr: | Sdarr:
typ^.form := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp); typ^.form := Comp; typ^.comp := DynArr; InStruct(typ^.BaseTyp);
IF typ^.BaseTyp^.comp = DynArr THEN typ^.n := typ^.BaseTyp^.n + 1 IF typ^.BaseTyp^.comp = DynArr THEN
ELSE typ^.n := 0 typ^.n := typ^.BaseTyp^.n + 1
ELSE
typ^.n := 0
END ; END ;
typSize(typ) typSize(typ)
| Srec: | Srec:
typ^.form := Comp; typ^.comp := Record; InStruct(typ^.BaseTyp); typ^.form := Comp; typ^.comp := Record;
InStruct(typ^.BaseTyp);
IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END; IF typ^.BaseTyp = notyp THEN typ^.BaseTyp := NIL END;
typ.extlev := 0; t := typ.BaseTyp; typ.extlev := 0; t := typ.BaseTyp;
(* do not take extlev from base type due to possible cycles! *) (* do not take extlev from base type due to possible cycles! *)
WHILE t # NIL DO INC(typ^.extlev); t := t.BaseTyp END; 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^.size := OPM.SymRInt(); typ^.align := OPM.SymRInt();
typ^.n := OPM.SymRInt(); typ^.n := OPM.SymRInt();
impCtxt.nextTag := OPM.SymRInt(); last := NIL; impCtxt.nextTag := OPM.SymRInt(); last := NIL;
@ -658,40 +692,57 @@ WHILE (impCtxt.nextTag >= Sfld) & (impCtxt.nextTag <= Shdpro) DO
last := fld; InsertImport(fld, typ^.link, dummy); last := fld; InsertImport(fld, typ^.link, dummy);
impCtxt.nextTag := OPM.SymRInt() impCtxt.nextTag := OPM.SymRInt()
END ; END ;
WHILE impCtxt.nextTag # Send DO fld := InTProc(mno); WHILE impCtxt.nextTag # Send DO
fld := InTProc(mno);
InsertImport(fld, typ^.link, dummy); InsertImport(fld, typ^.link, dummy);
impCtxt.nextTag := OPM.SymRInt() impCtxt.nextTag := OPM.SymRInt()
END END
| Spro: | Spro:
typ^.form := ProcTyp; typ^.size := OPM.ProcSize; InSign(mno, typ^.BaseTyp, typ^.link) 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 ; END ;
IF ref = impCtxt.minr THEN IF ref = impCtxt.minr THEN
WHILE ref < impCtxt.nofr DO WHILE (ref < impCtxt.nofr) (*OR ((ref >= Int8) & (ref <= Int64))*) DO
t := impCtxt.ref[ref]; FPrintStr(t); t := impCtxt.ref[ref]; FPrintStr(t);
obj := t^.strobj; (* obj^.typ^.strobj = obj, else obj^.fprint differs (alias) *) obj := t^.strobj; (* obj^.typ^.strobj = obj, else obj^.fprint differs (alias) *)
IF obj^.name # "" THEN FPrintObj(obj) END ; IF obj^.name # "" THEN FPrintObj(obj) END ;
old := impCtxt.old[ref]; old := impCtxt.old[ref];
IF old # NIL THEN t^.strobj := old; (* restore strobj *) IF old # NIL THEN
t^.strobj := old; (* restore strobj *)
IF impCtxt.self THEN IF impCtxt.self THEN
IF old^.mnolev < 0 THEN IF old^.mnolev < 0 THEN
IF old^.history # inconsistent THEN IF old^.history # inconsistent THEN
IF old^.fprint # obj^.fprint THEN old^.history := pbmodified IF old^.fprint # obj^.fprint THEN
ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN old^.history := pvmodified old^.history := pbmodified
ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN
old^.history := pvmodified
END END
(* ELSE remain inconsistent *) (* ELSE remain inconsistent *)
END END
ELSIF old^.fprint # obj^.fprint THEN old^.history := pbmodified ELSIF old^.fprint # obj^.fprint THEN
ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN old^.history := pvmodified old^.history := pbmodified
ELSIF old^.vis = internal THEN old^.history := same (* may be changed to "removed" in InObj *) ELSIF impCtxt.pvfp[ref] # t^.pvfp THEN
ELSE old^.history := inserted (* may be changed to "same" in InObj *) 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 END
ELSE ELSE
(* check private part, delay error message until really used *) (* check private part, delay error message until really used *)
IF impCtxt.pvfp[ref] # t^.pvfp THEN old^.history := inconsistent END ; IF impCtxt.pvfp[ref] # t^.pvfp THEN
IF old^.fprint # obj^.fprint THEN FPrintErr(old, 249) END old^.history := inconsistent
END ;
IF old^.fprint # obj^.fprint THEN
FPrintErr(old, 249)
END END
ELSIF impCtxt.self THEN obj^.history := removed END
ELSE obj^.history := same ELSIF impCtxt.self THEN
obj^.history := removed
ELSE
obj^.history := same
END ; END ;
INC(ref) INC(ref)
END ; END ;
@ -723,6 +774,8 @@ WHILE ref < impCtxt.nofr DO
ext := NewExt(); obj^.conval^.ext := ext; ext := NewExt(); obj^.conval^.ext := ext;
s := SHORT(OPM.SymRInt()); ext^[0] := CHR(s); i := 1; s := SHORT(OPM.SymRInt()); ext^[0] := CHR(s); i := 1;
WHILE i <= s DO OPM.SymRCh(ext^[i]); INC(i) END 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 END
ELSIF tag = Salias THEN ELSIF tag = Salias THEN
obj^.mode := Typ; InStruct(obj^.typ) obj^.mode := Typ; InStruct(obj^.typ)
@ -771,7 +824,7 @@ WHILE ref < impCtxt.nofr DO
IF name = "SYSTEM" THEN SYSimported := TRUE; IF name = "SYSTEM" THEN SYSimported := TRUE;
Insert(aliasName, obj); obj^.mode := Mod; obj^.mnolev := 0; obj^.scope := syslink; obj^.typ := notyp Insert(aliasName, obj); obj^.mode := Mod; obj^.mnolev := 0; obj^.scope := syslink; obj^.typ := notyp
ELSE 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; impCtxt.self := aliasName = "@self"; impCtxt.reffp := 0;
OPM.OldSym(name, done); OPM.OldSym(name, done);
IF done THEN IF done THEN
@ -884,18 +937,20 @@ WHILE ref < impCtxt.nofr DO
PROCEDURE OutStr(typ: Struct); (* OPV.TypeAlloc already applied *) PROCEDURE OutStr(typ: Struct); (* OPV.TypeAlloc already applied *)
VAR strobj: Object; VAR strobj: Object;
BEGIN 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 ELSE
OPM.SymWInt(Sstruct); OPM.SymWInt(Sstruct);
typ^.ref := expCtxt.ref; INC(expCtxt.ref); typ^.ref := expCtxt.ref; INC(expCtxt.ref);
IF expCtxt.ref >= maxStruct THEN err(228) END ; IF expCtxt.ref >= maxStruct THEN err(228) END ;
OutMod(typ^.mno); strobj := typ^.strobj; OutMod(typ^.mno); strobj := typ^.strobj;
IF (strobj # NIL) & (strobj^.name # "") THEN OutName(strobj^.name); IF (strobj # NIL) & (strobj^.name # "") THEN OutName(strobj^.name);
CASE strobj^.history OF CASE strobj^.history OF
| pbmodified: FPrintErr(strobj, 252) | pbmodified: FPrintErr(strobj, 252)
| pvmodified: FPrintErr(strobj, 251) | pvmodified: FPrintErr(strobj, 251)
| inconsistent: FPrintErr(strobj, 249) | inconsistent: FPrintErr(strobj, 249)
ELSE (* checked in OutObj or correct indirect export *) 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 END
ELSE OPM.SymWCh(0X) (* anonymous => never inconsistent, pvfp influences the client fp *) ELSE OPM.SymWCh(0X) (* anonymous => never inconsistent, pvfp influences the client fp *)
END ; END ;
@ -919,7 +974,10 @@ WHILE ref < impCtxt.nofr DO
nofhdfld := 0; OutFlds(typ^.link, 0, TRUE); nofhdfld := 0; OutFlds(typ^.link, 0, TRUE);
IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(223, typ^.txtpos) END ; IF nofhdfld > OPM.MaxHdFld THEN OPM.Mark(223, typ^.txtpos) END ;
OutTProcs(typ, typ^.link); OPM.SymWInt(Send) 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 END
ELSE OPM.LogWStr("unhandled case at OPT.OutStr, typ^.form = "); OPM.LogWNum(typ^.form, 0); OPM.LogWLn;
END END
END END
END OutStr; END OutStr;
@ -931,7 +989,7 @@ WHILE ref < impCtxt.nofr DO
CASE f OF CASE f OF
| Bool, Char: | Bool, Char:
OPM.SymWCh(CHR(obj^.conval^.intval)) 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) OPM.SymWInt(obj^.conval^.intval)
| Set: | Set:
OPM.SymWSet(obj^.conval^.setval) OPM.SymWSet(obj^.conval^.setval)
@ -959,6 +1017,8 @@ WHILE ref < impCtxt.nofr DO
| same: (* ok *) | same: (* ok *)
| pbmodified: FPrintErr(obj, 252) | pbmodified: FPrintErr(obj, 252)
| pvmodified: FPrintErr(obj, 251) | pvmodified: FPrintErr(obj, 251)
ELSE
OPM.LogWStr("unhandled case at OPT.OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn;
END ; END ;
CASE obj^.mode OF CASE obj^.mode OF
| Con: | Con:
@ -983,6 +1043,8 @@ WHILE ref < impCtxt.nofr DO
j := ORD(ext^[0]); i := 1; OPM.SymWInt(j); j := ORD(ext^[0]); i := 1; OPM.SymWInt(j);
WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END ; WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END ;
OutName(obj^.name) OutName(obj^.name)
ELSE
OPM.LogWStr("unhandled case at OPT.OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn;
END END
END END
END ; END ;
@ -999,7 +1061,7 @@ WHILE ref < impCtxt.nofr DO
OPM.NewSym(SelfName); OPM.NewSym(SelfName);
IF OPM.noerr THEN IF OPM.noerr THEN
OPM.SymWInt(Smname); OutName(SelfName); 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; expCtxt.nofm := 1; expCtxt.locmno[0] := 0;
i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END ; i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END ;
OutObj(topScope^.right); OutObj(topScope^.right);
@ -1058,12 +1120,12 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0;
(*initialization of module SYSTEM*) (*initialization of module SYSTEM*)
EnterTyp("BYTE", Byte, OPM.ByteSize, bytetyp); EnterTyp("BYTE", Byte, OPM.ByteSize, bytetyp);
(*
EnterTyp("INT8", Int8, OPM.Int8Size, int8typ); EnterTyp("INT8", Int8, OPM.Int8Size, int8typ);
EnterTyp("INT16", Int16, OPM.Int16Size, int16typ); EnterTyp("INT16", Int16, OPM.Int16Size, int16typ);
EnterTyp("INT32", Int32, OPM.Int32Size, int32typ); EnterTyp("INT32", Int32, OPM.Int32Size, int32typ);
EnterTyp("INT64", Int64, OPM.Int64Size, int64typ); EnterTyp("INT64", Int64, OPM.Int64Size, int64typ);
*)
EnterTyp("PTR", Pointer, OPM.PointerSize, sysptrtyp); EnterTyp("PTR", Pointer, OPM.PointerSize, sysptrtyp);
EnterProc("ADR", adrfn); EnterProc("ADR", adrfn);
EnterProc("CC", ccfn); EnterProc("CC", ccfn);
@ -1112,8 +1174,8 @@ BEGIN topScope := NIL; OpenScope(0, NIL); OPM.errpos := 0;
EnterProc("ASH", ashfn); EnterProc("ASH", ashfn);
EnterProc("ASSERT", assertfn); EnterProc("ASSERT", assertfn);
impCtxt.ref[Undef] := undftyp; impCtxt.ref[Byte] := bytetyp; impCtxt.ref[Undef] := undftyp; impCtxt.ref[Byte] := bytetyp;
impCtxt.ref[Int8] := int8typ; impCtxt.ref[Int16] := int16typ; (* impCtxt.ref[Int8] := int8typ; impCtxt.ref[Int16] := int16typ;
impCtxt.ref[Int32] := int32typ; impCtxt.ref[Int64] := int64typ; impCtxt.ref[Int32] := int32typ; impCtxt.ref[Int64] := int64typ;*)
impCtxt.ref[Bool] := booltyp; impCtxt.ref[Char] := chartyp; impCtxt.ref[Bool] := booltyp; impCtxt.ref[Char] := chartyp;
impCtxt.ref[SInt] := sinttyp; impCtxt.ref[Int] := inttyp; impCtxt.ref[SInt] := sinttyp; impCtxt.ref[Int] := inttyp;
impCtxt.ref[LInt] := linttyp; impCtxt.ref[Real] := realtyp; impCtxt.ref[LInt] := linttyp; impCtxt.ref[Real] := realtyp;

47
src/voc/OPV.Mod
View file

@ -24,13 +24,16 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
(* structure forms *) (* structure forms *)
Byte = 1; Bool = 2; Char = 3; Byte = 1; Bool = 2; Char = 3;
SInt = 4; Int = 5; LInt = 6; 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; (*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10;
Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16; Real = 11; LReal = 12; Set = 13; String = 14; NilTyp = 15; NoTyp = 16;
Pointer = 17; ProcTyp = 18; Pointer = 17; ProcTyp = 18;
Comp = 19;*) Comp = 19;*)
Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; Pointer = 13; ProcTyp = 14; (*Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; Pointer = 13; ProcTyp = 14;
Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; Int8 = 15; Int16 = 16; Int32 = 17; Int64 = 18;
Comp = (*15*)20; Comp = (*15*)19;*)
(* composite structure forms *) (* composite structure forms *)
Array = 2; DynArr = 3; Record = 4; 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; f := typ^.form; c := typ^.comp;
IF c = Record THEN btyp := typ^.BaseTyp; IF c = Record THEN btyp := typ^.BaseTyp;
IF btyp = NIL THEN offset := 0; base := OPM.RecAlign; 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; END;
fld := typ^.link; fld := typ^.link;
WHILE (fld # NIL) & (fld^.mode = Fld) DO 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.sinttyp^.strobj^.linkadr := PredefinedType;
OPT.booltyp^.strobj^.linkadr := PredefinedType; OPT.booltyp^.strobj^.linkadr := PredefinedType;
OPT.bytetyp^.strobj^.linkadr := PredefinedType; OPT.bytetyp^.strobj^.linkadr := PredefinedType;
OPT.int8typ^.strobj^.linkadr := PredefinedType; (*OPT.int8typ^.strobj^.linkadr := PredefinedType;
OPT.int16typ^.strobj^.linkadr := PredefinedType; OPT.int16typ^.strobj^.linkadr := PredefinedType;
OPT.int32typ^.strobj^.linkadr := PredefinedType; OPT.int32typ^.strobj^.linkadr := PredefinedType;
OPT.int64typ^.strobj^.linkadr := PredefinedType; OPT.int64typ^.strobj^.linkadr := PredefinedType;*)
OPT.sysptrtyp^.strobj^.linkadr := PredefinedType; OPT.sysptrtyp^.strobj^.linkadr := PredefinedType;
END AdrAndSize; END AdrAndSize;
@ -304,11 +307,15 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
RETURN 0 RETURN 0
| len, in, ash, msk, bit, lsh, rot: | len, in, ash, msk, bit, lsh, rot:
RETURN 10 RETURN 10
ELSE
OPM.LogWStr("unhandled case in OPV.Precedence, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END; END;
| Nupto: | Nupto:
RETURN 10 RETURN 10
| Ntype, Neguard: (* ignored anyway *) | Ntype, Neguard: (* ignored anyway *)
RETURN MaxPrec RETURN MaxPrec
ELSE
OPM.LogWStr("unhandled case in OPV.Precedence, class = "); OPM.LogWNum(class, 0); OPM.LogWLn;
END; END;
END Precedence; END Precedence;
@ -347,9 +354,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSIF form = LInt THEN ELSIF form = LInt THEN
IF from < LInt THEN OPM.WriteString("(LONGINT)") END ; IF from < LInt THEN OPM.WriteString("(LONGINT)") END ;
Entier(n, 9) 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; 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 ELSIF form = Int THEN
IF from < Int THEN OPM.WriteString("(int)"); expr(n, 9) IF from < Int THEN OPM.WriteString("(int)"); expr(n, 9)
ELSE ELSE
@ -499,6 +506,8 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
END END
| Nmop: | Nmop:
IF n^.subcl = val THEN design(n^.left, prec) END 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 ; END ;
IF prec > designPrec THEN OPM.Write(CloseParen) END IF prec > designPrec THEN OPM.Write(CloseParen) END
END design; END design;
@ -523,12 +532,12 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
OPM.WriteString("(void*)") (* type extension *) OPM.WriteString("(void*)") (* type extension *)
END END
ELSE 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 OPM.WriteString("(double)"); prec := 9
ELSIF (form = LInt) & (n^.typ^.form < LInt) THEN (* integral promotion *) ELSIF (form = LInt) & (n^.typ^.form < LInt) THEN (* integral promotion *)
OPM.WriteString("(LONGINT)"); prec := 9 OPM.WriteString("(LONGINT)"); prec := 9
ELSIF (form = Int64) & (n^.typ^.form < Int64) THEN (*ELSIF (form = Int64) & (n^.typ^.form < Int64) THEN
OPM.WriteString("(SYSTEM_INT64)"); prec := 9; OPM.WriteString("(SYSTEM_INT64)"); prec := 9;*)
END END
END END
ELSIF ansi THEN 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 form < LInt THEN OPM.WriteString("(int)") END ;
IF SideEffects(n) THEN OPM.WriteString("__MODF(") IF SideEffects(n) THEN OPM.WriteString("__MODF(")
ELSE OPM.WriteString("__MOD(") ELSE OPM.WriteString("__MOD(")
END END;
ELSE
OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END ; END ;
expr(l, MinPrec); expr(l, MinPrec);
OPM.WriteString(Comma); OPM.WriteString(Comma);
@ -724,7 +735,7 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
| slash: | slash:
IF form = Set THEN OPM.WriteString(" ^ ") IF form = Set THEN OPM.WriteString(" ^ ")
ELSE 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) OPM.Write(OpenParen); OPC.Ident(n^.typ^.strobj); OPM.Write(CloseParen)
END END
END END
@ -739,7 +750,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96
ELSE OPM.WriteString(" - ") ELSE OPM.WriteString(" - ")
END; END;
| or: | or:
OPM.WriteString(" || ") OPM.WriteString(" || ");
ELSE
OPM.LogWStr("unhandled case in OPV.expr, subclass = "); OPM.LogWNum(subclass, 0); OPM.LogWLn;
END; END;
expr(r, exprPrec); expr(r, exprPrec);
IF (subclass = and) OR ((form = Set) & ((subclass = times) OR (subclass = minus))) THEN OPM.Write(CloseParen) END; (* to silence clang warnings, -- noch*) 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(", "); design(n^.left, MinPrec); OPM.WriteString(", ");
expr(n^.right, MinPrec); expr(n^.right, MinPrec);
OPM.Write(")") OPM.Write(")")
ELSE
OPM.LogWStr("unhandled case in OPV.expr, n^.subcl = "); OPM.LogWNum(n^.subcl, 0); OPM.LogWLn;
END END
| Ncall: | Ncall:
IF (n^.left^.obj # NIL) & (n^.left^.obj^.mode = TProc) THEN 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 when compiling Texts0.Mod on raspberry pi
it generates __CASECHK and cause Halt, it generates __CASECHK and cause Halt,
noch *) noch *)
OPM.LogWStr("unhandled case in OPV.expr, n^.class = "); OPM.LogWNum(n^.class, 0); OPM.LogWLn;
OPM.WriteString ("/*n^class = "); OPM.WriteInt(n^.class); OPM.WriteString(" and this is not handled, please investigate */");
END ; END ;
IF ~(n^.class IN {Nenter, Ninittd, Nifelse, Nwith, Ncase, Nwhile, Nloop}) THEN OPC.EndStat END ; IF ~(n^.class IN {Nenter, Ninittd, Nifelse, Nwith, Ncase, Nwhile, Nloop}) THEN OPC.EndStat END ;
n := n^.link n := n^.link

3
src/voc/errors.Mod
View file

@ -6,7 +6,7 @@ VAR errors- : ARRAY 350 OF string;
BEGIN BEGIN
(* Incorroct use of the language Oberon *) (* Incorrect use of the language Oberon *)
errors[0] := "undeclared identifier"; errors[0] := "undeclared identifier";
errors[1] := "multiply defined identifier"; errors[1] := "multiply defined identifier";
errors[2] := "illegal character in number"; 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[301] := "implicit type cast";
errors[306] := "inappropriate symbol file ignored"; errors[306] := "inappropriate symbol file ignored";
errors[307] := "no ELSE symbol after CASE statement sequence may lead to trap"; (* new warning, -- noch *)
END errors. END errors.
(* (*

4
src/voc/voc.Mod
View file

@ -80,10 +80,10 @@ VAR mname : ARRAY 256 OF CHAR; (* noch *)
modulesobj := ""; modulesobj := "";
OPM.OpenPar; (* gclock(); slightly faste rtranslation but may lead to opening "too many files" *) OPM.OpenPar; (* gclock(); slightly faste rtranslation but may lead to opening "too many files" *)
OPT.bytetyp.size := OPM.ByteSize; OPT.bytetyp.size := OPM.ByteSize;
OPT.int8typ.size := 1; (*OPT.int8typ.size := 1;
OPT.int16typ.size := 2; OPT.int16typ.size := 2;
OPT.int32typ.size := 4; OPT.int32typ.size := 4;
OPT.int64typ.size := 8; OPT.int64typ.size := 8;*)
OPT.sysptrtyp.size := OPM.PointerSize; OPT.sysptrtyp.size := OPM.PointerSize;
OPT.chartyp.size := OPM.CharSize; OPT.chartyp.size := OPM.CharSize;
OPT.settyp.size := OPM.SetSize; OPT.settyp.size := OPM.SetSize;

2
vocstatic.linux.gcc.x86_64.REMOVED.git-id
View file

@ -1 +1 @@
6c417bc6b34eabba2b7ca560a01c15ddd9a43a29 924b37cbff137a08805e86eb63403bda0495cf16