From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1499) id B75D73858D1E; Wed, 9 Nov 2022 14:05:29 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org B75D73858D1E DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1668002729; bh=klE/qvCKviKN8QeNz+dfGW2HnRKK47CMWn6pLKLP0F8=; h=From:To:Subject:Date:From; b=n9G8D4O7qZcl+QiahN2S9DLRTtOPACxfpRlOLVBNl7Ged0gmDVkPknmh63OCdFZpo cRDAwTIDNiCOA0GE6TBzMeBiBQshCW7QV7QL85DHBHFteCwroVTmP1V1qi4Ow9HAM4 g/B9a37RefjX3QGdJhpXBHIGe15mZI1enZCdrF+k= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Gaius Mulley To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/modula-2] Bugfix to catch HIGH. Bugfix to check relational expressions. X-Act-Checkin: gcc X-Git-Author: Gaius Mulley X-Git-Refname: refs/heads/devel/modula-2 X-Git-Oldrev: 63edc9963c41be8026fd3a2eebd36ce3417af1b1 X-Git-Newrev: 0fea4cded352906fc6843696b64e8cf482babaec Message-Id: <20221109140529.B75D73858D1E@sourceware.org> Date: Wed, 9 Nov 2022 14:05:29 +0000 (GMT) List-Id: https://gcc.gnu.org/g:0fea4cded352906fc6843696b64e8cf482babaec commit 0fea4cded352906fc6843696b64e8cf482babaec Author: Gaius Mulley Date: Wed Nov 9 14:05:00 2022 +0000 Bugfix to catch HIGH. Bugfix to check relational expressions. These changes catch WHILE i < HIGH DO and also WHILE i < c DO where i is INTEGER and C is CARDINAL. Add new expression comparison matrix in M2Base.mod. Also add appropriate casts in testsuite and libraries. gcc/m2/ChangeLog: * gm2-compiler/M2Base.def (IsComparisonCompatible): New procedure function. * gm2-compiler/M2Base.mod (IsComparisonCompatible): New procedure function. Introduce new compatible array for relop checking. * gm2-compiler/M2GCCDeclare.mod (TryDeclareConstructor): Skip declaration if symbol is NulSym. * gm2-compiler/M2Quads.mod (M2MetaError): Import list inserted identifier MetaErrorsT1. (BuildRelOp) add comparison compatible check. * gm2-compiler/M2Range.def (InitTypesExpressionCheck) Add strict and isin parameters. * gm2-compiler/M2Range.mod (InitTypesExpressionCheck) Add strict and isin parameters. * gm2-compiler/SymbolTable.mod (GetConstLitType): Disable ability to return LongInt, LongCard instead of ZType. * gm2-libs/FIO.mod (ReadChar): Cast to integer to overcome strictness of new checks. * gm2-libs/FormatStrings.mod: Add relop casting. gcc/testsuite/gm2/ChangeLog: * testsuite/gm2/extensions/run/pass/align3.mod: Add relop casting. * testsuite/gm2/extensions/run/pass/align4.mod: Add relop casting. * testsuite/gm2/extensions/run/pass/align5.mod: Add relop casting. * testsuite/gm2/extensions/run/pass/align6.mod: Add relop casting. * testsuite/gm2/extensions/run/pass/align7.mod: Add relop casting. * testsuite/gm2/extensions/run/pass/record.mod: Add relop casting. * testsuite/gm2/iso/run/pass/testgeneric.mod: Add relop casting. * testsuite/gm2/iso/run/pass/testsystem.mod: Add relop casting. * testsuite/gm2/pim/run/pass/EndFor.mod: Add relop casting. * testsuite/gm2/pim/run/pass/EnumTest.mod: Add relop casting. * testsuite/gm2/pim/run/pass/TestLong2.mod: Add relop casting. * testsuite/gm2/pimlib/base/run/pass/FIO.mod: Add relop casting. * testsuite/gm2/projects/iso/run/pass/halma/halma.mod: Add relop casting. Signed-off-by: Gaius Mulley Diff: --- gcc/m2/gm2-compiler/M2Base.def | 10 + gcc/m2/gm2-compiler/M2Base.mod | 127 +++++++++++-- gcc/m2/gm2-compiler/M2Check.def | 3 +- gcc/m2/gm2-compiler/M2Check.mod | 62 +++++- gcc/m2/gm2-compiler/M2GCCDeclare.mod | 25 +-- gcc/m2/gm2-compiler/M2Quads.mod | 104 +++++----- gcc/m2/gm2-compiler/M2Range.def | 3 +- gcc/m2/gm2-compiler/M2Range.mod | 210 ++++++++++----------- gcc/m2/gm2-compiler/SymbolTable.mod | 2 + gcc/m2/gm2-libs/FIO.mod | 20 +- gcc/m2/gm2-libs/FormatStrings.mod | 2 +- gcc/testsuite/gm2/extensions/run/pass/align3.mod | 6 +- gcc/testsuite/gm2/extensions/run/pass/align4.mod | 4 +- gcc/testsuite/gm2/extensions/run/pass/align5.mod | 4 +- gcc/testsuite/gm2/extensions/run/pass/align6.mod | 4 +- gcc/testsuite/gm2/extensions/run/pass/align7.mod | 4 +- gcc/testsuite/gm2/extensions/run/pass/record.mod | 3 +- gcc/testsuite/gm2/iso/run/pass/testgeneric.mod | 4 +- gcc/testsuite/gm2/iso/run/pass/testsystem.mod | 4 +- gcc/testsuite/gm2/pim/run/pass/EndFor.mod | 2 +- gcc/testsuite/gm2/pim/run/pass/EnumTest.mod | 6 +- gcc/testsuite/gm2/pim/run/pass/TestLong2.mod | 6 +- gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod | 8 +- .../gm2/projects/iso/run/pass/halma/halma.mod | 8 +- 24 files changed, 391 insertions(+), 240 deletions(-) diff --git a/gcc/m2/gm2-compiler/M2Base.def b/gcc/m2/gm2-compiler/M2Base.def index efcc360413e..abe4036d4cd 100644 --- a/gcc/m2/gm2-compiler/M2Base.def +++ b/gcc/m2/gm2-compiler/M2Base.def @@ -71,6 +71,7 @@ EXPORT QUALIFIED Nil, (* Base constants *) IsAssignmentCompatible, IsExpressionCompatible, IsParameterCompatible, + IsComparisonCompatible, IsValidParameter, AssignmentRequiresWarning, IsMathType, @@ -286,6 +287,15 @@ PROCEDURE IsExpressionCompatible (t1, t2: CARDINAL) : BOOLEAN ; PROCEDURE IsParameterCompatible (t1, t2: CARDINAL) : BOOLEAN ; +(* + IsComparisonCompatible - returns TRUE if t1 and t2 are comparison + compatible. PIM allows INTEGER and ADDRESS within + expressions but we warn against their comparison. +*) + +PROCEDURE IsComparisonCompatible (t1, t2: CARDINAL) : BOOLEAN ; + + (* IsValidParameter - returns TRUE if an, actual, parameter can be passed to the, formal, parameter. This differs from diff --git a/gcc/m2/gm2-compiler/M2Base.mod b/gcc/m2/gm2-compiler/M2Base.mod index 7e7dd01724f..88195f42bf4 100644 --- a/gcc/m2/gm2-compiler/M2Base.mod +++ b/gcc/m2/gm2-compiler/M2Base.mod @@ -117,7 +117,7 @@ FROM m2decl IMPORT BuildIntegerConstant ; TYPE - Compatability = (expression, assignment, parameter) ; + Compatability = (expression, assignment, parameter, comparison) ; MetaType = (const, word, byte, address, chr, normint, shortint, longint, normcard, shortcard, longcard, @@ -141,6 +141,7 @@ TYPE CompatibilityArray = ARRAY MetaType, MetaType OF Compatible ; VAR + Comp, Expr, Ass : CompatibilityArray ; Ord, @@ -1132,7 +1133,8 @@ BEGIN expression: MetaError2('{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} in an expression, hint one of the expressions should be converted', t1, t2) | assignment: MetaError2('{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} during an assignment, hint maybe the expression should be converted', t1, t2) | - parameter : MetaError2('{%1W:} type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} {%2as}}}, hint the actual parameter {%2a} should be converted', t1, t2) + parameter : MetaError2('{%1W:} type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} {%2as}}}, hint the actual parameter {%2a} should be converted', t1, t2) | + comparison: MetaError2('{%1W:} type incompatibility found {%1as:{%2as:between types {%1as} {%2as}}} in a relational expression, hint one of the expressions should be converted', t1, t2) ELSE END @@ -1149,7 +1151,8 @@ BEGIN expression: MetaError2('type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} in an expression, hint one of the expressions should be converted', t1, t2) | assignment: MetaError2('type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} during an assignment, hint maybe the expression should be converted', t1, t2) | - parameter : MetaError2('type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} and {%2as}}}, hint the actual parameter should be converted', t1, t2) + parameter : MetaError2('type incompatibility found when passing a parameter {%1as:{%2as:between formal parameter and actual parameter types {%1as} and {%2as}}}, hint the actual parameter should be converted', t1, t2) | + comparison: MetaError2('type incompatibility found {%1as:{%2as:between types {%1as} and {%2as}}} in a relational expression, hint one of the expressions should be converted', t1, t2) ELSE END @@ -1165,7 +1168,7 @@ VAR s: String ; r: Compatible ; BEGIN - r := IsCompatible(t1, t2, kind) ; + r := IsCompatible (t1, t2, kind) ; IF (r#first) AND (r#second) THEN IF (r=warnfirst) OR (r=warnsecond) @@ -1428,10 +1431,11 @@ BEGIN expression: RETURN( Expr [mt1, mt2] ) | assignment: RETURN( Ass [mt1, mt2] ) | - parameter : RETURN( Ass [mt1, mt2] ) + parameter : RETURN( Ass [mt1, mt2] ) | + comparison: RETURN( Comp [mt1, mt2] ) ELSE - InternalError ('unexpected Compatibility') + InternalError ('unexpected compatibility') END END END IsBaseCompatible ; @@ -1481,17 +1485,17 @@ END CannotCheckTypeInPass3 ; PROCEDURE IsCompatible (t1, t2: CARDINAL; kind: Compatability) : Compatible ; BEGIN - t1 := SkipType(t1) ; - t2 := SkipType(t2) ; + t1 := SkipType (t1) ; + t2 := SkipType (t2) ; IF t1 = t2 THEN (* same types are always compatible. *) RETURN first - ELSIF IsPassCodeGeneration() + ELSIF IsPassCodeGeneration () THEN - RETURN( AfterResolved(t1, t2, kind) ) + RETURN AfterResolved (t1, t2, kind) ELSE - RETURN( BeforeResolved(t1, t2, kind) ) + RETURN BeforeResolved (t1, t2, kind) END END IsCompatible ; @@ -1938,6 +1942,19 @@ BEGIN END IsParameterCompatible ; +(* + IsComparisonCompatible - returns TRUE if t1 and t2 are comparison compatible. +*) + +PROCEDURE IsComparisonCompatible (t1, t2: CARDINAL (* ; tokenNo: CARDINAL *) ) : BOOLEAN ; +BEGIN + RETURN( + (IsCompatible(t1, t2, comparison)=first) OR + (IsCompatible(t1, t2, comparison)=second) + ) +END IsComparisonCompatible ; + + (* MixMetaTypes - *) @@ -2454,7 +2471,7 @@ END InitArray ; PROCEDURE A (y: MetaType; a: ARRAY OF CHAR) ; BEGIN - InitArray(Ass, y, a) + InitArray (Ass, y, a) END A ; @@ -2464,10 +2481,20 @@ END A ; PROCEDURE E (y: MetaType; a: ARRAY OF CHAR) ; BEGIN - InitArray(Expr, y, a) + InitArray (Expr, y, a) END E ; +(* + C - initialize the comparision array +*) + +PROCEDURE C (y: MetaType; a: ARRAY OF CHAR) ; +BEGIN + InitArray (Comp, y, a) +END C ; + + (* InitCompatibilityMatrices - initializes the tables above. *) @@ -2633,6 +2660,80 @@ BEGIN E(rec , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F') ; E(array , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F') ; + (* Comparison compatibility *) + + + (* + 1 p w + + N W B A C I S L C S L P E R S L S O L R Z I I I I C C C C W W W R R R R S S S C S L C C C C C R A + u o y d h n h o a h o t n e h o e p o t t n n n n a a a a o o o e e e e e e e o h o o o o o t e r + l r t d a t o n r o n r u a o n t a c y y t t t t r r r r r r r a a a a t t t m o n m m m m y c r + S d e r r e r g d r g m l r g q p p 8 1 3 6 d d d d d d d l l l l 8 1 3 p r g p p p p p a + y e g t i i t c t r u e e 6 2 4 8 1 3 6 1 3 6 3 6 9 1 6 2 l t C l l l l e y + m s e i n n c a r e e 6 2 4 6 2 4 2 4 6 2 e C o e e e e + s r n t a a r e a 8 x o m x x x x + t l r d a l m p 3 6 9 1 + d l p l 2 4 6 2 + l e 8 + e x + x + ------------------------------------------------------------------------------------------------------------ + 2 + P + W + *) + + C(const , 'T T T T T T T T T T T T T T T T T T F F T T T T T T T T T T T T T T T T F F F F F F F F F F F F F') ; + C(word , '. T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(byte , '. . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(address , '. . . T F F F F F F F T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(chr , '. . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(normint , '. . . . . T F F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(shortint , '. . . . . . T F F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(longint , '. . . . . . . T F F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(normcard , '. . . . . . . . T F F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(shortcard , '. . . . . . . . . T F F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(longcard , '. . . . . . . . . . T F F F F F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(pointer , '. . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(enum , '. . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(real , '. . . . . . . . . . . . . T F F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(shortreal , '. . . . . . . . . . . . . . T F F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(longreal , '. . . . . . . . . . . . . . . T F F F 2 F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(set , '. . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(opaque , '. . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(loc , '. . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(rtype , '. . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F 1 1 1 1 F F F F F F F F F F F F F') ; + C(ztype , '. . . . . . . . . . . . . . . . . . . . T 1 1 1 1 1 1 1 1 1 1 1 F F F F F F F F F F F F F F F F F') ; + C(int8 , '. . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(int16 , '. . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(int32 , '. . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(int64 , '. . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F F') ; + C(card8 , '. . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F F') ; + C(card16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F F') ; + C(card32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F F') ; + C(card64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F F F F F') ; + C(word16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F F') ; + C(word32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F F') ; + C(word64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F F F F F F F F F F F F F F F F F') ; + C(real32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F F') ; + C(real64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F F') ; + C(real96 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F F') ; + C(real128 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F F') ; + C(set8 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F F') ; + C(set16 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F F') ; + C(set32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F F F F F') ; + C(complex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F F T F F') ; + C(shortcomplex, '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F F T F F') ; + C(longcomplex , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F F T F F') ; + C(complex32 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F F T F F') ; + C(complex64 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F T F F') ; + C(complex96 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F T F F') ; + C(complex128 , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T T F F') ; + C(ctype , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . T F F') ; + C(rec , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F F') ; + C(array , '. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . F') ; + END InitCompatibilityMatrices ; diff --git a/gcc/m2/gm2-compiler/M2Check.def b/gcc/m2/gm2-compiler/M2Check.def index 30c3091a8d9..5222e32b079 100644 --- a/gcc/m2/gm2-compiler/M2Check.def +++ b/gcc/m2/gm2-compiler/M2Check.def @@ -60,7 +60,8 @@ PROCEDURE AssignmentTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR; *) PROCEDURE ExpressionTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR; - left, right: CARDINAL) : BOOLEAN ; + left, right: CARDINAL; + strict, isin: BOOLEAN) : BOOLEAN ; END M2Check. diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod index 9b8b36d81b2..a2ce7260586 100644 --- a/gcc/m2/gm2-compiler/M2Check.mod +++ b/gcc/m2/gm2-compiler/M2Check.mod @@ -33,7 +33,7 @@ IMPLEMENTATION MODULE M2Check ; *) FROM M2System IMPORT IsSystemType, IsGenericSystemType, IsSameSize, IsComplexN ; -FROM M2Base IMPORT IsParameterCompatible, IsAssignmentCompatible, IsExpressionCompatible, IsBaseType, IsMathType, ZType, CType, RType, IsComplexType ; +FROM M2Base IMPORT IsParameterCompatible, IsAssignmentCompatible, IsExpressionCompatible, IsComparisonCompatible, IsBaseType, IsMathType, ZType, CType, RType, IsComplexType ; FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, KillIndex, HighIndice, LowIndice, IncludeIndiceIntoIndex ; FROM M2Error IMPORT Error, InternalError, NewError, ErrorString, ChainError ; FROM M2MetaError IMPORT MetaErrorStringT2, MetaErrorStringT3, MetaErrorStringT4, MetaString2, MetaString3, MetaString4 ; @@ -82,6 +82,8 @@ TYPE procedure, nth : CARDINAL ; isvar : BOOLEAN ; + strict : BOOLEAN ; (* Comparison expression. *) + isin : BOOLEAN ; (* Expression created by IN? *) error : Error ; checkFunc : typeCheckFunction ; visited, @@ -390,8 +392,21 @@ BEGIN END | assignment: RETURN issueError (IsAssignmentCompatible (left, right), tinfo, left, right) | - expression: RETURN issueError (IsExpressionCompatible (left, right), - tinfo, left, right) + expression: IF tinfo^.isin + THEN + IF IsVar (right) OR IsConst (right) + THEN + right := GetSType (right) + END + END ; + IF tinfo^.strict + THEN + RETURN issueError (IsComparisonCompatible (left, right), + tinfo, left, right) + ELSE + RETURN issueError (IsExpressionCompatible (left, right), + tinfo, left, right) + END ELSE InternalError ('unexpected kind value') @@ -1393,6 +1408,8 @@ BEGIN tinfo^.resolved := InitIndex (1) ; tinfo^.unresolved := InitIndex (1) ; include (tinfo^.unresolved, des, expr, unknown) ; + tinfo^.strict := FALSE ; + tinfo^.isin := FALSE ; IF doCheck (tinfo) THEN deconstruct (tinfo) ; @@ -1434,6 +1451,8 @@ BEGIN tinfo^.visited := InitIndex (1) ; tinfo^.resolved := InitIndex (1) ; tinfo^.unresolved := InitIndex (1) ; + tinfo^.strict := FALSE ; + tinfo^.isin := FALSE ; include (tinfo^.unresolved, actual, formal, unknown) ; IF doCheck (tinfo) THEN @@ -1447,12 +1466,12 @@ END ParameterTypeCompatible ; (* - ExpressionTypeCompatible - returns TRUE if the expressions, left and right, - are expression compatible. + doExpressionTypeCompatible - *) -PROCEDURE ExpressionTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR; - left, right: CARDINAL) : BOOLEAN ; +PROCEDURE doExpressionTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR; + left, right: CARDINAL; + strict: BOOLEAN) : BOOLEAN ; VAR tinfo: tInfo ; BEGIN @@ -1472,6 +1491,8 @@ BEGIN tinfo^.visited := InitIndex (1) ; tinfo^.resolved := InitIndex (1) ; tinfo^.unresolved := InitIndex (1) ; + tinfo^.strict := strict ; + tinfo^.isin := FALSE ; include (tinfo^.unresolved, left, right, unknown) ; IF doCheck (tinfo) THEN @@ -1481,6 +1502,33 @@ BEGIN deconstruct (tinfo) ; RETURN FALSE END +END doExpressionTypeCompatible ; + + +(* + ExpressionTypeCompatible - returns TRUE if the expressions, left and right, + are expression compatible. +*) + +PROCEDURE ExpressionTypeCompatible (token: CARDINAL; format: ARRAY OF CHAR; + left, right: CARDINAL; + strict, isin: BOOLEAN) : BOOLEAN ; +BEGIN + IF (left#NulSym) AND (right#NulSym) + THEN + IF isin + THEN + IF IsConst (right) OR IsVar (right) + THEN + right := GetSType (right) + END ; + IF IsSet (right) + THEN + right := GetSType (right) + END + END + END ; + RETURN doExpressionTypeCompatible (token, format, left, right, strict) END ExpressionTypeCompatible ; diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod index 15614dcd428..81cffb6aae7 100644 --- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod +++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod @@ -1615,20 +1615,19 @@ END DeclareConstructor ; PROCEDURE TryDeclareConstructor (tokenno: CARDINAL; sym: CARDINAL) ; BEGIN - IF sym=NulSym + IF sym#NulSym THEN - InternalError ('trying to declare the NulSym') - END ; - IF IsConstructor(sym) AND (NOT GccKnowsAbout(sym)) - THEN - WalkConstructor(sym, TraverseDependants) ; - IF NOT IsElementInSet(ToBeSolvedByQuads, sym) + IF IsConstructor(sym) AND (NOT GccKnowsAbout(sym)) THEN - TryEvaluateValue(sym) ; - IF IsConstructorDependants(sym, IsFullyDeclared) + WalkConstructor(sym, TraverseDependants) ; + IF NOT IsElementInSet(ToBeSolvedByQuads, sym) THEN - PushValue(sym) ; - DeclareConstantFromTree(sym, PopConstructorTree(tokenno)) + TryEvaluateValue(sym) ; + IF IsConstructorDependants(sym, IsFullyDeclared) + THEN + PushValue(sym) ; + DeclareConstantFromTree(sym, PopConstructorTree(tokenno)) + END END END END @@ -3916,7 +3915,9 @@ BEGIN THEN printf0(' constant constructor set ') ; IncludeType(l, sym) - END ; + ELSE + IncludeType(l, sym) + END ELSIF IsConstructor(sym) THEN printf2('sym %d IsConstructor (non constant) (%a)', sym, n) ; diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 9f13d8359fa..72a350d4d35 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -34,6 +34,7 @@ FROM M2Scaffold IMPORT DeclareScaffold, mainFunction, initFunction, FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaError3, MetaErrors1, MetaErrors2, MetaErrors3, MetaErrorT0, MetaErrorT1, MetaErrorT2, + MetaErrorsT1, MetaErrorStringT0, MetaErrorStringT1, MetaErrorString1, MetaErrorString2, MetaErrorN1, MetaErrorN2, @@ -10728,7 +10729,7 @@ BEGIN n1, n2) ELSE (* this checks the types are compatible, not the data contents. *) - BuildRange(InitTypesAssignmentCheck(tokno, currentProc, actualVal)) + BuildRange (InitTypesAssignmentCheck (tokno, currentProc, actualVal)) END END CheckReturnType ; @@ -12240,19 +12241,9 @@ BEGIN ELSE OldPos := OperatorPos ; OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ; - (* - IF checkTypes - THEN - CheckExpressionCompatible (lefttype, righttype) ; - IF CannotCheckTypeInPass3 (left) OR CannotCheckTypeInPass3 (right) - THEN - BuildRange (InitTypesExpressionCheck (OperatorPos, left, right)) - END - END ; - *) IF checkTypes THEN - BuildRange (InitTypesExpressionCheck (OperatorPos, left, right)) + BuildRange (InitTypesExpressionCheck (OperatorPos, left, right, FALSE, FALSE)) END ; value := MakeTemporaryFromExpressions (OperatorPos, right, left, @@ -12536,29 +12527,37 @@ END BuildRelOpFromBoolean ; CheckVariableOrConstantOrProcedure - checks to make sure sym is a variable, constant or procedure. *) -PROCEDURE CheckVariableOrConstantOrProcedure (sym: CARDINAL) ; +PROCEDURE CheckVariableOrConstantOrProcedure (tokpos: CARDINAL; sym: CARDINAL) ; VAR type: CARDINAL ; BEGIN type := GetSType (sym) ; IF IsUnknown (sym) THEN - MetaError1 ('{%1EUad} has not been declared', sym) ; + MetaErrorT1 (tokpos, '{%1EUad} has not been declared', sym) ; UnknownReported (sym) + ELSIF IsPseudoSystemFunction (sym) OR IsPseudoBaseFunction (sym) + THEN + MetaErrorT1 (tokpos, + '{%1Ead} expected a variable, procedure, constant or expression, not an intrinsic procedure function', + sym) ELSIF (NOT IsConst(sym)) AND (NOT IsVar(sym)) AND (NOT IsProcedure(sym)) AND (NOT IsTemporary(sym)) AND (NOT MustNotCheckBounds) THEN - MetaErrors1 ('{%1Ead} expected a variable, procedure, constant or expression', - 'and it was declared as a {%1Dd}', sym) ; + MetaErrorsT1 (tokpos, + '{%1Ead} expected a variable, procedure, constant or expression', + 'and it was declared as a {%1Dd}', sym) ; ELSIF (type#NulSym) AND IsArray(type) THEN - MetaErrors1 ('{%1EU} not expecting an array variable as an operand for either comparison or binary operation', - 'it was declared as a {%1Dd}', sym) + MetaErrorsT1 (tokpos, + '{%1EU} not expecting an array variable as an operand for either comparison or binary operation', + 'it was declared as a {%1Dd}', sym) ELSIF IsConstString(sym) AND (GetStringLength(sym)>1) THEN - MetaError1 ('{%1EU} not expecting a string constant as an operand for either comparison or binary operation', - sym) + MetaErrorT1 (tokpos, + '{%1EU} not expecting a string constant as an operand for either comparison or binary operation', + sym) END END CheckVariableOrConstantOrProcedure ; @@ -12613,12 +12612,12 @@ END CheckInCompatible ; PROCEDURE BuildRelOp (optokpos: CARDINAL) ; VAR combinedTok, - tokpos1, - tokpos2 : CARDINAL ; - Op : Name ; + rightpos, + leftpos : CARDINAL ; + Op : Name ; t, - t1, t2, - e1, e2 : CARDINAL ; + rightType, leftType, + right, left : CARDINAL ; BEGIN IF CompilerDebugging THEN @@ -12640,45 +12639,38 @@ BEGIN THEN ConvertBooleanToVariable (OperandTtok (3), 3) END ; - PopTFtok (e1, t1, tokpos1) ; + PopTFtok (right, rightType, rightpos) ; PopT (Op) ; - PopTFtok (e2, t2, tokpos2) ; + PopTFtok (left, leftType, leftpos) ; - CheckVariableOrConstantOrProcedure (e1) ; - CheckVariableOrConstantOrProcedure (e2) ; + CheckVariableOrConstantOrProcedure (rightpos, right) ; + CheckVariableOrConstantOrProcedure (leftpos, left) ; - IF (Op = EqualTok) OR (Op = HashTok) OR (Op = LessGreaterTok) + IF (left#NulSym) AND (right#NulSym) THEN - CheckAssignmentCompatible (t1, t2) - ELSE - IF IsConstructor (e1) OR IsConstSet (e1) - THEN - (* ignore type checking for now *) - ELSE - t1 := CheckInCompatible (Op, t2, t1) ; - CheckExpressionCompatible (t1, t2) - END + (* BuildRange will check the expression later on once gcc knows about all data types. *) + BuildRange (InitTypesExpressionCheck (optokpos, left, right, TRUE, Op = InTok)) END ; - (* must dereference LeftValue operands *) - IF GetMode(e1) = LeftValue + (* Must dereference LeftValue operands. *) + IF GetMode(right) = LeftValue THEN - t := MakeTemporary (tokpos1, RightValue) ; - PutVar(t, GetSType(e1)) ; - CheckPointerThroughNil (tokpos1, e1) ; - doIndrX (tokpos1, t, e1) ; - e1 := t + t := MakeTemporary (rightpos, RightValue) ; + PutVar(t, GetSType(right)) ; + CheckPointerThroughNil (rightpos, right) ; + doIndrX (rightpos, t, right) ; + right := t END ; - IF GetMode(e2) = LeftValue + IF GetMode(left) = LeftValue THEN - t := MakeTemporary (tokpos2, RightValue) ; - PutVar (t, GetSType (e2)) ; - CheckPointerThroughNil (tokpos2, e2) ; - doIndrX (tokpos2, t, e2) ; - e2 := t + t := MakeTemporary (leftpos, RightValue) ; + PutVar (t, GetSType (left)) ; + CheckPointerThroughNil (leftpos, left) ; + doIndrX (leftpos, t, left) ; + left := t END ; - combinedTok := MakeVirtualTok (optokpos, tokpos2, tokpos1) ; - GenQuadO (combinedTok, MakeOp(Op), e2, e1, 0, FALSE) ; (* True Exit *) + combinedTok := MakeVirtualTok (optokpos, leftpos, rightpos) ; + GenQuadO (combinedTok, MakeOp(Op), left, right, 0, FALSE) ; (* True Exit *) GenQuadO (combinedTok, GotoOp, NulSym, NulSym, 0, FALSE) ; (* False Exit *) PushBool (NextQuad-2, NextQuad-1) END @@ -12704,8 +12696,8 @@ VAR t, f: CARDINAL ; BEGIN CheckBooleanId ; - PopBool(t, f) ; - PushBool(f, t) + PopBool (t, f) ; + PushBool (f, t) END BuildNot ; diff --git a/gcc/m2/gm2-compiler/M2Range.def b/gcc/m2/gm2-compiler/M2Range.def index f4e83c8fb05..d2bc4f62aea 100644 --- a/gcc/m2/gm2-compiler/M2Range.def +++ b/gcc/m2/gm2-compiler/M2Range.def @@ -304,7 +304,8 @@ PROCEDURE InitParameterRangeCheck (proc: CARDINAL; i: CARDINAL; are expression compatible. *) -PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ; +PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL; + strict, isin: BOOLEAN) : CARDINAL ; (* diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod index 408cc1d18f1..241c40057cc 100644 --- a/gcc/m2/gm2-compiler/M2Range.mod +++ b/gcc/m2/gm2-compiler/M2Range.mod @@ -126,12 +126,14 @@ TYPE exprLowestType: CARDINAL ; procedure : CARDINAL ; paramNo : CARDINAL ; - isLeftValue : BOOLEAN ; (* is des an LValue, - only used in pointernil *) + isLeftValue : BOOLEAN ; (* is des an LValue, + only used in pointernil *) dimension : CARDINAL ; caseList : CARDINAL ; tokenNo : CARDINAL ; - firstmention : BOOLEAN ; (* error message reported yet? *) + errorReported : BOOLEAN ; (* error message reported yet? *) + strict : BOOLEAN ; (* is it a comparison expression? *) + isin : BOOLEAN ; (* expression created by IN operator? *) END ; @@ -296,7 +298,7 @@ BEGIN dimension := 0 ; caseList := 0 ; tokenNo := 0 ; (* than pointernil *) - firstmention := TRUE + errorReported := FALSE END ; PutIndice(RangeIndex, r, p) END ; @@ -305,40 +307,30 @@ END InitRange ; (* - FirstMention - returns whether this is the first time this error has been - reported. + reportedError - returns whether this is the first time this error has been + reported. *) -PROCEDURE FirstMention (r: CARDINAL) : BOOLEAN ; +PROCEDURE reportedError (r: CARDINAL) : BOOLEAN ; VAR p: Range ; BEGIN - p := GetIndice(RangeIndex, r) ; - WITH p^ DO - IF firstmention - THEN - firstmention := FALSE ; - RETURN( TRUE ) - ELSE - RETURN( FALSE ) - END - END -END FirstMention ; + p := GetIndice (RangeIndex, r) ; + RETURN p^.errorReported +END reportedError ; (* - Mentioned - returns whether this error has been been reported. + setReported - assigns errorReported to TRUE. *) -PROCEDURE Mentioned (r: CARDINAL) : BOOLEAN ; +PROCEDURE setReported (r: CARDINAL) ; VAR p: Range ; BEGIN - p := GetIndice(RangeIndex, r) ; - WITH p^ DO - RETURN NOT firstmention - END -END Mentioned ; + p := GetIndice (RangeIndex, r) ; + p^.errorReported := TRUE +END setReported ; (* @@ -356,7 +348,9 @@ BEGIN expr := e ; desLowestType := GetLowestType (d) ; exprLowestType := GetLowestType (e) ; - tokenNo := tokno + tokenNo := tokno ; + strict := FALSE ; + isin := FALSE END ; RETURN p END PutRange ; @@ -393,12 +387,38 @@ BEGIN desLowestType := NulSym ; exprLowestType := NulSym ; isLeftValue := FALSE ; - tokenNo := chooseTokenPos (tokpos) + tokenNo := chooseTokenPos (tokpos) ; + strict := FALSE ; + isin := FALSE END ; - RETURN( p ) + RETURN p END PutRangeNoLow ; +(* + PutRangeExpr - initializes contents of, p. It + does not set lowest types as they may be + unknown at this point. +*) + +PROCEDURE PutRangeExpr (tokpos: CARDINAL; p: Range; t: TypeOfRange; + d, e: CARDINAL; strict, isin: BOOLEAN) : Range ; +BEGIN + WITH p^ DO + type := t ; + des := d ; + expr := e ; + desLowestType := NulSym ; + exprLowestType := NulSym ; + isLeftValue := FALSE ; + tokenNo := chooseTokenPos (tokpos) ; + END ; + p^.strict := strict ; + p^.isin := isin ; + RETURN p +END PutRangeExpr ; + + (* PutRangePointer - initializes contents of, p, to d, isLeft and their lowest types. @@ -416,9 +436,11 @@ BEGIN desLowestType := GetLowestType(GetType(d)) ; exprLowestType := NulSym ; isLeftValue := isLeft ; - tokenNo := tokpos + tokenNo := tokpos ; + strict := FALSE ; + isin := FALSE END ; - RETURN( p ) + RETURN p END PutRangePointer ; @@ -454,7 +476,9 @@ BEGIN desLowestType := GetLowestType(d) ; exprLowestType := NulSym ; isLeftValue := FALSE ; - tokenNo := chooseTokenPos (tokno) + tokenNo := chooseTokenPos (tokno) ; + strict := FALSE ; + isin := FALSE END ; RETURN( p ) END PutRangeUnary ; @@ -479,7 +503,9 @@ BEGIN procedure := proc ; paramNo := i ; isLeftValue := FALSE ; - tokenNo := GetTokenNo () + tokenNo := GetTokenNo () ; + strict := FALSE ; + isin := FALSE END ; RETURN p END PutRangeParam ; @@ -503,7 +529,9 @@ BEGIN desLowestType := GetLowestType(d) ; exprLowestType := GetLowestType(e) ; dimension := dim ; - tokenNo := GetTokenNo () + tokenNo := GetTokenNo () ; + strict := FALSE ; + isin := FALSE END ; RETURN p END PutRangeArraySubscript ; @@ -766,12 +794,12 @@ END InitParameterRangeCheck ; are expression compatible. *) -PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ; +PROCEDURE InitTypesExpressionCheck (tokno: CARDINAL; d, e: CARDINAL; strict, isin: BOOLEAN) : CARDINAL ; VAR r: CARDINAL ; BEGIN r := InitRange() ; - Assert (PutRangeNoLow (tokno, GetIndice (RangeIndex, r), typeexpr, d, e) # NIL) ; + Assert (PutRangeExpr (tokno, GetIndice (RangeIndex, r), typeexpr, d, e, strict, isin) # NIL) ; RETURN r END InitTypesExpressionCheck ; @@ -1033,7 +1061,7 @@ BEGIN IF TreeOverflow (max) THEN WriteString ("overflow detected in expr\n"); WriteLn ; - debug_tree (StringToChar(Mod2Gcc(expr), type, expr)); + debug_tree (StringToChar (Mod2Gcc (expr), type, expr)); END ; PushIntegerTree (StringToChar (Mod2Gcc (expr), type, expr)) ; PushIntegerTree (min) ; @@ -1107,22 +1135,22 @@ VAR p : Range ; min, max: Tree ; BEGIN - p := GetIndice(RangeIndex, r) ; + p := GetIndice (RangeIndex, r) ; WITH p^ DO - TryDeclareConstant(tokenno, expr) ; (* use quad tokenno, rather than the range tokenNo *) - IF desLowestType#NulSym + TryDeclareConstant (tokenno, expr) ; (* use quad tokenno, rather than the range tokenNo *) + IF desLowestType # NulSym THEN - IF GccKnowsAbout(expr) AND IsConst(expr) AND - GetMinMax(tokenno, desLowestType, min, max) + IF GccKnowsAbout (expr) AND IsConst (expr) AND + GetMinMax (tokenno, desLowestType, min, max) THEN - IF OutOfRange(tokenno, min, expr, max, desLowestType) + IF OutOfRange (tokenno, min, expr, max, desLowestType) THEN - MetaErrorT2(tokenNo, - 'attempting to assign a value {%2Wa} to a designator {%1a} which will exceed the range of type {%1tad}', - des, expr) ; - PutQuad(q, ErrorOp, NulSym, NulSym, r) + MetaErrorT2 (tokenNo, + 'attempting to assign a value {%2Wa} to a designator {%1a} which will exceed the range of type {%1tad}', + des, expr) ; + PutQuad (q, ErrorOp, NulSym, NulSym, r) ELSE - SubQuad(q) + SubQuad (q) END END END @@ -1559,23 +1587,24 @@ BEGIN exprType := GetType(expr) END ; - IF IsAssignmentCompatible(GetType(des), exprType) + IF IsAssignmentCompatible (GetType(des), exprType) THEN SubQuad(q) ELSE - IF FirstMention(r) + IF NOT reportedError (r) THEN - IF IsProcedure(des) + IF IsProcedure (des) THEN - MetaErrorsT2(tokenNo, - 'the return type {%1Etad} declared in procedure {%1Da}', - 'is incompatible with the returned expression {%2ad}}', - des, expr) ; + MetaErrorsT2 (tokenNo, + 'the return type {%1Etad} declared in procedure {%1Da}', + 'is incompatible with the returned expression {%2ad}}', + des, expr) ; ELSE - MetaErrorT3(tokenNo, - 'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%3ad:of type {%3ad}} are incompatible', - des, expr, exprType) + MetaErrorT3 (tokenNo, + 'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%3ad:of type {%3ad}} are incompatible', + des, expr, exprType) END ; + setReported (r) ; FlushErrors END END @@ -1593,17 +1622,6 @@ BEGIN procedure, formal, actual, paramNo, IsVarParam (procedure, paramNo)) THEN SubQuad(q) - ELSE - (* - IF FirstMention(r) - THEN - MetaErrorsT4(tokenNo, - '{%3EN} actual parameter {%2ad} is incompatible with the formal parameter {%1ad}', - '{%3EN} parameter in procedure {%4Da}', - formal, actual, paramNo, procedure) ; - (* FlushErrors *) - END - *) END END FoldTypeParam ; @@ -1612,25 +1630,17 @@ END FoldTypeParam ; FoldTypeExpr - *) -PROCEDURE FoldTypeExpr (q: CARDINAL; tokenNo: CARDINAL; left, right: CARDINAL; r: CARDINAL) ; +PROCEDURE FoldTypeExpr (q: CARDINAL; tokenNo: CARDINAL; left, right: CARDINAL; strict, isin: BOOLEAN; r: CARDINAL) ; BEGIN - IF NOT Mentioned (r) + IF (left # NulSym) AND (right # NulSym) AND (NOT reportedError (r)) THEN IF ExpressionTypeCompatible (tokenNo, 'expression of type {%1Etad} is incompatible with type {%2tad}', - left, right) - (* IsExpressionCompatible(GetType(des), GetType(expr)) *) + left, right, strict, isin) THEN - SubQuad(q) - ELSE - IF FirstMention (r) - THEN - MetaErrorT2 (tokenNo, - 'expression of type {%1Etad} is incompatible with type {%2tad}', - left, right) - END + SubQuad(q) ; + setReported (r) END - (* FlushErrors *) END END FoldTypeExpr ; @@ -1651,7 +1661,7 @@ BEGIN END ; IF NOT IsAssignmentCompatible(GetType(des), exprType) THEN - IF FirstMention(r) + IF NOT reportedError (r) THEN IF IsProcedure(des) THEN @@ -1663,7 +1673,8 @@ BEGIN MetaErrorT2(tokenNo, 'assignment designator {%1Ea} {%1ta:of type {%1ta}} {%1d:is a {%1d}} and expression {%2a} {%2tad:of type {%2tad}} are incompatible', des, expr) - END + END ; + setReported (r) END (* FlushErrors *) END @@ -1680,16 +1691,6 @@ BEGIN '{%4EN} type failure between actual {%3ad} and the formal {%2ad}', procedure, formal, actual, paramNo, IsVarParam (procedure, paramNo)) THEN - (* - IF FirstMention(r) - THEN - MetaErrorsT4(tokenNo, - '{%3EN} type failure between actual parameter {%2ad} and the formal parameter {%1ad}', - '{%3EN} parameter of procedure {%4Da} {%1a} has a type of {%1ad}', - formal, actual, paramNo, procedure) ; - (* FlushErrors *) - END - *) END END CodeTypeParam ; @@ -1698,22 +1699,15 @@ END CodeTypeParam ; CodeTypeExpr - *) -PROCEDURE CodeTypeExpr (tokenNo: CARDINAL; left, right: CARDINAL; r: CARDINAL) ; +PROCEDURE CodeTypeExpr (tokenNo: CARDINAL; left, right: CARDINAL; strict, isin: BOOLEAN; r: CARDINAL) ; BEGIN - IF NOT Mentioned (r) + IF NOT reportedError (r) THEN - IF NOT ExpressionTypeCompatible (tokenNo, - 'expression of type {%1Etad} is incompatible with type {%2tad}', - left, right) + IF ExpressionTypeCompatible (tokenNo, + 'expression of type {%1Etad} is incompatible with type {%2tad}', + left, right, strict, isin) THEN - (* IF NOT IsExpressionCompatible(GetType(des), GetType(expr)) *) - IF FirstMention(r) - THEN - MetaErrorT2 (tokenNo, - 'expression of type {%1Etad} is incompatible with type {%2tad}', - left, right) - (* FlushErrors *) - END + setReported (r) END END END CodeTypeExpr ; @@ -1740,7 +1734,7 @@ BEGIN typeassign: FoldTypeAssign(q, tokenNo, des, expr, r) | typeparam: FoldTypeParam(q, tokenNo, des, expr, procedure, paramNo) | - typeexpr: FoldTypeExpr(q, tokenNo, des, expr, r) + typeexpr: FoldTypeExpr(q, tokenNo, des, expr, strict, isin, r) ELSE InternalError ('not expecting to reach this point') @@ -1773,7 +1767,7 @@ BEGIN typeassign: CodeTypeAssign(tokenNo, des, expr, r) | typeparam: CodeTypeParam(tokenNo, des, expr, procedure, paramNo) | - typeexpr: CodeTypeExpr(tokenNo, des, expr, r) + typeexpr: CodeTypeExpr(tokenNo, des, expr, strict, isin, r) ELSE InternalError ('not expecting to reach this point') diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod index 920857a38b3..75522c4a57e 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.mod +++ b/gcc/m2/gm2-compiler/SymbolTable.mod @@ -6232,6 +6232,7 @@ BEGIN needsLong, needsUnsigned) END ; s := KillString (s) ; +(* IF needsLong AND needsUnsigned THEN RETURN LongCard @@ -6239,6 +6240,7 @@ BEGIN THEN RETURN LongInt END ; +*) RETURN ZType END END GetConstLitType ; diff --git a/gcc/m2/gm2-libs/FIO.mod b/gcc/m2/gm2-libs/FIO.mod index 6548bcb0de3..3630664735e 100644 --- a/gcc/m2/gm2-libs/FIO.mod +++ b/gcc/m2/gm2-libs/FIO.mod @@ -986,13 +986,13 @@ PROCEDURE ReadChar (f: File) : CHAR ; VAR ch: CHAR ; BEGIN - CheckAccess(f, openedforread, FALSE) ; - IF BufferedRead(f, SIZE(ch), ADR(ch))=SIZE(ch) + CheckAccess (f, openedforread, FALSE) ; + IF BufferedRead (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch)) THEN - SetEndOfLine(f, ch) ; - RETURN( ch ) + SetEndOfLine (f, ch) ; + RETURN ch ELSE - RETURN( nul ) + RETURN nul END END ReadChar ; @@ -1095,7 +1095,7 @@ END UnReadChar ; PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ; BEGIN CheckAccess(f, openedforread, FALSE) ; - IF BufferedRead(f, HIGH(a), ADR(a))=HIGH(a) + IF BufferedRead (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a)) THEN SetEndOfLine(f, a[HIGH(a)]) END @@ -1341,8 +1341,8 @@ END FlushBuffer ; PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ; BEGIN - CheckAccess(f, openedforwrite, TRUE) ; - IF BufferedWrite(f, HIGH(a), ADR(a))=HIGH(a) + CheckAccess (f, openedforwrite, TRUE) ; + IF BufferedWrite (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a)) THEN END END WriteAny ; @@ -1354,8 +1354,8 @@ END WriteAny ; PROCEDURE WriteChar (f: File; ch: CHAR) ; BEGIN - CheckAccess(f, openedforwrite, TRUE) ; - IF BufferedWrite(f, SIZE(ch), ADR(ch))=SIZE(ch) + CheckAccess (f, openedforwrite, TRUE) ; + IF BufferedWrite (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch)) THEN END END WriteChar ; diff --git a/gcc/m2/gm2-libs/FormatStrings.mod b/gcc/m2/gm2-libs/FormatStrings.mod index ab49205f38d..973c41aab46 100644 --- a/gcc/m2/gm2-libs/FormatStrings.mod +++ b/gcc/m2/gm2-libs/FormatStrings.mod @@ -446,7 +446,7 @@ VAR prevpos: INTEGER ; result : String ; BEGIN - IF (startpos = Length (fmt)) OR (startpos < 0) + IF (startpos = VAL (INTEGER, Length (fmt))) OR (startpos < 0) THEN RETURN s ELSE diff --git a/gcc/testsuite/gm2/extensions/run/pass/align3.mod b/gcc/testsuite/gm2/extensions/run/pass/align3.mod index 65f4d5563b0..2fb285257d0 100644 --- a/gcc/testsuite/gm2/extensions/run/pass/align3.mod +++ b/gcc/testsuite/gm2/extensions/run/pass/align3.mod @@ -18,16 +18,16 @@ Boston, MA 02110-1301, USA. *) MODULE align3 ; -FROM SYSTEM IMPORT ADR ; +FROM SYSTEM IMPORT ADR, ADDRESS ; FROM libc IMPORT exit ; VAR x : CHAR ; z : ARRAY [0..255] OF INTEGER <* bytealignment(1024) *> ; BEGIN - IF ADR(z) MOD 1024=0 + IF ADR(z) MOD 1024 = ADDRESS (0) THEN - IF ADR(z[1]) MOD 1024#0 + IF ADR(z[1]) MOD 1024 # ADDRESS (0) THEN exit(0) ELSE diff --git a/gcc/testsuite/gm2/extensions/run/pass/align4.mod b/gcc/testsuite/gm2/extensions/run/pass/align4.mod index 4a77a95ce77..56fbaaff895 100644 --- a/gcc/testsuite/gm2/extensions/run/pass/align4.mod +++ b/gcc/testsuite/gm2/extensions/run/pass/align4.mod @@ -18,14 +18,14 @@ Boston, MA 02110-1301, USA. *) MODULE align4 ; -FROM SYSTEM IMPORT ADR ; +FROM SYSTEM IMPORT ADR, ADDRESS ; FROM libc IMPORT exit ; VAR x : CHAR ; z : POINTER TO INTEGER <* bytealignment(1024) *> ; BEGIN - IF ADR(z) MOD 1024=0 + IF ADR(z) MOD 1024 = ADDRESS (0) THEN exit(0) ELSE diff --git a/gcc/testsuite/gm2/extensions/run/pass/align5.mod b/gcc/testsuite/gm2/extensions/run/pass/align5.mod index 5236460a3c1..a02a1e4efdc 100644 --- a/gcc/testsuite/gm2/extensions/run/pass/align5.mod +++ b/gcc/testsuite/gm2/extensions/run/pass/align5.mod @@ -18,7 +18,7 @@ Boston, MA 02110-1301, USA. *) MODULE align5 ; -FROM SYSTEM IMPORT ADR ; +FROM SYSTEM IMPORT ADR, ADDRESS ; FROM libc IMPORT exit ; TYPE @@ -29,7 +29,7 @@ TYPE VAR r: rec ; BEGIN - IF ADR(r.y) MOD 1024=0 + IF ADR(r.y) MOD 1024 = ADDRESS (0) THEN exit(0) ELSE diff --git a/gcc/testsuite/gm2/extensions/run/pass/align6.mod b/gcc/testsuite/gm2/extensions/run/pass/align6.mod index 1ffcd45dd67..4fa4223cb66 100644 --- a/gcc/testsuite/gm2/extensions/run/pass/align6.mod +++ b/gcc/testsuite/gm2/extensions/run/pass/align6.mod @@ -18,14 +18,14 @@ Boston, MA 02110-1301, USA. *) MODULE align6 ; -FROM SYSTEM IMPORT ADR ; +FROM SYSTEM IMPORT ADR, ADDRESS ; FROM libc IMPORT exit ; VAR x: CHAR ; y: CHAR <* bytealignment(1024) *> ; BEGIN - IF ADR(y) MOD 1024=0 + IF ADR(y) MOD 1024 = ADDRESS(0) THEN exit(0) ELSE diff --git a/gcc/testsuite/gm2/extensions/run/pass/align7.mod b/gcc/testsuite/gm2/extensions/run/pass/align7.mod index aec1d8a9f84..8aec3d09e4e 100644 --- a/gcc/testsuite/gm2/extensions/run/pass/align7.mod +++ b/gcc/testsuite/gm2/extensions/run/pass/align7.mod @@ -18,7 +18,7 @@ Boston, MA 02110-1301, USA. *) MODULE align7 ; -FROM SYSTEM IMPORT ADR ; +FROM SYSTEM IMPORT ADR, ADDRESS ; FROM libc IMPORT exit ; TYPE @@ -28,7 +28,7 @@ VAR x : CHAR ; z : foo ; BEGIN - IF ADR(z) MOD 1024=0 + IF ADR(z) MOD 1024 = ADDRESS(0) THEN exit(0) ELSE diff --git a/gcc/testsuite/gm2/extensions/run/pass/record.mod b/gcc/testsuite/gm2/extensions/run/pass/record.mod index ffce6d9af0b..7412075709b 100644 --- a/gcc/testsuite/gm2/extensions/run/pass/record.mod +++ b/gcc/testsuite/gm2/extensions/run/pass/record.mod @@ -17,7 +17,8 @@ BEGIN io.in2:=198; (* or set in2 to 0 and it works *) io.out:=io.in; - IF io.out#io.in + io.in2:=io.in; + IF io.in2 # io.in THEN exit(1) END diff --git a/gcc/testsuite/gm2/iso/run/pass/testgeneric.mod b/gcc/testsuite/gm2/iso/run/pass/testgeneric.mod index 6d2958e0246..f00afbd3204 100644 --- a/gcc/testsuite/gm2/iso/run/pass/testgeneric.mod +++ b/gcc/testsuite/gm2/iso/run/pass/testgeneric.mod @@ -28,7 +28,7 @@ VAR PROCEDURE assert (b: BOOLEAN; a: ARRAY OF CHAR) ; BEGIN - INC(test) ; + INC (test) ; IF NOT b THEN printf ("failed test %d which was %a\n", ADR(a)) ; @@ -49,7 +49,7 @@ BEGIN THEN w := c ; i := w ; - assert (i=c, "copying data through WORD32") + assert (CARDINAL(i) = c, "copying data through WORD32") END ; w := 1 ; diff --git a/gcc/testsuite/gm2/iso/run/pass/testsystem.mod b/gcc/testsuite/gm2/iso/run/pass/testsystem.mod index 50acaf6c414..c22f25be0c6 100644 --- a/gcc/testsuite/gm2/iso/run/pass/testsystem.mod +++ b/gcc/testsuite/gm2/iso/run/pass/testsystem.mod @@ -103,12 +103,12 @@ BEGIN Close(StdOut) ; exit(1) END ; - IF DIFADR(a2, a1)#TSIZE(LOC) + IF DIFADR(a2, a1) # INTEGER (TSIZE (LOC)) THEN Close(StdOut) ; exit(2) END ; - a1 := MAKEADR(ADDRESS(0)) ; + a1 := MAKEADR (ADDRESS (0)) ; IF a1#NIL THEN Close(StdOut) ; diff --git a/gcc/testsuite/gm2/pim/run/pass/EndFor.mod b/gcc/testsuite/gm2/pim/run/pass/EndFor.mod index b401ccdd7be..1659f0f86ce 100644 --- a/gcc/testsuite/gm2/pim/run/pass/EndFor.mod +++ b/gcc/testsuite/gm2/pim/run/pass/EndFor.mod @@ -146,7 +146,7 @@ BEGIN (* inc can never cause an underflow given its range *) ELSE (* des <= MAX(INTEGER) *) - IF des=MIN(INTEGER) + IF des = CARDINAL (MAX (INTEGER)) THEN printf("increment exceeds range at end of FOR loop\n") ; exit (4) diff --git a/gcc/testsuite/gm2/pim/run/pass/EnumTest.mod b/gcc/testsuite/gm2/pim/run/pass/EnumTest.mod index e80e3c48dad..196588149cf 100644 --- a/gcc/testsuite/gm2/pim/run/pass/EnumTest.mod +++ b/gcc/testsuite/gm2/pim/run/pass/EnumTest.mod @@ -45,7 +45,7 @@ CONST VAR e: enumType ; - i: INTEGER ; + i: CARDINAL ; a: arrayType ; BEGIN res := 0 ; @@ -63,8 +63,8 @@ BEGIN END ; i := 1 ; FOR e := one TO lastEnum DO - Assert(ORD(e)=i, __FILE__, __LINE__, 'enum against a value') ; - INC(i) + Assert (ORD (e) = i, __FILE__, __LINE__, 'enum against a value') ; + INC (i) END ; exit(res) END EnumTest. diff --git a/gcc/testsuite/gm2/pim/run/pass/TestLong2.mod b/gcc/testsuite/gm2/pim/run/pass/TestLong2.mod index 612877fb31c..cdc27392496 100644 --- a/gcc/testsuite/gm2/pim/run/pass/TestLong2.mod +++ b/gcc/testsuite/gm2/pim/run/pass/TestLong2.mod @@ -22,10 +22,10 @@ FROM libc IMPORT exit ; VAR l: LONGCARD ; BEGIN - (* test for assignment of MAX(LONGINT) *) + (* test for assignment of MAX (LONGINT). *) l := 9223372036854775807 ; - IF l#9223372036854775807 + IF l # 9223372036854775807 THEN - exit(1) + exit (1) END END TestLong2. diff --git a/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod b/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod index 5b470856793..6259b56873e 100644 --- a/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod +++ b/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod @@ -992,7 +992,7 @@ VAR ch: CHAR ; BEGIN CheckAccess(f, openedforread, FALSE) ; - IF BufferedRead(f, SIZE(ch), ADR(ch))=SIZE(ch) + IF BufferedRead(f, SIZE(ch), ADR(ch)) = INTEGER (SIZE(ch)) THEN SetEndOfLine(f, ch) ; RETURN( ch ) @@ -1097,7 +1097,7 @@ END UnReadChar ; PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ; BEGIN CheckAccess(f, openedforread, FALSE) ; - IF BufferedRead(f, HIGH(a), ADR(a))=HIGH(a) + IF BufferedRead(f, HIGH(a), ADR(a)) = INTEGER (HIGH(a)) THEN SetEndOfLine(f, a[HIGH(a)]) END @@ -1344,7 +1344,7 @@ END FlushBuffer ; PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ; BEGIN CheckAccess(f, openedforwrite, TRUE) ; - IF BufferedWrite(f, HIGH(a), ADR(a))=HIGH(a) + IF BufferedWrite (f, HIGH(a), ADR(a)) = INTEGER (HIGH(a)) THEN END END WriteAny ; @@ -1357,7 +1357,7 @@ END WriteAny ; PROCEDURE WriteChar (f: File; ch: CHAR) ; BEGIN CheckAccess(f, openedforwrite, TRUE) ; - IF BufferedWrite(f, SIZE(ch), ADR(ch))=SIZE(ch) + IF BufferedWrite(f, SIZE(ch), ADR(ch)) = INTEGER (SIZE(ch)) THEN END END WriteChar ; diff --git a/gcc/testsuite/gm2/projects/iso/run/pass/halma/halma.mod b/gcc/testsuite/gm2/projects/iso/run/pass/halma/halma.mod index 3d5b8166635..a56928f5602 100644 --- a/gcc/testsuite/gm2/projects/iso/run/pass/halma/halma.mod +++ b/gcc/testsuite/gm2/projects/iso/run/pass/halma/halma.mod @@ -323,7 +323,7 @@ BEGIN j := pieceHead[p] ; i := pieceHead[p-1]+1 ; WHILE i