PR modula2/114929 for loop fails to iterate down to zero when using a cardinal type

There is a bug in the for loop control code which is exposed when an
unsigned type is used in the iterator variable.  See
gm2/pim/run/pass/testforloopzero[234].mod.  The bug is in the
calculation of the last iterator value.  The bug fix is to avoid using
negative expressions when calculating the last iterator value with a
negative step value.  This patch detects if e1, e2, step value are all
constant, in which case the ztype is used internally and there is no
overflow.  If the last iterator value is held in a variable then it
uses a different method to calculate the last iterator depending upon
the sign of the step value.

gcc/m2/ChangeLog:

	PR modula2/114929
	* gm2-compiler/M2LangDump.mod (GenQualidentSymString): Add
	missing return result into identstr.
	* gm2-compiler/M2Quads.mod (ForLoopLastIteratorVariable): New
	procedure.
	(ForLoopLastIteratorConstant): Ditto.
	(ForLoopLastIterator): Ditto.
	(BuildForToByDo): Remove LastIterator calculation and call
	ForLoopLastIterator instead.
	(FinalValue): Replace with ...
	(LastIterator): ... this.

gcc/testsuite/ChangeLog:

	PR modula2/114929
	* gm2/pim/run/pass/testforloopzero.mod: New test.
	* gm2/pim/run/pass/testforloopzero2.mod: New test.
	* gm2/pim/run/pass/testforloopzero3.mod: New test.
	* gm2/pim/run/pass/testforloopzero4.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

diff --git a/gcc/m2/gm2-compiler/M2LangDump.mod b/gcc/m2/gm2-compiler/M2LangDump.mod
index e65f5b040a5b4212648bcd4fe8cbc9bfb79dc580..2ce77a03d1432e7e97d78081fa4b1939f74e9845 100644 (file)
--- a/gcc/m2/gm2-compiler/M2LangDump.mod
+++ b/gcc/m2/gm2-compiler/M2LangDump.mod
@@ -260,7 +260,7 @@ BEGIN
    WHILE GetScope (sym) # NulSym DO
       sym := GetScope (sym) ;
       identstr := InitStringCharStar (KeyToCharStar (GetSymName (sym))) ;
-      ConCatChar (identstr, '.') ;
+      identstr := ConCatChar (identstr, '.') ;
       qualidentstr := ConCat (identstr, Mark (qualidentstr))
    END ;
    RETURN qualidentstr

diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 8a9a23013b253191aef8d3d3c7595fa5723175a8..3f414e186b2d495a3c8550367809bb8d8e52f420 100644 (file)
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -4583,6 +4583,144 @@ BEGIN
 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).
+                         In the ForLoopLastIteratorVariable case only one
+                         path will be chosen but at the time of quadruple
+                         generation we do not know the value of BySym.
+*)
+
+PROCEDURE ForLoopLastIterator (LastIterator, e1, e2, BySym, ByType: CARDINAL ;
+                               e1tok, e2tok, bytok: CARDINAL) ;
+BEGIN
+   IF IsVar (LastIterator)
+   THEN
+      ForLoopLastIteratorVariable (LastIterator, e1, e2, BySym, ByType,
+                                   e1tok, e2tok, bytok)
+   ELSE
+      ForLoopLastIteratorConstant (LastIterator, e1, e2, BySym, ByType,
+                                   e1tok, e2tok, bytok)
+   END
+END ForLoopLastIterator ;
+
+
 (*
    BuildForToByDo - Builds the For To By Do part of the For statement
                     from the quad stack.
@@ -4659,7 +4797,7 @@ VAR
    e2tok,
    idtok,
    bytok     : CARDINAL ;
-   FinalValue,
+   LastIterator,
    exit1,
    IdSym,
    BySym,
@@ -4686,55 +4824,40 @@ BEGIN
    BuildAssignmentWithoutBounds (idtok, TRUE, TRUE) ;
 
    UseLineNote (l2) ;
-   FinalValue := MakeTemporary (e2tok,
-                                AreConstant (IsConst (e1) AND IsConst (e2) AND
-                                            IsConst (BySym))) ;
-   PutVar (FinalValue, GetSType (IdSym)) ;
+   LastIterator := MakeTemporary (e2tok,
+                                  AreConstant (IsConst (e1) AND IsConst (e2) AND
+                                               IsConst (BySym))) ;
+   PutVar (LastIterator, GetSType (IdSym)) ;
    etype := MixTypes (GetSType (e1), GetSType (e2), e2tok) ;
    e1 := doConvert (etype, e1) ;
    e2 := doConvert (etype, e2) ;
 
-   PushTF (FinalValue, GetSType(FinalValue)) ;
-   PushTFtok (e2, GetSType(e2), e2tok) ;  (* FinalValue := ((e1-e2) DIV By) * By + e1 *)
-   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) ;
+   ForLoopLastIterator (LastIterator, e1, e2, BySym, ByType, e1tok, e2tok, bytok) ;
 
    (* q+1 if >=      by        0  q+..2 *)
    (* q+2 GotoOp                  q+3   *)
-   PushTFtok (BySym, ByType, bytok) ;  (* BuildRelOp  1st parameter *)
-   PushT (GreaterEqualTok) ;           (*             2nd parameter *)
-                                       (* 3rd parameter *)
+   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(f, NextQuad) ;
+   BuildRelOp (e2tok) ;           (* Choose final expression position.  *)
+   PopBool (t, f) ;
+   BackPatch (f, NextQuad) ;
    (* q+3 If >=       e1  e2      q+5  *)
    (* q+4 GotoOp                  Exit *)
    PushTFtok (e1, GetSType (e1), e1tok) ;  (* BuildRelOp  1st parameter *)
    PushT (GreaterEqualTok) ;               (*             2nd parameter *)
    PushTFtok (e2, GetSType (e2), e2tok) ;  (*             3rd parameter *)
-   BuildRelOp (e2tok) ;           (* choose final expression position.  *)
+   BuildRelOp (e2tok) ;           (* Choose final expression position.  *)
    PopBool (t1, exit1) ;
    BackPatch (t1, NextQuad) ;
-   PushFor (Merge (PopFor(), exit1)) ;    (* merge exit1 *)
+   PushFor (Merge (PopFor (), exit1)) ;    (* Merge exit1.  *)
 
    GenQuad (GotoOp, NulSym, NulSym, 0) ;
    ForLoop := NextQuad-1 ;
 
-   (* ELSE *)
+   (* ELSE.  *)
 
    BackPatch (t, NextQuad) ;
    PushTFtok (e2, GetSType(e2), e2tok) ; (* BuildRelOp  1st parameter *)
@@ -4743,16 +4866,16 @@ BEGIN
    BuildRelOp (e2tok) ;
    PopBool (t1, exit1) ;
    BackPatch (t1, NextQuad) ;
-   PushFor (Merge (PopFor (), exit1)) ;       (* merge exit1 *)
+   PushFor (Merge (PopFor (), exit1)) ;       (* Merge exit1.  *)
 
-   BackPatch(ForLoop, NextQuad) ; (* fixes the start of the for loop *)
+   BackPatch(ForLoop, NextQuad) ; (* Fixes the start of the for loop.  *)
    ForLoop := NextQuad ;
 
-   (* and set up the stack *)
+   (* And set up the stack.  *)
 
    PushTFtok (IdSym, GetSym (IdSym), idtok) ;
    PushTFtok (BySym, ByType, bytok) ;
-   PushTFtok (FinalValue, GetSType (FinalValue), e2tok) ;
+   PushTFtok (LastIterator, GetSType (LastIterator), e2tok) ;
    PushT (ForLoop) ;
    PushT (RangeId)
 END BuildForToByDo ;

diff --git a/gcc/testsuite/gm2/pim/run/pass/testforloopzero.mod b/gcc/testsuite/gm2/pim/run/pass/testforloopzero.mod
new file mode 100644 (file)
index 0000000..5f00c6c
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testforloopzero.mod
@@ -0,0 +1,33 @@
+MODULE testforloopzero ;
+
+FROM libc IMPORT printf, exit ;
+
+
+(*
+   test -
+*)
+
+PROCEDURE test ;
+VAR
+   i, n,
+   count: CARDINAL ;
+BEGIN
+   n := 5 ;
+   count := 0 ;
+   FOR i := n TO 0 BY -1 DO
+      printf ("i = %d, count = %d\n", i, count);
+      INC (count)
+   END ;
+   IF count = 6
+   THEN
+      printf ("for loop counting down passed\n")
+   ELSE
+      printf ("for loop counting down failed\n") ;
+      exit (1)
+   END
+END test ;
+
+
+BEGIN
+   test
+END testforloopzero.

diff --git a/gcc/testsuite/gm2/pim/run/pass/testforloopzero2.mod b/gcc/testsuite/gm2/pim/run/pass/testforloopzero2.mod
new file mode 100644 (file)
index 0000000..bf82622
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testforloopzero2.mod
@@ -0,0 +1,35 @@
+MODULE testforloopzero2 ;
+
+FROM libc IMPORT printf, exit ;
+
+
+(*
+   test -
+*)
+
+PROCEDURE test ;
+VAR
+   i, n,
+   zero,
+   count: CARDINAL ;
+BEGIN
+   n := 5 ;
+   count := 0 ;
+   zero := 0 ;
+   FOR i := n TO zero BY -1 DO
+      printf ("i = %d, count = %d\n", i, count);
+      INC (count)
+   END ;
+   IF count = 6
+   THEN
+      printf ("for loop counting down passed\n")
+   ELSE
+      printf ("for loop counting down failed\n") ;
+      exit (1)
+   END
+END test ;
+
+
+BEGIN
+   test
+END testforloopzero2.

diff --git a/gcc/testsuite/gm2/pim/run/pass/testforloopzero3.mod b/gcc/testsuite/gm2/pim/run/pass/testforloopzero3.mod
new file mode 100644 (file)
index 0000000..16a899d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testforloopzero3.mod
@@ -0,0 +1,32 @@
+MODULE testforloopzero3 ;
+
+FROM libc IMPORT printf, exit ;
+
+
+(*
+   test -
+*)
+
+PROCEDURE test ;
+VAR
+   i,
+   count: CARDINAL ;
+BEGIN
+   count := 0 ;
+   FOR i := 5 TO 0 BY -1 DO
+      printf ("i = %d, count = %d\n", i, count);
+      INC (count)
+   END ;
+   IF count = 6
+   THEN
+      printf ("for loop counting down passed\n")
+   ELSE
+      printf ("for loop counting down failed\n") ;
+      exit (1)
+   END
+END test ;
+
+
+BEGIN
+   test
+END testforloopzero3.

diff --git a/gcc/testsuite/gm2/pim/run/pass/testforloopzero4.mod b/gcc/testsuite/gm2/pim/run/pass/testforloopzero4.mod
new file mode 100644 (file)
index 0000000..b969d55
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/testforloopzero4.mod
@@ -0,0 +1,32 @@
+MODULE testforloopzero4 ;
+
+FROM libc IMPORT printf, exit ;
+
+
+(*
+   test -
+*)
+
+PROCEDURE test ;
+VAR
+   i,
+   count: INTEGER ;
+BEGIN
+   count := 0 ;
+   FOR i := 5 TO -5 BY -1 DO
+      printf ("i = %d, count = %d\n", i, count);
+      INC (count)
+   END ;
+   IF count = 11
+   THEN
+      printf ("for loop counting down (%d) passed\n", count)
+   ELSE
+      printf ("for loop counting down (%d) failed\n", count) ;
+      exit (1)
+   END
+END test ;
+
+
+BEGIN
+   test
+END testforloopzero4.