public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] Bugfix to catch HIGH. Bugfix to check relational expressions.
@ 2022-11-09 14:05 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2022-11-09 14:05 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:0fea4cded352906fc6843696b64e8cf482babaec
commit 0fea4cded352906fc6843696b64e8cf482babaec
Author: Gaius Mulley <gaiusmod2@gmail.com>
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 <gaiusmod2@gmail.com>
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<j DO
- IF pieceList[i]=t
+ IF pieceList[i] = VAL (CARDINAL8, t)
THEN
RETURN( TRUE )
END ;
@@ -882,7 +882,7 @@ VAR
p: CARDINAL ;
BEGIN
FOR p := 1 TO Pieces DO
- IF b.pieces[c][p]=from
+ IF b.pieces[c][p] = VAL (CARDINAL8, from)
THEN
RETURN p
END
@@ -906,14 +906,14 @@ BEGIN
RETURN FALSE
END ;
genMoves(b, m, col) ;
- IF from#b.pieces[col][peg]
+ IF VAL (CARDINAL8, from) # b.pieces[col][peg]
THEN
RETURN FALSE
END ;
i := m.pieceHead[peg-1]+1 ; (* skip the initial move *)
j := m.pieceHead[peg] ;
WHILE i<j DO
- IF to=m.pieceList[i]
+ IF VAL (CARDINAL8, to) = m.pieceList[i]
THEN
RETURN TRUE
END ;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-11-09 14:05 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-11-09 14:05 [gcc/devel/modula-2] Bugfix to catch HIGH. Bugfix to check relational expressions Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).