https://gcc.gnu.org/g:a561dc0f6c7085e102fe9e9b6abd7f2138512576
commit r15-122-ga561dc0f6c7085e102fe9e9b6abd7f2138512576
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Fri May 3 01:22:10 2024 +0100
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 <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2LangDump.mod | 2 +-
gcc/m2/gm2-compiler/M2Quads.mod | 191 +++++++++++++++++----
gcc/testsuite/gm2/pim/run/pass/testforloopzero.mod | 33 ++++
.../gm2/pim/run/pass/testforloopzero2.mod | 35 ++++
.../gm2/pim/run/pass/testforloopzero3.mod | 32 ++++
.../gm2/pim/run/pass/testforloopzero4.mod | 32 ++++
6 files changed, 290 insertions(+), 35 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2LangDump.mod
b/gcc/m2/gm2-compiler/M2LangDump.mod
index e65f5b040a5..2ce77a03d14 100644
--- 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 8a9a23013b2..3f414e186b2 100644
--- 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
index 00000000000..5f00c6c6c9e
--- /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
index 00000000000..bf826221d4a
--- /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
index 00000000000..16a899d1328
--- /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
index 00000000000..b969d55bfea
--- /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.
