diff --git a/gcc/m2/gm2-compiler/M2Base.mod b/gcc/m2/gm2-compiler/M2Base.mod index 986e208e0c3..7064c60b1fb 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 e92bc174968..1cb60a87a84 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 19e261e83cb..766d9555ef9 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 5a0b6086bcb..c6521782a80 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 333a4a36c45..1bc87656181 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 2dd8c5c3d0a..b1ae6ca4dfe 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 12a4708ee67..bb0d6a0a954 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 fe1ddd5f830..2c3969805dc 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 04e1a9185a8..ec17fec55e3 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 f269fbb3a6c..e7f1dd94370 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 deca342f73f..2bc15d3bd0a 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 d51fd1c931a..70492705129 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 00000000000..4198d74f608 --- /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 00000000000..241e3530262 --- /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 00000000000..28b881ff190 --- /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 00000000000..d6064a67986 --- /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.