procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

PR modula2/117371: type incompatibility between INTEGER and CARDINAL

Browse source 
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.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
This commit is contained in:
Gaius Mulley 2024-11-15 21:12:37 +00:00
parent 3e6a782403
commit f242f79b8a
16 changed files with 330 additions and 179 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
gcc/m2/gm2-compiler/M2Base.mod
View file

@ -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) )

144
gcc/m2/gm2-compiler/M2GenGCC.mod
View file

@ -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

11
gcc/m2/gm2-compiler/M2LexBuf.def
View file

@ -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 ;

20
gcc/m2/gm2-compiler/M2LexBuf.mod
View file

@ -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 ;

5
gcc/m2/gm2-compiler/M2MetaError.def
View file

@ -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.

21
gcc/m2/gm2-compiler/M2MetaError.mod
View file

@ -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 ;

1
gcc/m2/gm2-compiler/M2Quads.def
View file

@ -202,6 +202,7 @@ TYPE
InitStartOp,
InlineOp,
KillLocalVarOp,
LastForIteratorOp,
LineNumberOp,
LogicalAndOp,
LogicalDiffOp,

186
gcc/m2/gm2-compiler/M2Quads.mod
View file

@ -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 ') |

8
gcc/m2/gm2-compiler/M2Students.def
View file

@ -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) ;
(*

8
gcc/m2/gm2-compiler/M2Students.mod
View file

@ -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 ;
(*

20
gcc/m2/gm2-compiler/M2SymInit.mod
View file

@ -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,

4
gcc/m2/gm2-compiler/P2SymBuild.mod
View file

@ -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) ;

16
gcc/testsuite/gm2/iso/fail/forloopbyvar.mod Normal file
View file

@ -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.

17
gcc/testsuite/gm2/iso/fail/forloopbyvar4.mod Normal file
View file

@ -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.

17
gcc/testsuite/gm2/iso/fail/forloopbyvar5.mod Normal file
View file

@ -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.

16
gcc/testsuite/gm2/iso/pass/forloopbyvar3.mod Normal file
View file

@ -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.