https://gcc.gnu.org/g:4e3c8257304c55f2ebfb24bd6de3236bda0f054e
commit r14-9823-g4e3c8257304c55f2ebfb24bd6de3236bda0f054e
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Sat Apr 6 23:45:35 2024 +0100
PR modula2/114617 gm2 unable to resolve const expressions using relop ICE
This patch allows cc1gm2 to resolve constant expressions which use
relative operators. Previous to the patch the result of a relop
was stored in a temporary variable set by an if then else quadruple
sequence. This patch marks a const expression in the quadruples
and then reduces this sequence of quadruples into a single
assignment to an internal constant.
gcc/m2/ChangeLog:
PR modula2/114617
* gm2-compiler/M2GenGCC.mod (CodeStatememt): Add quad trace.
(ResolveConstantExpressions): Add parameter p to FoldIfLess,
FoldIfGre, FoldIfLessEqu, FoldIfGreEqu, FoldIfEqu, FoldIfNotEqu,
FoldIfIn and FoldIfNotIn.
(CodeInline): Add constExpr variable and pass it to GetQuadOtok.
(CodeReturnValue): Ditto.
(CodeParam): Ditto.
(FoldStringLength): Ditto.
(FoldStringConvertM2nul): Ditto.
(FoldStringConvertCnul): Ditto.
(DeclaredOperandsBecomes): Ditto.
(TypeCheckBecomes): Ditto.
(PerformFoldBecomes): Ditto.
(CodeBecomes): Ditto.
(CheckElementSetTypes): Ditto.
(CodeBinarySet): Ditto.
(PerformCodeIfLess): Ditto.
(PerformCodeIfGre): Ditto.
(PerformCodeIfLessEqu): Ditto.
(PerformCodeIfGreEqu): Ditto.
(PerformCodeIfEqu): Ditto.
(PerformCodeIfNotEqu): Ditto.
(IsValidExpressionRelOp): Ditto.
(PerformCodeIfIn): Ditto.
(PerformCodeIfNotIn): Ditto.
(CodeXIndr): Ditto.
(QuadCondition): New procedure function.
(IsBooleanRelOpPattern): Ditto.
(FoldBooleanRelopPattern): Ditto.
(FoldIfGre): Check for boolean relop constant expression and
add parameter p.
(FoldIfLessEqu): Ditto.
(FoldIfIn): Ditto.
(FoldIfEqu): Ditto.
(FoldIfNotIn): Ditto.
(FoldIfGreEqu): New procedure.
(FoldIfNotEqu): Ditto.
* gm2-compiler/M2Optimize.mod (ReduceBranch): Add constExpr
variable and pass it to GetQuadOtok.
* gm2-compiler/M2Quads.def (IsBecomes): New procedure function.
(IsDummy): Ditto.
(IsQuadConstExpr): Ditto.
(SetQuadConstExpr): Ditto.
(GetQuadDest): New procedure.
(GetQuadOp1): New procedure.
(GetQuadOp2): New procedure.
(GetQuadOp3): New procedure.
(GetQuadOtok): New procedure.
(GetQuadOTypetok): New procedure.
(PutQuadOtok): New procedure.
(IsInConstParameters): New procedure function.
* gm2-compiler/M2Quads.mod (IsBecomes): New procedure function.
(IsDummy): Ditto.
(IsQuadConstExpr): Ditto.
(SetQuadConstExpr): Ditto.
(GetQuadDest): New procedure.
(GetQuadOp1): New procedure.
(GetQuadOp2): New procedure.
(GetQuadOp3): New procedure.
(GetQuadOtok): New procedure.
(GetQuadOTypetok): New procedure.
(PutQuadOtok): New procedure.
(IsInConstParameters): New procedure function.
(ConstStack): Remove to ...
(ConstExprStack): ... this.
(ConstParamStack): New variable and initialize.
(QuadFrame): New field ConstExpr.
(GetQuadOtok): Add parameter constExpr and assign.
(PutQuadOtok): Add constExpr parameter and assign.
(PutQuadOType): Ditto.
(GetQuadOTypetok): Ditto.
(EraseQuad): Assign ConstExpr to FALSE.
(FoldSubrange): Set ConstExpr to FALSE in BecomesOp.
(PushInConstParameters): New procedure.
(PopInConstParameters): New procedure.
(IsInConstParameters): New procedure function.
* gm2-compiler/M2SymInit.mod (IssueConditional): Add
constExpr boolean variable.
(CheckReadBeforeInitQuad): Ditto.
(trashParam): Ditto.
* gm2-compiler/P3Build.bnf (ConstExpression): Call
PushInConstExpression and PopInConstExpression.
(ConstSetOrQualidentOrFunction): Call
PushInConstParameters and PopInConstParameters.
* gm2-compiler/PCBuild.bnf (ConstExpression): Call
PushInConstExpression and PopInConstExpression.
* gm2-compiler/PHBuild.bnf: Ditto
* gm2-gcc/m2expr.cc (m2expr_BuildCondIfExpression): New
function.
* gm2-gcc/m2expr.def (BuildCondIfExpression): New prototype.
* gm2-gcc/m2expr.h (m2expr_BuildCondIfExpression): New function.
gcc/testsuite/ChangeLog:
PR modula2/114617
* gm2/iso/const/pass/iso-const-pass.exp: New test.
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2GenGCC.mod | 456 ++++++++++++++++++---
gcc/m2/gm2-compiler/M2Optimize.mod | 5 +-
gcc/m2/gm2-compiler/M2Quads.def | 91 +++-
gcc/m2/gm2-compiler/M2Quads.mod | 201 +++++++--
gcc/m2/gm2-compiler/M2SymInit.mod | 15 +-
gcc/m2/gm2-compiler/P3Build.bnf | 11 +-
gcc/m2/gm2-compiler/PCBuild.bnf | 5 +-
gcc/m2/gm2-compiler/PHBuild.bnf | 5 +-
gcc/m2/gm2-gcc/m2expr.cc | 8 +
gcc/m2/gm2-gcc/m2expr.def | 7 +
gcc/m2/gm2-gcc/m2expr.h | 2 +
.../gm2/iso/const/pass/iso-const-pass.exp | 36 ++
12 files changed, 738 insertions(+), 104 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 60f58cc2d1b..a45d33ef89e 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -257,10 +257,14 @@ FROM M2Quads IMPORT QuadOperator, GetQuad, IsReferenced,
GetNextQuad,
SubQuad, PutQuad, MustCheckOverflow, GetQuadOtok,
GetQuadOTypetok,
QuadToTokenNo, DisplayQuad, GetQuadtok,
- GetM2OperatorDesc, GetQuadOp ;
+ GetM2OperatorDesc, GetQuadOp,
+ IsQuadConstExpr, IsBecomes, IsGoto, IsConditional,
+ IsDummy,
+ GetQuadOp1, GetQuadOp3, GetQuadDest, SetQuadConstExpr ;
FROM M2Check IMPORT ParameterTypeCompatible, AssignmentTypeCompatible,
ExpressionTypeCompatible ;
FROM M2SSA IMPORT EnableSSA ;
+FROM M2Optimize IMPORT FoldBranches ;
CONST
@@ -460,8 +464,8 @@ BEGIN
CheckReferenced(q, op) ;
IF GetDebugTraceQuad ()
THEN
- printf0('building: ') ;
- DisplayQuad(q)
+ printf0 ('building: ') ;
+ DisplayQuad (q)
END ;
CASE op OF
@@ -588,6 +592,11 @@ BEGIN
THEN
tokenno := QuadToTokenNo (quad)
END ;
+ IF GetDebugTraceQuad ()
+ THEN
+ printf0('examining fold: ') ;
+ DisplayQuad (quad)
+ END ;
GetQuadtok (quad, op, op1, op2, op3,
op1pos, op2pos, op3pos) ;
CASE op OF
@@ -621,9 +630,14 @@ BEGIN
CastOp : FoldCast (tokenno, p, quad, op1, op2, op3) |
InclOp : FoldIncl (tokenno, p, quad, op1, op3) |
ExclOp : FoldExcl (tokenno, p, quad, op1, op3) |
- IfLessOp : FoldIfLess (tokenno, quad, op1, op2, op3) |
- IfInOp : FoldIfIn (tokenno, quad, op1, op2, op3) |
- IfNotInOp : FoldIfNotIn (tokenno, quad, op1, op2, op3) |
+ IfEquOp : FoldIfEqu (tokenno, p, quad, op1, op2, op3) |
+ IfNotEquOp : FoldIfNotEqu (tokenno, p, quad, op1, op2, op3) |
+ IfLessOp : FoldIfLess (tokenno, p, quad, op1, op2, op3) |
+ IfLessEquOp : FoldIfLessEqu (tokenno, p, quad, op1, op2, op3) |
+ IfGreOp : FoldIfGre (tokenno, p, quad, op1, op2, op3) |
+ IfGreEquOp : FoldIfGreEqu (tokenno, p, quad, op1, op2, op3) |
+ IfInOp : FoldIfIn (tokenno, p, quad, op1, op2, op3) |
+ IfNotInOp : FoldIfNotIn (tokenno, p, quad, op1, op2, op3) |
LogicalShiftOp : FoldSetShift(tokenno, p, quad, op1, op2, op3) |
LogicalRotateOp : FoldSetRotate (tokenno, p, quad, op1, op2, op3) |
ParamOp : FoldBuiltinFunction (tokenno, p, quad, op1, op2,
op3) |
@@ -812,6 +826,7 @@ END BuildTrashTreeFromInterface ;
PROCEDURE CodeInline (quad: CARDINAL) ;
VAR
+ constExpr,
overflowChecking: BOOLEAN ;
op : QuadOperator ;
op1, op2, GnuAsm: CARDINAL ;
@@ -824,7 +839,8 @@ VAR
labels : Tree ;
location : location_t ;
BEGIN
- GetQuadOtok (quad, asmpos, op, op1, op2, GnuAsm, overflowChecking,
+ GetQuadOtok (quad, asmpos, op, op1, op2, GnuAsm,
+ overflowChecking, constExpr,
op1pos, op2pos, op3pos) ;
location := TokenToLocation (asmpos) ;
inputs := BuildTreeFromInterface (GetGnuAsmInput (GnuAsm)) ;
@@ -1879,6 +1895,7 @@ END CodeProcedureScope ;
PROCEDURE CodeReturnValue (quad: CARDINAL) ;
VAR
op : QuadOperator ;
+ constExpr,
overflowChecking : BOOLEAN ;
expr, none, procedure : CARDINAL ;
combinedpos,
@@ -1886,7 +1903,8 @@ VAR
value, length : Tree ;
location : location_t ;
BEGIN
- GetQuadOtok (quad, returnpos, op, expr, none, procedure, overflowChecking,
+ GetQuadOtok (quad, returnpos, op, expr, none, procedure,
+ overflowChecking, constExpr,
exprpos, nonepos, procpos) ;
combinedpos := MakeVirtualTok (returnpos, returnpos, exprpos) ;
location := TokenToLocation (combinedpos) ;
@@ -2500,11 +2518,13 @@ VAR
parampos : CARDINAL ;
nth : CARDINAL ;
compatible,
+ constExpr,
overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, parampos, op,
- nth, procedure, parameter, overflow,
+ nth, procedure, parameter,
+ overflow, constExpr,
nopos, nopos, nopos) ;
compatible := TRUE ;
IF nth=0
@@ -2593,10 +2613,12 @@ VAR
stroppos,
despos, nonepos,
exprpos : CARDINAL ;
+ constExpr,
overflowChecking: BOOLEAN ;
location : location_t ;
BEGIN
- GetQuadOtok (quad, stroppos, op, des, none, expr, overflowChecking,
+ GetQuadOtok (quad, stroppos, op, des, none, expr,
+ overflowChecking, constExpr,
despos, nonepos, exprpos) ;
IF IsConstStr (expr) AND IsConstStrKnown (expr)
THEN
@@ -2624,9 +2646,11 @@ VAR
despos, nonepos,
exprpos : CARDINAL ;
s : String ;
+ constExpr,
overflowChecking: BOOLEAN ;
BEGIN
- GetQuadOtok (quad, stroppos, op, des, none, expr, overflowChecking,
+ GetQuadOtok (quad, stroppos, op, des, none, expr,
+ overflowChecking, constExpr,
despos, nonepos, exprpos) ;
IF IsConstStr (expr) AND IsConstStrKnown (expr)
THEN
@@ -2654,9 +2678,11 @@ VAR
despos, nonepos,
exprpos : CARDINAL ;
s : String ;
+ constExpr,
overflowChecking: BOOLEAN ;
BEGIN
- GetQuadOtok (quad, stroppos, op, des, none, expr, overflowChecking,
+ GetQuadOtok (quad, stroppos, op, des, none, expr,
+ overflowChecking, constExpr,
despos, nonepos, exprpos) ;
IF IsConstStr (expr) AND IsConstStrKnown (expr)
THEN
@@ -2729,7 +2755,7 @@ VAR
op : QuadOperator ;
des, op2, expr: CARDINAL ;
BEGIN
- IF DeclaredOperandsBecomes (p, quad)
+ IF DeclaredOperandsBecomes (p, quad) AND (NOT IsQuadConstExpr (quad))
THEN
IF TypeCheckBecomes (p, quad)
THEN
@@ -2774,13 +2800,15 @@ END RemoveQuad ;
PROCEDURE DeclaredOperandsBecomes (p: WalkAction; quad: CARDINAL) : BOOLEAN ;
VAR
des, op2, expr : CARDINAL ;
+ constExpr,
overflowChecking : BOOLEAN ;
despos, op2pos,
exprpos, becomespos: CARDINAL ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, becomespos, op,
- des, op2, expr, overflowChecking,
+ des, op2, expr,
+ overflowChecking, constExpr,
despos, op2pos, exprpos) ;
Assert (op2pos = UnknownTokenNo) ;
TryDeclareConst (exprpos, expr) ;
@@ -2812,13 +2840,15 @@ END DeclaredOperandsBecomes ;
PROCEDURE TypeCheckBecomes (p: WalkAction; quad: CARDINAL) : BOOLEAN ;
VAR
des, op2, expr : CARDINAL ;
+ constExpr,
overflowChecking : BOOLEAN ;
despos, op2pos,
exprpos, becomespos: CARDINAL ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, becomespos, op,
- des, op2, expr, overflowChecking,
+ des, op2, expr,
+ overflowChecking, constExpr,
despos, op2pos, exprpos) ;
Assert (op2pos = UnknownTokenNo) ;
IF StrictTypeChecking AND
@@ -2843,6 +2873,7 @@ END TypeCheckBecomes ;
PROCEDURE PerformFoldBecomes (p: WalkAction; quad: CARDINAL) ;
VAR
des, op2, expr : CARDINAL ;
+ constExpr,
overflowChecking : BOOLEAN ;
despos, op2pos,
exprpos, becomespos,
@@ -2850,7 +2881,8 @@ VAR
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, becomespos, op,
- des, op2, expr, overflowChecking,
+ des, op2, expr,
+ overflowChecking, constExpr,
despos, op2pos, exprpos) ;
Assert (op2pos = UnknownTokenNo) ;
IF IsConst (des) AND IsConstString (expr)
@@ -3329,6 +3361,7 @@ END checkDeclare ;
PROCEDURE CodeBecomes (quad: CARDINAL) ;
VAR
+ constExpr,
overflowChecking: BOOLEAN ;
op : QuadOperator ;
des, op2, expr : CARDINAL ;
@@ -3341,7 +3374,8 @@ VAR
exprt : Tree ;
location : location_t ;
BEGIN
- GetQuadOtok (quad, becomespos, op, des, op2, expr, overflowChecking,
+ GetQuadOtok (quad, becomespos, op, des, op2, expr,
+ overflowChecking, constExpr,
despos, op2pos, exprpos) ;
Assert (op2pos = UnknownTokenNo) ;
DeclareConstant (exprpos, expr) ; (* Check to see whether expr is a
constant and declare it. *)
@@ -3729,6 +3763,7 @@ VAR
righttype,
des, left, right: CARDINAL ;
typeChecking,
+ constExpr,
overflowChecking: BOOLEAN ;
despos, leftpos,
rightpos,
@@ -3737,7 +3772,8 @@ VAR
op : QuadOperator ;
BEGIN
GetQuadOTypetok (quad, operatorpos, op,
- des, left, right, overflowChecking, typeChecking,
+ des, left, right,
+ overflowChecking, typeChecking, constExpr,
despos, leftpos, rightpos) ;
IF typeChecking AND (op # LogicalRotateOp) AND (op # LogicalShiftOp)
THEN
@@ -3786,6 +3822,7 @@ VAR
lefttype,
righttype,
ignore, left, right: CARDINAL ;
+ constExpr,
overflowChecking: BOOLEAN ;
ignorepos,
leftpos,
@@ -3795,7 +3832,8 @@ VAR
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, operatorpos, op,
- left, right, ignore, overflowChecking,
+ left, right, ignore,
+ overflowChecking, constExpr,
leftpos, rightpos, ignorepos) ;
subexprpos := MakeVirtualTok (operatorpos, leftpos, rightpos) ;
lefttype := GetType (left) ;
@@ -3847,6 +3885,7 @@ PROCEDURE CodeBinarySet (binop: BuildBinProcedure; doOp:
DoProcedure;
quad: CARDINAL) ;
VAR
location : location_t ;
+ constExpr,
overflowChecking: BOOLEAN ;
op : QuadOperator ;
virttoken,
@@ -3859,7 +3898,8 @@ VAR
rightpos,
operatorpos : CARDINAL ;
BEGIN
- GetQuadOtok (quad, operatorpos, op, des, left, right, overflowChecking,
+ GetQuadOtok (quad, operatorpos, op, des, left, right,
+ overflowChecking, constExpr,
despos, leftpos, rightpos) ;
(* Firstly ensure that constant literals are declared. *)
@@ -5277,17 +5317,17 @@ END FoldIncl ;
if op1 < op2 then goto op3.
*)
-PROCEDURE FoldIfLess (tokenno: CARDINAL;
+PROCEDURE FoldIfLess (tokenno: CARDINAL; p: WalkAction;
quad: CARDINAL; left, right, destQuad: CARDINAL) ;
BEGIN
- (* firstly ensure that constant literals are declared *)
+ (* Firstly ensure that constant literals are declared. *)
TryDeclareConstant(tokenno, left) ;
TryDeclareConstant(tokenno, right) ;
IF IsConst (left) AND IsConst (right)
THEN
IF IsValueSolved (left) AND IsValueSolved (right)
THEN
- (* fine, we can take advantage of this and evaluate the condition *)
+ (* We can take advantage of the known values and evaluate the
condition. *)
PushValue (left) ;
PushValue (right) ;
IF Less (tokenno)
@@ -5295,21 +5335,229 @@ BEGIN
PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
SubQuad (quad)
- END
+ END ;
+ NoChange := FALSE
END
END
END FoldIfLess ;
+(*
+ IsBooleanRelOpPattern - return TRUE if the pattern:
+ q If left right q+2
+ q+1 Goto q+4
+ q+2 Becomes des[i] TRUE[i]
+ q+3 Goto q+5
+ q+4 Becomes des[i] FALSE[i]
+*)
+
+PROCEDURE IsBooleanRelOpPattern (quad: CARDINAL) : BOOLEAN ;
+BEGIN
+ IF IsQuadConstExpr (quad)
+ THEN
+ IF IsConditional (quad) AND
+ (IsGoto (quad+1) OR IsDummy (quad+1)) AND
+ IsBecomes (quad+2) AND IsGoto (quad+3) AND
+ IsBecomes (quad+4) AND
+ (GetQuadDest (quad) = quad+2) AND
+ (GetQuadDest (quad+1) = quad+4) AND
+ (GetQuadDest (quad+3) = quad+5) AND
+ (GetQuadOp1 (quad+2) = GetQuadOp1 (quad+4))
+ THEN
+ RETURN TRUE
+ END
+ END ;
+ RETURN FALSE
+END IsBooleanRelOpPattern ;
+
+
+(*
+ FoldBooleanRelopPattern - fold the boolean relop pattern of quadruples
+ above to:
+ q+2 Becomes des[i] TRUE[i]
+ or
+ q+4 Becomes des[i] FALSE[i]
+ depending upon the condition in quad.
+*)
+
+PROCEDURE FoldBooleanRelopPattern (p: WalkAction; quad: CARDINAL) ;
+VAR
+ des: CARDINAL ;
+BEGIN
+ des := GetQuadOp1 (quad+2) ;
+ IF QuadCondition (quad)
+ THEN
+ SetQuadConstExpr (quad+2, FALSE) ;
+ SubQuad (quad+4) (* Remove des := FALSE. *)
+ ELSE
+ SetQuadConstExpr (quad+4, FALSE) ;
+ SubQuad (quad+2) (* Remove des := TRUE. *)
+ END ;
+ RemoveQuad (p, des, quad) ;
+ SubQuad (quad+1) ;
+ SubQuad (quad+3)
+END FoldBooleanRelopPattern ;
+
+
+(*
+ QuadCondition - Pre-condition: left, right operands are constants
+ which have been resolved.
+ Post-condition: return TRUE if the condition at
+ quad is TRUE.
+*)
+
+PROCEDURE QuadCondition (quad: CARDINAL) : BOOLEAN ;
+VAR
+ left, right, dest, combined,
+ leftpos, rightpos, destpos : CARDINAL ;
+ constExpr, overflow : BOOLEAN ;
+ op : QuadOperator ;
+BEGIN
+ GetQuadOtok (quad, combined, op,
+ left, right, dest, overflow,
+ constExpr,
+ leftpos, rightpos, destpos) ;
+ CASE op OF
+
+ IfInOp : PushValue (right) ;
+ RETURN SetIn (left, combined) |
+ IfNotInOp : PushValue (right) ;
+ RETURN NOT SetIn (left, combined)
+
+ ELSE
+ END ;
+ PushValue (left) ;
+ PushValue (right) ;
+ CASE op OF
+
+ IfGreOp : RETURN Gre (combined) |
+ IfLessOp : RETURN Less (combined) |
+ IfLessEquOp: RETURN LessEqu (combined) |
+ IfGreEquOp : RETURN GreEqu (combined) |
+ IfEquOp : RETURN GreEqu (combined) |
+ IfNotEquOp : RETURN NotEqu (combined)
+
+ ELSE
+ InternalError ('unrecognized comparison operator')
+ END ;
+ RETURN FALSE
+END QuadCondition ;
+
+
+(*
+ FoldIfGre - check to see if it is possible to evaluate
+ if op1 > op2 then goto op3.
+*)
+
+PROCEDURE FoldIfGre (tokenno: CARDINAL; p: WalkAction;
+ quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+ (* Firstly ensure that constant literals are declared. *)
+ TryDeclareConstant(tokenno, left) ;
+ TryDeclareConstant(tokenno, right) ;
+ IF IsConst (left) AND IsConst (right)
+ THEN
+ IF IsValueSolved (left) AND IsValueSolved (right)
+ THEN
+ (* We can take advantage of the known values and evaluate the
condition. *)
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
+ ELSE
+ PushValue (left) ;
+ PushValue (right) ;
+ IF Gre (tokenno)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
+ END ;
+ NoChange := FALSE
+ END
+ END
+END FoldIfGre ;
+
+
+(*
+ FoldIfLessEqu - check to see if it is possible to evaluate
+ if op1 <= op2 then goto op3.
+*)
+
+PROCEDURE FoldIfLessEqu (tokenno: CARDINAL; p: WalkAction;
+ quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+ (* Firstly ensure that constant literals are declared. *)
+ TryDeclareConstant(tokenno, left) ;
+ TryDeclareConstant(tokenno, right) ;
+ IF IsConst (left) AND IsConst (right)
+ THEN
+ IF IsValueSolved (left) AND IsValueSolved (right)
+ THEN
+ (* We can take advantage of the known values and evaluate the
condition. *)
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
+ ELSE
+ PushValue (left) ;
+ PushValue (right) ;
+ IF LessEqu (tokenno)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
+ END ;
+ NoChange := FALSE
+ END
+ END
+END FoldIfLessEqu ;
+
+
+(*
+ FoldIfGreEqu - check to see if it is possible to evaluate
+ if op1 >= op2 then goto op3.
+*)
+
+PROCEDURE FoldIfGreEqu (tokenno: CARDINAL; p: WalkAction;
+ quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+ (* Firstly ensure that constant literals are declared. *)
+ TryDeclareConstant(tokenno, left) ;
+ TryDeclareConstant(tokenno, right) ;
+ IF IsConst (left) AND IsConst (right)
+ THEN
+ IF IsValueSolved (left) AND IsValueSolved (right)
+ THEN
+ (* We can take advantage of the known values and evaluate the
condition. *)
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
+ ELSE
+ PushValue (left) ;
+ PushValue (right) ;
+ IF GreEqu (tokenno)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
+ END ;
+ NoChange := FALSE
+ END
+ END
+END FoldIfGreEqu ;
+
+
(*
FoldIfIn - check whether we can fold the IfInOp
if op1 in op2 then goto op3
*)
-PROCEDURE FoldIfIn (tokenno: CARDINAL;
+PROCEDURE FoldIfIn (tokenno: CARDINAL; p: WalkAction;
quad: CARDINAL; left, right, destQuad: CARDINAL) ;
BEGIN
- (* firstly ensure that constant literals are declared *)
+ (* Firstly ensure that constant literals are declared. *)
TryDeclareConstant (tokenno, left) ;
TryDeclareConstant (tokenno, right) ;
IF IsConst (left) AND IsConst (right)
@@ -5318,17 +5566,23 @@ BEGIN
THEN
IF CheckBinaryExpressionTypes (quad, NoWalkProcedure)
THEN
- (* fine, we can take advantage of this and evaluate the condition
*)
- PushValue (right) ;
- IF SetIn (tokenno, left)
+ (* We can take advantage of the known values and evaluate the
condition. *)
+ IF IsBooleanRelOpPattern (quad)
THEN
- PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ FoldBooleanRelopPattern (p, quad)
ELSE
- SubQuad (quad)
+ PushValue (right) ;
+ IF SetIn (tokenno, left)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
END
ELSE
SubQuad (quad)
- END
+ END ;
+ NoChange := FALSE
END
END
END FoldIfIn ;
@@ -5339,10 +5593,10 @@ END FoldIfIn ;
if not (op1 in op2) then goto op3
*)
-PROCEDURE FoldIfNotIn (tokenno: CARDINAL;
+PROCEDURE FoldIfNotIn (tokenno: CARDINAL; p: WalkAction;
quad: CARDINAL; left, right, destQuad: CARDINAL) ;
BEGIN
- (* firstly ensure that constant literals are declared *)
+ (* Firstly ensure that constant literals are declared. *)
TryDeclareConstant (tokenno, left) ;
TryDeclareConstant (tokenno, right) ;
IF IsConst (left) AND IsConst (right)
@@ -5351,20 +5605,96 @@ BEGIN
THEN
IF CheckBinaryExpressionTypes (quad, NoWalkProcedure)
THEN
- (* fine, we can take advantage of this and evaluate the condition
*)
+ (* We can take advantage of the known values and evaluate the
condition. *)
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
+ ELSE
+ PushValue (right) ;
+ IF NOT SetIn (tokenno, left)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
+ END
+ ELSE
+ SubQuad (quad)
+ END ;
+ NoChange := FALSE
+ END
+ END
+END FoldIfNotIn ;
+
+
+(*
+ FoldIfEqu - check to see if it is possible to evaluate
+ if op1 = op2 then goto op3.
+*)
+
+PROCEDURE FoldIfEqu (tokenno: CARDINAL; p: WalkAction;
+ quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+ (* Firstly ensure that constant literals are declared. *)
+ TryDeclareConstant(tokenno, left) ;
+ TryDeclareConstant(tokenno, right) ;
+ IF IsConst (left) AND IsConst (right)
+ THEN
+ IF IsValueSolved (left) AND IsValueSolved (right)
+ THEN
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
+ ELSE
+ (* We can take advantage of the known values and evaluate the
condition. *)
+ PushValue (left) ;
PushValue (right) ;
- IF NOT SetIn (tokenno, left)
+ IF Equ (tokenno)
THEN
PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
SubQuad (quad)
END
+ END ;
+ NoChange := FALSE
+ END
+ END
+END FoldIfEqu ;
+
+
+(*
+ FoldIfNotEqu - check to see if it is possible to evaluate
+ if op1 # op2 then goto op3.
+*)
+
+PROCEDURE FoldIfNotEqu (tokenno: CARDINAL; p: WalkAction;
+ quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+ (* Firstly ensure that constant literals are declared. *)
+ TryDeclareConstant(tokenno, left) ;
+ TryDeclareConstant(tokenno, right) ;
+ IF IsConst (left) AND IsConst (right)
+ THEN
+ IF IsValueSolved (left) AND IsValueSolved (right)
+ THEN
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
ELSE
- SubQuad (quad)
- END
+ (* We can take advantage of the known values and evaluate the
condition. *)
+ PushValue (left) ;
+ PushValue (right) ;
+ IF NotEqu (tokenno)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
+ END ;
+ NoChange := FALSE
END
END
-END FoldIfNotIn ;
+END FoldIfNotEqu ;
(*
@@ -6839,11 +7169,12 @@ VAR
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, combined, op,
left, right, dest, overflow,
+ constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
@@ -6855,7 +7186,7 @@ BEGIN
THEN
BuildGoto(location, string(CreateLabelName(dest)))
ELSE
- (* fall through *)
+ (* Fall through. *)
END
ELSIF IsConstSet(left) OR (IsVar(left) AND IsSet(SkipType(GetType(left))))
OR
IsConstSet(right) OR (IsVar(right) AND
IsSet(SkipType(GetType(right))))
@@ -6951,11 +7282,11 @@ VAR
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest, overflow, constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst(left) AND IsConst(right)
@@ -7061,11 +7392,12 @@ VAR
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ overflow, constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst(left) AND IsConst(right)
@@ -7172,11 +7504,12 @@ VAR
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ overflow, constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst(left) AND IsConst(right)
@@ -7358,11 +7691,12 @@ VAR
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ overflow, constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst (left) AND IsConst (right)
@@ -7409,12 +7743,13 @@ VAR
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
(* Ensure that any remaining undeclared constant literal is declared. *)
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ constExpr, overflow,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst (left) AND IsConst (right)
@@ -7463,12 +7798,13 @@ VAR
lefttype, righttype,
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
(* Ensure that any remaining undeclared constant literal is declared. *)
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ constExpr, overflow,
leftpos, rightpos, destpos) ;
DeclareConstant (leftpos, left) ;
DeclareConstant (rightpos, right) ;
@@ -7614,12 +7950,13 @@ VAR
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
(* Ensure that any remaining undeclared constant literal is declared. *)
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ constExpr, overflow,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst(left) AND IsConst(right)
@@ -7683,12 +8020,13 @@ VAR
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
(* Ensure that any remaining undeclared constant literal is declared. *)
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ overflow, constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst(left) AND IsConst(right)
@@ -7804,6 +8142,7 @@ END CodeIndrX ;
PROCEDURE CodeXIndr (quad: CARDINAL) ;
VAR
+ constExpr,
overflowChecking: BOOLEAN ;
op : QuadOperator ;
tokenno,
@@ -7818,7 +8157,8 @@ VAR
newstr : Tree ;
location : location_t ;
BEGIN
- GetQuadOtok (quad, xindrpos, op, left, type, right, overflowChecking,
+ GetQuadOtok (quad, xindrpos, op, left, type, right,
+ overflowChecking, constExpr,
leftpos, typepos, rightpos) ;
tokenno := MakeVirtualTok (xindrpos, leftpos, rightpos) ;
location := TokenToLocation (tokenno) ;
diff --git a/gcc/m2/gm2-compiler/M2Optimize.mod
b/gcc/m2/gm2-compiler/M2Optimize.mod
index 29fda9a6dd7..71b0094fdff 100644
--- a/gcc/m2/gm2-compiler/M2Optimize.mod
+++ b/gcc/m2/gm2-compiler/M2Optimize.mod
@@ -154,6 +154,7 @@ PROCEDURE ReduceBranch (Operator: QuadOperator;
VAR NextQuad: CARDINAL;
Folded: BOOLEAN) : BOOLEAN ;
VAR
+ constExpr,
overflowChecking: BOOLEAN ;
OpNext : QuadOperator ;
tok,
@@ -188,11 +189,11 @@ BEGIN
THEN
GetQuadOtok (CurrentQuad, tok, Operator,
CurrentOperand1, CurrentOperand2, CurrentOperand3,
- overflowChecking, op1tok, op2tok, op3tok) ;
+ overflowChecking, constExpr, op1tok, op2tok, op3tok) ;
SubQuad (NextQuad) ;
PutQuadOtok (CurrentQuad, tok, Opposite (Operator),
CurrentOperand1, CurrentOperand2, Op3Next,
- overflowChecking,
+ overflowChecking, constExpr,
op1tok, op2tok, op3tok) ;
NextQuad := NextPlusOne ;
Folded := TRUE
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index a8ca69b7bc6..6175d8d1cb2 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -124,6 +124,11 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile,
EndBuildFile,
IsPseudoQuad,
IsDefOrModFile,
IsInitialisingConst,
+ IsQuadConstExpr,
+ IsBecomes,
+ IsDummy,
+ GetQuadOp1, GetQuadOp2, GetQuadOp3, GetQuadDest,
+ SetQuadConstExpr,
DumpQuadruples, DisplayQuadRange, DisplayQuad,
WriteOperator, BackPatchSubrangesAndOptParam,
@@ -146,6 +151,8 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile,
EndBuildFile,
IsAutoPushOn, PushAutoOn, PushAutoOff, PopAuto,
PushInConstExpression, PopInConstExpression,
IsInConstExpression,
+ PushInConstParameters, PopInConstParameters,
+ IsInConstParameters,
MustCheckOverflow, BuildAsmElement, BuildAsmTrash,
GetQuadTrash ;
@@ -394,6 +401,62 @@ PROCEDURE IsFinallyStart (QuadNo: CARDINAL) : BOOLEAN ;
PROCEDURE IsFinallyEnd (QuadNo: CARDINAL) : BOOLEAN ;
+(*
+ IsBecomes - return TRUE if QuadNo is a BecomesOp.
+*)
+
+PROCEDURE IsBecomes (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+ IsDummy - return TRUE if QuadNo is a DummyOp.
+*)
+
+PROCEDURE IsDummy (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+ IsQuadConstExpr - returns TRUE if QuadNo is part of a constant expression.
+*)
+
+PROCEDURE IsQuadConstExpr (QuadNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+ SetQuadConstExpr - sets the constexpr field to value.
+*)
+
+PROCEDURE SetQuadConstExpr (QuadNo: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+ GetQuadDest - returns the jump destination associated with quad.
+*)
+
+PROCEDURE GetQuadDest (QuadNo: CARDINAL) : CARDINAL ;
+
+
+(*
+ GetQuadOp1 - returns the 1st operand associated with quad.
+*)
+
+PROCEDURE GetQuadOp1 (QuadNo: CARDINAL) : CARDINAL ;
+
+
+(*
+ GetQuadOp2 - returns the 2nd operand associated with quad.
+*)
+
+PROCEDURE GetQuadOp2 (QuadNo: CARDINAL) : CARDINAL ;
+
+
+(*
+ GetQuadOp3 - returns the 3rd operand associated with quad.
+*)
+
+PROCEDURE GetQuadOp3 (QuadNo: CARDINAL) : CARDINAL ;
+
+
(*
IsInitialisingConst - returns TRUE if the quadruple is setting
a const (op1) with a value.
@@ -547,7 +610,7 @@ PROCEDURE GetQuadOtok (QuadNo: CARDINAL;
VAR tok: CARDINAL;
VAR Op: QuadOperator;
VAR Oper1, Oper2, Oper3: CARDINAL;
- VAR overflowChecking: BOOLEAN ;
+ VAR overflowChecking, constExpr: BOOLEAN ;
VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
@@ -559,9 +622,10 @@ PROCEDURE GetQuadOTypetok (QuadNo: CARDINAL;
VAR tok: CARDINAL;
VAR Op: QuadOperator;
VAR Oper1, Oper2, Oper3: CARDINAL;
- VAR overflowChecking, typeChecking: BOOLEAN ;
+ VAR overflowChecking, typeChecking, constExpr:
BOOLEAN ;
VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
+
(*
PutQuadOtok - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
sets a boolean to determinine whether overflow should be
checked.
@@ -571,7 +635,7 @@ PROCEDURE PutQuadOtok (QuadNo: CARDINAL;
tok: CARDINAL;
Op: QuadOperator;
Oper1, Oper2, Oper3: CARDINAL;
- overflowChecking: BOOLEAN ;
+ overflowChecking, constExpr: BOOLEAN ;
Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
@@ -2801,6 +2865,27 @@ PROCEDURE PopInConstExpression ;
PROCEDURE IsInConstExpression () : BOOLEAN ;
+(*
+ PushInConstParameters - push the InConstParameters flag and then set it to
TRUE.
+*)
+
+PROCEDURE PushInConstParameters ;
+
+
+(*
+ PopInConstParameters - restores the previous value of the InConstParameters.
+*)
+
+PROCEDURE PopInConstParameters ;
+
+
+(*
+ IsInConstParameters - returns the value of the InConstParameters.
+*)
+
+PROCEDURE IsInConstParameters () : BOOLEAN ;
+
+
(*
BuildAsmElement - the stack is expected to contain:
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 12bc5494996..17d7aabc10a 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -307,6 +307,8 @@ TYPE
LineNo : CARDINAL ; (* Line No of
source text. *)
TokenNo : CARDINAL ; (* Token No
of source text. *)
NoOfTimesReferenced: CARDINAL ; (* No of
times quad is referenced. *)
+ ConstExpr, (* Must
backend resolve this at *)
+ (* compile
time? *)
CheckType,
CheckOverflow : BOOLEAN ; (* should
backend check overflow *)
op1pos,
@@ -344,7 +346,8 @@ VAR
TryStack,
CatchStack,
ExceptStack,
- ConstStack,
+ ConstExprStack,
+ ConstParamStack,
AutoStack,
RepeatStack,
WhileStack,
@@ -369,6 +372,7 @@ VAR
LogicalXorTok, (* Internal _LXOR token.
*)
LogicalDifferenceTok : Name ; (* Internal _LDIFF token.
*)
InConstExpression,
+ InConstParameters,
IsAutoOn, (* Should parser automatically push
*)
(* idents?
*)
MustNotCheckBounds : BOOLEAN ;
@@ -849,6 +853,101 @@ BEGIN
END IsFinallyEnd ;
+(*
+ IsBecomes - return TRUE if QuadNo is a BecomesOp.
+*)
+
+PROCEDURE IsBecomes (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN IsQuadA (QuadNo, BecomesOp)
+END IsBecomes ;
+
+
+(*
+ IsDummy - return TRUE if QuadNo is a DummyOp.
+*)
+
+PROCEDURE IsDummy (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN IsQuadA (QuadNo, DummyOp)
+END IsDummy ;
+
+
+(*
+ IsQuadConstExpr - returns TRUE if QuadNo is part of a constant expression.
+*)
+
+PROCEDURE IsQuadConstExpr (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (QuadNo) ;
+ RETURN f^.ConstExpr
+END IsQuadConstExpr ;
+
+
+(*
+ SetQuadConstExpr - sets the constexpr field to value.
+*)
+
+PROCEDURE SetQuadConstExpr (QuadNo: CARDINAL; value: BOOLEAN) ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (QuadNo) ;
+ f^.ConstExpr := value
+END SetQuadConstExpr ;
+
+
+(*
+ GetQuadDest - returns the jump destination associated with quad.
+*)
+
+PROCEDURE GetQuadDest (QuadNo: CARDINAL) : CARDINAL ;
+BEGIN
+ RETURN GetQuadOp3 (QuadNo)
+END GetQuadDest ;
+
+
+(*
+ GetQuadOp1 - returns the 1st operand associated with quad.
+*)
+
+PROCEDURE GetQuadOp1 (QuadNo: CARDINAL) : CARDINAL ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (QuadNo) ;
+ RETURN f^.Operand1
+END GetQuadOp1 ;
+
+
+(*
+ GetQuadOp2 - returns the 2nd operand associated with quad.
+*)
+
+PROCEDURE GetQuadOp2 (QuadNo: CARDINAL) : CARDINAL ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (QuadNo) ;
+ RETURN f^.Operand2
+END GetQuadOp2 ;
+
+
+(*
+ GetQuadOp3 - returns the 3rd operand associated with quad.
+*)
+
+PROCEDURE GetQuadOp3 (QuadNo: CARDINAL) : CARDINAL ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (QuadNo) ;
+ RETURN f^.Operand3
+END GetQuadOp3 ;
+
+
(*
IsInitialisingConst - returns TRUE if the quadruple is setting
a const (op1) with a value.
@@ -1180,7 +1279,7 @@ PROCEDURE GetQuadOtok (QuadNo: CARDINAL;
VAR tok: CARDINAL;
VAR Op: QuadOperator;
VAR Oper1, Oper2, Oper3: CARDINAL;
- VAR overflowChecking: BOOLEAN ;
+ VAR overflowChecking, constExpr: BOOLEAN ;
VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
VAR
f: QuadFrame ;
@@ -1196,7 +1295,8 @@ BEGIN
Op2Pos := op2pos ;
Op3Pos := op3pos ;
tok := TokenNo ;
- overflowChecking := CheckOverflow
+ overflowChecking := CheckOverflow ;
+ constExpr := ConstExpr
END
END GetQuadOtok ;
@@ -1210,7 +1310,7 @@ PROCEDURE PutQuadOtok (QuadNo: CARDINAL;
tok: CARDINAL;
Op: QuadOperator;
Oper1, Oper2, Oper3: CARDINAL;
- overflowChecking: BOOLEAN ;
+ overflowChecking, constExpr: BOOLEAN ;
Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
VAR
f: QuadFrame ;
@@ -1233,7 +1333,8 @@ BEGIN
op1pos := Op1Pos ;
op2pos := Op2Pos ;
op3pos := Op3Pos ;
- TokenNo := tok
+ TokenNo := tok ;
+ ConstExpr := constExpr
END
END
END PutQuadOtok ;
@@ -1384,7 +1485,8 @@ BEGIN
Operand2 := Oper2 ;
Operand3 := Oper3 ;
CheckOverflow := overflow ;
- CheckType := checktype
+ CheckType := checktype ;
+ ConstExpr := IsInConstExpression ()
END
END
END PutQuadOType ;
@@ -1403,14 +1505,14 @@ END PutQuad ;
(*
- GetQuadOtok - returns the fields associated with quadruple QuadNo.
+ GetQuadOTypetok - returns the fields associated with quadruple QuadNo.
*)
PROCEDURE GetQuadOTypetok (QuadNo: CARDINAL;
VAR tok: CARDINAL;
VAR Op: QuadOperator;
VAR Oper1, Oper2, Oper3: CARDINAL;
- VAR overflowChecking, typeChecking: BOOLEAN ;
+ VAR overflowChecking, typeChecking, constExpr:
BOOLEAN ;
VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
VAR
f: QuadFrame ;
@@ -1427,7 +1529,8 @@ BEGIN
Op3Pos := op3pos ;
tok := TokenNo ;
overflowChecking := CheckOverflow ;
- typeChecking := CheckType
+ typeChecking := CheckType ;
+ constExpr := ConstExpr
END
END GetQuadOTypetok ;
@@ -1547,7 +1650,8 @@ BEGIN
Trash := 0 ;
op1pos := UnknownTokenNo ;
op2pos := UnknownTokenNo ;
- op3pos := UnknownTokenNo
+ op3pos := UnknownTokenNo ;
+ ConstExpr := FALSE
END
END EraseQuad ;
@@ -3199,9 +3303,11 @@ BEGIN
CASE Operator OF
SubrangeLowOp : Operand3 := CollectLow (Operand3) ;
- Operator := BecomesOp |
+ Operator := BecomesOp ;
+ ConstExpr := FALSE |
SubrangeHighOp: Operand3 := CollectHigh (Operand3) ;
- Operator := BecomesOp |
+ Operator := BecomesOp ;
+ ConstExpr := FALSE |
OptParamOp : Operand3 := GetOptArgInit (Operand3) ;
Operator := ParamOp
@@ -3665,21 +3771,21 @@ BEGIN
PopTtok (Des, destok) ;
(* Conditional Boolean Assignment. *)
BackPatch (t, NextQuad) ;
- IF GetMode (Des) = RightValue
+ IF GetMode (Des) = LeftValue
THEN
- GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, True, checkOverflow)
- ELSE
CheckPointerThroughNil (destok, Des) ;
GenQuadO (destok, XIndrOp, Des, Boolean, True, checkOverflow)
+ ELSE
+ GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, True, checkOverflow)
END ;
GenQuadO (destok, GotoOp, NulSym, NulSym, NextQuad+2, checkOverflow) ;
BackPatch (f, NextQuad) ;
- IF GetMode (Des) = RightValue
+ IF GetMode (Des) = LeftValue
THEN
- GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, False, checkOverflow)
- ELSE
CheckPointerThroughNil (destok, Des) ;
GenQuadO (destok, XIndrOp, Des, Boolean, False, checkOverflow)
+ ELSE
+ GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, False, checkOverflow)
END
ELSE
PopTrwtok (Exp, r, exptok) ;
@@ -12956,11 +13062,9 @@ VAR
f : BoolFrame ;
BEGIN
Assert (IsBoolean (i)) ;
- (*
- need to convert it to a variable containing the result.
- Des will be a boolean type
- *)
- Des := MakeTemporary (tok, RightValue) ;
+ (* We need to convert the boolean top of stack into a variable or
+ constant boolean. *)
+ Des := MakeTemporary (tok, AreConstant (IsInConstExpression ())) ;
PutVar (Des, Boolean) ;
PushTtok (Des, tok) ; (* we have just increased the stack so we must use
i+1 *)
f := PeepAddress (BoolStack, i+1) ;
@@ -12968,9 +13072,9 @@ BEGIN
BuildAssignmentWithoutBounds (tok, FALSE, TRUE) ; (* restored stack *)
f := PeepAddress (BoolStack, i) ;
WITH f^ DO
- TrueExit := Des ; (* alter Stack(i) to contain the variable *)
+ TrueExit := Des ; (* Alter Stack(i) to contain the variable. *)
FalseExit := Boolean ;
- BooleanOp := FALSE ; (* no longer a Boolean True|False pair *)
+ BooleanOp := FALSE ; (* No longer a Boolean True|False pair. *)
Unbounded := NulSym ;
Dimension := 0 ;
ReadWrite := NulSym ;
@@ -13802,7 +13906,13 @@ BEGIN
f := GetQF(BufferQuad) ;
WITH f^ DO
WriteOperator(Operator) ;
- fprintf1 (GetDumpFile (), ' [%d] ', NoOfTimesReferenced) ;
+ fprintf1 (GetDumpFile (), ' [%d]', NoOfTimesReferenced) ;
+ IF ConstExpr
+ THEN
+ fprintf0 (GetDumpFile (), ' const ')
+ ELSE
+ fprintf0 (GetDumpFile (), ' ')
+ END ;
CASE Operator OF
HighOp : WriteOperand(Operand1) ;
@@ -15651,7 +15761,7 @@ END PopAuto ;
PROCEDURE PushInConstExpression ;
BEGIN
- PushWord(ConstStack, InConstExpression) ;
+ PushWord(ConstExprStack, InConstExpression) ;
InConstExpression := TRUE
END PushInConstExpression ;
@@ -15662,7 +15772,7 @@ END PushInConstExpression ;
PROCEDURE PopInConstExpression ;
BEGIN
- InConstExpression := PopWord(ConstStack)
+ InConstExpression := PopWord(ConstExprStack)
END PopInConstExpression ;
@@ -15676,6 +15786,37 @@ BEGIN
END IsInConstExpression ;
+(*
+ PushInConstParameters - push the InConstParameters flag and then set it to
TRUE.
+*)
+
+PROCEDURE PushInConstParameters ;
+BEGIN
+ PushWord (ConstParamStack, InConstParameters) ;
+ InConstParameters := TRUE
+END PushInConstParameters ;
+
+
+(*
+ PopInConstParameters - restores the previous value of the InConstParameters.
+*)
+
+PROCEDURE PopInConstParameters ;
+BEGIN
+ InConstParameters := PopWord(ConstParamStack)
+END PopInConstParameters ;
+
+
+(*
+ IsInConstParameters - returns the value of the InConstParameters.
+*)
+
+PROCEDURE IsInConstParameters () : BOOLEAN ;
+BEGIN
+ RETURN( InConstParameters )
+END IsInConstParameters ;
+
+
(*
MustCheckOverflow - returns TRUE if the quadruple should test for overflow.
*)
@@ -15764,7 +15905,8 @@ BEGIN
CatchStack := InitStackWord() ;
ExceptStack := InitStackWord() ;
ConstructorStack := InitStackAddress() ;
- ConstStack := InitStackWord() ;
+ ConstParamStack := InitStackWord () ;
+ ConstExprStack := InitStackWord () ;
(* StressStack ; *)
SuppressWith := FALSE ;
Head := 1 ;
@@ -15779,6 +15921,7 @@ BEGIN
AutoStack := InitStackWord() ;
IsAutoOn := TRUE ;
InConstExpression := FALSE ;
+ InConstParameters := FALSE ;
FreeLineList := NIL ;
InitList(VarientFields) ;
VarientFieldNo := 0 ;
diff --git a/gcc/m2/gm2-compiler/M2SymInit.mod
b/gcc/m2/gm2-compiler/M2SymInit.mod
index 0b23e53a4a9..4c6035ae929 100644
--- a/gcc/m2/gm2-compiler/M2SymInit.mod
+++ b/gcc/m2/gm2-compiler/M2SymInit.mod
@@ -571,10 +571,11 @@ VAR
op : QuadOperator ;
op1, op2, op3 : CARDINAL ;
op1tok, op2tok, op3tok, qtok: CARDINAL ;
- overflowChecking : BOOLEAN ;
+ constExpr, overflowChecking : BOOLEAN ;
s : String ;
BEGIN
- GetQuadOtok (quad, qtok, op, op1, op2, op3, overflowChecking,
+ GetQuadOtok (quad, qtok, op, op1, op2, op3,
+ overflowChecking, constExpr,
op1tok, op2tok, op3tok) ;
IF IsUniqueWarning (qtok)
THEN
@@ -1249,7 +1250,7 @@ VAR
op : QuadOperator ;
op1, op2, op3 : CARDINAL ;
op1tok, op2tok, op3tok, qtok: CARDINAL ;
- overflowChecking : BOOLEAN ;
+ constExpr, overflowChecking : BOOLEAN ;
BEGIN
IF quad = 3140
THEN
@@ -1262,7 +1263,8 @@ BEGIN
ForeachLocalSymDo (procSym, PrintSym) ;
printf0 ("***********************************\n")
END ;
- GetQuadOtok (quad, qtok, op, op1, op2, op3, overflowChecking,
+ GetQuadOtok (quad, qtok, op, op1, op2, op3,
+ overflowChecking, constExpr,
op1tok, op2tok, op3tok) ;
op1tok := DefaultTokPos (op1tok, qtok) ;
op2tok := DefaultTokPos (op2tok, qtok) ;
@@ -1541,12 +1543,13 @@ VAR
op : QuadOperator ;
op1, proc, param, paramValue : CARDINAL ;
op1tok, op2tok, paramtok, qtok: CARDINAL ;
- overflowChecking : BOOLEAN ;
+ constExpr, overflowChecking : BOOLEAN ;
heapValue, ptrToHeap : CARDINAL ;
BEGIN
IF trashQuad # 0
THEN
- GetQuadOtok (trashQuad, qtok, op, op1, proc, param, overflowChecking,
+ GetQuadOtok (trashQuad, qtok, op, op1, proc, param,
+ overflowChecking, constExpr,
op1tok, op2tok, paramtok) ;
heapValue := GetQuadTrash (trashQuad) ;
IF Debugging
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index cc1accef1a0..d5eddc7e98e 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -129,7 +129,8 @@ FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing,
Annotate,
AddVarientRange, AddVarientEquality,
BuildAsmElement, BuildAsmTrash,
BeginVarient, EndVarient, BeginVarientList, EndVarientList,
- PushInConstExpression, PopInConstExpression,
IsInConstExpression,
+ PushInConstExpression, PopInConstExpression,
+ PushInConstParameters, PopInConstParameters,
IsInConstParameters,
BuildDefaultFieldAlignment, BuildPragmaField,
IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto ;
@@ -670,10 +671,12 @@ ConstantDeclaration :=
% VAR
=:
ConstExpression := %
VAR tokpos: CARDINAL ; %
+ %
PushInConstExpression %
%
PushAutoOn %
SimpleConstExpr [ Relation %
tokpos := GetTokenNo ()-1 %
SimpleConstExpr %
BuildRelOp (tokpos) %
] %
PopAuto %
+ %
PopInConstExpression %
=:
Relation := "=" %
PushTtok(EqualTok, GetTokenNo() -1) %
@@ -773,8 +776,8 @@ ConstSetOrQualidentOrFunction :=
% VAR
Constructor
) =:
-ConstActualParameters := %
PushInConstExpression %
- ActualParameters %
PopInConstExpression %
+ConstActualParameters := %
PushInConstParameters %
+ ActualParameters %
PopInConstParameters %
=:
ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" %
PushAutoOn %
@@ -1121,7 +1124,7 @@ SetOrDesignatorOrFunction :=
% VAR
%
Assert (OperandTok (1) # UnknownTokenNo) %
[ Constructor |
SimpleDes %
(* Assert (OperandTok(1) # UnknownTokenNo) *) %
- [ ActualParameters %
IF IsInConstExpression()
+ [ ActualParameters %
IF IsInConstParameters ()
THEN
BuildConstFunctionCall
ELSE
diff --git a/gcc/m2/gm2-compiler/PCBuild.bnf b/gcc/m2/gm2-compiler/PCBuild.bnf
index 4034dda245a..b983cc8b852 100644
--- a/gcc/m2/gm2-compiler/PCBuild.bnf
+++ b/gcc/m2/gm2-compiler/PCBuild.bnf
@@ -66,7 +66,8 @@ FROM M2Quads IMPORT Top, PushT, PopT, PushTF, PopTF,
PopNothing, OperandT, PushT
PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn,
PopAuto,
BuildTypeForConstructor, BuildConstructor,
BuildConstructorEnd,
PopConstructor,
- NextConstructorField, SilentBuildConstructor ;
+ NextConstructorField, SilentBuildConstructor,
+ PushInConstExpression, PopInConstExpression ;
FROM P3SymBuild IMPORT CheckCanBeImported ;
@@ -603,9 +604,11 @@ ConstantDeclaration :=
% VAR
ConstExpression := %
VAR top: CARDINAL ; %
%
top := Top() %
+ %
PushInConstExpression %
%
PushAutoOff %
SimpleConstExpr [ Relation SimpleConstExpr %
BuildRelationConst %
] %
PopAuto %
+ %
PopInConstExpression %
%
Assert(top=Top()) %
=:
diff --git a/gcc/m2/gm2-compiler/PHBuild.bnf b/gcc/m2/gm2-compiler/PHBuild.bnf
index fcb1ce6092a..52214894d0a 100644
--- a/gcc/m2/gm2-compiler/PHBuild.bnf
+++ b/gcc/m2/gm2-compiler/PHBuild.bnf
@@ -102,7 +102,8 @@ FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing,
Annotate,
AddVarientRange, AddVarientEquality,
BuildDefaultFieldAlignment, BuildPragmaField,
CheckWithReference, DisplayStack, Annotate,
- IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto ;
+ IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto,
+ PushInConstExpression, PopInConstExpression ;
FROM P3SymBuild IMPORT P3StartBuildProgModule,
P3EndBuildProgModule,
@@ -572,10 +573,12 @@ ConstantDeclaration :=
% Pus
=:
ConstExpression := %
VAR tokpos: CARDINAL ; %
+ %
PushInConstExpression %
%
PushAutoOn %
SimpleConstExpr [ Relation %
tokpos := GetTokenNo ()-1 %
SimpleConstExpr %
BuildRelOp (tokpos) %
] %
PopAuto %
+ %
PopInConstExpression %
=:
Relation := "=" %
PushTtok(EqualTok, GetTokenNo() -1) %
diff --git a/gcc/m2/gm2-gcc/m2expr.cc b/gcc/m2/gm2-gcc/m2expr.cc
index ba5c652209e..746e211ab51 100644
--- a/gcc/m2/gm2-gcc/m2expr.cc
+++ b/gcc/m2/gm2-gcc/m2expr.cc
@@ -111,6 +111,14 @@ m2expr_StringLength (tree string)
return TREE_STRING_LENGTH (string);
}
+/* BuildCondIfExpression returns a tree containing (condition) ? (left) :
right. */
+
+tree
+m2expr_BuildCondIfExpression (tree condition, tree type, tree left, tree right)
+{
+ return fold_build3 (COND_EXPR, type, condition, left, right);
+}
+
/* CheckAddressToCardinal if op is a pointer convert it to the ADDRESS type.
*/
static tree
diff --git a/gcc/m2/gm2-gcc/m2expr.def b/gcc/m2/gm2-gcc/m2expr.def
index d4b040c8ac3..c195f1987a8 100644
--- a/gcc/m2/gm2-gcc/m2expr.def
+++ b/gcc/m2/gm2-gcc/m2expr.def
@@ -737,5 +737,12 @@ PROCEDURE OverflowZType (location: location_t;
str: ADDRESS; base: CARDINAL;
issueError: BOOLEAN) : BOOLEAN ;
+(*
+ BuildCondIfExpression - returns a tree containing
+ (condition) ? (left) : right.
+*)
+
+PROCEDURE BuildCondIfExpression (condition, type, left, right: Tree) : Tree ;
+
END m2expr.
diff --git a/gcc/m2/gm2-gcc/m2expr.h b/gcc/m2/gm2-gcc/m2expr.h
index f045d2949ff..d5fb475645c 100644
--- a/gcc/m2/gm2-gcc/m2expr.h
+++ b/gcc/m2/gm2-gcc/m2expr.h
@@ -239,6 +239,8 @@ EXTERN void m2expr_ConstantExpressionWarning (tree value);
EXTERN tree m2expr_BuildAddAddress (location_t location, tree op1, tree op2);
EXTERN tree m2expr_BuildRDiv (location_t location, tree op1, tree op2,
bool needconvert);
+EXTERN tree m2expr_BuildCondIfExpression (tree condition, tree type,
+ tree left, tree right);
EXTERN int m2expr_GetCstInteger (tree cst);
EXTERN tree m2expr_calcNbits (location_t location, tree min, tree max);
EXTERN bool m2expr_OverflowZType (location_t location, const char *str,
diff --git a/gcc/testsuite/gm2/iso/const/pass/iso-const-pass.exp
b/gcc/testsuite/gm2/iso/const/pass/iso-const-pass.exp
new file mode 100644
index 00000000000..6deabf2aaa4
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/const/pass/iso-const-pass.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2024 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mul...@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_iso "${srcdir}/gm2/iso/const/pass" -fcpp
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture $testcase
+}
