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>
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 ) |
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 ;
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) )
IsConstString, GetString, GetStringLength,
IsConstStringCnul, IsConstStringM2nul,
IsConst, IsConstSet, IsProcedure, IsProcType,
- IsVar, IsVarParamAny, IsTemporary,
+ IsVar, IsVarParamAny, IsTemporary, IsTuple,
IsEnumeration,
IsUnbounded, IsArray, IsSet, IsConstructor,
IsProcedureVariable,
GetPointerZero,
GetCardinalZero,
GetSizeOfInBits,
+ TreeOverflow,
FoldAndStrip,
CompareTrees,
StringLength,
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,
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 ;
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.
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) |
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 *)
THEN
ErrorMessageDecl (virtpos,
'illegal assignment error between {%1Etad} and {%2tad}',
- des, expr) ;
+ des, expr, TRUE) ;
RETURN( FALSE )
END
END
THEN
ErrorMessageDecl (subexprpos,
'expression mismatch between {%1Etad} and {%2tad}',
- left, right) ;
+ left, right, TRUE) ;
NoChange := FALSE ;
SubQuad (quad) ;
p (des) ;
THEN
ErrorMessageDecl (subexprpos,
'the types used in expression {%1Etad} {%kIN} {%2tad} are incompatible',
- left, right) ;
+ left, right, TRUE) ;
NoChange := FALSE ;
SubQuad (quad) ;
RETURN FALSE
(*
- 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 ;
(*
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 ;
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 ;
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) ;
(*
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 ;
(*
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.
(*
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 ;
InitStartOp,
InlineOp,
KillLocalVarOp,
+ LastForIteratorOp,
LineNumberOp,
LogicalAndOp,
LogicalDiffOp,
MetaErrorStringT2,
MetaErrorString1, MetaErrorString2,
MetaErrorN1, MetaErrorN2,
- MetaErrorNT0, MetaErrorNT1, MetaErrorNT2 ;
+ MetaErrorNT0, MetaErrorNT1, MetaErrorNT2,
+ MetaErrorDecl ;
FROM DynamicStrings IMPORT String, string, InitString, KillString,
ConCat, InitStringCharStar, Dup, Mark,
MakeConstLit,
MakeConstString, MakeConstant, MakeConstVar,
MakeConstStringM2nul, MakeConstStringCnul,
- Make2Tuple,
+ Make2Tuple, IsTuple,
RequestSym, MakePointer, PutPointer,
SkipType,
GetDType, GetSType, GetLType,
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) |
*)
+(*
+ 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
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).
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 ;
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
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
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 *)
END ;
CASE Operator OF
+ LastForIteratorOp: WriteOperand(Operand1) ;
+ fprintf0 (GetDumpFile (), ' ') ;
+ WriteOperand(Operand2) ;
+ fprintf0 (GetDumpFile (), ' ') ;
+ WriteOperand(Operand3) |
HighOp : WriteOperand(Operand1) ;
fprintf1 (GetDumpFile (), ' %4d ', Operand2) ;
WriteOperand(Operand3) |
ArithAddOp : fprintf0 (GetDumpFile (), 'Arith + ') |
InitAddressOp : fprintf0 (GetDumpFile (), 'InitAddress ') |
+ LastForIteratorOp : fprintf0 (GetDumpFile (), 'LastForIterator ') |
LogicalOrOp : fprintf0 (GetDumpFile (), 'Or ') |
LogicalAndOp : fprintf0 (GetDumpFile (), 'And ') |
LogicalXorOp : fprintf0 (GetDumpFile (), 'Xor ') |
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) ;
(*
(*
- 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 ;
(*
IsReallyPointer, IsUnbounded,
IsVarient, IsFieldVarient, GetVarient,
IsVarArrayRef, GetSymName,
- IsType, IsPointer,
+ IsType, IsPointer, IsTuple,
GetParameterShadowVar, IsParameter, GetLType,
GetParameterHeapVar, GetVarDeclTok ;
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 -
*)
IfLessEquOp,
IfGreOp,
IfGreEquOp : CheckComparison (op1tok, op1, op2tok, op2, warning, i) |
+ LastForIteratorOp : CheckLastForIterator (op1tok, op1, op2tok, op2,
+ warning, i) ;
+ Assert (IsConst (op3)) |
TryOp,
ReturnOp,
CallOp,
CompilingProgramModule ;
FROM M2Const IMPORT constType ;
-FROM M2Students IMPORT CheckForVariableThatLooksLikeKeyword ;
+FROM M2Students IMPORT CheckVariableAgainstKeyword ;
IMPORT M2Error ;
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) ;
--- /dev/null
+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.
--- /dev/null
+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.
--- /dev/null
+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.
--- /dev/null
+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.
projects / thirdparty / gcc.git / commitdiff
