From 9d6a71eb59bd95d6031a3933dd485d8d7ee47961 Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Wed, 11 Mar 2015 14:03:49 +0400 Subject: [PATCH 1/7] introducing new integer types in SYSTEM module. -- noch. Former-commit-id: 747943b0084c5db13167555d0e1bf117e0665dae --- src/lib/system/darwin/clang/x86_64/SYSTEM.h | 5 + src/lib/system/freebsd/clang/x86_64/SYSTEM.h | 5 + .../system/linux/clang/armv6j_hardfp/SYSTEM.h | 5 + src/lib/system/linux/clang/powerpc/SYSTEM.h | 5 + src/lib/system/linux/clang/x86/SYSTEM.h | 5 + src/lib/system/linux/clang/x86_64/SYSTEM.h | 5 + .../system/linux/gcc/armv6j_hardfp/SYSTEM.h | 5 + src/lib/system/linux/gcc/powerpc/SYSTEM.h | 5 + src/lib/system/linux/gcc/x86/SYSTEM.h | 5 + src/lib/system/linux/gcc/x86_64/SYSTEM.h | 5 + src/par/voc.par.clang.powerpc | 4 + src/par/voc.par.clang.x86_64 | 4 + src/par/voc.par.gcc.armv6j_hardfp | 4 + src/par/voc.par.gcc.powerpc | 4 + src/par/voc.par.gcc.x86 | 4 + src/par/voc.par.gcc.x86_64 | 4 + src/tools/vocparam/vocparam.c | 9 + src/voc/OPB.Mod | 75 +- src/voc/OPC.Mod | 18 +- src/voc/OPM.cmdln.Mod | 91 +- src/voc/OPP.Mod | 12 +- src/voc/OPT.Mod | 1292 +++++++++-------- src/voc/OPV.Mod | 17 +- src/voc/voc.Mod | 4 + voc.REMOVED.git-id | 2 +- vocstatic.linux.gcc.x86_64.REMOVED.git-id | 2 +- 26 files changed, 923 insertions(+), 673 deletions(-) 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 From cb9cf67876cce67c860e3e225c87846e6f4380d7 Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Wed, 11 Mar 2015 18:49:01 +0400 Subject: [PATCH 2/7] fixed forceNewSym/Verbose mistake, working on new types relations. -- noch Former-commit-id: a2e64ff15fe43bfd4721debe9a18de80bfd5876e --- src/voc/OPB.Mod | 34 +++++++++++++---------- src/voc/OPM.cmdln.Mod | 4 +-- src/voc/OPT.Mod | 10 +++++-- voc.REMOVED.git-id | 2 +- vocstatic.linux.gcc.x86_64.REMOVED.git-id | 2 +- 5 files changed, 31 insertions(+), 21 deletions(-) diff --git a/src/voc/OPB.Mod b/src/voc/OPB.Mod index 42db11b5..aae13fff 100644 --- a/src/voc/OPB.Mod +++ b/src/voc/OPB.Mod @@ -155,12 +155,14 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END EmptySet; PROCEDURE SetIntType(node: OPT.Node); - VAR v: LONGINT; + VAR v: LONGINT(*SYSTEM.INT64*); BEGIN v := node^.conval^.intval; - IF (OPM.MinSInt <= v) & (v <= OPM.MaxSInt) THEN node^.typ := OPT.sinttyp - ELSIF (OPM.MinInt <= v) & (v <= OPM.MaxInt) THEN node^.typ := OPT.inttyp + IF (OPM.MinSInt <= SYSTEM.VAL(LONGINT, v)) & (SYSTEM.VAL(LONGINT, v) <= OPM.MaxSInt) THEN node^.typ := OPT.sinttyp + ELSIF (OPM.MinInt <= SYSTEM.VAL(LONGINT, v)) & (SYSTEM.VAL(LONGINT, v) <= OPM.MaxInt) THEN node^.typ := OPT.inttyp ELSIF (OPM.MinLInt <= v) & (v <= OPM.MaxLInt) (*bootstrap or cross*) THEN node^.typ := OPT.linttyp + (*ELSIF (OPM.MinInt64 <= v) & (v <= OPM.MaxInt64) THEN + node^.typ := OPT.int64typ*) ELSE err(203); node^.typ := OPT.sinttyp; node^.conval^.intval := 1 END END SetIntType; @@ -510,7 +512,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSE res := eql END ELSE - OPM.WriteString("/* this should not happen. handle this. OPB.ConstCmp(); -- noch */"); OPM.WriteLn; + OPM.LogWStr("/* this should not happen. handle this. OPB.ConstCmp(); -- noch */"); OPM.LogWLn; END ; x^.typ := OPT.booltyp; RETURN res END ConstCmp; @@ -523,13 +525,13 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) IF g = String THEN CharToString(x) ELSE err(100); y^.typ := x^.typ; yval^ := xval^ END ; - | SInt: + | SInt(*, Int8*): IF g IN intSet THEN x^.typ := y^.typ ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval ELSIF g = LReal THEN x^.typ := OPT.lrltyp; xval^.realval := xval^.intval ELSE err(100); y^.typ := x^.typ; yval^ := xval^ END - | Int: + | Int(*, Int16, Int32, Int64*): IF g = SInt THEN y^.typ := OPT.inttyp ELSIF g IN intSet THEN x^.typ := y^.typ ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval @@ -685,7 +687,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSE xval^.intval := BoolToInt(ConstCmp() # lss) END ELSE - OPM.WriteString("/* this should not happen. handle this. OPB.ConstOp(); -- noch */ "); OPM.WriteLn; + OPM.LogWStr("this should not happen. handle this. OPB.ConstOp(); -- noch "); OPM.LogWLn; END END ConstOp; @@ -760,7 +762,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) CASE z^.typ^.form OF Char: IF z^.class = Nconst THEN CharToString(z) ELSE err(100) END - | SInt: + | SInt(*, Int8*): IF g IN intSet + realSet THEN Convert(z, y^.typ) ELSE err(100) END @@ -769,7 +771,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSIF g IN intSet + realSet THEN Convert(z, y^.typ) ELSE err(100) END - | LInt: + | LInt(*, Int16, Int32, Int64*): IF g IN intSet THEN Convert(y, z^.typ) ELSIF g IN realSet THEN Convert(z, y^.typ) ELSE err(100) @@ -864,7 +866,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSIF f # Undef THEN err(94); z^.typ := OPT.undftyp END | plus: - IF ~(f IN {Undef, SInt..Set}) THEN err(105); typ := OPT.undftyp END ; + IF ~(f IN {Undef, SInt..Set, Int8..Int64}) THEN err(105); typ := OPT.undftyp END ; do := TRUE; IF f IN intSet THEN IF (z^.class = Nconst) & (z^.conval^.intval = 0) THEN do := FALSE; z := y END ; @@ -872,7 +874,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) END ; IF do THEN NewOp(op, typ, z, y) END | minus: - IF ~(f IN {Undef, SInt..Set}) THEN err(106); typ := OPT.undftyp END ; + IF ~(f IN {Undef, SInt..Set, Int8..Int64}) THEN err(106); typ := OPT.undftyp END ; IF ~(f IN intSet) OR (y^.class # Nconst) OR (y^.conval^.intval # 0) THEN NewOp(op, typ, z, y) END | or: IF f = Bool THEN @@ -886,17 +888,19 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSIF f # Undef THEN err(95); z^.typ := OPT.undftyp END | eql, neq: - IF (f IN {Undef..Set, NilTyp, Pointer, ProcTyp}) OR strings(z, y) THEN typ := OPT.booltyp + IF (f IN {Undef..Set, NilTyp, Pointer, ProcTyp, Int8..Int64}) OR strings(z, y) THEN typ := OPT.booltyp ELSE err(107); typ := OPT.undftyp END ; NewOp(op, typ, z, y) | lss, leq, gtr, geq: - IF (f IN {Undef, Char..LReal}) OR strings(z, y) THEN typ := OPT.booltyp - ELSE err(108); typ := OPT.undftyp + IF (f IN {Undef, Char..LReal, Int8..Int64}) OR strings(z, y) THEN typ := OPT.booltyp + ELSE + OPM.LogWStr("ELSE in Op()"); OPM.LogWLn; + err(108); typ := OPT.undftyp END ; NewOp(op, typ, z, y) ELSE - OPM.WriteString(" /* OPB.Op(), not handled case possibility; -- noch */ "); OPM.WriteLn; + OPM.LogWStr(" OPB.Op(), not handled case possibility; -- noch"); OPM.LogWLn; END END ; x := z diff --git a/src/voc/OPM.cmdln.Mod b/src/voc/OPM.cmdln.Mod index 20bb6819..5326db35 100644 --- a/src/voc/OPM.cmdln.Mod +++ b/src/voc/OPM.cmdln.Mod @@ -235,7 +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; + IF verbose IN glbopt THEN Verbose := TRUE ELSE Verbose := 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; @@ -256,7 +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; + IF verbose IN glbopt THEN Verbose := TRUE ELSE Verbose := FALSE END; END InitOptions; PROCEDURE Init*(VAR done: BOOLEAN; VAR mname : ARRAY OF CHAR); (* get the source for one translation *) diff --git a/src/voc/OPT.Mod b/src/voc/OPT.Mod index ab08dfcd..ddb93cfc 100644 --- a/src/voc/OPT.Mod +++ b/src/voc/OPT.Mod @@ -1000,13 +1000,19 @@ WHILE ref < impCtxt.nofr DO i := 1; WHILE i < maxImps DO expCtxt.locmno[i] := -1; INC(i) END ; OutObj(topScope^.right); ext := sfpresent & symExtended; new := ~sfpresent OR symNew; - IF OPM.forceNewSym THEN new := TRUE END; (* for bootstrapping -- noch *) + IF OPM.forceNewSym THEN + new := TRUE; + OPM.LogWStr("forceNewSym = TRUE"); OPM.LogWLn; + END; (* for bootstrapping -- noch *) IF OPM.noerr & sfpresent & (impCtxt.reffp # expCtxt.reffp) THEN new := TRUE; IF ~extsf THEN err(155) END END ; newsf := FALSE; symNew := FALSE; (* because of call to FPrintErr from OPL *) - IF ~OPM.noerr OR findpc THEN OPM.DeleteNewSym END + IF ~OPM.noerr OR findpc THEN + OPM.DeleteNewSym; + OPM.LogWStr("DeleteNewSym called"); OPM.LogWLn; + END (* OPM.RegisterNewSym is called in OP2 after writing the object file *) END END diff --git a/voc.REMOVED.git-id b/voc.REMOVED.git-id index 34a6b129..fd98fc4b 100644 --- a/voc.REMOVED.git-id +++ b/voc.REMOVED.git-id @@ -1 +1 @@ -ec06062804e7d3c08aa622ae3ee778f2f4003ae0 \ No newline at end of file +bb64d7eff3dd625c80249c41cfb769e408355149 \ 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 34a6b129..fd98fc4b 100644 --- a/vocstatic.linux.gcc.x86_64.REMOVED.git-id +++ b/vocstatic.linux.gcc.x86_64.REMOVED.git-id @@ -1 +1 @@ -ec06062804e7d3c08aa622ae3ee778f2f4003ae0 \ No newline at end of file +bb64d7eff3dd625c80249c41cfb769e408355149 \ No newline at end of file From 412a03787c87e217a68106bf33653519157b28cf Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Wed, 11 Mar 2015 18:53:26 +0400 Subject: [PATCH 3/7] OPT cleanup. Former-commit-id: d3b0c0352af1985bd23cce5e3b02475f75ae6f6d --- src/voc/OPT.Mod | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/voc/OPT.Mod b/src/voc/OPT.Mod index ddb93cfc..4f7d2a05 100644 --- a/src/voc/OPT.Mod +++ b/src/voc/OPT.Mod @@ -1001,17 +1001,15 @@ WHILE ref < impCtxt.nofr DO OutObj(topScope^.right); ext := sfpresent & symExtended; new := ~sfpresent OR symNew; IF OPM.forceNewSym THEN - new := TRUE; - OPM.LogWStr("forceNewSym = TRUE"); OPM.LogWLn; - END; (* for bootstrapping -- noch *) + new := TRUE + END; (* for bootstrapping -- noch *) IF OPM.noerr & sfpresent & (impCtxt.reffp # expCtxt.reffp) THEN new := TRUE; IF ~extsf THEN err(155) END END ; newsf := FALSE; symNew := FALSE; (* because of call to FPrintErr from OPL *) IF ~OPM.noerr OR findpc THEN - OPM.DeleteNewSym; - OPM.LogWStr("DeleteNewSym called"); OPM.LogWLn; + OPM.DeleteNewSym END (* OPM.RegisterNewSym is called in OP2 after writing the object file *) END From d76a806cbbc274e11838953297867260b6688eee Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Wed, 11 Mar 2015 19:05:45 +0400 Subject: [PATCH 4/7] small addition in system functions Former-commit-id: fe36147392fb1c4cf3c2235a229973c5787a2982 --- src/voc/OPB.Mod | 18 +++++++++++------- voc.REMOVED.git-id | 2 +- vocstatic.linux.gcc.x86_64.REMOVED.git-id | 2 +- 3 files changed, 13 insertions(+), 9 deletions(-) diff --git a/src/voc/OPB.Mod b/src/voc/OPB.Mod index aae13fff..4f482e35 100644 --- a/src/voc/OPB.Mod +++ b/src/voc/OPB.Mod @@ -525,13 +525,13 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) IF g = String THEN CharToString(x) ELSE err(100); y^.typ := x^.typ; yval^ := xval^ END ; - | SInt(*, Int8*): + | SInt, Int8: IF g IN intSet THEN x^.typ := y^.typ ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval ELSIF g = LReal THEN x^.typ := OPT.lrltyp; xval^.realval := xval^.intval ELSE err(100); y^.typ := x^.typ; yval^ := xval^ END - | Int(*, Int16, Int32, Int64*): + | Int, Int16, Int32, Int64: IF g = SInt THEN y^.typ := OPT.inttyp ELSIF g IN intSet THEN x^.typ := y^.typ ELSIF g = Real THEN x^.typ := OPT.realtyp; xval^.realval := xval^.intval @@ -762,7 +762,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) CASE z^.typ^.form OF Char: IF z^.class = Nconst THEN CharToString(z) ELSE err(100) END - | SInt(*, Int8*): + | SInt, Int8: IF g IN intSet + realSet THEN Convert(z, y^.typ) ELSE err(100) END @@ -771,7 +771,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSIF g IN intSet + realSet THEN Convert(z, y^.typ) ELSE err(100) END - | LInt(*, Int16, Int32, Int64*): + | LInt, Int16, Int32, Int64: IF g IN intSet THEN Convert(y, z^.typ) ELSIF g IN realSet THEN Convert(z, y^.typ) ELSE err(100) @@ -895,7 +895,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) | lss, leq, gtr, geq: IF (f IN {Undef, Char..LReal, Int8..Int64}) OR strings(z, y) THEN typ := OPT.booltyp ELSE - OPM.LogWStr("ELSE in Op()"); OPM.LogWLn; + OPM.LogWLn; OPM.LogWStr("ELSE in Op()"); OPM.LogWLn; err(108); typ := OPT.undftyp END ; NewOp(op, typ, z, y) @@ -991,7 +991,11 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) | Int: IF ~(g IN {SInt, Int}) THEN err(113) END | LInt: - IF ~(g IN intSet) THEN err(113) END + IF OPM.LIntSize = 4 THEN + IF ~(g IN {SInt, Int, LInt, Int8, Int16, Int32}) THEN err(113) END + ELSE (* assume OPM.LIntSize = 8 *) + IF ~(g IN {SInt, Int, LInt, Int8, Int16, Int32, Int64}) THEN err(113) END + END; | Real: IF ~(g IN {SInt..Real}) THEN err(113) END | LReal: @@ -1138,7 +1142,7 @@ avoid unnecessary intermediate variables in voc END | chrfn: (*CHR*) IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126) - ELSIF f IN {Undef, SInt..LInt} THEN Convert(x, OPT.chartyp) + ELSIF f IN {Undef, SInt..LInt, Int8..Int64} THEN Convert(x, OPT.chartyp) ELSE err(111); x^.typ := OPT.chartyp END | shortfn: (*SHORT*) diff --git a/voc.REMOVED.git-id b/voc.REMOVED.git-id index fd98fc4b..f8e5a954 100644 --- a/voc.REMOVED.git-id +++ b/voc.REMOVED.git-id @@ -1 +1 @@ -bb64d7eff3dd625c80249c41cfb769e408355149 \ No newline at end of file +c40c89b190a3039cd0942a22f6c10e6eceba9ef7 \ 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 fd98fc4b..f8e5a954 100644 --- a/vocstatic.linux.gcc.x86_64.REMOVED.git-id +++ b/vocstatic.linux.gcc.x86_64.REMOVED.git-id @@ -1 +1 @@ -bb64d7eff3dd625c80249c41cfb769e408355149 \ No newline at end of file +c40c89b190a3039cd0942a22f6c10e6eceba9ef7 \ No newline at end of file From 5c9ef62469ebec0d0ad4fae9630f7fdb6e7e3eaf Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Wed, 11 Mar 2015 20:26:05 +0400 Subject: [PATCH 5/7] updated OPV Convert to support 64bit type. -- noch Former-commit-id: fb960f552f1298a5f9047c89bfa23cfcff4a597c --- src/voc/OPB.Mod | 6 +++++- src/voc/OPC.Mod | 4 ++++ src/voc/OPP.Mod | 4 ++++ src/voc/OPT.Mod | 4 ++++ src/voc/OPV.Mod | 7 +++++++ voc.REMOVED.git-id | 2 +- vocstatic.linux.gcc.x86_64.REMOVED.git-id | 2 +- 7 files changed, 26 insertions(+), 3 deletions(-) diff --git a/src/voc/OPB.Mod b/src/voc/OPB.Mod index 4f482e35..fb706845 100644 --- a/src/voc/OPB.Mod +++ b/src/voc/OPB.Mod @@ -20,6 +20,10 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) (* Structure forms *) Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; + (*Int8 = 7; Int16 = 8; Int32 = 9; Int64 = 10; + Real = 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 = 16; Int16 = 17; Int32 = 18; Int64 = 19; @@ -161,7 +165,7 @@ MODULE OPB; (* RC 6.3.89 / 21.2.94 *) (* object model 17.1.93 *) ELSIF (OPM.MinInt <= SYSTEM.VAL(LONGINT, v)) & (SYSTEM.VAL(LONGINT, v) <= OPM.MaxInt) THEN node^.typ := OPT.inttyp ELSIF (OPM.MinLInt <= v) & (v <= OPM.MaxLInt) (*bootstrap or cross*) THEN node^.typ := OPT.linttyp - (*ELSIF (OPM.MinInt64 <= v) & (v <= OPM.MaxInt64) THEN + (*ELSIF (OPM.MinInt64) <= v) & (v <= OPM.MaxInt64) THEN node^.typ := OPT.int64typ*) ELSE err(203); node^.typ := OPT.sinttyp; node^.conval^.intval := 1 END diff --git a/src/voc/OPC.Mod b/src/voc/OPC.Mod index 4be53f40..0bfc8e48 100644 --- a/src/voc/OPC.Mod +++ b/src/voc/OPC.Mod @@ -13,6 +13,10 @@ MODULE OPC; (* copyright (c) J. Templ 12.7.95 / 3.7.96 *) (* structure forms *) Byte = 1; Bool = 2; Char = 3; 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; Pointer = 13; ProcTyp = 14; Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; diff --git a/src/voc/OPP.Mod b/src/voc/OPP.Mod index 4b33aaca..3348a9af 100644 --- a/src/voc/OPP.Mod +++ b/src/voc/OPP.Mod @@ -29,6 +29,10 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *) (* Structure forms *) Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; + (*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 = 16; Int16 = 17; Int32 = 18; Int64 = 19; diff --git a/src/voc/OPT.Mod b/src/voc/OPT.Mod index 4f7d2a05..2239dce0 100644 --- a/src/voc/OPT.Mod +++ b/src/voc/OPT.Mod @@ -83,6 +83,10 @@ 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; +(*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 = 16; Int16 = 17; Int32 = 18; Int64 = 19; diff --git a/src/voc/OPV.Mod b/src/voc/OPV.Mod index 63b91762..e16b35b6 100644 --- a/src/voc/OPV.Mod +++ b/src/voc/OPV.Mod @@ -24,6 +24,10 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 (* structure forms *) Byte = 1; Bool = 2; Char = 3; 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; Pointer = 13; ProcTyp = 14; Int8 = 16; Int16 = 17; Int32 = 18; Int64 = 19; Comp = (*15*)20; @@ -343,6 +347,9 @@ MODULE OPV; (* J. Templ 16.2.95 / 3.7.96 ELSIF form = LInt THEN IF from < LInt THEN OPM.WriteString("(LONGINT)") END ; Entier(n, 9) + ELSIF form = Int64 THEN + IF (from >= SInt) & (from <= LInt) OR (from >= Int8) & (from < Int64) THEN OPM.WriteString("(SYSTEM_INT64)") END; + Entier(n, 9); ELSIF form = Int THEN IF from < Int THEN OPM.WriteString("(int)"); expr(n, 9) ELSE diff --git a/voc.REMOVED.git-id b/voc.REMOVED.git-id index f8e5a954..b1072231 100644 --- a/voc.REMOVED.git-id +++ b/voc.REMOVED.git-id @@ -1 +1 @@ -c40c89b190a3039cd0942a22f6c10e6eceba9ef7 \ No newline at end of file +d2c8d82b7f397b66ebf6a08a17c3a4f294942403 \ 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 f8e5a954..b1072231 100644 --- a/vocstatic.linux.gcc.x86_64.REMOVED.git-id +++ b/vocstatic.linux.gcc.x86_64.REMOVED.git-id @@ -1 +1 @@ -c40c89b190a3039cd0942a22f6c10e6eceba9ef7 \ No newline at end of file +d2c8d82b7f397b66ebf6a08a17c3a4f294942403 \ No newline at end of file From d0cfd06289d841eb2ee4eda4e9b2afa2c1a31864 Mon Sep 17 00:00:00 2001 From: norayr Date: Thu, 12 Mar 2015 21:39:13 +0400 Subject: [PATCH 6/7] on line 605 of OPT.Mod typ := impCtxt.ref[-tag] read let's say, 19, i. e. int64 typ, but because in procedure Close set to NIL everything upper than FirstRef, which is 16, that's why obj.typ was not set in InStruct, which caused crash later. for now fixed by starting to NIL array from Comp + 1, not from FirstRef. changing FirstRef causes crashes, which I did not investigate yet. -- noch Former-commit-id: 42ecf2464c39d8949d0296eb3532418b6da92fb1 --- src/voc/OPT.Mod | 2 +- voc.REMOVED.git-id | 2 +- vocstatic.linux.gcc.x86_64.REMOVED.git-id | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/voc/OPT.Mod b/src/voc/OPT.Mod index 2239dce0..2270a143 100644 --- a/src/voc/OPT.Mod +++ b/src/voc/OPT.Mod @@ -200,7 +200,7 @@ 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 +i := (*FirstRef*)Comp + 1; WHILE i < maxStruct DO impCtxt.ref[i] := NIL; impCtxt.old[i] := NIL; INC(i) END END Close; PROCEDURE FindImport*(mod: Object; VAR res: Object); diff --git a/voc.REMOVED.git-id b/voc.REMOVED.git-id index b1072231..27323f58 100644 --- a/voc.REMOVED.git-id +++ b/voc.REMOVED.git-id @@ -1 +1 @@ -d2c8d82b7f397b66ebf6a08a17c3a4f294942403 \ No newline at end of file +8b5292ff2d9cf79496998d1d70418ee752189589 \ 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 b1072231..27323f58 100644 --- a/vocstatic.linux.gcc.x86_64.REMOVED.git-id +++ b/vocstatic.linux.gcc.x86_64.REMOVED.git-id @@ -1 +1 @@ -d2c8d82b7f397b66ebf6a08a17c3a4f294942403 \ No newline at end of file +8b5292ff2d9cf79496998d1d70418ee752189589 \ No newline at end of file From c36bb99593a2fd2014616a761fe6340948e6d784 Mon Sep 17 00:00:00 2001 From: norayr Date: Mon, 16 Mar 2015 17:20:36 +0400 Subject: [PATCH 7/7] updated x86 bootstrap binary. -- noch Former-commit-id: aa7a4d56aa8d81960b9f0fe9c8550a562162da91 --- vocstatic.linux.gcc.x86.REMOVED.git-id | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vocstatic.linux.gcc.x86.REMOVED.git-id b/vocstatic.linux.gcc.x86.REMOVED.git-id index ffe4fb7a..ac3437c7 100644 --- a/vocstatic.linux.gcc.x86.REMOVED.git-id +++ b/vocstatic.linux.gcc.x86.REMOVED.git-id @@ -1 +1 @@ -4bacfbffebb82fe3863b5e4a6460310b75d6c19c \ No newline at end of file +a2db668d18b01af6e9d7d814ca80d1ec69a1dac0 \ No newline at end of file