https://gcc.gnu.org/g:c1409e1955110fcf3641cec6e8381fbf03f0a510
commit r14-11057-gc1409e1955110fcf3641cec6e8381fbf03f0a510
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Wed Dec 4 00:11:22 2024 +0000
[PATCH] PR modula2/117371: type incompatibility between INTEGER and CARDINAL
This patch enforces a const expression increment in a FOR loop.
It also fixes missing error locations. The FOR loop last iterator
value is now calculated during M2GenGCC after all types and constants have
been resolved. This results in fewer quadruples (as there is no need to
build two paths for step > 0 and step < 0).
gcc/m2/ChangeLog:
PR modula2/117371
* gm2-compiler/M2Base.mod (MixMetaTypes): Add parameter TRUE to
MetaErrorDecl.
(IsUserType): Test against ZType.
(MixTypesDecl): Test for ZType.
* gm2-compiler/M2GenGCC.mod (ErrorMessageDecl): Add parameter TRUE
to
MetaErrorDecl.
(CodeLastForIterator): New procedure.
(FoldLastForIterator): Ditto.
(PerformLastForIterator): Ditto.
(CodeStatement): Add case clause for LastForIteratorOp.
(ErrorMessageDecl): Add iserror parameter.
Call MetaErrorDecl with iserror parameter.
(checkIncorrectMeta): Call MetaErrorDecl with TRUE parameter.
(CheckBinaryExpressionTypes): Ditto.
(CheckElementSetTypes): Ditto.
* gm2-compiler/M2LexBuf.def (MakeVirtualTok): Update comment
detailing the fall back when UnknownTokenNo is encountered.
(MakeVirtual2Tok): Ditto.
* gm2-compiler/M2LexBuf.mod (MakeVirtualTok): Check against
UnknownTokenNo.
(MakeVirtual2Tok): Ditto.
* gm2-compiler/M2MetaError.def (MetaErrorDecl): Add error parameter.
* gm2-compiler/M2MetaError.mod (MetaErrorDecl): Add error
parameter.
Issue warning if error is FALSE.
* gm2-compiler/M2Quads.def (QuadOperator): Add LastForIteratorOp.
* gm2-compiler/M2Quads.mod (AddQuadInformation): New case clause
LastForIteratorOp.
(CheckAddTuple2Read): New procedure.
(BuildForLoopToRangeCheck): Remove.
(ForLoopLastIteratorVariable): Ditto.
(ForLoopLastIteratorConstant): Ditto.
(ForLoopLastIterator): Reimplement.
(BuildForToByDo): Remove ByType from call to ForLoopLastIterator.
(WriteQuad): New case clause LastForIteratorOp.
(WriteOperator): Ditto.
* gm2-compiler/M2Students.def
(CheckForVariableThatLooksLikeKeyword): Replace with ...
(CheckVariableAgainstKeyword): ... this.
* gm2-compiler/M2Students.mod
(CheckForVariableThatLooksLikeKeyword): Replace with ...
(CheckVariableAgainstKeyword): ... this.
* gm2-compiler/M2SymInit.mod (CheckLastForIterator): New
procedure.
(CheckReadBeforeInitQuad): New case clause to call
CheckLastForIterator.
* gm2-compiler/P2SymBuild.mod: Replace
CheckForVariableThatLooksLikeKeyword with
CheckVariableAgainstKeyword.
gcc/testsuite/ChangeLog:
PR modula2/117371
* gm2/iso/fail/forloopbyvar.mod: New test.
* gm2/iso/fail/forloopbyvar4.mod: New test.
* gm2/iso/fail/forloopbyvar5.mod: New test.
* gm2/iso/pass/forloopbyvar3.mod: New test.
(cherry picked from commit f242f79b8afeec58477e99c44530bd503878c6d5)
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Base.mod | 15 ++-
gcc/m2/gm2-compiler/M2GenGCC.mod | 144 +++++++++++++++++++--
gcc/m2/gm2-compiler/M2LexBuf.def | 11 +-
gcc/m2/gm2-compiler/M2LexBuf.mod | 20 ++-
gcc/m2/gm2-compiler/M2MetaError.def | 5 +-
gcc/m2/gm2-compiler/M2MetaError.mod | 21 ++-
gcc/m2/gm2-compiler/M2Quads.def | 1 +
gcc/m2/gm2-compiler/M2Quads.mod | 186 ++++++---------------------
gcc/m2/gm2-compiler/M2Students.def | 8 +-
gcc/m2/gm2-compiler/M2Students.mod | 8 +-
gcc/m2/gm2-compiler/M2SymInit.mod | 20 ++-
gcc/m2/gm2-compiler/P2SymBuild.mod | 4 +-
gcc/testsuite/gm2/iso/fail/forloopbyvar.mod | 16 +++
gcc/testsuite/gm2/iso/fail/forloopbyvar4.mod | 17 +++
gcc/testsuite/gm2/iso/fail/forloopbyvar5.mod | 17 +++
gcc/testsuite/gm2/iso/pass/forloopbyvar3.mod | 16 +++
16 files changed, 330 insertions(+), 179 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Base.mod b/gcc/m2/gm2-compiler/M2Base.mod
index 986e208e0c37..7064c60b1fbe 100644
--- a/gcc/m2/gm2-compiler/M2Base.mod
+++ b/gcc/m2/gm2-compiler/M2Base.mod
@@ -1997,8 +1997,8 @@ BEGIN
no : MetaErrorT2 (NearTok, 'type incompatibility between {%1asd}
and {%2asd}',
leftType, rightType) ;
- MetaErrorDecl (left) ;
- MetaErrorDecl (right) ;
+ MetaErrorDecl (left, TRUE) ;
+ MetaErrorDecl (right, TRUE) ;
FlushErrors (* unrecoverable at present *) |
warnfirst,
first : RETURN( leftType ) |
@@ -2018,7 +2018,10 @@ END MixMetaTypes ;
PROCEDURE IsUserType (type: CARDINAL) : BOOLEAN ;
BEGIN
- RETURN IsType (type) AND (NOT IsBaseType (type)) AND (NOT IsSystemType
(type))
+ RETURN IsType (type) AND
+ (NOT IsBaseType (type)) AND
+ (NOT IsSystemType (type)) AND
+ (type # ZType)
END IsUserType ;
@@ -2111,6 +2114,12 @@ BEGIN
ELSIF IsUserType (rightType)
THEN
RETURN( MixTypes(leftType, GetType(rightType), NearTok) )
+ ELSIF leftType = ZType
+ THEN
+ RETURN rightType
+ ELSIF rightType = ZType
+ THEN
+ RETURN leftType
ELSIF (leftType=GetLowestType(leftType)) AND
(rightType=GetLowestType(rightType))
THEN
RETURN( MixMetaTypes (left, right, leftType, rightType, NearTok) )
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index e92bc1749683..1cb60a87a84f 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -41,7 +41,7 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue,
PopValue,
IsConstString, GetString, GetStringLength,
IsConstStringCnul, IsConstStringM2nul,
IsConst, IsConstSet, IsProcedure, IsProcType,
- IsVar, IsVarParamAny, IsTemporary,
+ IsVar, IsVarParamAny, IsTemporary, IsTuple,
IsEnumeration,
IsUnbounded, IsArray, IsSet, IsConstructor,
IsProcedureVariable,
@@ -169,6 +169,7 @@ FROM m2expr IMPORT GetIntegerZero, GetIntegerOne,
GetPointerZero,
GetCardinalZero,
GetSizeOfInBits,
+ TreeOverflow,
FoldAndStrip,
CompareTrees,
StringLength,
@@ -239,7 +240,7 @@ FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree,
BuildParam, BuildFunct
FROM m2type IMPORT ChainOnParamValue, GetPointerType, GetIntegerType,
AddStatement,
GetCardinalType, GetWordType, GetM2ZType, GetM2RType,
GetM2CType,
BuildCharConstant, AddStringToTreeList,
BuildArrayStringConstructor,
- GetArrayNoOfElements ;
+ GetArrayNoOfElements, GetTreeType ;
FROM m2block IMPORT RememberConstant, pushGlobalScope, popGlobalScope,
finishFunctionDecl,
pushFunctionScope, popFunctionScope,
@@ -386,11 +387,12 @@ VAR
and right if they are parameters or variables.
*)
-PROCEDURE ErrorMessageDecl (tok: CARDINAL; message: ARRAY OF CHAR; left,
right: CARDINAL) ;
+PROCEDURE ErrorMessageDecl (tok: CARDINAL; message: ARRAY OF CHAR;
+ left, right: CARDINAL; iserror: BOOLEAN) ;
BEGIN
MetaErrorT2 (tok, message, left, right) ;
- MetaErrorDecl (left) ;
- MetaErrorDecl (right)
+ MetaErrorDecl (left, iserror) ;
+ MetaErrorDecl (right, iserror)
END ErrorMessageDecl ;
@@ -457,6 +459,128 @@ BEGIN
END IsCompilingMainModule ;
+(*
+ CodeLastForIterator - call PerformLastForIterator allowing for
+ a non constant last iterator value.
+*)
+
+PROCEDURE CodeLastForIterator (quad: CARDINAL) ;
+BEGIN
+ PerformLastForIterator (quad, NoWalkProcedure, FALSE)
+END CodeLastForIterator ;
+
+
+(*
+ FoldLastForIterator - call PerformLastForIterator providing
+ all operands are constant and are known by GCC.
+*)
+
+PROCEDURE FoldLastForIterator (quad: CARDINAL; p: WalkAction) ;
+VAR
+ op : QuadOperator ;
+ e1, e2,
+ op1, tuple, incr: CARDINAL ;
+BEGIN
+ GetQuad (quad, op, op1, tuple, incr) ;
+ Assert (IsTuple (tuple)) ;
+ e1 := GetNth (tuple, 1) ;
+ e2 := GetNth (tuple, 2) ;
+ IF IsConst (op1) AND IsConst (e1) AND IsConst (e2) AND IsConst (incr) AND
+ GccKnowsAbout (e1) AND GccKnowsAbout (e2) AND GccKnowsAbout (incr)
+ THEN
+ PerformLastForIterator (quad, p, TRUE)
+ END
+END FoldLastForIterator ;
+
+
+(*
+ FoldLastForIterator - generates code to calculate the last iterator value
+ in a for loop. It examines the increment constant
+ and generates different code depending whether it is
+ negative or positive.
+*)
+
+PROCEDURE PerformLastForIterator (quad: CARDINAL; p: WalkAction; constant:
BOOLEAN) ;
+VAR
+ success,
+ constExpr,
+ overflowChecking : BOOLEAN ;
+ op : QuadOperator ;
+ lastpos, op1pos,
+ op2pos, incrpos,
+ last, tuple, incr: CARDINAL ;
+ e1, e2 : CARDINAL ;
+ lasttree,
+ e1tree, e2tree,
+ expr, incrtree : tree ;
+ location : location_t ;
+BEGIN
+ GetQuadOtok (quad, lastpos, op, last, tuple, incr,
+ overflowChecking, constExpr,
+ op1pos, op2pos, incrpos) ;
+ DeclareConstant (incrpos, incr) ;
+ lasttree := Mod2Gcc (last) ;
+ success := TRUE ;
+ IF IsConst (incr)
+ THEN
+ incrtree := Mod2Gcc (incr) ;
+ location := TokenToLocation (lastpos) ;
+ e1 := GetNth (tuple, 1) ;
+ e2 := GetNth (tuple, 2) ;
+ e1tree := Mod2Gcc (e1) ;
+ e2tree := Mod2Gcc (e2) ;
+ IF CompareTrees (incrtree, GetIntegerZero (location)) > 0
+ THEN
+ (* If incr > 0 then LastIterator := ((e2-e1) DIV incr) * incr + e1.
*)
+ expr := BuildSub (location, e2tree, e1tree, FALSE) ;
+ expr := BuildDivFloor (location, expr, incrtree, FALSE) ;
+ expr := BuildMult (location, expr, incrtree, FALSE) ;
+ expr := BuildAdd (location, expr, e1tree, FALSE)
+ ELSE
+ (* Else use LastIterator := e1 - ((e1-e2) DIV PositiveBy) * PositiveBy
+ to avoid unsigned div signed arithmetic. *)
+ expr := BuildSub (location, e1tree, e2tree, FALSE) ;
+ incrtree := BuildConvert (location, GetM2ZType (), incrtree, FALSE) ;
+ incrtree := BuildNegate (location, incrtree, FALSE) ;
+ incrtree := BuildConvert (location, GetTreeType (expr), incrtree,
FALSE) ;
+ IF TreeOverflow (incrtree)
+ THEN
+ MetaErrorT0 (lastpos,
+ 'the intemediate calculation for the last iterator
value in the {%kFOR} loop has caused an overflow') ;
+ NoChange := FALSE ;
+ SubQuad (quad) ;
+ success := FALSE
+ ELSE
+ expr := BuildSub (location, e1tree, e2tree, FALSE) ;
+ expr := BuildDivFloor (location, expr, incrtree, FALSE) ;
+ expr := BuildMult (location, expr, incrtree, FALSE) ;
+ expr := BuildSub (location, e1tree, expr, FALSE)
+ END
+ END ;
+ IF success
+ THEN
+ IF IsConst (last)
+ THEN
+ AddModGcc (last, expr) ;
+ p (last) ;
+ NoChange := FALSE ;
+ SubQuad (quad)
+ ELSE
+ Assert (NOT constant) ;
+ BuildAssignmentStatement (location, lasttree, expr)
+ END
+ END
+ ELSE
+ MetaErrorT1 (lastpos,
+ 'the value {%1Ead} in the {%kBY} clause of the {%kFOR} loop
must be constant',
+ incr) ;
+ MetaErrorDecl (incr, TRUE) ;
+ NoChange := FALSE ;
+ SubQuad (quad)
+ END
+END PerformLastForIterator ;
+
+
(*
CodeStatement - A multi-way decision call depending on the current
quadruple.
@@ -523,6 +647,7 @@ BEGIN
InclOp : CodeIncl (op1, op3) |
ExclOp : CodeExcl (op1, op3) |
NegateOp : CodeNegateChecked (q, op1, op3) |
+ LastForIteratorOp : CodeLastForIterator (q) |
LogicalShiftOp : CodeSetShift (q, op1, op2, op3) |
LogicalRotateOp : CodeSetRotate (q, op1, op2, op3) |
LogicalOrOp : CodeSetOr (q) |
@@ -665,7 +790,8 @@ BEGIN
StatementNoteOp : FoldStatementNote (op3) |
StringLengthOp : FoldStringLength (quad, p) |
StringConvertM2nulOp: FoldStringConvertM2nul (quad, p) |
- StringConvertCnulOp : FoldStringConvertCnul (quad, p)
+ StringConvertCnulOp : FoldStringConvertCnul (quad, p) |
+ LastForIteratorOp : FoldLastForIterator (quad, p)
ELSE
(* ignore quadruple as it is not associated with a constant
expression *)
@@ -3338,7 +3464,7 @@ BEGIN
THEN
ErrorMessageDecl (virtpos,
'illegal assignment error between {%1Etad} and
{%2tad}',
- des, expr) ;
+ des, expr, TRUE) ;
RETURN( FALSE )
END
END
@@ -3824,7 +3950,7 @@ BEGIN
THEN
ErrorMessageDecl (subexprpos,
'expression mismatch between {%1Etad} and {%2tad}',
- left, right) ;
+ left, right, TRUE) ;
NoChange := FALSE ;
SubQuad (quad) ;
p (des) ;
@@ -3892,7 +4018,7 @@ BEGIN
THEN
ErrorMessageDecl (subexprpos,
'the types used in expression {%1Etad} {%kIN} {%2tad}
are incompatible',
- left, right) ;
+ left, right, TRUE) ;
NoChange := FALSE ;
SubQuad (quad) ;
RETURN FALSE
diff --git a/gcc/m2/gm2-compiler/M2LexBuf.def b/gcc/m2/gm2-compiler/M2LexBuf.def
index 19e261e83cbc..766d9555ef9c 100644
--- a/gcc/m2/gm2-compiler/M2LexBuf.def
+++ b/gcc/m2/gm2-compiler/M2LexBuf.def
@@ -185,8 +185,12 @@ PROCEDURE GetFileName () : String ;
(*
- MakeVirtualTok - creates and return a new tokenno which is created from
- tokenno caret, left and right.
+ MakeVirtualTok - providing caret, left, right are associated with a source
file
+ and exist on the same src line then
+ create and return a new tokenno which is created from
+ tokenno left and right. Otherwise return caret.
+ If caret is UnknownTokenNo then it is replaced with left
or right
+ in sequence to avoid an UnknownTokenNo.
*)
PROCEDURE MakeVirtualTok (caret, left, right: CARDINAL) : CARDINAL ;
@@ -194,7 +198,8 @@ PROCEDURE MakeVirtualTok (caret, left, right: CARDINAL) :
CARDINAL ;
(*
MakeVirtual2Tok - creates and return a new tokenno which is created from
- two tokens left and right.
+ two tokens left and right. It tries to avoid
UnknownTokenNo
+ and will fall back to left or right if necessary.
*)
PROCEDURE MakeVirtual2Tok (left, right: CARDINAL) : CARDINAL ;
diff --git a/gcc/m2/gm2-compiler/M2LexBuf.mod b/gcc/m2/gm2-compiler/M2LexBuf.mod
index 5a0b6086bcb0..c6521782a802 100644
--- a/gcc/m2/gm2-compiler/M2LexBuf.mod
+++ b/gcc/m2/gm2-compiler/M2LexBuf.mod
@@ -1061,6 +1061,8 @@ END isSrcToken ;
and exist on the same src line then
create and return a new tokenno which is created from
tokenno left and right. Otherwise return caret.
+ If caret is UnknownTokenNo then it is replaced with left
or right
+ in sequence to avoid an UnknownTokenNo.
*)
PROCEDURE MakeVirtualTok (caret, left, right: CARDINAL) : CARDINAL ;
@@ -1068,6 +1070,14 @@ VAR
descLeft, descRight: TokenDesc ;
lc, ll, lr : location_t ;
BEGIN
+ IF caret = UnknownTokenNo
+ THEN
+ caret := left
+ END ;
+ IF caret = UnknownTokenNo
+ THEN
+ caret := right
+ END ;
IF isSrcToken (caret) AND isSrcToken (left) AND isSrcToken (right)
THEN
lc := TokenToLocation (caret) ;
@@ -1098,11 +1108,19 @@ END MakeVirtualTok ;
(*
MakeVirtual2Tok - creates and return a new tokenno which is created from
- two tokens left and right.
+ two tokens left and right. It tries to avoid
UnknownTokenNo
+ and will fall back to left or right if necessary.
*)
PROCEDURE MakeVirtual2Tok (left, right: CARDINAL) : CARDINAL ;
BEGIN
+ IF left = UnknownTokenNo
+ THEN
+ left := right
+ ELSIF right = UnknownTokenNo
+ THEN
+ right := left
+ END ;
RETURN MakeVirtualTok (left, left, right) ;
END MakeVirtual2Tok ;
diff --git a/gcc/m2/gm2-compiler/M2MetaError.def
b/gcc/m2/gm2-compiler/M2MetaError.def
index 333a4a36c455..1bc876561816 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.def
+++ b/gcc/m2/gm2-compiler/M2MetaError.def
@@ -175,10 +175,11 @@ PROCEDURE MetaString4 (m: String; s1, s2, s3, s4:
CARDINAL) : String ;
(*
MetaErrorDecl - if sym is a variable or parameter then generate a
- declaration error message.
+ declaration error or warning message. If error is
+ FALSE then a warning is issued.
*)
-PROCEDURE MetaErrorDecl (sym: CARDINAL) ;
+PROCEDURE MetaErrorDecl (sym: CARDINAL; error: BOOLEAN) ;
END M2MetaError.
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod
b/gcc/m2/gm2-compiler/M2MetaError.mod
index 2dd8c5c3d0a9..b1ae6ca4dfeb 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -2684,18 +2684,29 @@ END MetaString4 ;
(*
MetaErrorDecl - if sym is a variable or parameter then generate a
- declaration error message.
+ declaration error or warning message. If error is
+ FALSE then a warning is issued.
*)
-PROCEDURE MetaErrorDecl (sym: CARDINAL) ;
+PROCEDURE MetaErrorDecl (sym: CARDINAL; error: BOOLEAN) ;
BEGIN
IF (sym # NulSym) AND IsVar (sym)
THEN
- IF IsVarAParam (sym)
+ IF error
THEN
- MetaErrorT1 (GetVarDeclFullTok (sym), 'parameter declaration for
{%1ad}', sym)
+ IF IsVarAParam (sym)
+ THEN
+ MetaErrorT1 (GetVarDeclFullTok (sym), 'parameter declaration for
{%1ad}', sym)
+ ELSE
+ MetaErrorT1 (GetVarDeclFullTok (sym), 'variable declaration for
{%1ad}', sym)
+ END
ELSE
- MetaErrorT1 (GetVarDeclFullTok (sym), 'variable declaration for
{%1ad}', sym)
+ IF IsVarAParam (sym)
+ THEN
+ MetaErrorT1 (GetVarDeclFullTok (sym), 'parameter declaration for
{%1Wad}', sym)
+ ELSE
+ MetaErrorT1 (GetVarDeclFullTok (sym), 'variable declaration for
{%1Wad}', sym)
+ END
END
END
END MetaErrorDecl ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index 12a4708ee676..bb0d6a0a9543 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -202,6 +202,7 @@ TYPE
InitStartOp,
InlineOp,
KillLocalVarOp,
+ LastForIteratorOp,
LineNumberOp,
LogicalAndOp,
LogicalDiffOp,
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index fe1ddd5f830c..2c3969805dc4 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -40,7 +40,8 @@ FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2,
MetaError3,
MetaErrorStringT2,
MetaErrorString1, MetaErrorString2,
MetaErrorN1, MetaErrorN2,
- MetaErrorNT0, MetaErrorNT1, MetaErrorNT2 ;
+ MetaErrorNT0, MetaErrorNT1, MetaErrorNT2,
+ MetaErrorDecl ;
FROM DynamicStrings IMPORT String, string, InitString, KillString,
ConCat, InitStringCharStar, Dup, Mark,
@@ -55,7 +56,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode,
GetSymName, IsUnknown,
MakeConstLit,
MakeConstString, MakeConstant, MakeConstVar,
MakeConstStringM2nul, MakeConstStringCnul,
- Make2Tuple,
+ Make2Tuple, IsTuple,
RequestSym, MakePointer, PutPointer,
SkipType,
GetDType, GetSType, GetLType,
@@ -1399,7 +1400,9 @@ BEGIN
IfGreEquOp : ManipulateReference(QuadNo, Oper3) ;
CheckAddVariableRead(Oper1, FALSE, QuadNo) ;
CheckAddVariableRead(Oper2, FALSE, QuadNo) |
-
+ LastForIteratorOp: CheckAddVariableWrite (Oper1, FALSE, QuadNo) ;
+ CheckAddTuple2Read (Oper2, FALSE, QuadNo) ;
+ CheckAddVariableRead (Oper3, FALSE, QuadNo) |
TryOp,
RetryOp,
GotoOp : ManipulateReference(QuadNo, Oper3) |
@@ -1735,6 +1738,22 @@ END CheckRemoveVariableReadLeftValue ;
*)
+(*
+ CheckAddTuple2Read - checks to see whether symbol tuple contains variables
or
+ parameters and if so it then adds them to the quadruple
+ variable list.
+*)
+
+PROCEDURE CheckAddTuple2Read (tuple: CARDINAL; canDereference: BOOLEAN; Quad:
CARDINAL) ;
+BEGIN
+ IF IsTuple (tuple)
+ THEN
+ CheckAddVariableRead (GetNth (tuple, 1), canDereference, Quad) ;
+ CheckAddVariableRead (GetNth (tuple, 2), canDereference, Quad)
+ END
+END CheckAddTuple2Read ;
+
+
(*
CheckAddVariableRead - checks to see whether symbol, Sym, is a variable or
a parameter and if so it then adds this quadruple
@@ -4612,140 +4631,6 @@ BEGIN
END BuildPseudoBy ;
-(*
- BuildForLoopToRangeCheck - builds the range check to ensure that the id
- does not exceed the limits of its type.
-*)
-
-PROCEDURE BuildForLoopToRangeCheck ;
-VAR
- d, dt,
- e, et: CARDINAL ;
-BEGIN
- PopTF (e, et) ;
- PopTF (d, dt) ;
- BuildRange (InitForLoopToRangeCheck (d, e)) ;
- PushTF (d, dt) ;
- PushTF (e, et)
-END BuildForLoopToRangeCheck ;
-
-
-(*
- ForLoopLastIteratorVariable - assigns the last value of the index variable
to
- symbol LastIterator.
- The For Loop is regarded:
-
- For ident := e1 To e2 By BySym Do
-
- End
-*)
-
-PROCEDURE ForLoopLastIteratorVariable (LastIterator, e1, e2, BySym, ByType:
CARDINAL ;
- e1tok, e2tok, bytok: CARDINAL) ;
-VAR
- PBType,
- PositiveBy,
- ElseQuad,
- t, f : CARDINAL ;
-BEGIN
- Assert (IsVar (LastIterator)) ;
- (* If By > 0 then. *)
- (* q+1 if >= by 0 q+3. *)
- (* q+2 GotoOp q+else. *)
- PushTFtok (BySym, ByType, bytok) ; (* BuildRelOp 1st parameter *)
- PushT (GreaterEqualTok) ; (* 2nd parameter *)
- (* 3rd parameter *)
- PushZero (bytok, ByType) ;
- BuildRelOp (e2tok) ; (* Choose final expression position. *)
- PopBool (t, f) ;
- BackPatch (t, NextQuad) ;
-
- (* LastIterator := ((e2-e1) DIV By) * By + e1. *)
- PushTF (LastIterator, GetSType (LastIterator)) ;
- PushTFtok (e2, GetSType (e2), e2tok) ;
- PushT (MinusTok) ;
- PushTFtok (e1, GetSType (e1), e1tok) ;
- doBuildBinaryOp (TRUE, FALSE) ;
- PushT (DivideTok) ;
- PushTFtok (BySym, ByType, bytok) ;
- doBuildBinaryOp (FALSE, FALSE) ;
- PushT (TimesTok) ;
- PushTFtok (BySym, ByType, bytok) ;
- doBuildBinaryOp (FALSE, FALSE) ;
- PushT (ArithPlusTok) ;
- PushTFtok (e1, GetSType (e1), e1tok) ;
- doBuildBinaryOp (FALSE, FALSE) ;
- BuildForLoopToRangeCheck ;
- BuildAssignmentWithoutBounds (e1tok, FALSE, FALSE) ;
- GenQuad (GotoOp, NulSym, NulSym, 0) ;
- ElseQuad := NextQuad-1 ;
-
- (* Else. *)
-
- BackPatch (f, NextQuad) ;
-
- PushTtok (MinusTok, bytok) ;
- PushTFtok (BySym, ByType, bytok) ;
- BuildUnaryOp ;
- PopTF (PositiveBy, PBType) ; (* PositiveBy := - BySym. *)
-
- (* LastIterator := e1 - ((e1-e2) DIV PositiveBy) * PositiveBy. *)
- PushTF (LastIterator, GetSType (LastIterator)) ;
- PushTFtok (e1, GetSType (e1), e1tok) ;
- PushT (MinusTok) ;
- PushTFtok (e1, GetSType (e1), e1tok) ;
- PushT (MinusTok) ;
- PushTFtok (e2, GetSType (e2), e2tok) ;
- doBuildBinaryOp (TRUE, FALSE) ;
- PushT (DivideTok) ;
- PushTFtok (PositiveBy, ByType, bytok) ;
- doBuildBinaryOp (FALSE, FALSE) ;
- PushT (TimesTok) ;
- PushTFtok (PositiveBy, ByType, bytok) ;
- doBuildBinaryOp (FALSE, FALSE) ;
- doBuildBinaryOp (FALSE, FALSE) ;
- BuildForLoopToRangeCheck ;
- BuildAssignmentWithoutBounds (e1tok, FALSE, FALSE) ;
- BackPatch (ElseQuad, NextQuad) ;
-
- (* End. *)
-END ForLoopLastIteratorVariable ;
-
-
-(*
- ForLoopLastIteratorConstant - assigns the last value of the index variable
to
- symbol LastIterator.
- The For Loop is regarded:
-
- For ident := e1 To e2 By BySym Do
-
- End
-*)
-
-PROCEDURE ForLoopLastIteratorConstant (LastIterator, e1, e2, BySym, ByType:
CARDINAL;
- e1tok, e2tok, bytok: CARDINAL) ;
-BEGIN
- Assert (IsConst (LastIterator)) ;
- (* LastIterator := VAL (GetType (LastIterator), ((e2-e1) DIV By) * By + e1)
*)
- PushTF (LastIterator, GetSType (LastIterator)) ;
- PushTFtok (e2, GetSType (e2), e2tok) ;
- PushT (MinusTok) ;
- PushTFtok (e1, GetSType (e1), e1tok) ;
- doBuildBinaryOp (TRUE, FALSE) ;
- PushT (DivideTok) ;
- PushTFtok (BySym, ByType, bytok) ;
- doBuildBinaryOp (FALSE, FALSE) ;
- PushT (TimesTok) ;
- PushTFtok (BySym, ByType, bytok) ;
- doBuildBinaryOp (FALSE, FALSE) ;
- PushT (ArithPlusTok) ;
- PushTFtok (e1, GetSType (e1), e1tok) ;
- doBuildBinaryOp (FALSE, FALSE) ;
- BuildForLoopToRangeCheck ;
- BuildAssignmentWithoutBounds (e1tok, FALSE, FALSE)
-END ForLoopLastIteratorConstant ;
-
-
(*
ForLoopLastIterator - calculate the last iterator value but avoid setting
LastIterator twice if it is a constant (in the quads).
@@ -4754,16 +4639,19 @@ END ForLoopLastIteratorConstant ;
generation we do not know the value of BySym.
*)
-PROCEDURE ForLoopLastIterator (LastIterator, e1, e2, BySym, ByType: CARDINAL ;
+PROCEDURE ForLoopLastIterator (LastIterator, e1, e2, BySym: CARDINAL ;
e1tok, e2tok, bytok: CARDINAL) ;
BEGIN
- IF IsVar (LastIterator)
+ IF NOT IsConst (BySym)
THEN
- ForLoopLastIteratorVariable (LastIterator, e1, e2, BySym, ByType,
- e1tok, e2tok, bytok)
+ MetaErrorT1 (bytok,
+ '{%E}the {%kFOR} loop {%kBY} expression must be constant,
the expression {%1a} is variable',
+ BySym) ;
+ MetaErrorDecl (BySym, TRUE)
ELSE
- ForLoopLastIteratorConstant (LastIterator, e1, e2, BySym, ByType,
- e1tok, e2tok, bytok)
+ GenQuadOTypetok (bytok, LastForIteratorOp, LastIterator,
+ Make2Tuple (e1, e2), BySym, FALSE, FALSE,
+ bytok, MakeVirtual2Tok (e1tok, e2tok), bytok)
END
END ForLoopLastIterator ;
@@ -4792,6 +4680,8 @@ END ForLoopLastIterator ;
x := e1 ;
+ Note that LASTVALUE is calculated during M2GenGCC
+ after all the types have been resolved.
LASTVALUE := ((e2-e1) DIV BySym) * BySym + e1
IF BySym<0
THEN
@@ -4817,7 +4707,7 @@ END ForLoopLastIterator ;
Quadruples:
q BecomesOp IdentSym _ e1
- q+ LastValue := ((e1-e2) DIV by) * by + e1
+ q+ LastForIteratorOp LastValue := ((e1-e2) DIV by) *
by + e1
q+1 if >= by 0 q+..2
q+2 GotoOp q+3
q+3 If >= e1 e2 q+5
@@ -4879,7 +4769,7 @@ BEGIN
e1 := doConvert (etype, e1) ;
e2 := doConvert (etype, e2) ;
- ForLoopLastIterator (LastIterator, e1, e2, BySym, ByType, e1tok, e2tok,
bytok) ;
+ ForLoopLastIterator (LastIterator, e1, e2, BySym, e1tok, e2tok, bytok) ;
(* q+1 if >= by 0 q+..2 *)
(* q+2 GotoOp q+3 *)
@@ -14063,6 +13953,11 @@ BEGIN
END ;
CASE Operator OF
+ LastForIteratorOp: WriteOperand(Operand1) ;
+ fprintf0 (GetDumpFile (), ' ') ;
+ WriteOperand(Operand2) ;
+ fprintf0 (GetDumpFile (), ' ') ;
+ WriteOperand(Operand3) |
HighOp : WriteOperand(Operand1) ;
fprintf1 (GetDumpFile (), ' %4d ', Operand2) ;
WriteOperand(Operand3) |
@@ -14213,6 +14108,7 @@ BEGIN
ArithAddOp : fprintf0 (GetDumpFile (), 'Arith + ') |
InitAddressOp : fprintf0 (GetDumpFile (), 'InitAddress ') |
+ LastForIteratorOp : fprintf0 (GetDumpFile (), 'LastForIterator ') |
LogicalOrOp : fprintf0 (GetDumpFile (), 'Or ') |
LogicalAndOp : fprintf0 (GetDumpFile (), 'And ') |
LogicalXorOp : fprintf0 (GetDumpFile (), 'Xor ') |
diff --git a/gcc/m2/gm2-compiler/M2Students.def
b/gcc/m2/gm2-compiler/M2Students.def
index 04e1a9185a81..ec17fec55e35 100644
--- a/gcc/m2/gm2-compiler/M2Students.def
+++ b/gcc/m2/gm2-compiler/M2Students.def
@@ -31,15 +31,15 @@ DEFINITION MODULE M2Students ;
FROM SYSTEM IMPORT ADDRESS ;
FROM NameKey IMPORT Name ;
-EXPORT QUALIFIED StudentVariableCheck, CheckForVariableThatLooksLikeKeyword ;
+EXPORT QUALIFIED StudentVariableCheck, CheckVariableAgainstKeyword ;
(*
- CheckForVariableThatLooksLikeKeyword - checks for a identifier that looks
the same
- as a keyword except for its case.
+ CheckVariableAgainstKeyword - checks for a identifier that looks the same
+ as a keyword except for its case.
*)
-PROCEDURE CheckForVariableThatLooksLikeKeyword (name: Name) ;
+PROCEDURE CheckVariableAgainstKeyword (name: Name) ;
(*
diff --git a/gcc/m2/gm2-compiler/M2Students.mod
b/gcc/m2/gm2-compiler/M2Students.mod
index f269fbb3a6c1..e7f1dd943708 100644
--- a/gcc/m2/gm2-compiler/M2Students.mod
+++ b/gcc/m2/gm2-compiler/M2Students.mod
@@ -74,17 +74,17 @@ END IsNotADuplicateName ;
(*
- CheckForVariableThatLooksLikeKeyword - checks for a identifier that looks
the same
- as a keyword except for its case.
+ CheckVariableAgainstKeyword - checks for a identifier that looks the same
+ as a keyword except for its case.
*)
-PROCEDURE CheckForVariableThatLooksLikeKeyword (name: Name) ;
+PROCEDURE CheckVariableAgainstKeyword (name: Name) ;
BEGIN
IF StyleChecking
THEN
PerformVariableKeywordCheck (name)
END
-END CheckForVariableThatLooksLikeKeyword ;
+END CheckVariableAgainstKeyword ;
(*
diff --git a/gcc/m2/gm2-compiler/M2SymInit.mod
b/gcc/m2/gm2-compiler/M2SymInit.mod
index deca342f73f0..2bc15d3bd0ad 100644
--- a/gcc/m2/gm2-compiler/M2SymInit.mod
+++ b/gcc/m2/gm2-compiler/M2SymInit.mod
@@ -61,7 +61,7 @@ FROM SymbolTable IMPORT NulSym, ModeOfAddr, IsVar, IsRecord,
GetSType,
IsReallyPointer, IsUnbounded,
IsVarient, IsFieldVarient, GetVarient,
IsVarArrayRef, GetSymName,
- IsType, IsPointer,
+ IsType, IsPointer, IsTuple,
GetParameterShadowVar, IsParameter, GetLType,
GetParameterHeapVar, GetVarDeclTok ;
@@ -1165,6 +1165,21 @@ BEGIN
END CheckRecordField ;
+(*
+ CheckLastForIterator -
+*)
+
+PROCEDURE CheckLastForIterator (op1tok: CARDINAL; op1: CARDINAL;
+ op2tok: CARDINAL; op2: CARDINAL;
+ warning: BOOLEAN; i: CARDINAL) ;
+BEGIN
+ SetVarInitialized (op1, FALSE, op1tok) ;
+ Assert (IsTuple (op2)) ;
+ CheckDeferredRecordAccess (op2tok, GetNth (op2, 1), FALSE, warning, i) ;
+ CheckDeferredRecordAccess (op2tok, GetNth (op2, 2), FALSE, warning, i) ;
+END CheckLastForIterator ;
+
+
(*
CheckBecomes -
*)
@@ -1282,6 +1297,9 @@ BEGIN
IfLessEquOp,
IfGreOp,
IfGreEquOp : CheckComparison (op1tok, op1, op2tok, op2, warning, i) |
+ LastForIteratorOp : CheckLastForIterator (op1tok, op1, op2tok, op2,
+ warning, i) ;
+ Assert (IsConst (op3)) |
TryOp,
ReturnOp,
CallOp,
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod
b/gcc/m2/gm2-compiler/P2SymBuild.mod
index d51fd1c931a2..70492705129b 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -153,7 +153,7 @@ FROM M2Comp IMPORT CompilingDefinitionModule,
CompilingProgramModule ;
FROM M2Const IMPORT constType ;
-FROM M2Students IMPORT CheckForVariableThatLooksLikeKeyword ;
+FROM M2Students IMPORT CheckVariableAgainstKeyword ;
IMPORT M2Error ;
@@ -1177,7 +1177,7 @@ BEGIN
PopT (n) ;
i := 1 ;
WHILE i <= n DO
- CheckForVariableThatLooksLikeKeyword (OperandT (n+1-i)) ;
+ CheckVariableAgainstKeyword (OperandT (n+1-i)) ;
tok := OperandTok (n+1-i) ;
Var := MakeVar (tok, OperandT (n+1-i)) ;
AtAddress := OperandA (n+1-i) ;
diff --git a/gcc/testsuite/gm2/iso/fail/forloopbyvar.mod
b/gcc/testsuite/gm2/iso/fail/forloopbyvar.mod
new file mode 100644
index 000000000000..4198d74f6085
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/forloopbyvar.mod
@@ -0,0 +1,16 @@
+MODULE forloopbyvar ;
+
+
+PROCEDURE foo ;
+VAR
+ i, n: CARDINAL ;
+ s : CARDINAL ;
+BEGIN
+ s := 1 ;
+ FOR i := 1 TO 10 BY s DO
+ END
+END foo ;
+
+BEGIN
+ foo
+END forloopbyvar.
diff --git a/gcc/testsuite/gm2/iso/fail/forloopbyvar4.mod
b/gcc/testsuite/gm2/iso/fail/forloopbyvar4.mod
new file mode 100644
index 000000000000..241e35302627
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/forloopbyvar4.mod
@@ -0,0 +1,17 @@
+MODULE forloopbyvar4 ;
+
+PROCEDURE TestFor (boolarray: ARRAY OF BOOLEAN);
+VAR
+ k, m: CARDINAL ;
+BEGIN
+ k := 4 ;
+ FOR m := k * k TO HIGH (boolarray) BY k DO
+ boolarray[m] := FALSE;
+ END
+END TestFor ;
+
+VAR
+ boolarray: ARRAY [1..1024] OF BOOLEAN ;
+BEGIN
+ TestFor (boolarray)
+END forloopbyvar4.
diff --git a/gcc/testsuite/gm2/iso/fail/forloopbyvar5.mod
b/gcc/testsuite/gm2/iso/fail/forloopbyvar5.mod
new file mode 100644
index 000000000000..28b881ff1900
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/forloopbyvar5.mod
@@ -0,0 +1,17 @@
+MODULE forloopbyvar5 ;
+
+PROCEDURE TestFor (boolarray: ARRAY OF BOOLEAN);
+VAR
+ k, m: CARDINAL ;
+BEGIN
+ k := 4 ;
+ FOR m := k * k TO HIGH (boolarray) BY k*3 DO
+ boolarray[m] := FALSE;
+ END
+END TestFor ;
+
+VAR
+ boolarray: ARRAY [1..1024] OF BOOLEAN ;
+BEGIN
+ TestFor (boolarray)
+END forloopbyvar5.
diff --git a/gcc/testsuite/gm2/iso/pass/forloopbyvar3.mod
b/gcc/testsuite/gm2/iso/pass/forloopbyvar3.mod
new file mode 100644
index 000000000000..d6064a679866
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/forloopbyvar3.mod
@@ -0,0 +1,16 @@
+MODULE forloopbyvar3 ;
+
+PROCEDURE TestFor (boolarray: ARRAY OF BOOLEAN);
+VAR
+ m: CARDINAL ;
+BEGIN
+ FOR m := HIGH (boolarray) TO 2 BY -2 DO
+ boolarray[m] := FALSE;
+ END
+END TestFor ;
+
+VAR
+ boolarray: ARRAY [1..1024] OF BOOLEAN ;
+BEGIN
+ TestFor (boolarray)
+END forloopbyvar3.
