From: Gaius Mulley Date: Thu, 4 May 2023 17:15:59 +0000 (+0100) Subject: PR modula2/109729 cannot use a CHAR type as a FOR loop iterator X-Git-Tag: basepoints/gcc-15~9655 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ac7c9954ece9a75c5e7c3b76a4800f2432002487;p=thirdparty%2Fgcc.git PR modula2/109729 cannot use a CHAR type as a FOR loop iterator This patch introduces a new quadruple ArithAddOp which is used in the construction of FOR loop to ensure that when constant folding is applied it does not concatenate two constant char operands into a string constant. Overloading only occurs with constant operands. gcc/m2/ChangeLog: PR modula2/109729 * gm2-compiler/M2GenGCC.mod (CodeStatement): Detect ArithAddOp and call CodeAddChecked. (ResolveConstantExpressions): Detect ArithAddOp and call FoldArithAdd. (FoldArithAdd): New procedure. (FoldAdd): Refactor to use FoldArithAdd. * gm2-compiler/M2Quads.def (QuadOperator): Add ArithAddOp. * gm2-compiler/M2Quads.mod: Remove commented imports. (QuadFrame): Changed comments to use GNU coding standards. (ArithPlusTok): New global variable. (BuildForToByDo): Use ArithPlusTok instead of PlusTok. (MakeOp): Detect ArithPlusTok and return ArithAddOp. (WriteQuad): Add ArithAddOp clause. (WriteOperator): Add ArithAddOp clause. (Init): Initialize ArithPlusTok. gcc/testsuite/ChangeLog: PR modula2/109729 * gm2/pim/run/pass/ForChar.mod: New test. Signed-off-by: Gaius Mulley --- diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod index 1f593cf6939b..15fb929cd87d 100644 --- a/gcc/m2/gm2-compiler/M2GenGCC.mod +++ b/gcc/m2/gm2-compiler/M2GenGCC.mod @@ -476,6 +476,7 @@ BEGIN DummyOp : | InitAddressOp : CodeInitAddress(q, op1, op2, op3) | BecomesOp : CodeBecomes(q) | + ArithAddOp, AddOp : CodeAddChecked (q, op2, op3) | SubOp : CodeSubChecked (q, op2, op3) | MultOp : CodeMultChecked (q, op2, op3) | @@ -586,6 +587,7 @@ BEGIN LogicalAndOp : FoldSetAnd (tokenno, p, quad, op1, op2, op3) | LogicalXorOp : FoldSymmetricDifference (tokenno, p, quad, op1, op2, op3) | BecomesOp : FoldBecomes (tokenno, p, quad, op1, op3) | + ArithAddOp : FoldArithAdd (op1pos, p, quad, op1, op2, op3) | AddOp : FoldAdd (op1pos, p, quad, op1, op2, op3) | SubOp : FoldSub (op1pos, p, quad, op1, op2, op3) | MultOp : FoldMult (op1pos, p, quad, op1, op2, op3) | @@ -3623,7 +3625,8 @@ END GetStr ; (* - FoldAdd - check addition for constant folding. + FoldAdd - check addition for constant folding. It checks for conststrings + overloading the +. *) PROCEDURE FoldAdd (tokenno: CARDINAL; p: WalkAction; @@ -3643,14 +3646,25 @@ BEGIN SubQuad (quad) ; s := KillString (s) ELSE - IF BinaryOperands (quad, op2, op3) - THEN - FoldBinary (tokenno, p, BuildAdd, quad, op1, op2, op3) - END + FoldArithAdd (tokenno, p, quad, op1, op2, op3) END END FoldAdd ; +(* + FoldArithAdd - check arithmetic addition for constant folding. +*) + +PROCEDURE FoldArithAdd (tokenno: CARDINAL; p: WalkAction; + quad: CARDINAL; op1, op2, op3: CARDINAL) ; +BEGIN + IF BinaryOperands (quad, op2, op3) + THEN + FoldBinary (tokenno, p, BuildAdd, quad, op1, op2, op3) + END +END FoldArithAdd ; + + (* CodeAddChecked - code an addition instruction, determine whether checking is required. diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def index f1b841e744dd..84c01e236932 100644 --- a/gcc/m2/gm2-compiler/M2Quads.def +++ b/gcc/m2/gm2-compiler/M2Quads.def @@ -165,6 +165,7 @@ TYPE DivCeilOp, ModCeilOp, DivFloorOp, ModFloorOp, DivTruncOp, ModTruncOp, LogicalOrOp, LogicalAndOp, LogicalXorOp, LogicalDiffOp, + ArithAddOp, InclOp, ExclOp, LogicalShiftOp, LogicalRotateOp, UnboundedOp, HighOp, CoerceOp, ConvertOp, CastOp, diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 2380efb70417..57f272f6106c 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -248,8 +248,6 @@ FROM M2Range IMPORT InitAssignmentRangeCheck, InitWholeZeroDivisionCheck, InitWholeZeroRemainderCheck, InitParameterRangeCheck, - (* CheckRangeAddVariableRead, *) - (* CheckRangeRemoveVariableRead, *) WriteRangeCheck ; FROM M2CaseList IMPORT PushCase, PopCase, AddRange, BeginCaseList, EndCaseList, ElseCase ; @@ -289,14 +287,14 @@ TYPE Operand1 : CARDINAL ; Operand2 : CARDINAL ; Operand3 : CARDINAL ; - Next : CARDINAL ; (* Next quadruple *) - LineNo : CARDINAL ; (* Line No of source text *) - TokenNo : CARDINAL ; (* Token No of source text *) - NoOfTimesReferenced: CARDINAL ; (* No of times quad is referenced *) - CheckOverflow : BOOLEAN ; (* should backend check overflow *) + Next : CARDINAL ; (* Next quadruple. *) + LineNo : CARDINAL ; (* Line No of source text. *) + TokenNo : CARDINAL ; (* Token No of source text. *) + NoOfTimesReferenced: CARDINAL ; (* No of times quad is referenced. *) + CheckOverflow : BOOLEAN ; (* should backend check overflow *) op1pos, op2pos, - op3pos : CARDINAL ; (* token position of operands. *) + op3pos : CARDINAL ; (* Token position of operands. *) END ; WithFrame = POINTER TO RECORD @@ -309,10 +307,11 @@ TYPE ForLoopInfo = POINTER TO RECORD IncrementQuad, - StartOfForLoop, (* we keep a list of all for *) - EndOfForLoop, (* loops so we can check index *) + StartOfForLoop, (* We keep a list of all for *) + EndOfForLoop, (* loops so we can check index. *) ForLoopIndex, - IndexTok : CARDINAL ; (* variables are not abused *) + IndexTok : CARDINAL ; (* Used to ensure iterators are not *) + (* user modified. *) END ; LineNote = POINTER TO RECORD @@ -334,37 +333,39 @@ VAR WhileStack, ForStack, ExitStack, - ReturnStack : StackOfWord ; (* Return quadruple of the procedure. *) - PriorityStack : StackOfWord ; (* temporary variable holding old priority *) + ReturnStack : StackOfWord ; (* Return quadruple of the procedure. *) + PriorityStack : StackOfWord ; (* Temporary variable holding old priority. *) SuppressWith : BOOLEAN ; QuadArray : Index ; NextQuad : CARDINAL ; (* Next quadruple number to be created. *) FreeList : CARDINAL ; (* FreeList of quadruples. *) CurrentProc : CARDINAL ; (* Current procedure being compiled, used *) - (* to determine which procedure a RETURN *) + (* to determine which procedure a RETURN. *) (* ReturnValueOp must have as its 3rd op. *) InitQuad : CARDINAL ; (* Initial Quad BackPatch that starts the *) (* suit of Modules. *) LastQuadNo : CARDINAL ; (* Last Quadruple accessed by GetQuad. *) + ArithPlusTok, (* Internal + token for arithmetic only. *) LogicalOrTok, (* Internal _LOR token. *) LogicalAndTok, (* Internal _LAND token. *) LogicalXorTok, (* Internal _LXOR token. *) LogicalDifferenceTok : Name ; (* Internal _LDIFF token. *) InConstExpression, - IsAutoOn, (* should parser automatically push idents *) + IsAutoOn, (* Should parser automatically push *) + (* idents? *) MustNotCheckBounds : BOOLEAN ; - ForInfo : Index ; (* start and end of all FOR loops *) - GrowInitialization : CARDINAL ; (* upper limit of where the initialized *) + ForInfo : Index ; (* Start and end of all FOR loops. *) + GrowInitialization : CARDINAL ; (* Upper limit of where the initialized *) (* quadruples. *) BuildingHigh, BuildingSize, - QuadrupleGeneration : BOOLEAN ; (* should we be generating quadruples? *) - FreeLineList : LineNote ; (* free list of line notes *) - VarientFields : List ; (* the list of all varient fields created *) - VarientFieldNo : CARDINAL ; (* used to retrieve the VarientFields *) + QuadrupleGeneration : BOOLEAN ; (* Should we be generating quadruples? *) + FreeLineList : LineNote ; (* Free list of line notes. *) + VarientFields : List ; (* The list of all varient fields created. *) + VarientFieldNo : CARDINAL ; (* Used to retrieve the VarientFields *) (* in order. *) NoOfQuads : CARDINAL ; (* Number of used quadruples. *) - Head : CARDINAL ; (* Head of the list of quadruples *) + Head : CARDINAL ; (* Head of the list of quadruples. *) (* @@ -4436,7 +4437,7 @@ BEGIN PushT (TimesTok) ; PushTFtok (BySym, ByType, bytok) ; doBuildBinaryOp (FALSE, FALSE) ; - PushT (PlusTok) ; + PushT (ArithPlusTok) ; PushTFtok (e1, GetSType (e1), e1tok) ; doBuildBinaryOp (FALSE, FALSE) ; BuildForLoopToRangeCheck ; @@ -12906,7 +12907,7 @@ BEGIN left := t END ; combinedTok := MakeVirtualTok (optokpos, leftpos, rightpos) ; - GenQuadO (combinedTok, MakeOp(Op), left, right, 0, FALSE) ; (* True Exit *) + GenQuadO (combinedTok, MakeOp (Op), left, right, 0, FALSE) ; (* True Exit *) GenQuadO (combinedTok, GotoOp, NulSym, NulSym, 0, FALSE) ; (* False Exit *) PushBool (NextQuad-2, NextQuad-1) END @@ -12946,7 +12947,10 @@ END BuildNot ; PROCEDURE MakeOp (t: Name) : QuadOperator ; BEGIN - IF t=PlusTok + IF t=ArithPlusTok + THEN + RETURN ArithAddOp + ELSIF t=PlusTok THEN RETURN( AddOp ) ELSIF t=MinusTok @@ -13394,6 +13398,7 @@ BEGIN LogicalAndOp, LogicalXorOp, LogicalDiffOp, + ArithAddOp, CoerceOp, ConvertOp, CastOp, @@ -13454,6 +13459,7 @@ PROCEDURE WriteOperator (Operator: QuadOperator) ; BEGIN CASE Operator OF + ArithAddOp : printf0('Arith + ') | InitAddressOp : printf0('InitAddress ') | LogicalOrOp : printf0('Or ') | LogicalAndOp : printf0('And ') | @@ -15120,6 +15126,7 @@ BEGIN LogicalAndTok := MakeKey('_LAND') ; LogicalXorTok := MakeKey('_LXOR') ; LogicalDifferenceTok := MakeKey('_LDIFF') ; + ArithPlusTok := MakeKey ('_ARITH_+') ; QuadArray := InitIndex (1) ; FreeList := 1 ; NewQuad(NextQuad) ; diff --git a/gcc/testsuite/gm2/pim/run/pass/ForChar.mod b/gcc/testsuite/gm2/pim/run/pass/ForChar.mod new file mode 100644 index 000000000000..604ce9bd4b9b --- /dev/null +++ b/gcc/testsuite/gm2/pim/run/pass/ForChar.mod @@ -0,0 +1,33 @@ +MODULE ForChar ; + +FROM StrLib IMPORT StrEqual ; +FROM libc IMPORT printf, exit ; + + +(* + Test - +*) + +PROCEDURE Test ; +VAR + ch : CHAR ; + digits: ARRAY [0..10] OF CHAR ; + c : CARDINAL ; +BEGIN + c := 0 ; + FOR ch := '0' TO '9' DO + digits[c] := ch ; + INC (c) + END ; + digits[10] := 0C ; + IF NOT StrEqual (digits, "0123456789") + THEN + printf ("digits should equal 0123456789, but is %s\n", digits) ; + exit (1) + END +END Test ; + + +BEGIN + Test +END ForChar.