diff --git a/src/lib/system/darwin/clang/x86_64/SYSTEM.h b/src/lib/system/darwin/clang/x86_64/SYSTEM.h index db32127b..71ec724f 100644 --- a/src/lib/system/darwin/clang/x86_64/SYSTEM.h +++ b/src/lib/system/darwin/clang/x86_64/SYSTEM.h @@ -12,6 +12,7 @@ uses double # as concatenation operator */ #include +#include /* for type sizes -- noch */ //#include extern void *memcpy(void *dest, const void *src, unsigned long n); @@ -52,6 +53,10 @@ typedef void *SYSTEM_PTR; //#define *SYSTEM_PTR void //typedef unsigned char SYSTEM_BYTE; #define SYSTEM_BYTE unsigned char +typedef int8_t SYSTEM_INT8; +typedef int16_t SYSTEM_INT16; +typedef int32_t SYSTEM_INT32; +typedef int64_t SYSTEM_INT64; /* runtime system routines */ extern long SYSTEM_DIV(); diff --git a/src/lib/system/freebsd/clang/x86_64/SYSTEM.h b/src/lib/system/freebsd/clang/x86_64/SYSTEM.h index 4d4b47c5..90bdadd4 100644 --- a/src/lib/system/freebsd/clang/x86_64/SYSTEM.h +++ b/src/lib/system/freebsd/clang/x86_64/SYSTEM.h @@ -12,6 +12,7 @@ uses double # as concatenation operator */ #include //#include +#include /* for type sizes -- noch */ //#include extern void *memcpy(void *dest, const void *src, unsigned long n); @@ -52,6 +53,10 @@ typedef void *SYSTEM_PTR; //#define *SYSTEM_PTR void //typedef unsigned char SYSTEM_BYTE; #define SYSTEM_BYTE unsigned char +typedef int8_t SYSTEM_INT8; +typedef int16_t SYSTEM_INT16; +typedef int32_t SYSTEM_INT32; +typedef int64_t SYSTEM_INT64; /* runtime system routines */ extern long SYSTEM_DIV(); diff --git a/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.h b/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.h index 719a6d18..ea9ae5d6 100644 --- a/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.h +++ b/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.h @@ -12,6 +12,7 @@ uses double # as concatenation operator */ #include +#include /* for type sizes -- noch */ //extern void *memcpy(void *dest, const void *src, long n); extern void *memcpy(void *dest, const void *src, size_t n); @@ -37,6 +38,10 @@ typedef double LONGREAL; typedef unsigned long SET; typedef void *SYSTEM_PTR; typedef unsigned char SYSTEM_BYTE; +typedef int8_t SYSTEM_INT8; +typedef int16_t SYSTEM_INT16; +typedef int32_t SYSTEM_INT32; +typedef int64_t SYSTEM_INT64; /* runtime system routines */ extern long SYSTEM_DIV(); diff --git a/src/lib/system/linux/clang/powerpc/SYSTEM.h b/src/lib/system/linux/clang/powerpc/SYSTEM.h index 719a6d18..ea9ae5d6 100644 --- a/src/lib/system/linux/clang/powerpc/SYSTEM.h +++ b/src/lib/system/linux/clang/powerpc/SYSTEM.h @@ -12,6 +12,7 @@ uses double # as concatenation operator */ #include +#include /* for type sizes -- noch */ //extern void *memcpy(void *dest, const void *src, long n); extern void *memcpy(void *dest, const void *src, size_t n); @@ -37,6 +38,10 @@ typedef double LONGREAL; typedef unsigned long SET; typedef void *SYSTEM_PTR; typedef unsigned char SYSTEM_BYTE; +typedef int8_t SYSTEM_INT8; +typedef int16_t SYSTEM_INT16; +typedef int32_t SYSTEM_INT32; +typedef int64_t SYSTEM_INT64; /* runtime system routines */ extern long SYSTEM_DIV(); diff --git a/src/lib/system/linux/clang/x86/SYSTEM.h b/src/lib/system/linux/clang/x86/SYSTEM.h index 719a6d18..ea9ae5d6 100644 --- a/src/lib/system/linux/clang/x86/SYSTEM.h +++ b/src/lib/system/linux/clang/x86/SYSTEM.h @@ -12,6 +12,7 @@ uses double # as concatenation operator */ #include +#include /* for type sizes -- noch */ //extern void *memcpy(void *dest, const void *src, long n); extern void *memcpy(void *dest, const void *src, size_t n); @@ -37,6 +38,10 @@ typedef double LONGREAL; typedef unsigned long SET; typedef void *SYSTEM_PTR; typedef unsigned char SYSTEM_BYTE; +typedef int8_t SYSTEM_INT8; +typedef int16_t SYSTEM_INT16; +typedef int32_t SYSTEM_INT32; +typedef int64_t SYSTEM_INT64; /* runtime system routines */ extern long SYSTEM_DIV(); diff --git a/src/lib/system/linux/clang/x86_64/SYSTEM.h b/src/lib/system/linux/clang/x86_64/SYSTEM.h index c0cd257a..2c8e71d0 100644 --- a/src/lib/system/linux/clang/x86_64/SYSTEM.h +++ b/src/lib/system/linux/clang/x86_64/SYSTEM.h @@ -12,6 +12,7 @@ uses double # as concatenation operator */ #include +#include /* for type sizes -- noch */ extern void *memcpy(void *dest, const void *src, unsigned long n); extern void *malloc(unsigned long size); @@ -51,6 +52,10 @@ typedef void *SYSTEM_PTR; //#define *SYSTEM_PTR void //typedef unsigned char SYSTEM_BYTE; #define SYSTEM_BYTE unsigned char +typedef int8_t SYSTEM_INT8; +typedef int16_t SYSTEM_INT16; +typedef int32_t SYSTEM_INT32; +typedef int64_t SYSTEM_INT64; /* runtime system routines */ extern long SYSTEM_DIV(); diff --git a/src/lib/system/linux/gcc/armv6j_hardfp/SYSTEM.h b/src/lib/system/linux/gcc/armv6j_hardfp/SYSTEM.h index 719a6d18..ea9ae5d6 100644 --- a/src/lib/system/linux/gcc/armv6j_hardfp/SYSTEM.h +++ b/src/lib/system/linux/gcc/armv6j_hardfp/SYSTEM.h @@ -12,6 +12,7 @@ uses double # as concatenation operator */ #include +#include /* for type sizes -- noch */ //extern void *memcpy(void *dest, const void *src, long n); extern void *memcpy(void *dest, const void *src, size_t n); @@ -37,6 +38,10 @@ typedef double LONGREAL; typedef unsigned long SET; typedef void *SYSTEM_PTR; typedef unsigned char SYSTEM_BYTE; +typedef int8_t SYSTEM_INT8; +typedef int16_t SYSTEM_INT16; +typedef int32_t SYSTEM_INT32; +typedef int64_t SYSTEM_INT64; /* runtime system routines */ extern long SYSTEM_DIV(); diff --git a/src/lib/system/linux/gcc/powerpc/SYSTEM.h b/src/lib/system/linux/gcc/powerpc/SYSTEM.h index 719a6d18..ea9ae5d6 100644 --- a/src/lib/system/linux/gcc/powerpc/SYSTEM.h +++ b/src/lib/system/linux/gcc/powerpc/SYSTEM.h @@ -12,6 +12,7 @@ uses double # as concatenation operator */ #include +#include /* for type sizes -- noch */ //extern void *memcpy(void *dest, const void *src, long n); extern void *memcpy(void *dest, const void *src, size_t n); @@ -37,6 +38,10 @@ typedef double LONGREAL; typedef unsigned long SET; typedef void *SYSTEM_PTR; typedef unsigned char SYSTEM_BYTE; +typedef int8_t SYSTEM_INT8; +typedef int16_t SYSTEM_INT16; +typedef int32_t SYSTEM_INT32; +typedef int64_t SYSTEM_INT64; /* runtime system routines */ extern long SYSTEM_DIV(); diff --git a/src/lib/system/linux/gcc/x86/SYSTEM.h b/src/lib/system/linux/gcc/x86/SYSTEM.h index 719a6d18..ea9ae5d6 100644 --- a/src/lib/system/linux/gcc/x86/SYSTEM.h +++ b/src/lib/system/linux/gcc/x86/SYSTEM.h @@ -12,6 +12,7 @@ uses double # as concatenation operator */ #include +#include /* for type sizes -- noch */ //extern void *memcpy(void *dest, const void *src, long n); extern void *memcpy(void *dest, const void *src, size_t n); @@ -37,6 +38,10 @@ typedef double LONGREAL; typedef unsigned long SET; typedef void *SYSTEM_PTR; typedef unsigned char SYSTEM_BYTE; +typedef int8_t SYSTEM_INT8; +typedef int16_t SYSTEM_INT16; +typedef int32_t SYSTEM_INT32; +typedef int64_t SYSTEM_INT64; /* runtime system routines */ extern long SYSTEM_DIV(); diff --git a/src/lib/system/linux/gcc/x86_64/SYSTEM.h b/src/lib/system/linux/gcc/x86_64/SYSTEM.h index c0cd257a..2c8e71d0 100644 --- a/src/lib/system/linux/gcc/x86_64/SYSTEM.h +++ b/src/lib/system/linux/gcc/x86_64/SYSTEM.h @@ -12,6 +12,7 @@ uses double # as concatenation operator */ #include +#include /* for type sizes -- noch */ extern void *memcpy(void *dest, const void *src, unsigned long n); extern void *malloc(unsigned long size); @@ -51,6 +52,10 @@ typedef void *SYSTEM_PTR; //#define *SYSTEM_PTR void //typedef unsigned char SYSTEM_BYTE; #define SYSTEM_BYTE unsigned char +typedef int8_t SYSTEM_INT8; +typedef int16_t SYSTEM_INT16; +typedef int32_t SYSTEM_INT32; +typedef int64_t SYSTEM_INT64; /* runtime system routines */ extern long SYSTEM_DIV(); diff --git a/src/par/voc.par.clang.powerpc b/src/par/voc.par.clang.powerpc index df29c90d..fdc5342a 100644 --- a/src/par/voc.par.clang.powerpc +++ b/src/par/voc.par.clang.powerpc @@ -10,3 +10,7 @@ PTR 4 4 PROC 4 4 RECORD 1 1 ENDIAN 0 0 +SYSTEM.INT8 1 1 +SYSTEM.INT16 2 2 +SYSTEM.INT32 4 4 +SYSTEM.INT64 8 4 diff --git a/src/par/voc.par.clang.x86_64 b/src/par/voc.par.clang.x86_64 index 4e15dfd1..bf5ed486 100644 --- a/src/par/voc.par.clang.x86_64 +++ b/src/par/voc.par.clang.x86_64 @@ -10,3 +10,7 @@ PTR 8 8 PROC 8 8 RECORD 1 1 ENDIAN 1 0 +SYSTEM.INT8 1 1 +SYSTEM.INT16 2 2 +SYSTEM.INT32 4 4 +SYSTEM.INT64 8 8 diff --git a/src/par/voc.par.gcc.armv6j_hardfp b/src/par/voc.par.gcc.armv6j_hardfp index 02702d43..49740442 100644 --- a/src/par/voc.par.gcc.armv6j_hardfp +++ b/src/par/voc.par.gcc.armv6j_hardfp @@ -10,3 +10,7 @@ PTR 4 4 PROC 4 4 RECORD 1 1 ENDIAN 1 0 +SYSTEM.INT8 1 1 +SYSTEM.INT16 2 2 +SYSTEM.INT32 4 4 +SYSTEM.INT64 8 4 diff --git a/src/par/voc.par.gcc.powerpc b/src/par/voc.par.gcc.powerpc index df29c90d..fdc5342a 100644 --- a/src/par/voc.par.gcc.powerpc +++ b/src/par/voc.par.gcc.powerpc @@ -10,3 +10,7 @@ PTR 4 4 PROC 4 4 RECORD 1 1 ENDIAN 0 0 +SYSTEM.INT8 1 1 +SYSTEM.INT16 2 2 +SYSTEM.INT32 4 4 +SYSTEM.INT64 8 4 diff --git a/src/par/voc.par.gcc.x86 b/src/par/voc.par.gcc.x86 index 7ee762e0..b6abadc5 100644 --- a/src/par/voc.par.gcc.x86 +++ b/src/par/voc.par.gcc.x86 @@ -10,3 +10,7 @@ PTR 4 4 PROC 4 4 RECORD 1 1 ENDIAN 1 0 +SYSTEM.INT8 1 1 +SYSTEM.INT16 2 2 +SYSTEM.INT32 4 4 +SYSTEM.INT64 8 4 diff --git a/src/par/voc.par.gcc.x86_64 b/src/par/voc.par.gcc.x86_64 index 4e15dfd1..bf5ed486 100644 --- a/src/par/voc.par.gcc.x86_64 +++ b/src/par/voc.par.gcc.x86_64 @@ -10,3 +10,7 @@ PTR 8 8 PROC 8 8 RECORD 1 1 ENDIAN 1 0 +SYSTEM.INT8 1 1 +SYSTEM.INT16 2 2 +SYSTEM.INT32 4 4 +SYSTEM.INT64 8 8 diff --git a/src/tools/vocparam/vocparam.c b/src/tools/vocparam/vocparam.c index 6b2232ed..4fb325fd 100644 --- a/src/tools/vocparam/vocparam.c +++ b/src/tools/vocparam/vocparam.c @@ -14,6 +14,10 @@ struct {CHAR ch; BOOLEAN x;} b; struct {CHAR ch; SHORTINT x;} si; struct {CHAR ch; INTEGER x;} i; struct {CHAR ch; LONGINT x;} li; +struct {CHAR ch; SYSTEM_INT8 x;} i8; +struct {CHAR ch; SYSTEM_INT16 x;} i16; +struct {CHAR ch; SYSTEM_INT32 x;} i32; +struct {CHAR ch; SYSTEM_INT64 x;} i64; struct {CHAR ch; SET x;} s; struct {CHAR ch; REAL x;} r; struct {CHAR ch; LONGREAL x;} lr; @@ -40,6 +44,11 @@ int main() printf("RECORD %d %lu\n", (sizeof rec2 == 65) == (sizeof rec0 == 1), sizeof rec2 - 64); x = 1; printf("ENDIAN %hhd %d\n", *(char*)&x, 0); + printf("SYSTEM.INT8 %lu %lu\n", sizeof(SYSTEM_INT8), (char*)&i8.x - (char*)&i8); + printf("SYSTEM.INT16 %lu %lu\n", sizeof(SYSTEM_INT16), (char*)&i16.x - (char*)&i16); + printf("SYSTEM.INT32 %lu %lu\n", sizeof(SYSTEM_INT32), (char*)&i32.x - (char*)&i32); + printf("SYSTEM.INT64 %lu %lu\n", sizeof(SYSTEM_INT64), (char*)&i64.x - (char*)&i64); + if (sizeof(CHAR)!=1) printf("error: CHAR should have size 1\n"); if (sizeof(BOOLEAN)!=1) printf("error: BOOLEAN should have size 1\n"); diff --git a/src/voc/OPB.Mod b/src/voc/OPB.Mod index c2769922..42db11b5 100644 --- a/src/voc/OPB.Mod +++ b/src/voc/OPB.Mod @@ -1,7 +1,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) (* build parse tree *) - IMPORT OPT, OPS, OPM; + IMPORT OPT, OPS, OPM, SYSTEM; CONST (* symbol values or ops *) @@ -18,10 +18,14 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) 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; + 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; - intSet = {SInt..LInt}; realSet = {Real, LReal}; + Pointer = 13; ProcTyp = 14; + Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; + Comp = (*15*)20; + + intSet = {SInt..LInt, Int8..Int64}; realSet = {Real, LReal}; (* composite structure forms *) Basic = 1; Array = 2; DynArr = 3; Record = 4; @@ -405,6 +409,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSE err(69) END ; z^.typ := OPT.booltyp + ELSE + OPM.WriteString("/* this should not happen. handle this. OPB.MOp(); -- noch */"); OPM.WriteLn; END END ; x := z @@ -476,7 +482,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) CASE f OF Undef: res := eql - | Byte, Char..LInt: + | Byte, Char..LInt,Int8..Int64: IF xval^.intval < yval^.intval THEN res := lss ELSIF xval^.intval > yval^.intval THEN res := gtr ELSE res := eql @@ -503,6 +509,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) IF xval^.intval # yval^.intval THEN res := neq ELSE res := eql END + ELSE + OPM.WriteString("/* this should not happen. handle this. OPB.ConstCmp(); -- noch */"); OPM.WriteLn; END ; x^.typ := OPT.booltyp; RETURN res END ConstCmp; @@ -676,6 +684,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) IF f IN {Bool, Set, NilTyp, Pointer} THEN err(108) ELSE xval^.intval := BoolToInt(ConstCmp() # lss) END + ELSE + OPM.WriteString("/* this should not happen. handle this. OPB.ConstOp(); -- noch */ "); OPM.WriteLn; END END ConstOp; @@ -885,6 +895,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSE err(108); typ := OPT.undftyp END ; NewOp(op, typ, z, y) + ELSE + OPM.WriteString(" /* OPB.Op(), not handled case possibility; -- noch */ "); OPM.WriteLn; END END ; x := z @@ -935,10 +947,39 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) PROCEDURE CheckAssign(x: OPT.Struct; ynode: OPT.Node); (* x := y *) VAR f, g: INTEGER; y, p, q: OPT.Struct; BEGIN + IF OPM.Verbose THEN + OPM.LogWLn; OPM.LogWStr("PROCEDURE CheckAssign"); OPM.LogWLn; + END; y := ynode^.typ; f := x^.form; g := y^.form; + IF OPM.Verbose THEN + OPM.LogWStr("y.form = "); OPM.LogWNum(y.form, 0); OPM.LogWLn; + OPM.LogWStr("f = "); OPM.LogWNum(f, 0); OPM.LogWLn; + OPM.LogWStr("g = "); OPM.LogWNum(g, 0); OPM.LogWLn; + OPM.LogWStr("ynode.typ.syze = "); OPM.LogWNum(ynode.typ.size, 0); OPM.LogWLn; + END; IF (ynode^.class = Ntype) OR (ynode^.class = Nproc) & (f # ProcTyp) THEN err(126) END ; CASE f OF Undef, String: + | Int8: + IF (ynode.typ.size > OPM.Int8Size) THEN + IF OPM.Verbose THEN OPM.LogWStr("f of int8"); OPM.LogWLn END; + err(113) + END + | Int16: + IF (ynode.typ.size > OPM.Int16Size) THEN + IF OPM.Verbose THEN OPM.LogWStr("f of int16"); OPM.LogWLn END; + err(113) + END + | Int32: + IF (ynode.typ.size > OPM.Int32Size) THEN + IF OPM.Verbose THEN OPM.LogWStr("f of int32"); OPM.LogWLn END; + err(113) + END + | Int64: + IF ynode.typ.size > OPM.Int64Size THEN + IF OPM.Verbose THEN OPM.LogWStr("f of int64"); OPM.LogWLn END; + err(113) + END | Byte: IF ~(g IN {Byte, Char, SInt}) THEN err(113) END | Bool, Char, SInt, Set: @@ -988,6 +1029,8 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END 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; END ; IF (ynode^.class = Nconst) & (g < f) & (g IN {SInt..Real}) & (f IN {Int..LReal}) THEN Convert(ynode, x) @@ -1059,6 +1102,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) + | Int16: x := NewIntConst(OPM.MinInt16) + | Int32: x := NewIntConst(OPM.MinInt32) + | 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) @@ -1074,6 +1121,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) + | Int16: x := NewIntConst(OPM.MaxInt16) + | Int32: x := NewIntConst(OPM.MaxInt32) + | 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) @@ -1090,6 +1141,9 @@ avoid unnecessary intermediate variables in voc 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 = Int32 THEN Convert(x, OPT.int16typ) + ELSIF f = Int16 THEN Convert(x, OPT.int8typ) ELSIF f = LReal THEN Convert(x, OPT.realtyp) ELSE err(111) END @@ -1097,6 +1151,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 = Int16 THEN Convert(x, OPT.int32typ) + 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) @@ -1129,7 +1186,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, 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 @@ -1137,7 +1194,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}) 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) @@ -1164,6 +1221,8 @@ avoid unnecessary intermediate variables in voc ELSIF f # Bool THEN err(120); x := NewBoolConst(FALSE) ELSE MOp(not, x) END + ELSE + OPM.WriteString("/* this should not happen, needs to be handled. procedure StPar0; -- noch */"); OPM.WriteLn; END ; par0 := x END StPar0; @@ -1393,7 +1452,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}) 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 5fab8387..4be53f40 100644 --- a/src/voc/OPC.Mod +++ b/src/voc/OPC.Mod @@ -11,9 +11,12 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) CONST (* structure forms *) - Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; + 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; + Pointer = 13; ProcTyp = 14; + Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; + Comp = (*15*)20; (* composite structure forms *) Array = 2; DynArr = 3; Record = 4; @@ -170,8 +173,9 @@ 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) 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 ; OPM.WriteStringVar(obj^.name) END @@ -614,6 +618,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 + | Int16: RETURN OPM.Int16Align + | Int32: RETURN OPM.Int32Align + | Int64: RETURN OPM.Int64Align | Real: RETURN OPM.RealAlign | LReal: RETURN OPM.LRealAlign | Set: RETURN OPM.SetAlign @@ -857,6 +865,7 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) | OPM.mainlinkstat: OPM.Write("M") | OPM.notcoloroutput: OPM.Write("f") | OPM.forcenewsym: OPM.Write("F") + | OPM.verbose: OPM.Write("v") ELSE (* this else is necessary cause if someone defined a new option in OPM module @@ -1283,6 +1292,9 @@ 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) + | Real: OPM.WriteReal(con^.realval, "f") | LReal: diff --git a/src/voc/OPM.cmdln.Mod b/src/voc/OPM.cmdln.Mod index 3777f51d..20bb6819 100644 --- a/src/voc/OPM.cmdln.Mod +++ b/src/voc/OPM.cmdln.Mod @@ -28,6 +28,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) mainlinkstat* = 15; (* generate code for main module and then link object file statically *) notcoloroutput* = 16; (* turn off color output *) forcenewsym* = 17; (* force new symbol file *) + verbose* = 18; (* verbose *) defopt* = {inxchk, typchk, ptrinit, ansi, assert}; (* default options *) nilval* = 0; @@ -96,10 +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 *) CharAlign*, BoolAlign*, SIntAlign*, IntAlign*, + 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; MinReal*, MaxReal*, MinLReal*, MaxLReal*: LONGREAL; noerr*: BOOLEAN; @@ -122,7 +127,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) oldSFile, newSFile, HFile, BFile, HIFile: Files.File; S: INTEGER; - stop, useLineNo, useParFile, dontAsm-, dontLink-, mainProg-, mainLinkStat-, notColorOutput-, forceNewSym-: BOOLEAN; + stop, useLineNo, useParFile, dontAsm-, dontLink-, mainProg-, mainLinkStat-, notColorOutput-, forceNewSym-, Verbose-: BOOLEAN; (* ------------------------- Log Output ------------------------- *) @@ -170,6 +175,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) | "M": opt := opt / {mainlinkstat} | "f": opt := opt / {notcoloroutput} | "F": opt := opt / {forcenewsym} + | "V": opt := opt / {verbose} ELSE LogWStr(" warning: option "); LogW(OptionChar); LogW(s[i]); LogWStr(" ignored"); LogWLn END ; INC(i) @@ -192,7 +198,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) Console.Ln; Console.String(' command = "voc" options {file options}.'); Console.Ln; Console.String(' options = ["-" {option} ].'); Console.Ln; - Console.String(' option = "m" | "M" | "s" | "e" | "i" | "l" | "k" | "r" | "x" | "a" | "p" | "t" | "P" | "S" | "c" | "f" | "F" .'); Console.Ln; + Console.String(' option = "m" | "M" | "s" | "e" | "i" | "l" | "k" | "r" | "x" | "a" | "p" | "t" | "P" | "S" | "c" | "f" | "F" | "V" .'); Console.Ln; Console.Ln; Console.String(" m - generate code for main module"); Console.Ln; Console.String(" M - generate code for main module and link object statically"); Console.Ln; @@ -210,6 +216,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) Console.String(" c - don't call linker"); Console.Ln; Console.String(" f - don't use color output"); Console.Ln; Console.String(" F - force writing new symbol file"); Console.Ln; + Console.String(" V - verbose output"); Console.Ln; Console.Ln; ELSE glbopt := defopt; S := 1; s := ""; @@ -228,6 +235,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) IF mainlinkstat IN glbopt THEN INCL(glbopt, mainprog); mainLinkStat := TRUE ELSE mainLinkStat := FALSE END; IF notcoloroutput IN glbopt THEN notColorOutput := TRUE ELSE notColorOutput := FALSE END; IF forcenewsym IN glbopt THEN forceNewSym := TRUE ELSE forceNewSym := FALSE END; + IF verbose IN glbopt THEN Verbose := TRUE ELSE forceNewSym := FALSE END; GetProperties; (* GetProperties moved here in order to call it after ScanOptions because we have an option whether to use par file or not, noch *) END; @@ -248,6 +256,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) IF mainprog IN opt THEN mainProg := TRUE ELSE mainProg := FALSE END; IF mainlinkstat IN opt THEN INCL(glbopt, mainprog); mainLinkStat := TRUE ELSE mainLinkStat := FALSE END; IF forcenewsym IN glbopt THEN forceNewSym := TRUE ELSE forceNewSym := FALSE END; + IF verbose IN glbopt THEN Verbose := TRUE ELSE forceNewSym := FALSE END; END InitOptions; PROCEDURE Init*(VAR done: BOOLEAN; VAR mname : ARRAY OF CHAR); (* get the source for one translation *) @@ -588,6 +597,41 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) RETURN p; END power0; + PROCEDURE VerboseListSizes; + BEGIN + Console.String("Type Size Alignement"); Console.Ln; + Console.String("CHAR "); Console.Int(CharSize, 0); Console.Int(CharAlign, 5); Console.Ln; + Console.String("BOOLEAN "); Console.Int(BoolSize, 0); Console.Int(BoolAlign, 5); Console.Ln; + Console.String("SHORTINT "); Console.Int(SIntSize, 0); Console.Int(SIntAlign, 5); Console.Ln; + Console.String("INTEGER "); Console.Int(IntSize, 0); Console.Int(IntAlign, 5); Console.Ln; + Console.String("LONGINT "); Console.Int(LIntSize, 0); Console.Int(LIntAlign, 5); Console.Ln; + Console.String("SET "); Console.Int(SetSize, 0); Console.Int(SetAlign, 5); Console.Ln; + Console.String("REAL "); Console.Int(RealSize, 0); Console.Int(RealAlign, 5); Console.Ln; + Console.String("LONGREAL "); Console.Int(LRealSize, 0); Console.Int(LRealAlign, 5); Console.Ln; + 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("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; + Console.String("Min int16 "); Console.Int(MinInt16, 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("Max int32 "); Console.Int(MaxInt32, 0); Console.Ln; + + + END VerboseListSizes; PROCEDURE GetProperties(); VAR T: Texts.Text; S: Texts.Scanner; @@ -601,6 +645,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; SetAlign := 8; RealAlign := 4; LRealAlign := 8; ProcAlign := 8; PointerAlign := 8; RecAlign := 1; (* not necessary, we will calculate values later MinSInt := -80H; MaxSInt := 7FH; @@ -617,6 +662,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; SetAlign := 4; RealAlign := 4; LRealAlign := 8; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; (* not necessary, we will calculate values later @@ -630,6 +676,8 @@ 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; SetAlign := 4; RealAlign := 4; LRealAlign := 8; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; @@ -638,6 +686,8 @@ 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; SetAlign := 4; RealAlign := 4; LRealAlign := 4; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; ELSE (* this should suite any gnu x86 system *) @@ -645,6 +695,8 @@ 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; SetAlign := 4; RealAlign := 4; LRealAlign := 4; ProcAlign := 4; PointerAlign := 4; RecAlign := 1; (* LRealAlign should be checked and confirmed *) (* not necessary, will be calculated later @@ -658,7 +710,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) (* read voc.par *) IF useParFile THEN (* noch *) - Console.String ("loading type sizes from voc.par"); Console.Ln; + IF Verbose THEN Console.String ("loading type sizes from voc.par"); Console.Ln; END; NEW(T); Texts.Open(T, "voc.par"); IF T.len # 0 THEN Texts.OpenScanner(S, T, 0); Texts.Scan(S); @@ -677,12 +729,23 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) Size = 1; size and alignment follows from field types but at least RecAlign; e.g, SPARC, MIPS, PowerPC *) GetProperty(S, "ENDIAN", ByteOrder, BitOrder); (*currently not used*) + + GetProperty(S, "SYSTEM.INT8", Int8Size, Int8Align); + GetProperty(S, "SYSTEM.INT16", Int16Size, Int16Align); + GetProperty(S, "SYSTEM.INT32", Int32Size, Int32Align); + GetProperty(S, "SYSTEM.INT64", Int64Size, Int64Align); (* add here Max and Min sizes, noch *) ByteSize := CharSize; + ELSE Mark(-156, -1) END ; - ELSE Console.String ("not using voc.par file"); Console.Ln; - END; (* if useParFile , noch *) + ELSE + IF Verbose THEN + Console.String ("not using voc.par file"); Console.Ln + END + END; (* if useParFile , noch *) + + 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)*) @@ -708,15 +771,11 @@ 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); -(* - Console.Int(MinSInt, 0); Console.Ln; - Console.Int(MaxSInt, 0); Console.Ln; - Console.Int(MinInt, 0); Console.Ln; - Console.Int(MaxInt, 0); Console.Ln; - Console.Int(MinLInt, 0); Console.Ln; - Console.Int(MaxLInt, 0); Console.Ln; -*) - + 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 @@ -733,6 +792,10 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) (*IF IntSize = 4 THEN MinLInt := MinInt; MaxLInt := MaxInt END ;*) MaxSet := SetSize * 8 - 1; MaxIndex := MaxLInt; (* shouldn't it be like max(int)? so that for loop will be safe, noch *) + IF Verbose THEN + VerboseListSizes + END; + END GetProperties; diff --git a/src/voc/OPP.Mod b/src/voc/OPP.Mod index 88037863..4b33aaca 100644 --- a/src/voc/OPP.Mod +++ b/src/voc/OPP.Mod @@ -27,10 +27,14 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) 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; + 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; - intSet = {SInt..LInt}; + Pointer = 13; ProcTyp = 14; + Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; + Comp = (*15*)20; + + intSet = {SInt..LInt, Int8..Int64}; (* composite structure forms *) Basic = 1; Array = 2; DynArr = 3; Record = 4; @@ -281,7 +285,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 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) diff --git a/src/voc/OPT.Mod b/src/voc/OPT.Mod index 2104ffc4..ab08dfcd 100644 --- a/src/voc/OPT.Mod +++ b/src/voc/OPT.Mod @@ -4,680 +4,688 @@ MODULE OPT; (* NW, RC 6.3.89 / 23.1.92 *) (* object model 24.2.94 *) 2002-08-20 jt: NewStr: txtpos remains 0 for structs read from symbol file *) - IMPORT - OPS, OPM; +IMPORT +OPS, OPM; - CONST - MaxConstLen* = OPS.MaxStrLen; +CONST +MaxConstLen* = OPS.MaxStrLen; - TYPE - Const* = POINTER TO ConstDesc; - Object* = POINTER TO ObjDesc; - Struct* = POINTER TO StrDesc; - Node* = POINTER TO NodeDesc; - ConstExt* = POINTER TO OPS.String; +TYPE +Const* = POINTER TO ConstDesc; +Object* = POINTER TO ObjDesc; +Struct* = POINTER TO StrDesc; +Node* = POINTER TO NodeDesc; +ConstExt* = POINTER TO OPS.String; - ConstDesc* = RECORD - ext*: ConstExt; (* string or code for code proc *) - intval*: LONGINT; (* constant value or adr, proc par size, text position or least case label *) - intval2*: LONGINT; (* string length, proc var size or larger case label *) - setval*: SET; (* constant value, procedure body present or "ELSE" present in case *) - realval*: LONGREAL (* real or longreal constant value *) - END ; +ConstDesc* = RECORD +ext*: ConstExt; (* string or code for code proc *) +intval*: LONGINT; (* constant value or adr, proc par size, text position or least case label *) +intval2*: LONGINT; (* string length, proc var size or larger case label *) +setval*: SET; (* constant value, procedure body present or "ELSE" present in case *) +realval*: LONGREAL (* real or longreal constant value *) +END ; - ObjDesc* = RECORD - left*, right*, link*, scope*: Object; - name*: OPS.Name; - leaf*: BOOLEAN; - mode*, mnolev*: SHORTINT; (* mnolev < 0 -> mno = -mnolev *) - vis*: SHORTINT; (* internal, external, externalR *) - history*: SHORTINT; (* relevant if name # "" *) - used*, fpdone*: BOOLEAN; - fprint*: LONGINT; - typ*: Struct; - conval*: Const; - adr*, linkadr*: LONGINT; - x*: INTEGER (* linkadr and x can be freely used by the backend *) - END ; +ObjDesc* = RECORD +left*, right*, link*, scope*: Object; +name*: OPS.Name; +leaf*: BOOLEAN; +mode*, mnolev*: SHORTINT; (* mnolev < 0 -> mno = -mnolev *) +vis*: SHORTINT; (* internal, external, externalR *) +history*: SHORTINT; (* relevant if name # "" *) +used*, fpdone*: BOOLEAN; +fprint*: LONGINT; +typ*: Struct; +conval*: Const; +adr*, linkadr*: LONGINT; +x*: INTEGER (* linkadr and x can be freely used by the backend *) +END ; - StrDesc* = RECORD - form*, comp*, mno*, extlev*: SHORTINT; - ref*, sysflag*: INTEGER; - n*, size*, align*, txtpos*: LONGINT; (* align is alignment for records and len offset for dynarrs *) - allocated*, pbused*, pvused*, fpdone, idfpdone: BOOLEAN; - idfp, pbfp*, pvfp*:LONGINT; - BaseTyp*: Struct; - link*, strobj*: Object - END ; - - NodeDesc* = RECORD - left*, right*, link*: Node; - class*, subcl*: SHORTINT; - readonly*: BOOLEAN; - typ*: Struct; - obj*: Object; - conval*: Const - END ; - - CONST - maxImps = 64; (* must be <= MAX(SHORTINT) *) - maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *) - FirstRef = 16; +StrDesc* = RECORD +form*, comp*, mno*, extlev*: SHORTINT; +ref*, sysflag*: INTEGER; +n*, size*, align*, txtpos*: LONGINT; (* align is alignment for records and len offset for dynarrs *) +allocated*, pbused*, pvused*, fpdone, idfpdone: BOOLEAN; +idfp, pbfp*, pvfp*:LONGINT; +BaseTyp*: Struct; +link*, strobj*: Object +END ; - VAR - typSize*: PROCEDURE(typ: Struct); - topScope*: Object; - undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*, - realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*, sysptrtyp*: 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 *) - SYSimported*: BOOLEAN; - - CONST - (* object modes *) - Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7; - SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13; +NodeDesc* = RECORD +left*, right*, link*: Node; +class*, subcl*: SHORTINT; +readonly*: BOOLEAN; +typ*: Struct; +obj*: Object; +conval*: Const +END ; - (* 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; - - (* composite structure forms *) - Basic = 1; Array = 2; DynArr = 3; Record = 4; +CONST +maxImps = 64; (* must be <= MAX(SHORTINT) *) +maxStruct = OPM.MaxStruct; (* must be < MAX(INTEGER) DIV 2 *) +FirstRef = 16; - (*function number*) - assign = 0; - haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4; - entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9; - shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14; - inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32; - - (*SYSTEM function number*) - adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23; - getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; - bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31; - - (* module visibility of objects *) - internal = 0; external = 1; externalR = 2; +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; +nofGmod*: SHORTINT; (*nof imports*) +GlbMod*: ARRAY maxImps OF Object; (* ^.right = first object, ^.name = module import name (not alias) *) +SelfName*: OPS.Name; (* name of module being compiled *) +SYSimported*: BOOLEAN; - (* history of imported objects *) - inserted = 0; same = 1; pbmodified = 2; pvmodified = 3; removed = 4; inconsistent = 5; +CONST +(* object modes *) +Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7; +SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13; - (* symbol file items *) - Smname = 16; Send = 18; Stype = 19; Salias = 20; Svar = 21; Srvar = 22; - Svalpar = 23; Svarpar = 24; Sfld = 25; Srfld = 26; Shdptr = 27; Shdpro = 28; Stpro = 29; Shdtpro = 30; - Sxpro = 31; Sipro = 32; Scpro = 33; Sstruct = 34; Ssys = 35; Sptr = 36; Sarr = 37; Sdarr = 38; Srec = 39; Spro = 40; - - TYPE - ImpCtxt = RECORD - nextTag, reffp: LONGINT; - nofr, minr, nofm: INTEGER; - self: BOOLEAN; - ref: ARRAY maxStruct OF Struct; - old: ARRAY maxStruct OF Object; - pvfp: ARRAY maxStruct OF LONGINT; (* set only if old # NIL *) - glbmno: ARRAY maxImps OF SHORTINT (* index is local mno *) - END ; +(* 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; +Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; +Comp = 20; - ExpCtxt = RECORD - reffp: LONGINT; - ref: INTEGER; - nofm: SHORTINT; - locmno: ARRAY maxImps OF SHORTINT (* index is global mno *) - END ; +(* composite structure forms *) +Basic = 1; Array = 2; DynArr = 3; Record = 4; - VAR - universe, syslink: Object; - impCtxt: ImpCtxt; - expCtxt: ExpCtxt; - nofhdfld: LONGINT; - newsf, findpc, extsf, sfpresent, symExtended, symNew: BOOLEAN; +(*function number*) +assign = 0; +haltfn = 0; newfn = 1; absfn = 2; capfn = 3; ordfn = 4; +entierfn = 5; oddfn = 6; minfn = 7; maxfn = 8; chrfn = 9; +shortfn = 10; longfn = 11; sizefn = 12; incfn = 13; decfn = 14; +inclfn = 15; exclfn = 16; lenfn = 17; copyfn = 18; ashfn = 19; assertfn = 32; - PROCEDURE err(n: INTEGER); - BEGIN OPM.err(n) - END err; - - PROCEDURE NewConst*(): Const; - VAR const: Const; - BEGIN NEW(const); RETURN const - END NewConst; - - PROCEDURE NewObj*(): Object; - VAR obj: Object; - BEGIN NEW(obj); RETURN obj - END NewObj; - - PROCEDURE NewStr*(form, comp: SHORTINT): Struct; - VAR typ: Struct; - BEGIN NEW(typ); typ^.form := form; typ^.comp := comp; typ^.ref := maxStruct; (* ref >= maxStruct: not exported yet *) - IF form # Undef THEN typ^.txtpos := OPM.errpos END ; (* txtpos remains 0 for structs read from symbol file *) - typ^.size := -1; typ^.BaseTyp := undftyp; RETURN typ - END NewStr; - - PROCEDURE NewNode*(class: SHORTINT): Node; - VAR node: Node; - BEGIN NEW(node); node^.class := class; RETURN node - END NewNode; - - PROCEDURE NewExt*(): ConstExt; - VAR ext: ConstExt; - BEGIN NEW(ext); RETURN ext - END NewExt; +(*SYSTEM function number*) +adrfn = 20; ccfn = 21; lshfn = 22; rotfn = 23; +getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; +bitfn = 28; valfn = 29; sysnewfn = 30; movefn = 31; - PROCEDURE OpenScope*(level: SHORTINT; owner: Object); - VAR head: Object; - BEGIN head := NewObj(); - head^.mode := Head; head^.mnolev := level; head^.link := owner; - IF owner # NIL THEN owner^.scope := head END ; - head^.left := topScope; head^.right := NIL; head^.scope := NIL; topScope := head - END OpenScope; +(* module visibility of objects *) +internal = 0; external = 1; externalR = 2; - PROCEDURE CloseScope*; - BEGIN topScope := topScope^.left - END CloseScope; +(* history of imported objects *) +inserted = 0; same = 1; pbmodified = 2; pvmodified = 3; removed = 4; inconsistent = 5; - PROCEDURE Init*(VAR name: OPS.Name; opt: SET); - CONST nsf = 4; fpc = 8; esf = 9; - BEGIN - topScope := universe; OpenScope(0, NIL); SYSimported := FALSE; - SelfName := name; topScope^.name := name; - GlbMod[0] := topScope; nofGmod := 1; - newsf := nsf IN opt; findpc := fpc IN opt; extsf := newsf OR (esf IN opt); sfpresent := TRUE - END Init; +(* symbol file items *) +Smname = 16; Send = 18; Stype = 19; Salias = 20; Svar = 21; Srvar = 22; +Svalpar = 23; Svarpar = 24; Sfld = 25; Srfld = 26; Shdptr = 27; Shdpro = 28; Stpro = 29; Shdtpro = 30; +Sxpro = 31; Sipro = 32; Scpro = 33; Sstruct = 34; Ssys = 35; Sptr = 36; Sarr = 37; Sdarr = 38; Srec = 39; Spro = 40; - PROCEDURE Close*; - VAR i: INTEGER; - BEGIN (* garbage collection *) - CloseScope; - i := 0; WHILE i < maxImps DO GlbMod[i] := NIL; INC(i) END ; - i := FirstRef; WHILE i < maxStruct DO impCtxt.ref[i] := NIL; impCtxt.old[i] := NIL; INC(i) END - END Close; +TYPE +ImpCtxt = RECORD +nextTag, reffp: LONGINT; +nofr, minr, nofm: INTEGER; +self: BOOLEAN; +ref: ARRAY maxStruct OF Struct; +old: ARRAY maxStruct OF Object; +pvfp: ARRAY maxStruct OF LONGINT; (* set only if old # NIL *) +glbmno: ARRAY maxImps OF SHORTINT (* index is local mno *) +END ; - PROCEDURE FindImport*(mod: Object; VAR res: Object); - VAR obj: Object; - BEGIN obj := mod^.scope; - LOOP - IF obj = NIL THEN EXIT END ; - IF OPS.name < obj^.name THEN obj := obj^.left - ELSIF OPS.name > obj^.name THEN obj := obj^.right - ELSE (*found*) - IF (obj^.mode = Typ) & (obj^.vis = internal) THEN obj := NIL - ELSE obj^.used := TRUE - END ; - EXIT - END - END ; - res := obj - END FindImport; +ExpCtxt = RECORD +reffp: LONGINT; +ref: INTEGER; +nofm: SHORTINT; +locmno: ARRAY maxImps OF SHORTINT (* index is global mno *) +END ; - PROCEDURE Find*(VAR res: Object); - VAR obj, head: Object; - BEGIN head := topScope; - LOOP obj := head^.right; - LOOP - IF obj = NIL THEN EXIT END ; - IF OPS.name < obj^.name THEN obj := obj^.left - ELSIF OPS.name > obj^.name THEN obj := obj^.right - ELSE (* found, obj^.used not set for local objects *) EXIT - END - END ; - IF obj # NIL THEN EXIT END ; - head := head^.left; - IF head = NIL THEN EXIT END - END ; - res := obj - END Find; +VAR +universe, syslink: Object; +impCtxt: ImpCtxt; +expCtxt: ExpCtxt; +nofhdfld: LONGINT; +newsf, findpc, extsf, sfpresent, symExtended, symNew: BOOLEAN; - PROCEDURE FindField*(VAR name: OPS.Name; typ: Struct; VAR res: Object); - VAR obj: Object; - BEGIN - WHILE typ # NIL DO obj := typ^.link; - WHILE obj # NIL DO - IF name < obj^.name THEN obj := obj^.left - ELSIF name > obj^.name THEN obj := obj^.right - ELSE (*found*) res := obj; RETURN - END - END ; - typ := typ^.BaseTyp - END ; - res := NIL - END FindField; +PROCEDURE err(n: INTEGER); +BEGIN OPM.err(n) +END err; - PROCEDURE Insert*(VAR name: OPS.Name; VAR obj: Object); - VAR ob0, ob1: Object; left: BOOLEAN; mnolev: SHORTINT; - BEGIN ob0 := topScope; ob1 := ob0^.right; left := FALSE; - LOOP - IF ob1 # NIL THEN - IF name < ob1^.name THEN ob0 := ob1; ob1 := ob0^.left; left := TRUE - ELSIF name > ob1^.name THEN ob0 := ob1; ob1 := ob0^.right; left := FALSE - ELSE (*double def*) err(1); ob0 := ob1; ob1 := ob0^.right - END - ELSE (*insert*) ob1 := NewObj(); ob1^.leaf := TRUE; - IF left THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END ; - ob1^.left := NIL; ob1^.right := NIL; COPY(name, ob1^.name); - mnolev := topScope^.mnolev; ob1^.mnolev := mnolev; - EXIT - END - END ; - obj := ob1 - END Insert; +PROCEDURE NewConst*(): Const; +VAR const: Const; +BEGIN NEW(const); RETURN const +END NewConst; + +PROCEDURE NewObj*(): Object; +VAR obj: Object; +BEGIN NEW(obj); RETURN obj +END NewObj; + +PROCEDURE NewStr*(form, comp: SHORTINT): Struct; +VAR typ: Struct; +BEGIN NEW(typ); typ^.form := form; typ^.comp := comp; typ^.ref := maxStruct; (* ref >= maxStruct: not exported yet *) +IF form # Undef THEN typ^.txtpos := OPM.errpos END ; (* txtpos remains 0 for structs read from symbol file *) +typ^.size := -1; typ^.BaseTyp := undftyp; RETURN typ +END NewStr; + +PROCEDURE NewNode*(class: SHORTINT): Node; +VAR node: Node; +BEGIN NEW(node); node^.class := class; RETURN node +END NewNode; + +PROCEDURE NewExt*(): ConstExt; +VAR ext: ConstExt; +BEGIN NEW(ext); RETURN ext +END NewExt; + +PROCEDURE OpenScope*(level: SHORTINT; owner: Object); +VAR head: Object; +BEGIN head := NewObj(); +head^.mode := Head; head^.mnolev := level; head^.link := owner; +IF owner # NIL THEN owner^.scope := head END ; +head^.left := topScope; head^.right := NIL; head^.scope := NIL; topScope := head +END OpenScope; + +PROCEDURE CloseScope*; +BEGIN topScope := topScope^.left +END CloseScope; + +PROCEDURE Init*(VAR name: OPS.Name; opt: SET); +CONST nsf = 4; fpc = 8; esf = 9; +BEGIN +topScope := universe; OpenScope(0, NIL); SYSimported := FALSE; +SelfName := name; topScope^.name := name; +GlbMod[0] := topScope; nofGmod := 1; +newsf := nsf IN opt; findpc := fpc IN opt; extsf := newsf OR (esf IN opt); sfpresent := TRUE +END Init; + +PROCEDURE Close*; +VAR i: INTEGER; +BEGIN (* garbage collection *) +CloseScope; +i := 0; WHILE i < maxImps DO GlbMod[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); +VAR obj: Object; +BEGIN obj := mod^.scope; +LOOP +IF obj = NIL THEN EXIT END ; +IF OPS.name < obj^.name THEN obj := obj^.left +ELSIF OPS.name > obj^.name THEN obj := obj^.right +ELSE (*found*) +IF (obj^.mode = Typ) & (obj^.vis = internal) THEN obj := NIL +ELSE obj^.used := TRUE +END ; +EXIT +END +END ; +res := obj +END FindImport; + +PROCEDURE Find*(VAR res: Object); +VAR obj, head: Object; +BEGIN head := topScope; +LOOP obj := head^.right; +LOOP +IF obj = NIL THEN EXIT END ; +IF OPS.name < obj^.name THEN obj := obj^.left +ELSIF OPS.name > obj^.name THEN obj := obj^.right +ELSE (* found, obj^.used not set for local objects *) EXIT +END +END ; +IF obj # NIL THEN EXIT END ; +head := head^.left; +IF head = NIL THEN EXIT END +END ; +res := obj +END Find; + +PROCEDURE FindField*(VAR name: OPS.Name; typ: Struct; VAR res: Object); +VAR obj: Object; +BEGIN +WHILE typ # NIL DO obj := typ^.link; +WHILE obj # NIL DO +IF name < obj^.name THEN obj := obj^.left +ELSIF name > obj^.name THEN obj := obj^.right +ELSE (*found*) res := obj; RETURN +END +END ; +typ := typ^.BaseTyp +END ; +res := NIL +END FindField; + +PROCEDURE Insert*(VAR name: OPS.Name; VAR obj: Object); +VAR ob0, ob1: Object; left: BOOLEAN; mnolev: SHORTINT; +BEGIN ob0 := topScope; ob1 := ob0^.right; left := FALSE; +LOOP +IF ob1 # NIL THEN +IF name < ob1^.name THEN ob0 := ob1; ob1 := ob0^.left; left := TRUE +ELSIF name > ob1^.name THEN ob0 := ob1; ob1 := ob0^.right; left := FALSE +ELSE (*double def*) err(1); ob0 := ob1; ob1 := ob0^.right +END +ELSE (*insert*) ob1 := NewObj(); ob1^.leaf := TRUE; +IF left THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END ; +ob1^.left := NIL; ob1^.right := NIL; COPY(name, ob1^.name); +mnolev := topScope^.mnolev; ob1^.mnolev := mnolev; +EXIT +END +END ; +obj := ob1 +END Insert; (*-------------------------- Fingerprinting --------------------------*) - PROCEDURE FPrintName(VAR fp: LONGINT; VAR name: ARRAY OF CHAR); - VAR i: INTEGER; ch: CHAR; - BEGIN i := 0; - REPEAT ch := name[i]; OPM.FPrint(fp, ORD(ch)); INC(i) UNTIL ch = 0X - END FPrintName; +PROCEDURE FPrintName(VAR fp: LONGINT; VAR name: ARRAY OF CHAR); +VAR i: INTEGER; ch: CHAR; +BEGIN i := 0; +REPEAT ch := name[i]; OPM.FPrint(fp, ORD(ch)); INC(i) UNTIL ch = 0X +END FPrintName; - PROCEDURE ^IdFPrint*(typ: Struct); +PROCEDURE ^IdFPrint*(typ: Struct); - 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 +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 +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 +END IdFPrint; + +PROCEDURE FPrintStr*(typ: Struct); +VAR f, c: INTEGER; btyp: Struct; strobj, bstrobj: Object; pbfp, pvfp: LONGINT; + +PROCEDURE ^FPrintFlds(fld: Object; adr: LONGINT; visible: BOOLEAN); + +PROCEDURE FPrintHdFld(typ: Struct; fld: Object; adr: LONGINT); (* modifies pvfp only *) +VAR i, j, n: LONGINT; btyp: Struct; +BEGIN +IF typ^.comp = Record THEN FPrintFlds(typ^.link, adr, FALSE) +ELSIF typ^.comp = Array THEN btyp := typ^.BaseTyp; n := typ^.n; +WHILE btyp^.comp = Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END ; +IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN + j := nofhdfld; FPrintHdFld(btyp, fld, adr); + 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 FPrintSign; + END +END +ELSIF OPM.ExpHdPtrFld & ((typ^.form = Pointer) OR (fld^.name = OPM.HdPtrName)) THEN +OPM.FPrint(pvfp, Pointer); OPM.FPrint(pvfp, adr); INC(nofhdfld) +ELSIF OPM.ExpHdProcFld & ((typ^.form = ProcTyp) OR (fld^.name = OPM.HdProcName)) THEN +OPM.FPrint(pvfp, ProcTyp); OPM.FPrint(pvfp, adr); INC(nofhdfld) +END +END FPrintHdFld; - 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 - END IdFPrint; +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 +END FPrintFlds; - PROCEDURE FPrintStr*(typ: Struct); - VAR f, c: INTEGER; btyp: Struct; strobj, bstrobj: Object; pbfp, pvfp: LONGINT; +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 +END FPrintTProcs; - PROCEDURE ^FPrintFlds(fld: Object; adr: LONGINT; visible: BOOLEAN); +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 +END FPrintStr; - PROCEDURE FPrintHdFld(typ: Struct; fld: Object; adr: LONGINT); (* modifies pvfp only *) - VAR i, j, n: LONGINT; btyp: Struct; - BEGIN - IF typ^.comp = Record THEN FPrintFlds(typ^.link, adr, FALSE) - ELSIF typ^.comp = Array THEN btyp := typ^.BaseTyp; n := typ^.n; - WHILE btyp^.comp = Array DO n := btyp^.n * n; btyp := btyp^.BaseTyp END ; - IF (btyp^.form = Pointer) OR (btyp^.comp = Record) THEN - j := nofhdfld; FPrintHdFld(btyp, fld, adr); - 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 - ELSIF OPM.ExpHdPtrFld & ((typ^.form = Pointer) OR (fld^.name = OPM.HdPtrName)) THEN - OPM.FPrint(pvfp, Pointer); OPM.FPrint(pvfp, adr); INC(nofhdfld) - ELSIF OPM.ExpHdProcFld & ((typ^.form = ProcTyp) OR (fld^.name = OPM.HdProcName)) THEN - OPM.FPrint(pvfp, ProcTyp); OPM.FPrint(pvfp, adr); INC(nofhdfld) - END - END FPrintHdFld; +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 +END FPrintObj; - 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 - 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 - 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 - 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: - 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); - VAR i, j: INTEGER; ch: CHAR; - BEGIN - IF obj^.mnolev # 0 THEN - COPY(GlbMod[-obj^.mnolev]^.name, OPM.objname); i := 0; - WHILE OPM.objname[i] # 0X DO INC(i) END ; - OPM.objname[i] := "."; j := 0; INC(i); - REPEAT ch := obj^.name[j]; OPM.objname[i] := ch; INC(j); INC(i) UNTIL ch = 0X; - ELSE - COPY(obj^.name, OPM.objname) - END ; - IF errno = 249 THEN - IF OPM.noerr THEN err(errno) END - ELSIF errno = 253 THEN (* extension *) - IF ~symNew & ~symExtended & ~extsf THEN err(errno) END ; - symExtended := TRUE - ELSE - IF ~symNew & ~newsf THEN err(errno) END ; - symNew := TRUE - END - END FPrintErr; +PROCEDURE FPrintErr*(obj: Object; errno: INTEGER); +VAR i, j: INTEGER; ch: CHAR; +BEGIN +IF obj^.mnolev # 0 THEN +COPY(GlbMod[-obj^.mnolev]^.name, OPM.objname); i := 0; +WHILE OPM.objname[i] # 0X DO INC(i) END ; +OPM.objname[i] := "."; j := 0; INC(i); +REPEAT ch := obj^.name[j]; OPM.objname[i] := ch; INC(j); INC(i) UNTIL ch = 0X; +ELSE +COPY(obj^.name, OPM.objname) +END ; +IF errno = 249 THEN +IF OPM.noerr THEN err(errno) END +ELSIF errno = 253 THEN (* extension *) +IF ~symNew & ~symExtended & ~extsf THEN err(errno) END ; +symExtended := TRUE +ELSE +IF ~symNew & ~newsf THEN err(errno) END ; +symNew := TRUE +END +END FPrintErr; (*-------------------------- Import --------------------------*) - PROCEDURE InsertImport*(obj: Object; VAR root, old: Object); - VAR ob0, ob1: Object; left: BOOLEAN; - BEGIN - IF root = NIL THEN root := obj; old := NIL - ELSE - ob0 := root; ob1 := ob0^.right; left := FALSE; - IF obj^.name < ob0^.name THEN ob1 := ob0^.left; left := TRUE - ELSIF obj^.name > ob0^.name THEN ob1 := ob0^.right; left := FALSE - ELSE old := ob0; RETURN - END ; - LOOP - IF ob1 # NIL THEN - IF obj^.name < ob1^.name THEN ob0 := ob1; ob1 := ob1^.left; left := TRUE - ELSIF obj^.name > ob1^.name THEN ob0 := ob1; ob1 := ob1^.right; left := FALSE - ELSE old := ob1; EXIT - END - ELSE ob1 := obj; - IF left THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END ; - ob1^.left := NIL; ob1^.right := NIL; old := NIL; EXIT - END +PROCEDURE InsertImport*(obj: Object; VAR root, old: Object); +VAR ob0, ob1: Object; left: BOOLEAN; +BEGIN +IF root = NIL THEN root := obj; old := NIL +ELSE +ob0 := root; ob1 := ob0^.right; left := FALSE; +IF obj^.name < ob0^.name THEN ob1 := ob0^.left; left := TRUE +ELSIF obj^.name > ob0^.name THEN ob1 := ob0^.right; left := FALSE +ELSE old := ob0; RETURN +END ; +LOOP +IF ob1 # NIL THEN + IF obj^.name < ob1^.name THEN ob0 := ob1; ob1 := ob1^.left; left := TRUE + ELSIF obj^.name > ob1^.name THEN ob0 := ob1; ob1 := ob1^.right; left := FALSE + ELSE old := ob1; EXIT + END +ELSE ob1 := obj; + IF left THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END ; + ob1^.left := NIL; ob1^.right := NIL; old := NIL; EXIT +END +END +END +END InsertImport; + +PROCEDURE InName(VAR name: ARRAY OF CHAR); +VAR i: INTEGER; ch: CHAR; +BEGIN i := 0; +REPEAT +OPM.SymRCh(ch); name[i] := ch; INC(i) +UNTIL ch = 0X +END InName; + +PROCEDURE InMod(VAR mno: SHORTINT); (* mno is global *) +VAR head: Object; name: OPS.Name; mn: LONGINT; i: SHORTINT; +BEGIN +mn := OPM.SymRInt(); +IF mn = 0 THEN mno := impCtxt.glbmno[0] +ELSE +IF mn = Smname THEN +InName(name); +IF (name = SelfName) & ~impCtxt.self THEN err(154) END ; +i := 0; +WHILE (i < nofGmod) & (name # GlbMod[i].name) DO INC(i) END ; +IF i < nofGmod THEN mno := i (*module already present*) +ELSE + head := NewObj(); head^.mode := Head; COPY(name, head^.name); + mno := nofGmod; head^.mnolev := -mno; + IF nofGmod < maxImps THEN + GlbMod[mno] := head; INC(nofGmod) + ELSE err(227) + END +END ; +impCtxt.glbmno[impCtxt.nofm] := mno; INC(impCtxt.nofm) +ELSE +mno := impCtxt.glbmno[-mn] +END +END +END InMod; + +PROCEDURE InConstant(f: LONGINT; conval: Const); +VAR ch: CHAR; i: INTEGER; ext: ConstExt; rval: REAL; +BEGIN +CASE f OF +| Byte, Char, Bool: +OPM.SymRCh(ch); conval^.intval := ORD(ch) +| Int8, Int16, Int32, Int64: +conval^.intval := OPM.SymRInt() +| SInt, Int, LInt: +conval^.intval := OPM.SymRInt() +| Set: +OPM.SymRSet(conval^.setval) +| Real: +OPM.SymRReal(rval); conval^.realval := rval; +conval^.intval := OPM.ConstNotAlloc +| LReal: +OPM.SymRLReal(conval^.realval); +conval^.intval := OPM.ConstNotAlloc +| String: +ext := NewExt(); conval^.ext := ext; i := 0; +REPEAT +OPM.SymRCh(ch); ext^[i] := ch; INC(i) +UNTIL ch = 0X; +conval^.intval2 := i; +conval^.intval := OPM.ConstNotAlloc +| NilTyp: +conval^.intval := OPM.nilval +ELSE +OPM.WriteString(" /* function OPT.InConstant(); unhandled case; -- noch */ "); OPM.WriteLn; +END +END InConstant; + +PROCEDURE ^InStruct(VAR typ: Struct); + +PROCEDURE InSign(mno: SHORTINT; VAR res: Struct; VAR par: Object); +VAR last, new: Object; tag: LONGINT; +BEGIN +InStruct(res); +tag := OPM.SymRInt(); last := NIL; +WHILE tag # Send DO +new := NewObj(); new^.mnolev := -mno; +IF last = NIL THEN par := new ELSE last^.link := new END ; +IF tag = Svalpar THEN new^.mode := Var ELSE new^.mode := VarPar END ; +InStruct(new^.typ); new^.adr := OPM.SymRInt(); InName(new^.name); +last := new; tag := OPM.SymRInt() +END +END InSign; + +PROCEDURE InFld(): Object; (* first number in impCtxt.nextTag, mno set outside *) +VAR tag: LONGINT; obj: Object; +BEGIN +tag := impCtxt.nextTag; obj := NewObj(); +IF tag <= Srfld THEN +obj^.mode := Fld; +IF tag = Srfld THEN obj^.vis := externalR ELSE obj^.vis := external END ; +InStruct(obj^.typ); InName(obj^.name); +obj^.adr := OPM.SymRInt() +ELSE +obj^.mode := Fld; +IF tag = Shdptr THEN obj^.name := OPM.HdPtrName ELSE obj^.name := OPM.HdProcName END ; +obj^.typ := undftyp; obj^.vis := internal; +obj^.adr := OPM.SymRInt() +END ; +RETURN obj +END InFld; + +PROCEDURE InTProc(mno: SHORTINT): Object; (* first number in impCtxt.nextTag *) +VAR tag: LONGINT; obj: Object; +BEGIN +tag := impCtxt.nextTag; +obj := NewObj(); obj^.mnolev := -mno; +IF tag = Stpro THEN +obj^.mode := TProc; obj^.conval := NewConst(); obj^.conval^.intval := -1; +InSign(mno, obj^.typ, obj^.link); obj^.vis := external; InName(obj^.name); +obj^.adr := 10000H*OPM.SymRInt() +ELSE (* tag = Shdtpro *) +obj^.mode := TProc; obj^.name := OPM.HdTProcName; +obj^.link := NewObj(); (* dummy, easier in Browser *) +obj^.typ := undftyp; obj^.vis := internal; +obj^.adr := 10000H*OPM.SymRInt() +END ; +RETURN obj +END InTProc; + +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 := "" +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 + (* 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 - END - END InsertImport; - - PROCEDURE InName(VAR name: ARRAY OF CHAR); - VAR i: INTEGER; ch: CHAR; - BEGIN i := 0; - REPEAT - OPM.SymRCh(ch); name[i] := ch; INC(i) - UNTIL ch = 0X - END InName; - - PROCEDURE InMod(VAR mno: SHORTINT); (* mno is global *) - VAR head: Object; name: OPS.Name; mn: LONGINT; i: SHORTINT; - BEGIN - mn := OPM.SymRInt(); - IF mn = 0 THEN mno := impCtxt.glbmno[0] ELSE - IF mn = Smname THEN - InName(name); - IF (name = SelfName) & ~impCtxt.self THEN err(154) END ; - i := 0; - WHILE (i < nofGmod) & (name # GlbMod[i].name) DO INC(i) END ; - IF i < nofGmod THEN mno := i (*module already present*) - ELSE - head := NewObj(); head^.mode := Head; COPY(name, head^.name); - mno := nofGmod; head^.mnolev := -mno; - IF nofGmod < maxImps THEN - GlbMod[mno] := head; INC(nofGmod) - ELSE err(227) - END - END ; - impCtxt.glbmno[impCtxt.nofm] := mno; INC(impCtxt.nofm) - ELSE - mno := impCtxt.glbmno[-mn] - END + (* 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 - END InMod; - - PROCEDURE InConstant(f: LONGINT; conval: Const); - VAR ch: CHAR; i: INTEGER; ext: ConstExt; rval: REAL; - BEGIN - CASE f OF - | Byte, Char, Bool: - OPM.SymRCh(ch); conval^.intval := ORD(ch) - | SInt, Int, LInt: - conval^.intval := OPM.SymRInt() - | Set: - OPM.SymRSet(conval^.setval) - | Real: - OPM.SymRReal(rval); conval^.realval := rval; - conval^.intval := OPM.ConstNotAlloc - | LReal: - OPM.SymRLReal(conval^.realval); - conval^.intval := OPM.ConstNotAlloc - | String: - ext := NewExt(); conval^.ext := ext; i := 0; - REPEAT - OPM.SymRCh(ch); ext^[i] := ch; INC(i) - UNTIL ch = 0X; - conval^.intval2 := i; - conval^.intval := OPM.ConstNotAlloc - | NilTyp: - conval^.intval := OPM.nilval - END - END InConstant; - - PROCEDURE ^InStruct(VAR typ: Struct); - - PROCEDURE InSign(mno: SHORTINT; VAR res: Struct; VAR par: Object); - VAR last, new: Object; tag: LONGINT; - BEGIN - InStruct(res); - tag := OPM.SymRInt(); last := NIL; - WHILE tag # Send DO - new := NewObj(); new^.mnolev := -mno; - IF last = NIL THEN par := new ELSE last^.link := new END ; - IF tag = Svalpar THEN new^.mode := Var ELSE new^.mode := VarPar END ; - InStruct(new^.typ); new^.adr := OPM.SymRInt(); InName(new^.name); - last := new; tag := OPM.SymRInt() - END - END InSign; - - PROCEDURE InFld(): Object; (* first number in impCtxt.nextTag, mno set outside *) - VAR tag: LONGINT; obj: Object; - BEGIN - tag := impCtxt.nextTag; obj := NewObj(); - IF tag <= Srfld THEN - obj^.mode := Fld; - IF tag = Srfld THEN obj^.vis := externalR ELSE obj^.vis := external END ; - InStruct(obj^.typ); InName(obj^.name); - obj^.adr := OPM.SymRInt() - ELSE - obj^.mode := Fld; - IF tag = Shdptr THEN obj^.name := OPM.HdPtrName ELSE obj^.name := OPM.HdProcName END ; - obj^.typ := undftyp; obj^.vis := internal; - obj^.adr := OPM.SymRInt() - END ; - RETURN obj - END InFld; - - PROCEDURE InTProc(mno: SHORTINT): Object; (* first number in impCtxt.nextTag *) - VAR tag: LONGINT; obj: Object; - BEGIN - tag := impCtxt.nextTag; - obj := NewObj(); obj^.mnolev := -mno; - IF tag = Stpro THEN - obj^.mode := TProc; obj^.conval := NewConst(); obj^.conval^.intval := -1; - InSign(mno, obj^.typ, obj^.link); obj^.vis := external; InName(obj^.name); - obj^.adr := 10000H*OPM.SymRInt() - ELSE (* tag = Shdtpro *) - obj^.mode := TProc; obj^.name := OPM.HdTProcName; - obj^.link := NewObj(); (* dummy, easier in Browser *) - obj^.typ := undftyp; obj^.vis := internal; - obj^.adr := 10000H*OPM.SymRInt() - END ; - RETURN obj - END InTProc; - - 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 := "" - 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 - (* 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 - 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 ; @@ -872,7 +880,7 @@ MODULE OPT; (* NW, RC 6.3.89 / 23.1.92 *) (* object model 24.2.94 *) PROCEDURE OutStr(typ: Struct); (* OPV.TypeAlloc already applied *) VAR strobj: Object; BEGIN - IF typ^.ref < expCtxt.ref 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); @@ -919,7 +927,7 @@ MODULE OPT; (* NW, RC 6.3.89 / 23.1.92 *) (* object model 24.2.94 *) CASE f OF | Bool, Char: OPM.SymWCh(CHR(obj^.conval^.intval)) - | SInt, Int, LInt: + | SInt, Int, LInt, Int8, Int16, Int32, Int64: OPM.SymWInt(obj^.conval^.intval) | Set: OPM.SymWSet(obj^.conval^.setval) @@ -1042,6 +1050,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); @@ -1090,6 +1104,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[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 65bb415b..63b91762 100644 --- a/src/voc/OPV.Mod +++ b/src/voc/OPV.Mod @@ -22,8 +22,11 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29; (* structure forms *) - Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; - Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; Pointer = 13; ProcTyp = 14; Comp = 15; + Byte = 1; Bool = 2; Char = 3; + SInt = 4; Int = 5; LInt = 6; + 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; (* composite structure forms *) Array = 2; DynArr = 3; Record = 4; @@ -249,6 +252,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.int16typ^.strobj^.linkadr := PredefinedType; + OPT.int32typ^.strobj^.linkadr := PredefinedType; + OPT.int64typ^.strobj^.linkadr := PredefinedType; OPT.sysptrtyp^.strobj^.linkadr := PredefinedType; END AdrAndSize; @@ -509,10 +516,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}) 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; END END ELSIF ansi THEN @@ -708,7 +717,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}) 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 diff --git a/src/voc/voc.Mod b/src/voc/voc.Mod index 687687e8..a109762a 100644 --- a/src/voc/voc.Mod +++ b/src/voc/voc.Mod @@ -80,6 +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.int16typ.size := 2; + OPT.int32typ.size := 4; + OPT.int64typ.size := 8; OPT.sysptrtyp.size := OPM.PointerSize; OPT.chartyp.size := OPM.CharSize; OPT.settyp.size := OPM.SetSize; diff --git a/voc.REMOVED.git-id b/voc.REMOVED.git-id index 2e79cd41..34a6b129 100644 --- a/voc.REMOVED.git-id +++ b/voc.REMOVED.git-id @@ -1 +1 @@ -6ba9f2d70e2bad97118512d33e656f8d3430596c \ No newline at end of file +ec06062804e7d3c08aa622ae3ee778f2f4003ae0 \ No newline at end of file diff --git a/vocstatic.linux.gcc.x86_64.REMOVED.git-id b/vocstatic.linux.gcc.x86_64.REMOVED.git-id index 617b79d7..34a6b129 100644 --- a/vocstatic.linux.gcc.x86_64.REMOVED.git-id +++ b/vocstatic.linux.gcc.x86_64.REMOVED.git-id @@ -1 +1 @@ -7ce73aa13bfab8e21eda71e0e351d5d5395e6bd3 \ No newline at end of file +ec06062804e7d3c08aa622ae3ee778f2f4003ae0 \ No newline at end of file