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 <gaiusmod2@gmail.com>

diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 1f593cf6939b40a5682f49398908e5e730bb9975..15fb929cd87d20cf63184a2d3e3ca87d1cd7abec 100644 (file)
--- 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 f1b841e744dd3f30fba07116665edd5cc24bafff..84c01e236932ed34a7fa7615f13929193c8f0314 100644 (file)
--- 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 2380efb70417bc7ed39ccce901ee24817202ddfb..57f272f6106c8b76a01258b8c4e5760505719e74 100644 (file)
--- 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 (file)
index 0000000..604ce9b
--- /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.