The bug fix re-implements gcc/m2/gm2-compiler/M2GenGCC.mod:FoldHigh
to ignore any attempt to constant fold HIGH if it has an unbounded
array operand.
gcc/m2/ChangeLog:
PR modula2/121354
* gm2-compiler/M2GenGCC.mod (FoldHigh): Rewrite.
(IsUnboundedArray): New procedure function.
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
---
gcc/m2/gm2-compiler/M2GenGCC.mod | 51 +++++++++++++++++++++-----------
1 file changed, 33 insertions(+), 18 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 2507c536181..2440b2acf66 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -6438,38 +6438,53 @@ BEGIN
END ResolveHigh ;
+(*
+ IsUnboundedArray - return TRUE if symbol is an unbounded array.
+*)
+
+PROCEDURE IsUnboundedArray (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+ IF IsParameter (sym) OR IsVar (sym)
+ THEN
+ RETURN IsUnbounded (GetType (sym))
+ END ;
+ RETURN FALSE
+END IsUnboundedArray ;
+
+
(*
FoldHigh - if the array is not dynamic then we should be able to
remove the HighOp quadruple and assign op1 with
- the known compile time HIGH(op3).
+ the known compile time HIGH(array).
*)
PROCEDURE FoldHigh (tokenno: CARDINAL; p: WalkAction;
- quad: CARDINAL; op1, dim, op3: CARDINAL) ;
+ quad: CARDINAL; op1, dim, array: CARDINAL) ;
VAR
t : tree ;
location: location_t ;
BEGIN
- (* firstly ensure that any constant literal is declared *)
- TryDeclareConstant(tokenno, op3) ;
- location := TokenToLocation(tokenno) ;
- IF GccKnowsAbout(op3) AND CompletelyResolved(op3)
+ (* Firstly ensure that any constant literal is declared. *)
+ TryDeclareConstant (tokenno, array) ;
+ location := TokenToLocation (tokenno) ;
+ IF (NOT IsUnboundedArray (array)) AND
+ GccKnowsAbout (array) AND CompletelyResolved (array)
THEN
- t := ResolveHigh(tokenno, dim, op3) ;
- (* fine, we can take advantage of this and fold constants *)
- IF IsConst(op1) AND (t#tree(NIL))
+ t := ResolveHigh (tokenno, dim, array) ;
+ (* We can take advantage of this and fold constants. *)
+ IF IsConst (op1) AND (t # tree (NIL))
THEN
- PutConst(op1, Cardinal) ;
- AddModGcc(op1,
- DeclareKnownConstant(location, GetCardinalType(),
- ToCardinal(location, t))) ;
- p(op1) ;
+ PutConst (op1, Cardinal) ;
+ AddModGcc (op1,
+ DeclareKnownConstant (location, GetCardinalType (),
+ ToCardinal (location, t))) ;
+ p (op1) ;
NoChange := FALSE ;
- SubQuad(quad)
+ SubQuad (quad)
ELSE
- (* we can still fold the expression, but not the assignment, however,
we will
- not do this here but in CodeHigh
- *)
+ (* We can still fold the expression but not the assignment,
+ we will not do this here but in CodeHigh when the result
+ can be stored. *)
END
END
END FoldHigh ;
--
2.39.5
