https://gcc.gnu.org/g:9f168b412f44781013401492acfedf22afe7741b
commit r15-1618-g9f168b412f44781013401492acfedf22afe7741b
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Tue Jun 25 18:35:22 2024 +0100
PR modula2/115536 Expression is evaluated incorrectly when encountering
relops and indirection
This fix ensures that we only call BuildRelOpFromBoolean if we are
inside a constant expression (where no indirection can be used).
The fix creates a temporary variable when a boolean is created from
a relop in other cases.
The previous pattern implementation would not work if the operands required
dereferencing during non const expressions. Comparison of relop results
in a constant expression are resolved by constant propagation, basic
block analysis and dead code removal. After the quadruples have been
optimized only one assignment to the boolean variable will remain for
const expressions. All quadruple pattern checking for boolean
expressions is removed by the patch. Thus the implementation becomes
more generic.
gcc/m2/ChangeLog:
PR modula2/115536
* gm2-compiler/M2BasicBlock.def (GetBasicBlockScope): New procedure.
(GetBasicBlockStart): Ditto.
(GetBasicBlockEnd): Ditto.
(IsBasicBlockFirst): New procedure function.
* gm2-compiler/M2BasicBlock.mod (ConvertQuads2BasicBlock): Allow
conditional boolean quads to be removed.
(GetBasicBlockScope): Implement new procedure.
(GetBasicBlockStart): Ditto.
(GetBasicBlockEnd): Ditto.
(IsBasicBlockFirst): Implement new procedure function.
* gm2-compiler/M2GCCDeclare.def (FoldConstants): New parameter
declaration.
* gm2-compiler/M2GCCDeclare.mod (FoldConstants): New parameter
declaration.
(DeclareTypesConstantsProceduresInRange): Recreate basic blocks
after resolving constant expressions.
(CodeBecomes): Guard IsVariableSSA with IsVar.
* gm2-compiler/M2GenGCC.def (ResolveConstantExpressions): New
parameter declaration.
* gm2-compiler/M2GenGCC.mod (FoldIfLess): Remove relop pattern
detection.
(FoldIfGre): Ditto.
(FoldIfLessEqu): Ditto.
(FoldIfGreEqu): Ditto.
(FoldIfIn): Ditto.
(FoldIfNotIn): Ditto.
(FoldIfEqu): Ditto.
(FoldIfNotEqu): Ditto.
(FoldBecomes): Add BasicBlock parameter and allow conditional
boolean becomes to be folded in the first basic block.
(ResolveConstantExpressions): Reimplement.
* gm2-compiler/M2Quads.def (IsConstQuad): New procedure function.
(IsConditionalBooleanQuad): Ditto.
* gm2-compiler/M2Quads.mod (IsConstQuad): Implement new procedure
function.
(IsConditionalBooleanQuad): Ditto.
(MoveWithMode): Use GenQuadOTypetok.
(IsInitialisingConst): Rewrite using OpUsesOp1.
(OpUsesOp1): New procedure function.
(doBuildAssignment): Mark des as a VarConditional.
(ConvertBooleanToVariable): Call PutVarConditional.
(DumpQuadSummary): New procedure.
(BuildRelOpFromBoolean): Updated debugging and improved comments.
(BuildRelOp): Only call BuildRelOpFromBoolean if we are in a const
expression and both operands are boolean relops.
(GenQuadOTypeUniquetok): New procedure.
(BackPatch): Correct comment.
* gm2-compiler/SymbolTable.def (PutVarConditional): New procedure.
(IsVarConditional): New procedure function.
* gm2-compiler/SymbolTable.mod (PutVarConditional): Implement new
procedure.
(IsVarConditional): Implement new procedure function.
(SymConstVar): New field IsConditional.
(SymVar): New field IsConditional.
(MakeVar): Initialize IsConditional field.
(MakeConstVar): Initialize IsConditional field.
* gm2-compiler/M2Swig.mod (DoBasicBlock): Change parameters to
use BasicBlock.
* gm2-compiler/M2Code.mod (SecondDeclareAndOptimize): Use iterator
to FoldConstants over basic block list.
* gm2-compiler/M2SymInit.mod (AppendEntry): Replace parameters
with BasicBlock.
* gm2-compiler/P3Build.bnf (Relation): Call RecordOp for #, <> and
=.
gcc/testsuite/ChangeLog:
PR modula2/115536
* gm2/iso/const/pass/constbool4.mod: New test.
* gm2/iso/const/pass/constbool5.mod: New test.
* gm2/iso/run/pass/condtest2.mod: New test.
* gm2/iso/run/pass/condtest3.mod: New test.
* gm2/iso/run/pass/condtest4.mod: New test.
* gm2/iso/run/pass/condtest5.mod: New test.
* gm2/iso/run/pass/constbool4.mod: New test.
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2BasicBlock.def | 34 +++-
gcc/m2/gm2-compiler/M2BasicBlock.mod | 129 ++++++++-----
gcc/m2/gm2-compiler/M2Code.mod | 7 +-
gcc/m2/gm2-compiler/M2GCCDeclare.def | 3 +-
gcc/m2/gm2-compiler/M2GCCDeclare.mod | 148 +++------------
gcc/m2/gm2-compiler/M2GenGCC.def | 7 +-
gcc/m2/gm2-compiler/M2GenGCC.mod | 237 ++++++++----------------
gcc/m2/gm2-compiler/M2Quads.def | 16 +-
gcc/m2/gm2-compiler/M2Quads.mod | 229 ++++++++++++++++++-----
gcc/m2/gm2-compiler/M2Swig.mod | 9 +-
gcc/m2/gm2-compiler/M2SymInit.mod | 17 +-
gcc/m2/gm2-compiler/P3Build.bnf | 9 +-
gcc/m2/gm2-compiler/SymbolTable.def | 15 ++
gcc/m2/gm2-compiler/SymbolTable.mod | 51 +++++
gcc/testsuite/gm2/iso/const/pass/constbool4.mod | 17 ++
gcc/testsuite/gm2/iso/const/pass/constbool5.mod | 24 +++
gcc/testsuite/gm2/iso/run/pass/condtest2.mod | 26 +++
gcc/testsuite/gm2/iso/run/pass/condtest3.mod | 26 +++
gcc/testsuite/gm2/iso/run/pass/condtest4.mod | 24 +++
gcc/testsuite/gm2/iso/run/pass/condtest5.mod | 24 +++
gcc/testsuite/gm2/iso/run/pass/constbool4.mod | 17 ++
21 files changed, 677 insertions(+), 392 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2BasicBlock.def
b/gcc/m2/gm2-compiler/M2BasicBlock.def
index 7387ae69c4d..54b2ec48293 100644
--- a/gcc/m2/gm2-compiler/M2BasicBlock.def
+++ b/gcc/m2/gm2-compiler/M2BasicBlock.def
@@ -32,15 +32,11 @@ DEFINITION MODULE M2BasicBlock ;
*)
FROM M2Scope IMPORT ScopeBlock ;
-EXPORT QUALIFIED BasicBlock, BasicBlockProc,
- InitBasicBlocks, InitBasicBlocksFromRange,
- KillBasicBlocks, FreeBasicBlocks,
- ForeachBasicBlockDo ;
TYPE
BasicBlock ;
- BasicBlockProc = PROCEDURE (CARDINAL, CARDINAL) ;
+ BasicBlockProc = PROCEDURE (BasicBlock) ;
(*
@@ -85,4 +81,32 @@ PROCEDURE FreeBasicBlocks (bb: BasicBlock) ;
PROCEDURE ForeachBasicBlockDo (bb: BasicBlock; p: BasicBlockProc) ;
+(*
+ GetBasicBlockScope - return the scope associated with the basic block.
+*)
+
+PROCEDURE GetBasicBlockScope (bb: BasicBlock) : CARDINAL ;
+
+
+(*
+ GetBasicBlockStart - return the quad associated with the start of the basic
block.
+*)
+
+PROCEDURE GetBasicBlockStart (bb: BasicBlock) : CARDINAL ;
+
+
+(*
+ GetBasicBlockEnd - return the quad associated with the end of the basic
block.
+*)
+
+PROCEDURE GetBasicBlockEnd (bb: BasicBlock) : CARDINAL ;
+
+
+(*
+ IsBasicBlockFirst - return TRUE if this basic block is the first in the
sequence.
+*)
+
+PROCEDURE IsBasicBlockFirst (bb: BasicBlock) : BOOLEAN ;
+
+
END M2BasicBlock.
diff --git a/gcc/m2/gm2-compiler/M2BasicBlock.mod
b/gcc/m2/gm2-compiler/M2BasicBlock.mod
index f4b9cb021c8..96dc649965a 100644
--- a/gcc/m2/gm2-compiler/M2BasicBlock.mod
+++ b/gcc/m2/gm2-compiler/M2BasicBlock.mod
@@ -32,7 +32,7 @@ FROM M2Quads IMPORT IsReferenced, IsConditional,
IsUnConditional, IsCall,
IsReturn, IsNewLocalVar, IsKillLocalVar,
IsCatchBegin, IsCatchEnd,
IsInitStart, IsInitEnd, IsFinallyStart, IsFinallyEnd,
- IsInitialisingConst,
+ IsInitialisingConst, IsConditionalBooleanQuad,
IsPseudoQuad, IsDefOrModFile,
GetNextQuad, GetQuad, QuadOperator,
SubQuad, DisplayQuadRange ;
@@ -45,10 +45,11 @@ CONST
TYPE
BasicBlock = POINTER TO RECORD
- StartQuad : CARDINAL ; (* First Quad in Basic Block *)
- EndQuad : CARDINAL ; (* End Quad in Basic Block *)
+ Scope : CARDINAL ; (* Scope associated with the
block. *)
+ StartQuad : CARDINAL ; (* First Quad in Basic Block. *)
+ EndQuad : CARDINAL ; (* End Quad in Basic Block. *)
+ First : BOOLEAN ; (* The first block? *)
Right : BasicBlock ;
- (* Last Basic Block in list *)
Left : BasicBlock ;
END ;
@@ -57,6 +58,10 @@ VAR
HeadOfBasicBlock: BasicBlock ;
+PROCEDURE stop ;
+END stop ;
+
+
(*
InitBasicBlocks - converts a list of quadruples as defined by
scope blocks into a set of basic blocks.
@@ -128,19 +133,21 @@ END FreeBasicBlocks ;
New - returns a basic block.
*)
-PROCEDURE New () : BasicBlock ;
+PROCEDURE New (Scope: CARDINAL; First: BOOLEAN) : BasicBlock ;
VAR
b: BasicBlock ;
BEGIN
IF FreeList=NIL
THEN
- NEW(b)
+ NEW (b)
ELSE
b := FreeList ;
FreeList := FreeList^.Right
END ;
- Assert(b#NIL) ;
- RETURN( b )
+ Assert (b#NIL) ;
+ b^.Scope := Scope ;
+ b^.First := First ;
+ RETURN b
END New ;
@@ -153,6 +160,7 @@ END New ;
PROCEDURE ConvertQuads2BasicBlock (ScopeSym: CARDINAL; Start, End: CARDINAL) ;
VAR
+ First,
LastQuadDefMod,
LastQuadConditional,
LastQuadCall,
@@ -163,13 +171,14 @@ VAR
BEGIN
IF Debugging
THEN
+ WriteString ("Enter ConvertQuads2BasicBlock") ; WriteLn ;
DisplayQuadRange (ScopeSym, Start, End)
END ;
(*
Algorithm to perform Basic Block:
For every quadruple establish a set of leaders.
- A Leader is defined as a quadruple which is
+ A leader is defined as a quadruple which is
either:
(i) The first quadruple.
@@ -179,7 +188,7 @@ BEGIN
For each leader construct a basic block.
A Basic Block starts with a leader quadruple and ends with either:
- (i) Another Leader
+ (i) Another leader
(ii) An unconditional Jump.
Any quadruples that do not fall into a Basic Block can be thrown away
@@ -188,20 +197,26 @@ BEGIN
LastBB := NIL ;
CurrentBB := NIL ;
Quad := Start ;
- LastQuadConditional := TRUE ; (* Force Rule (i) *)
+ LastQuadConditional := TRUE ; (* Force Rule (i). *)
LastQuadCall := FALSE ;
LastQuadReturn := FALSE ;
LastQuadDefMod := FALSE ;
- (* Scan all quadruples *)
+ First := TRUE ;
+ (* Scan all quadruples. *)
WHILE (Quad<=End) AND (Quad#0) DO
+ IF Quad = 200
+ THEN
+ stop
+ END ;
IF LastQuadConditional OR LastQuadCall OR LastQuadReturn OR
LastQuadDefMod OR IsReferenced(Quad)
THEN
(* Rule (ii) *)
- CurrentBB := New() ; (* Get a new Basic Block *)
- (* At least one quad in this Basic Block *)
+ CurrentBB := New (ScopeSym, First) ; (* Get a new Basic Block. *)
+ (* At least one quad in this Basic Block. *)
StartBB(CurrentBB, Quad) ;
- EndBB(CurrentBB, Quad)
+ EndBB(CurrentBB, Quad) ;
+ First := FALSE
ELSIF CurrentBB#NIL
THEN
(* We have a Basic Block - therefore add quad to this Block *)
@@ -216,14 +231,20 @@ BEGIN
IsInitStart(Quad) OR IsInitEnd(Quad) OR
IsFinallyStart(Quad) OR IsFinallyEnd(Quad)
THEN
- (* we must leave these quads alone *)
+ (* We must leave these quads alone. *)
EndBB(LastBB, Quad)
+ ELSIF IsConditionalBooleanQuad (Quad)
+ THEN
+ (* We can remove unreachable const quads. *)
+ SubQuad (Quad)
+(*
ELSIF IsInitialisingConst(Quad)
THEN
- (* we must leave these quads alone *)
+ (* But we leave remaining constant quads alone. *)
EndBB(LastBB, Quad)
+*)
ELSE
- (* remove this Quad since it will never be reached *)
+ (* Remove this Quad since it will never be reached. *)
SubQuad(Quad)
END ;
LastQuadConditional := IsConditional(Quad) ;
@@ -236,12 +257,17 @@ BEGIN
CurrentBB := NIL
END ;
Quad := GetNextQuad(Quad)
+ END ;
+ IF Debugging
+ THEN
+ WriteString ("Exit ConvertQuads2BasicBlock") ; WriteLn ;
+ DisplayQuadRange (ScopeSym, Start, End)
END
END ConvertQuads2BasicBlock ;
(*
- ForeachBasicBlockDo - for each basic block call procedure, p.
+ ForeachBasicBlockDo - for each basic block call procedure p.
*)
PROCEDURE ForeachBasicBlockDo (bb: BasicBlock; p: BasicBlockProc) ;
@@ -253,7 +279,7 @@ BEGIN
b := bb ;
REPEAT
WITH b^ DO
- p (StartQuad, EndQuad)
+ p (b)
END ;
b := b^.Right
UNTIL b=bb
@@ -307,29 +333,6 @@ BEGIN
END Add ;
-(*
- Sub deletes an element from the specified queue.
-*)
-
-(*
-PROCEDURE Sub (VAR Head: BasicBlock;
- b: BasicBlock) ;
-BEGIN
- IF (b^.Right=Head) AND (b=Head)
- THEN
- Head := NIL
- ELSE
- IF Head=b
- THEN
- Head := Head^.Right
- END ;
- b^.Left^.Right := b^.Right ;
- b^.Right^.Left := b^.Left
- END
-END Sub ;
-*)
-
-
(*
DisplayBasicBlocks - displays the basic block data structure.
*)
@@ -359,6 +362,46 @@ BEGIN
END DisplayBlock ;
+(*
+ GetBasicBlockScope - return the scope associated with the basic block.
+*)
+
+PROCEDURE GetBasicBlockScope (bb: BasicBlock) : CARDINAL ;
+BEGIN
+ RETURN bb^.Scope
+END GetBasicBlockScope ;
+
+
+(*
+ GetBasicBlockStart - return the quad associated with the start of the basic
block.
+*)
+
+PROCEDURE GetBasicBlockStart (bb: BasicBlock) : CARDINAL ;
+BEGIN
+ RETURN bb^.StartQuad
+END GetBasicBlockStart ;
+
+
+(*
+ GetBasicBlockEnd - return the quad associated with the end of the basic
block.
+*)
+
+PROCEDURE GetBasicBlockEnd (bb: BasicBlock) : CARDINAL ;
+BEGIN
+ RETURN bb^.EndQuad
+END GetBasicBlockEnd ;
+
+
+(*
+ IsBasicBlockFirst - return TRUE if this basic block is the first in the
sequence.
+*)
+
+PROCEDURE IsBasicBlockFirst (bb: BasicBlock) : BOOLEAN ;
+BEGIN
+ RETURN bb^.First
+END IsBasicBlockFirst ;
+
+
BEGIN
FreeList := NIL
END M2BasicBlock.
diff --git a/gcc/m2/gm2-compiler/M2Code.mod b/gcc/m2/gm2-compiler/M2Code.mod
index f8a773dc103..ea86232c714 100644
--- a/gcc/m2/gm2-compiler/M2Code.mod
+++ b/gcc/m2/gm2-compiler/M2Code.mod
@@ -320,9 +320,14 @@ END InitialDeclareAndOptimize ;
PROCEDURE SecondDeclareAndOptimize (scope: CARDINAL;
start, end: CARDINAL) ;
+VAR
+ bb: BasicBlock ;
BEGIN
REPEAT
- FoldConstants(start, end) ;
+ bb := InitBasicBlocksFromRange (scope, start, end) ;
+ ForeachBasicBlockDo (bb, FoldConstants) ;
+ FreeBasicBlocks (bb) ;
+
DeltaConst := Count - CountQuads () ;
Count := CountQuads () ;
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.def
b/gcc/m2/gm2-compiler/M2GCCDeclare.def
index 28bbb1a41b5..13570dabfbb 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.def
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.def
@@ -32,6 +32,7 @@ DEFINITION MODULE M2GCCDeclare ;
FROM SYSTEM IMPORT WORD ;
FROM m2tree IMPORT Tree ;
+FROM M2BasicBlock IMPORT BasicBlock ;
TYPE
WalkAction = PROCEDURE (WORD) ;
@@ -42,7 +43,7 @@ TYPE
FoldConstants - a wrapper for ResolveConstantExpressions.
*)
-PROCEDURE FoldConstants (start, end: CARDINAL) ;
+PROCEDURE FoldConstants (bb: BasicBlock) ;
(*
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
index 9607085b967..a2effe97b66 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -71,6 +71,8 @@ FROM Sets IMPORT Set, InitSet, KillSet,
NoOfElementsInSet, IsElementInSet, ForeachElementInSetDo,
DuplicateSet, EqualSet ;
+FROM M2BasicBlock IMPORT BasicBlock, InitBasicBlocks, KillBasicBlocks,
ForeachBasicBlockDo ;
+
FROM SymbolTable IMPORT NulSym,
ModeOfAddr,
GetMode,
@@ -252,6 +254,7 @@ VAR
WatchList : Set ; (* Set of symbols being watched. *)
EnumerationIndex : Index ;
action : IsAction ;
+ ConstantResolved,
enumDeps : BOOLEAN ;
@@ -1296,30 +1299,6 @@ BEGIN
END DeclareTypeFromPartial ;
-(*
- DeclarePointerTypeFully - if, sym, is a pointer type then
- declare it.
-*)
-
-(*
-PROCEDURE DeclarePointerTypeFully (sym: CARDINAL) ;
-BEGIN
- IF IsPointer(sym)
- THEN
- WatchIncludeList(sym, fullydeclared) ;
- WatchRemoveList(sym, partiallydeclared) ;
- WatchRemoveList(sym, todolist) ;
- PreAddModGcc(sym, DeclarePointer(sym))
- ELSE
- (* place sym and all dependants on the todolist
- providing they are not already on the FullyDeclared list
- *)
- TraverseDependants(sym)
- END
-END DeclarePointerTypeFully ;
-*)
-
-
(*
CanBeDeclaredPartiallyViaPartialDependants - returns TRUE if, sym,
can be partially declared via
@@ -1476,22 +1455,6 @@ BEGIN
DeclareTypePartially)
THEN
(* continue looping *)
-(*
- ELSIF ForeachTryDeclare (todolist,
- setarraynul,
- CanCreateSetArray,
- CreateSetArray)
- THEN
- (* Populates the finishedsetarray list with each set seen. *)
- (* Continue looping. *)
- ELSIF ForeachTryDeclare (finishedsetarray,
- setfully,
- CanCreateSet,
- CreateSet)
- THEN
- (* Populates the fullydeclared list with each set. *)
- (* Continue looping. *)
-*)
ELSIF ForeachTryDeclare (todolist,
arraynil,
CanDeclareArrayAsNil,
@@ -1902,25 +1865,15 @@ BEGIN
IF (type#NulSym) AND (NOT CompletelyResolved(type))
THEN
TraverseDependants(sym) ;
-(*
- WatchIncludeList(sym, todolist) ;
- WatchIncludeList(type, todolist) ;
-*)
RETURN
END ;
IF IsConstructor(sym) AND (NOT IsConstructorConstant(sym))
THEN
TraverseDependants(sym) ;
-(*
- WatchIncludeList(sym, todolist) ;
-*)
RETURN
END ;
IF (IsConstructor(sym) OR IsConstSet(sym)) AND (type=NulSym)
THEN
-(*
- WatchIncludeList(sym, todolist) ;
-*)
TraverseDependants(sym) ;
RETURN
END ;
@@ -1936,10 +1889,7 @@ BEGIN
THEN
RETURN
END ;
- TraverseDependants(sym) ;
-(*
- WatchIncludeList(sym, todolist)
-*)
+ TraverseDependants(sym)
ELSE
TryDeclareConst(tokenno, sym)
END
@@ -2011,9 +1961,6 @@ BEGIN
TryEvaluateValue(sym) ;
IF NOT IsConstructorDependants(sym, IsFullyDeclared)
THEN
-(*
- WatchIncludeList(sym, todolist) ;
-*)
TraverseDependants(sym) ;
RETURN
END ;
@@ -2161,38 +2108,6 @@ BEGIN
END WalkAssociatedUnbounded ;
-(*
- WalkProcedureParameterDependants -
-*)
-
-(*
-PROCEDURE WalkProcedureParameterDependants (sym: CARDINAL; p: WalkAction) ;
-VAR
- son,
- type,
- n, i: CARDINAL ;
-BEGIN
- IF IsProcedure(sym)
- THEN
- n := NoOfParam(sym) ;
- i := n ;
- WHILE i>0 DO
- IF IsUnboundedParam(sym, i)
- THEN
- son := GetNthParam(sym, i)
- ELSE
- son := GetNth(sym, i) ;
- END ;
- type := GetSType(son) ;
- p(type) ;
- WalkDependants(type, p) ;
- DEC(i)
- END
- END
-END WalkProcedureParameterDependants ;
-*)
-
-
(*
WalkDependants - walks through all dependants of, Sym,
calling, p, for each dependant.
@@ -2723,10 +2638,11 @@ END DeclareProcedure ;
FoldConstants - a wrapper for ResolveConstantExpressions.
*)
-PROCEDURE FoldConstants (start, end: CARDINAL) ;
+PROCEDURE FoldConstants (bb: BasicBlock) ;
BEGIN
- IF ResolveConstantExpressions(DeclareConstFully, start, end)
+ IF ResolveConstantExpressions (DeclareConstFully, bb)
THEN
+ ConstantResolved := TRUE
END
END FoldConstants ;
@@ -2778,6 +2694,8 @@ CONST
VAR
copy: Group ;
loop: CARDINAL ;
+ sb : ScopeBlock ;
+ bb : BasicBlock ;
BEGIN
IF TraceQuadruples
THEN
@@ -2785,11 +2703,18 @@ BEGIN
END ;
loop := 0 ;
copy := NIL ;
+ sb := InitScopeBlock (scope) ;
REPEAT
+ (* Throw away any unreachable quad. *)
+ bb := InitBasicBlocks (sb) ;
+ KillBasicBlocks (bb) ;
+ (* Now iterate over remaining quads in scope attempting to resolve
constants. *)
copy := DupGroup (copy) ;
- WHILE ResolveConstantExpressions (DeclareConstFully, start, end) DO
- END ;
- (* we need to evaluate some constant expressions to resolve these types
*)
+ bb := InitBasicBlocks (sb) ;
+ ConstantResolved := FALSE ;
+ ForeachBasicBlockDo (bb, FoldConstants) ;
+ KillBasicBlocks (bb) ;
+ (* And now types. *)
IF DeclaredOutstandingTypes (FALSE)
THEN
END ;
@@ -2803,9 +2728,11 @@ BEGIN
loop := 0
END ;
INC (loop)
- UNTIL (NOT ResolveConstantExpressions (DeclareConstFully, start, end)) AND
- EqualGroup (copy, GlobalGroup) ;
- KillGroup (copy)
+ UNTIL (NOT ConstantResolved) AND EqualGroup (copy, GlobalGroup) ;
+ KillGroup (copy) ;
+ bb := InitBasicBlocks (sb) ;
+ KillBasicBlocks (bb) ;
+ KillScopeBlock (sb)
END DeclareTypesConstantsProceduresInRange ;
@@ -5990,33 +5917,6 @@ BEGIN
END WalkRecordFieldDependants ;
-(*
- WalkVarient -
-*)
-
-(*
-PROCEDURE WalkVarient (sym: CARDINAL; p: WalkAction) ;
-VAR
- v : CARDINAL ;
- var,
- align: CARDINAL ;
-BEGIN
- p(sym) ;
- v := GetVarient(sym) ;
- IF v#NulSym
- THEN
- p(v)
- END ;
- var := GetRecordOfVarient(sym) ;
- align := GetDefaultRecordFieldAlignment(var) ;
- IF align#NulSym
- THEN
- p(align)
- END
-END WalkVarient ;
-*)
-
-
(*
WalkRecordDependants2 - walks the fields of record, sym, calling
p on every dependant.
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.def b/gcc/m2/gm2-compiler/M2GenGCC.def
index 3e4705ec235..fc7cdf281dd 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.def
+++ b/gcc/m2/gm2-compiler/M2GenGCC.def
@@ -34,10 +34,7 @@ DEFINITION MODULE M2GenGCC ;
FROM M2GCCDeclare IMPORT WalkAction ;
FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t ;
-EXPORT QUALIFIED ConvertQuadsToTree, ResolveConstantExpressions,
- GetHighFromUnbounded, StringToChar,
- LValueToGenericPtr, ZConstToTypedConst,
- PrepareCopyString ;
+FROM M2BasicBlock IMPORT BasicBlock ;
(*
@@ -55,7 +52,7 @@ PROCEDURE ConvertQuadsToTree (Start, End: CARDINAL) ;
p(sym) is invoked.
*)
-PROCEDURE ResolveConstantExpressions (p: WalkAction; start, end: CARDINAL) :
BOOLEAN ;
+PROCEDURE ResolveConstantExpressions (p: WalkAction; bb: BasicBlock) : BOOLEAN
;
(*
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 26ed399b24c..c59695a3779 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -259,13 +259,16 @@ FROM M2Quads IMPORT QuadOperator, GetQuad, IsReferenced,
GetNextQuad,
QuadToTokenNo, DisplayQuad, GetQuadtok,
GetM2OperatorDesc, GetQuadOp,
IsQuadConstExpr, IsBecomes, IsGoto, IsConditional,
- IsDummy,
+ IsDummy, IsConditionalBooleanQuad,
GetQuadOp1, GetQuadOp3, GetQuadDest, SetQuadConstExpr ;
FROM M2Check IMPORT ParameterTypeCompatible, AssignmentTypeCompatible,
ExpressionTypeCompatible ;
FROM M2SSA IMPORT EnableSSA ;
FROM M2Optimize IMPORT FoldBranches ;
+FROM M2BasicBlock IMPORT BasicBlock, IsBasicBlockFirst,
+ GetBasicBlockStart, GetBasicBlockEnd ;
+
CONST
Debugging = FALSE ;
@@ -568,7 +571,7 @@ END CodeStatement ;
p(sym) is invoked.
*)
-PROCEDURE ResolveConstantExpressions (p: WalkAction; start, end: CARDINAL) :
BOOLEAN ;
+PROCEDURE ResolveConstantExpressions (p: WalkAction; bb: BasicBlock) : BOOLEAN
;
VAR
tokenno: CARDINAL ;
quad : CARDINAL ;
@@ -580,8 +583,12 @@ VAR
op2pos,
op3pos : CARDINAL ;
Changed: BOOLEAN ;
+ start,
+ end : CARDINAL ;
BEGIN
InitBuiltinSyms (BuiltinTokenNo) ;
+ start := GetBasicBlockStart (bb) ;
+ end := GetBasicBlockEnd (bb) ;
Changed := FALSE ;
REPEAT
NoChange := TRUE ;
@@ -607,7 +614,7 @@ BEGIN
LogicalOrOp : FoldSetOr (tokenno, p, quad, op1, op2, op3) |
LogicalAndOp : FoldSetAnd (tokenno, p, quad, op1, op2, op3) |
LogicalXorOp : FoldSymmetricDifference (tokenno, p, quad, op1,
op2, op3) |
- BecomesOp : FoldBecomes (p, quad) |
+ BecomesOp : FoldBecomes (p, bb, quad) |
ArithAddOp : FoldArithAdd (op1pos, p, quad, op1, op2, op3) |
AddOp : FoldAdd (op1pos, p, quad, op1, op2, op3) |
SubOp : FoldSub (op1pos, p, quad, op1, op2, op3) |
@@ -650,7 +657,7 @@ BEGIN
ELSE
(* ignore quadruple as it is not associated with a constant
expression *)
END ;
- quad := GetNextQuad(quad)
+ quad := GetNextQuad (quad)
END ;
IF NOT NoChange
THEN
@@ -2750,19 +2757,22 @@ END CheckStop ;
Sym1<I> := Sym3<I> := produces a constant
*)
-PROCEDURE FoldBecomes (p: WalkAction; quad: CARDINAL) ;
+PROCEDURE FoldBecomes (p: WalkAction; bb: BasicBlock; quad: CARDINAL) ;
VAR
op : QuadOperator ;
des, op2, expr: CARDINAL ;
BEGIN
- IF DeclaredOperandsBecomes (p, quad) AND (NOT IsQuadConstExpr (quad))
+ IF DeclaredOperandsBecomes (p, quad)
THEN
- IF TypeCheckBecomes (p, quad)
+ IF (NOT IsConditionalBooleanQuad (quad)) OR IsBasicBlockFirst (bb)
THEN
- PerformFoldBecomes (p, quad)
- ELSE
- GetQuad (quad, op, des, op2, expr) ;
- RemoveQuad (p, des, quad)
+ IF TypeCheckBecomes (p, quad)
+ THEN
+ PerformFoldBecomes (p, quad)
+ ELSE
+ GetQuad (quad, op, des, op2, expr) ;
+ RemoveQuad (p, des, quad)
+ END
END
END
END FoldBecomes ;
@@ -3432,7 +3442,7 @@ BEGIN
ELSE
IF checkBecomes (des, expr, virtpos, despos, exprpos)
THEN
- IF IsVariableSSA (des)
+ IF IsVar (des) AND IsVariableSSA (des)
THEN
Replace (des, FoldConstBecomes (virtpos, des, expr))
ELSE
@@ -5333,18 +5343,13 @@ BEGIN
IF IsValueSolved (left) AND IsValueSolved (right)
THEN
(* We can take advantage of the known values and evaluate the
condition. *)
- IF IsBooleanRelOpPattern (quad)
+ PushValue (left) ;
+ PushValue (right) ;
+ IF Less (tokenno)
THEN
- FoldBooleanRelopPattern (p, quad)
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
- PushValue (left) ;
- PushValue (right) ;
- IF Less (tokenno)
- THEN
- PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
- ELSE
- SubQuad (quad)
- END
+ SubQuad (quad)
END ;
NoChange := FALSE
END
@@ -5352,63 +5357,6 @@ BEGIN
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.
@@ -5460,7 +5408,8 @@ END QuadCondition ;
*)
PROCEDURE FoldIfGre (tokenno: CARDINAL; p: WalkAction;
- quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+ quad: CARDINAL;
+ left, right, destQuad: CARDINAL) ;
BEGIN
(* Firstly ensure that constant literals are declared. *)
TryDeclareConstant(tokenno, left) ;
@@ -5470,18 +5419,13 @@ BEGIN
IF IsValueSolved (left) AND IsValueSolved (right)
THEN
(* We can take advantage of the known values and evaluate the
condition. *)
- IF IsBooleanRelOpPattern (quad)
+ PushValue (left) ;
+ PushValue (right) ;
+ IF Gre (tokenno)
THEN
- FoldBooleanRelopPattern (p, quad)
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
- PushValue (left) ;
- PushValue (right) ;
- IF Gre (tokenno)
- THEN
- PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
- ELSE
- SubQuad (quad)
- END
+ SubQuad (quad)
END ;
NoChange := FALSE
END
@@ -5495,7 +5439,8 @@ END FoldIfGre ;
*)
PROCEDURE FoldIfLessEqu (tokenno: CARDINAL; p: WalkAction;
- quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+ quad: CARDINAL;
+ left, right, destQuad: CARDINAL) ;
BEGIN
(* Firstly ensure that constant literals are declared. *)
TryDeclareConstant(tokenno, left) ;
@@ -5505,18 +5450,13 @@ BEGIN
IF IsValueSolved (left) AND IsValueSolved (right)
THEN
(* We can take advantage of the known values and evaluate the
condition. *)
- IF IsBooleanRelOpPattern (quad)
+ PushValue (left) ;
+ PushValue (right) ;
+ IF LessEqu (tokenno)
THEN
- FoldBooleanRelopPattern (p, quad)
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
- PushValue (left) ;
- PushValue (right) ;
- IF LessEqu (tokenno)
- THEN
- PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
- ELSE
- SubQuad (quad)
- END
+ SubQuad (quad)
END ;
NoChange := FALSE
END
@@ -5530,7 +5470,8 @@ END FoldIfLessEqu ;
*)
PROCEDURE FoldIfGreEqu (tokenno: CARDINAL; p: WalkAction;
- quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+ quad: CARDINAL;
+ left, right, destQuad: CARDINAL) ;
BEGIN
(* Firstly ensure that constant literals are declared. *)
TryDeclareConstant(tokenno, left) ;
@@ -5540,18 +5481,13 @@ BEGIN
IF IsValueSolved (left) AND IsValueSolved (right)
THEN
(* We can take advantage of the known values and evaluate the
condition. *)
- IF IsBooleanRelOpPattern (quad)
+ PushValue (left) ;
+ PushValue (right) ;
+ IF GreEqu (tokenno)
THEN
- FoldBooleanRelopPattern (p, quad)
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
- PushValue (left) ;
- PushValue (right) ;
- IF GreEqu (tokenno)
- THEN
- PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
- ELSE
- SubQuad (quad)
- END
+ SubQuad (quad)
END ;
NoChange := FALSE
END
@@ -5565,7 +5501,8 @@ END FoldIfGreEqu ;
*)
PROCEDURE FoldIfIn (tokenno: CARDINAL; p: WalkAction;
- quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+ quad: CARDINAL;
+ left, right, destQuad: CARDINAL) ;
BEGIN
(* Firstly ensure that constant literals are declared. *)
TryDeclareConstant (tokenno, left) ;
@@ -5577,17 +5514,12 @@ BEGIN
IF CheckBinaryExpressionTypes (quad, NoWalkProcedure)
THEN
(* We can take advantage of the known values and evaluate the
condition. *)
- IF IsBooleanRelOpPattern (quad)
+ PushValue (right) ;
+ IF SetIn (tokenno, left)
THEN
- FoldBooleanRelopPattern (p, quad)
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad) ;
ELSE
- PushValue (right) ;
- IF SetIn (tokenno, left)
- THEN
- PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
- ELSE
- SubQuad (quad)
- END
+ SubQuad (quad)
END
ELSE
SubQuad (quad)
@@ -5604,7 +5536,8 @@ END FoldIfIn ;
*)
PROCEDURE FoldIfNotIn (tokenno: CARDINAL; p: WalkAction;
- quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+ quad: CARDINAL;
+ left, right, destQuad: CARDINAL) ;
BEGIN
(* Firstly ensure that constant literals are declared. *)
TryDeclareConstant (tokenno, left) ;
@@ -5615,18 +5548,14 @@ BEGIN
THEN
IF CheckBinaryExpressionTypes (quad, NoWalkProcedure)
THEN
- (* We can take advantage of the known values and evaluate the
condition. *)
- IF IsBooleanRelOpPattern (quad)
+ (* We can take advantage of the known values and evaluate the
+ condition. *)
+ PushValue (right) ;
+ IF NOT SetIn (tokenno, left)
THEN
- FoldBooleanRelopPattern (p, quad)
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
- PushValue (right) ;
- IF NOT SetIn (tokenno, left)
- THEN
- PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
- ELSE
- SubQuad (quad)
- END
+ SubQuad (quad)
END
ELSE
SubQuad (quad)
@@ -5643,7 +5572,8 @@ END FoldIfNotIn ;
*)
PROCEDURE FoldIfEqu (tokenno: CARDINAL; p: WalkAction;
- quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+ quad: CARDINAL;
+ left, right, destQuad: CARDINAL) ;
BEGIN
(* Firstly ensure that constant literals are declared. *)
TryDeclareConstant(tokenno, left) ;
@@ -5652,19 +5582,15 @@ BEGIN
THEN
IF IsValueSolved (left) AND IsValueSolved (right)
THEN
- IF IsBooleanRelOpPattern (quad)
+ (* We can take advantage of the known values and evaluate the
+ condition. *)
+ PushValue (left) ;
+ PushValue (right) ;
+ IF Equ (tokenno)
THEN
- FoldBooleanRelopPattern (p, quad)
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
- (* We can take advantage of the known values and evaluate the
condition. *)
- PushValue (left) ;
- PushValue (right) ;
- IF Equ (tokenno)
- THEN
- PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
- ELSE
- SubQuad (quad)
- END
+ SubQuad (quad)
END ;
NoChange := FALSE
END
@@ -5678,7 +5604,8 @@ END FoldIfEqu ;
*)
PROCEDURE FoldIfNotEqu (tokenno: CARDINAL; p: WalkAction;
- quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+ quad: CARDINAL;
+ left, right, destQuad: CARDINAL) ;
BEGIN
(* Firstly ensure that constant literals are declared. *)
TryDeclareConstant(tokenno, left) ;
@@ -5687,19 +5614,15 @@ BEGIN
THEN
IF IsValueSolved (left) AND IsValueSolved (right)
THEN
- IF IsBooleanRelOpPattern (quad)
+ (* We can take advantage of the known values and evaluate the
+ condition. *)
+ PushValue (left) ;
+ PushValue (right) ;
+ IF NotEqu (tokenno)
THEN
- FoldBooleanRelopPattern (p, quad)
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
- (* 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
+ SubQuad (quad)
END ;
NoChange := FALSE
END
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index 304c8dd6eab..d3e2118abfd 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -123,7 +123,7 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile,
EndBuildFile,
IsOptimizeOn,
IsPseudoQuad,
IsDefOrModFile,
- IsInitialisingConst,
+ IsInitialisingConst, IsConstQuad, IsConditionalBooleanQuad,
IsQuadConstExpr,
IsBecomes,
IsDummy,
@@ -465,6 +465,20 @@ PROCEDURE GetQuadOp3 (QuadNo: CARDINAL) : CARDINAL ;
PROCEDURE IsInitialisingConst (QuadNo: CARDINAL) : BOOLEAN ;
+(*
+ IsConstQuad - return TRUE if the quadruple is marked as a constexpr.
+*)
+
+PROCEDURE IsConstQuad (quad: CARDINAL) : BOOLEAN ;
+
+
+(*
+ IsConditionalBooleanQuad - return TRUE if operand 1 is a boolean result.
+*)
+
+PROCEDURE IsConditionalBooleanQuad (quad: CARDINAL) : BOOLEAN ;
+
+
(*
IsOptimizeOn - returns true if the Optimize flag was true at QuadNo.
*)
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 3f414e186b2..16c1e016a6f 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -135,6 +135,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode,
GetSymName, IsUnknown,
ForeachFieldEnumerationDo, ForeachLocalSymDo,
GetExported, PutImported, GetSym, GetLibName,
GetTypeMode,
+ IsVarConditional, PutVarConditional,
IsUnused,
NulSym ;
@@ -276,7 +277,7 @@ IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO ;
CONST
DebugStackOn = TRUE ;
DebugVarients = FALSE ;
- BreakAtQuad = 140 ;
+ BreakAtQuad = 200 ;
DebugTokPos = FALSE ;
TYPE
@@ -959,6 +960,29 @@ VAR
op1, op2, op3: CARDINAL ;
BEGIN
GetQuad (QuadNo, op, op1, op2, op3) ;
+ RETURN OpUsesOp1 (op) AND IsConst (op1)
+END IsInitialisingConst ;
+
+
+(*
+ IsConstQuad - return TRUE if the quadruple is marked as a constexpr.
+*)
+
+PROCEDURE IsConstQuad (quad: CARDINAL) : BOOLEAN ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (quad) ;
+ RETURN f^.ConstExpr
+END IsConstQuad ;
+
+
+(*
+ OpUsesOp1 - return TRUE if op allows op1.
+*)
+
+PROCEDURE OpUsesOp1 (op: QuadOperator) : BOOLEAN ;
+BEGIN
CASE op OF
StringConvertCnulOp,
@@ -997,12 +1021,27 @@ BEGIN
XIndrOp,
IndrXOp,
SaveExceptionOp,
- RestoreExceptionOp: RETURN( IsConst(op1) )
+ RestoreExceptionOp: RETURN TRUE
ELSE
- RETURN( FALSE )
+ RETURN FALSE
END
-END IsInitialisingConst ;
+END OpUsesOp1 ;
+
+
+(*
+ IsConditionalBooleanQuad - return TRUE if operand 1 is a boolean result.
+*)
+
+PROCEDURE IsConditionalBooleanQuad (quad: CARDINAL) : BOOLEAN ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (quad) ;
+ RETURN OpUsesOp1 (f^.Operator) AND
+ (IsVar (f^.Operand1) OR IsConst (f^.Operand1)) AND
+ IsVarConditional (f^.Operand1)
+END IsConditionalBooleanQuad ;
(*
@@ -1486,7 +1525,7 @@ BEGIN
Operand3 := Oper3 ;
CheckOverflow := overflow ;
CheckType := checktype ;
- ConstExpr := IsInConstExpression ()
+ ConstExpr := FALSE ; (* IsInConstExpression () *)
END
END
END PutQuadOType ;
@@ -1810,6 +1849,10 @@ VAR
i : CARDINAL ;
f, g: QuadFrame ;
BEGIN
+ IF QuadNo = BreakAtQuad
+ THEN
+ stop
+ END ;
f := GetQF(QuadNo) ;
WITH f^ DO
AlterReference(Head, QuadNo, f^.Next) ;
@@ -1955,8 +1998,8 @@ END ManipulateReference ;
(*
- RemoveReference - remove the reference by quadruple, q, to wherever
- it was pointing to.
+ RemoveReference - remove the reference by quadruple q to wherever
+ it was pointing.
*)
PROCEDURE RemoveReference (q: CARDINAL) ;
@@ -1966,6 +2009,10 @@ BEGIN
f := GetQF(q) ;
IF (f^.Operand3#0) AND (f^.Operand3<NextQuad)
THEN
+ IF f^.Operand3 = BreakAtQuad
+ THEN
+ stop
+ END ;
g := GetQF(f^.Operand3) ;
Assert(g^.NoOfTimesReferenced#0) ;
DEC(g^.NoOfTimesReferenced)
@@ -3483,8 +3530,11 @@ BEGIN
checkOverflow)
END
ELSE
- GenQuadOtok (tokno, BecomesOp, Des, NulSym, Exp, TRUE,
- destok, UnknownTokenNo, exptok)
+ (* This might be inside a const expression. *)
+ GenQuadOTypetok (tokno, BecomesOp,
+ Des, NulSym, Exp,
+ TRUE, TRUE,
+ destok, UnknownTokenNo, exptok)
END
END
END MoveWithMode ;
@@ -3768,16 +3818,19 @@ BEGIN
THEN
PopBool (t, f) ;
PopTtok (Des, destok) ;
+ PutVarConditional (Des, TRUE) ; (* Des will contain the result of a
boolean relop. *)
(* Conditional Boolean Assignment. *)
BackPatch (t, NextQuad) ;
IF GetMode (Des) = LeftValue
THEN
CheckPointerThroughNil (destok, Des) ;
- GenQuadO (destok, XIndrOp, Des, Boolean, True, checkOverflow)
+ GenQuadO (destok, XIndrOp, Des, Boolean, True, checkOverflow) ;
+ GenQuadO (destok, GotoOp, NulSym, NulSym, NextQuad+2, FALSE) ;
ELSE
- GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, True, checkOverflow)
+ (* This might be inside a const expression. *)
+ GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, True, checkOverflow) ;
+ GenQuadO (destok, GotoOp, NulSym, NulSym, NextQuad+2, FALSE)
END ;
- GenQuadO (destok, GotoOp, NulSym, NulSym, NextQuad+2, checkOverflow) ;
BackPatch (f, NextQuad) ;
IF GetMode (Des) = LeftValue
THEN
@@ -3823,16 +3876,6 @@ BEGIN
MoveWithMode (combinedtok, Des, Exp, Array, destok, exptok,
checkOverflow) ;
IF checkTypes
THEN
- (*
- IF (CannotCheckTypeInPass3 (Des) OR CannotCheckTypeInPass3 (Exp))
- THEN
- (* We must do this after the assignment to allow the Designator to
be
- resolved (if it is a constant) before the type checking is
done. *)
- (* Prompt post pass 3 to check the assignment once all types are
resolved. *)
- BuildRange (InitTypesAssignmentCheck (combinedtok, Des, Exp))
- END ;
- *)
- (* BuildRange (InitTypesAssignmentCheck (combinedtok, Des, Exp)) ; *)
CheckAssignCompatible (Des, Exp, combinedtok, destok, exptok)
END
END ;
@@ -12735,7 +12778,7 @@ BEGIN
PopT(e2) ;
PopT(e1) ;
PopT(const) ;
- WriteFormat0('the constant must be an array constructor or a set
constructor but not both') ;
+ WriteFormat0('the constant must be either an array constructor or a
set constructor') ;
PushT(const)
END
END
@@ -12744,6 +12787,14 @@ END BuildComponentValue ;
(*
RecordOp - Records the operator passed on the stack.
+ This is called when a boolean operator is found in an
+ expression. It is called just after the lhs has been built
+ and pushed to the quad stack and prior to the rhs build.
+ It checks to see if AND OR or equality tests are required.
+ It will short circuit AND and OR expressions. It also
+ converts a lhs to a boolean variable if an xor comparison
+ is about to be performed.
+
Checks for AND operator or OR operator
if either of these operators are found then BackPatching
takes place.
@@ -12787,6 +12838,10 @@ BEGIN
PopBool(t, f) ;
BackPatch(f, NextQuad) ;
PushBool(t, 0)
+ ELSIF IsBoolean (1) AND
+ ((Op = EqualTok) OR (Op = LessGreaterTok) OR (Op = HashTok) OR (Op =
InTok))
+ THEN
+ ConvertBooleanToVariable (tokno, 1)
END ;
PushTtok(Op, tokno)
END RecordOp ;
@@ -13180,7 +13235,7 @@ END AreConstant ;
(*
ConvertBooleanToVariable - converts a BoolStack(i) from a Boolean True|False
exit pair into a variable containing the value
TRUE or
- FALSE. The parameter, i, is relative to the top
+ FALSE. The parameter i is relative to the top
of the stack.
*)
@@ -13194,10 +13249,12 @@ BEGIN
constant boolean. *)
Des := MakeTemporary (tok, AreConstant (IsInConstExpression ())) ;
PutVar (Des, Boolean) ;
+ PutVarConditional (Des, TRUE) ;
PushTtok (Des, tok) ; (* we have just increased the stack so we must use
i+1 *)
f := PeepAddress (BoolStack, i+1) ;
PushBool (f^.TrueExit, f^.FalseExit) ;
- BuildAssignmentWithoutBounds (tok, FALSE, TRUE) ; (* restored stack *)
+ BuildAssignmentWithoutBounds (tok, FALSE, TRUE) ;
+ (* Restored stack after the BuildAssign... above. *)
f := PeepAddress (BoolStack, i) ;
WITH f^ DO
TrueExit := Des ; (* Alter Stack(i) to contain the variable. *)
@@ -13228,6 +13285,23 @@ BEGIN
END BuildBooleanVariable ;
+(*
+ DumpQuadSummary -
+*)
+
+PROCEDURE DumpQuadSummary (quad: CARDINAL) ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ IF quad # 0
+ THEN
+ f := GetQF (quad) ;
+ printf2 ("%d op3 = %d\n", quad, f^.Operand3)
+ END
+END DumpQuadSummary ;
+
+
+
(*
BuildRelOpFromBoolean - builds a relational operator sequence of quadruples
instead of using a temporary boolean variable.
@@ -13244,10 +13318,11 @@ END BuildBooleanVariable ;
before
- q if r1 op1 op2 t2
- q+1 Goto f2
- q+2 if r2 op3 op4 t1
- q+3 Goto f1
+ q if r1 op1 op2 t2
+ q+1 Goto f2
+ ...
+ q+n if r2 op3 op4 t1
+ q+n+1 Goto f1
after (in case of =)
@@ -13260,12 +13335,14 @@ END BuildBooleanVariable ;
after (in case of #)
- q if r1 op1 op2 q+2
- q+1 Goto q+4
- q+2 if r2 op3 op4 f
- q+3 Goto t
- q+4 if r2 op3 op4 t
- q+5 Goto f
+ q if r1 op1 op2 q+2
+ q+1 Goto q+n+2
+ q+2 ...
+ ... ...
+ q+n if r2 op3 op4 f
+ q+n+1 Goto t
+ q+n+2 if r2 op3 op4 t
+ q+n+3 Goto f
The Stack is expected to contain:
@@ -13295,11 +13372,11 @@ BEGIN
Assert (IsBoolean (1) AND IsBoolean (3)) ;
IF OperandT (2) = EqualTok
THEN
- (* are the two boolean expressions the same? *)
+ (* Are the two boolean expressions the same? *)
PopBool (t1, f1) ;
PopT (Tok) ;
PopBool (t2, f2) ;
- (* give the false exit a second chance *)
+ (* Give the false exit a second chance. *)
BackPatch (t2, t1) ; (* q if _ _ q+2 *)
BackPatch (f2, NextQuad) ; (* q+1 if _ _ q+4 *)
Assert (NextQuad = f1+1) ;
@@ -13311,11 +13388,25 @@ BEGIN
PushBooltok (Merge (NextQuad-1, t1), Merge (NextQuad-2, f1), tokpos)
ELSIF (OperandT (2) = HashTok) OR (OperandT (2) = LessGreaterTok)
THEN
- (* are the two boolean expressions different? *)
+ IF CompilerDebugging
+ THEN
+ printf0 ("BuildRelOpFromBoolean (NotEqualTok)\n") ;
+ DisplayStack
+ END ;
+ (* Are the two boolean expressions different? *)
PopBool (t1, f1) ;
PopT (Tok) ;
PopBool (t2, f2) ;
- (* give the false exit a second chance *)
+ IF CompilerDebugging
+ THEN
+ printf2 ("t1 = %d, f1 = %d\n", t1, f1) ;
+ printf2 ("t2 = %d, f2 = %d\n", t2, f2) ;
+ DumpQuadSummary (t1) ;
+ DumpQuadSummary (f1) ;
+ DumpQuadSummary (t2) ;
+ DumpQuadSummary (f2) ;
+ END ;
+ (* Give the false exit a second chance. *)
BackPatch (t2, t1) ; (* q if _ _ q+2 *)
BackPatch (f2, NextQuad) ; (* q+1 if _ _ q+4 *)
Assert (NextQuad = f1+1) ;
@@ -13410,11 +13501,13 @@ BEGIN
THEN
DisplayStack (* Debugging info *)
END ;
- IF IsBoolean (1) AND IsBoolean (3)
+ IF IsInConstExpression () AND IsBoolean (1) AND IsBoolean (3)
THEN
(*
we allow # and = to be used with Boolean expressions.
- we do not allow > < >= <= though
+ we do not allow > < >= <= though. We only examine
+ this case if we are in a const expression as there will be
+ no dereferencing of operands.
*)
BuildRelOpFromBoolean (optokpos)
ELSE
@@ -13729,6 +13822,58 @@ BEGIN
END GenQuadOTypetok ;
+(*
+ GenQuadOTypeUniquetok - assigns the fields of the quadruple with
+ the parameters and marks the quad as constexpr.
+*)
+
+PROCEDURE GenQuadOTypeUniquetok (TokPos: CARDINAL;
+ Operation: QuadOperator;
+ Op1, Op2, Op3: CARDINAL;
+ overflow, typecheck: BOOLEAN;
+ Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ (* WriteString('Potential Quad: ') ; *)
+ IF QuadrupleGeneration
+ THEN
+ IF NextQuad # Head
+ THEN
+ f := GetQF (NextQuad-1) ;
+ f^.Next := NextQuad
+ END ;
+ PutQuadOType (NextQuad, Operation, Op1, Op2, Op3, overflow, typecheck) ;
+ f := GetQF (NextQuad) ;
+ WITH f^ DO
+ Next := 0 ;
+ LineNo := GetLineNo () ;
+ IF TokPos = UnknownTokenNo
+ THEN
+ TokenNo := GetTokenNo ()
+ ELSE
+ TokenNo := TokPos
+ END ;
+ op1pos := Op1Pos ;
+ op2pos := Op2Pos ;
+ op3pos := Op3Pos ;
+ ConstExpr := TRUE ;
+ IF GetDebugTraceQuad ()
+ THEN
+ printf0('generating: ') ;
+ DisplayQuad (NextQuad) ;
+ (* MetaErrorT1 (TokenNo, '{%1On}', NextQuad) *)
+ END
+ END ;
+ IF NextQuad=BreakAtQuad
+ THEN
+ stop
+ END ;
+ NewQuad (NextQuad)
+ END
+END GenQuadOTypeUniquetok ;
+
+
(*
DumpUntil - dump all quadruples until we seen the ending quadruple
with procsym in the third operand.
@@ -13869,7 +14014,7 @@ END DisplayQuadRange ;
(*
BackPatch - Makes each of the quadruples on the list pointed to by
- StartQuad, take quadruple Value as a target.
+ QuadNo take quadruple Value as a target.
*)
PROCEDURE BackPatch (QuadNo, Value: CARDINAL) ;
diff --git a/gcc/m2/gm2-compiler/M2Swig.mod b/gcc/m2/gm2-compiler/M2Swig.mod
index 11b2dbe3a45..194abd5fb78 100644
--- a/gcc/m2/gm2-compiler/M2Swig.mod
+++ b/gcc/m2/gm2-compiler/M2Swig.mod
@@ -57,7 +57,8 @@ FROM SymbolTable IMPORT GetSymName, IsType, IsProcedure,
IsConst, IsVar,
NulSym ;
FROM M2BasicBlock IMPORT BasicBlock, InitBasicBlocks, KillBasicBlocks,
- ForeachBasicBlockDo ;
+ ForeachBasicBlockDo,
+ GetBasicBlockStart, GetBasicBlockEnd ;
TYPE
@@ -520,8 +521,12 @@ VAR
DoBasicBlock -
*)
-PROCEDURE DoBasicBlock (start, end: CARDINAL) ;
+PROCEDURE DoBasicBlock (bb: BasicBlock) ;
+VAR
+ start, end: CARDINAL ;
BEGIN
+ start := GetBasicBlockStart (bb) ;
+ end := GetBasicBlockEnd (bb) ;
IF IsProcedureScope(start)
THEN
(* skip this basic block, as this will not modify the parameter *)
diff --git a/gcc/m2/gm2-compiler/M2SymInit.mod
b/gcc/m2/gm2-compiler/M2SymInit.mod
index 4c6035ae929..48f1b3d3288 100644
--- a/gcc/m2/gm2-compiler/M2SymInit.mod
+++ b/gcc/m2/gm2-compiler/M2SymInit.mod
@@ -39,7 +39,8 @@ FROM M2Error IMPORT InternalError ;
FROM M2BasicBlock IMPORT BasicBlock,
InitBasicBlocks, InitBasicBlocksFromRange,
KillBasicBlocks, FreeBasicBlocks,
- ForeachBasicBlockDo ;
+ ForeachBasicBlockDo,
+ GetBasicBlockStart, GetBasicBlockEnd ;
IMPORT Indexing ;
FROM Indexing IMPORT Index ;
@@ -1873,7 +1874,7 @@ END DetectTrash ;
AppendEntry -
*)
-PROCEDURE AppendEntry (Start, End: CARDINAL) ;
+PROCEDURE AppendEntry (bb: BasicBlock) ;
VAR
bbPtr: bbEntry ;
high : CARDINAL ;
@@ -1881,13 +1882,13 @@ BEGIN
high := Indexing.HighIndice (bbArray) ;
bbPtr := NewEntry () ;
WITH bbPtr^ DO
- start := Start ;
- end := End ;
+ start := GetBasicBlockStart (bb) ;
+ end := GetBasicBlockEnd (bb) ;
first := high = 0 ;
- endCall := IsCall (End) ;
- endGoto := IsGoto (End) ;
- endCond := IsConditional (End) ;
- topOfLoop := IsBackReference (Start) ;
+ endCall := IsCall (end) ;
+ endGoto := IsGoto (end) ;
+ endCond := IsConditional (end) ;
+ topOfLoop := IsBackReference (start) ;
trashQuad := 0 ;
indexBB := high + 1 ;
nextQuad := 0 ;
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index 643309424a7..0cec32914fc 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -679,9 +679,12 @@ ConstExpression :=
% VAR
%
PopInConstExpression %
=:
-Relation := "=" %
PushTtok(EqualTok, GetTokenNo() -1) %
- | "#" %
PushTtok(HashTok, GetTokenNo() -1) %
- | "<>" %
PushTtok(LessGreaterTok, GetTokenNo() -1) %
+Relation := "=" %
PushTtok(EqualTok, GetTokenNo() -1) ;
+
RecordOp %
+ | "#" %
PushTtok(HashTok, GetTokenNo() -1) ;
+
RecordOp %
+ | "<>" %
PushTtok(LessGreaterTok, GetTokenNo() -1) ;
+
RecordOp %
| "<" %
PushTtok(LessTok, GetTokenNo() -1) %
| "<=" %
PushTtok(LessEqualTok, GetTokenNo() -1) %
| ">" %
PushTtok(GreaterTok, GetTokenNo() -1) %
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def
b/gcc/m2/gm2-compiler/SymbolTable.def
index 06f8a227563..05ef313f322 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -392,6 +392,21 @@ PROCEDURE IsVarHeap (sym: CARDINAL) : BOOLEAN ;
PROCEDURE MakeVar (tok: CARDINAL; VarName: Name) : CARDINAL ;
+(*
+ PutVarConditional - assign IsConditional to value.
+*)
+
+PROCEDURE PutVarConditional (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+ IsVarConditional - return TRUE if the symbol is a var symbol
+ containing the result of a boolean conditional.
+*)
+
+PROCEDURE IsVarConditional (sym: CARDINAL) : BOOLEAN ;
+
+
(*
MakeRecord - makes a Record symbol with name RecordName.
*)
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod
b/gcc/m2/gm2-compiler/SymbolTable.mod
index f206a47dff7..c76e942f729 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -510,6 +510,8 @@ TYPE
(* of const. *)
Value : PtrToValue ; (* Value of the constant *)
Type : CARDINAL ; (* TYPE of constant, char etc *)
+ IsConditional, (* Is it the result of a *)
+ (* boolean conditional? *)
IsSet : BOOLEAN ; (* is the constant a set? *)
IsConstructor: BOOLEAN ; (* is the constant a set? *)
FromType : CARDINAL ; (* type is determined FromType *)
@@ -533,6 +535,7 @@ TYPE
IsComponentRef: BOOLEAN ; (* Is temporary referencing a *)
(* record field? *)
list : Indexing.Index ; (* the record and fields *)
+ IsConditional,
IsTemp : BOOLEAN ; (* Is variable a temporary? *)
IsParam : BOOLEAN ; (* Is variable a parameter? *)
IsPointerCheck: BOOLEAN ; (* Is variable used to *)
@@ -4306,6 +4309,7 @@ BEGIN
Scope := GetCurrentScope() ; (* Procedure or Module? *)
AtAddress := FALSE ;
Address := NulSym ; (* Address at which declared. *)
+ IsConditional := FALSE ;
IsTemp := FALSE ;
IsComponentRef := FALSE ;
IsParam := FALSE ;
@@ -4334,6 +4338,52 @@ BEGIN
END MakeVar ;
+(*
+ PutVarConditional - assign IsConditional to value.
+*)
+
+PROCEDURE PutVarConditional (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym(sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym : Var.IsConditional := value |
+ ConstVarSym: ConstVar.IsConditional := value
+
+ ELSE
+ InternalError ('expecting Var')
+ END
+ END
+END PutVarConditional ;
+
+
+(*
+ IsVarConditional - return TRUE if the symbol is a var symbol
+ containing the result of a boolean conditional.
+*)
+
+PROCEDURE IsVarConditional (sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym(sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym : RETURN Var.IsConditional |
+ ConstVarSym: RETURN ConstVar.IsConditional
+
+ ELSE
+ RETURN FALSE
+ END
+ END ;
+ RETURN FALSE
+END IsVarConditional ;
+
+
(*
PutExceptionBlock - sets a BOOLEAN in block module/procedure/defimp,
sym, indicating that this block as an EXCEPT
@@ -5043,6 +5093,7 @@ BEGIN
Value := InitValue() ;
Type := NulSym ;
IsSet := FALSE ;
+ IsConditional := FALSE ;
IsConstructor := FALSE ;
FromType := NulSym ; (* type is determined FromType *)
UnresFromType := FALSE ; (* is Type resolved? *)
diff --git a/gcc/testsuite/gm2/iso/const/pass/constbool4.mod
b/gcc/testsuite/gm2/iso/const/pass/constbool4.mod
new file mode 100644
index 00000000000..faf335eb85a
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/const/pass/constbool4.mod
@@ -0,0 +1,17 @@
+MODULE constbool4 ;
+
+
+CONST
+ World = "W" + "o" + "r" + "l" + "d" ;
+ Hello = "Hello" + " " + World ;
+ AddressableBits = 32 ;
+ MaxBits = 32 ;
+
+ BitsInUse =
+ ORD(AddressableBits > MaxBits) * MaxBits +
+ ORD(AddressableBits <= MaxBits) * AddressableBits +
+ ORD (LENGTH (Hello) = 15) ;
+
+BEGIN
+
+END constbool4.
diff --git a/gcc/testsuite/gm2/iso/const/pass/constbool5.mod
b/gcc/testsuite/gm2/iso/const/pass/constbool5.mod
new file mode 100644
index 00000000000..31b6de3bd5f
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/const/pass/constbool5.mod
@@ -0,0 +1,24 @@
+MODULE constbool5 ;
+
+FROM libc IMPORT printf, exit ;
+
+CONST
+ World = "W" + "o" + "r" + "l" + "d" ;
+ Hello = "Hello" + " " + World ;
+ AddressableBits = 32 ;
+ MaxBits = 32 ;
+
+ BitsInUse =
+ ORD(AddressableBits > MaxBits) * MaxBits +
+ ORD(AddressableBits <= MaxBits) * AddressableBits +
+ ORD (LENGTH (Hello) = 11) ;
+
+BEGIN
+ IF BitsInUse = 33
+ THEN
+ printf ("passed\n") ;
+ ELSE
+ printf ("failed\n") ;
+ exit (1)
+ END
+END constbool5.
diff --git a/gcc/testsuite/gm2/iso/run/pass/condtest2.mod
b/gcc/testsuite/gm2/iso/run/pass/condtest2.mod
new file mode 100644
index 00000000000..17ecd18102c
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/condtest2.mod
@@ -0,0 +1,26 @@
+MODULE condtest2 ;
+
+FROM libc IMPORT printf, exit ;
+
+
+PROCEDURE test (VAR a, b, c, d: CARDINAL) ;
+BEGIN
+ IF (a = b) # (c = d)
+ THEN
+ printf ("passed\n")
+ ELSE
+ printf ("failed\n") ;
+ exit (1)
+ END
+END test ;
+
+
+VAR
+ e, f, g, h: CARDINAL ;
+BEGIN
+ e := 1 ;
+ f := 2 ;
+ g := 3 ;
+ h := 3 ;
+ test (e, f, g, h)
+END condtest2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/condtest3.mod
b/gcc/testsuite/gm2/iso/run/pass/condtest3.mod
new file mode 100644
index 00000000000..457a94f638d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/condtest3.mod
@@ -0,0 +1,26 @@
+MODULE condtest3 ;
+
+FROM libc IMPORT printf, exit ;
+
+
+PROCEDURE test ;
+CONST
+ a = 1 ;
+ b = 2 ;
+ c = 3 ;
+ d = 3 ;
+ Result = ((a = b) # (c = d)) ;
+BEGIN
+ IF Result
+ THEN
+ printf ("passed\n")
+ ELSE
+ printf ("failed\n") ;
+ exit (1)
+ END
+END test ;
+
+
+BEGIN
+ test
+END condtest3.
diff --git a/gcc/testsuite/gm2/iso/run/pass/condtest4.mod
b/gcc/testsuite/gm2/iso/run/pass/condtest4.mod
new file mode 100644
index 00000000000..6fd027b12e2
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/condtest4.mod
@@ -0,0 +1,24 @@
+MODULE condtest4 ;
+
+FROM libc IMPORT printf, exit ;
+
+
+PROCEDURE test (VAR a, b: BOOLEAN) ;
+BEGIN
+ IF a AND b
+ THEN
+ printf ("passed\n")
+ ELSE
+ printf ("failed\n") ;
+ exit (1)
+ END
+END test ;
+
+
+VAR
+ e, f: BOOLEAN ;
+BEGIN
+ e := TRUE ;
+ f := TRUE ;
+ test (e, f)
+END condtest4.
diff --git a/gcc/testsuite/gm2/iso/run/pass/condtest5.mod
b/gcc/testsuite/gm2/iso/run/pass/condtest5.mod
new file mode 100644
index 00000000000..5cb88433eaa
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/condtest5.mod
@@ -0,0 +1,24 @@
+MODULE condtest5 ;
+
+FROM libc IMPORT printf, exit ;
+
+
+PROCEDURE test (VAR a, b: BOOLEAN) ;
+BEGIN
+ IF (a = a) AND b
+ THEN
+ printf ("passed\n")
+ ELSE
+ printf ("failed\n") ;
+ exit (1)
+ END
+END test ;
+
+
+VAR
+ e, f: BOOLEAN ;
+BEGIN
+ e := TRUE ;
+ f := TRUE ;
+ test (e, f)
+END condtest5.
diff --git a/gcc/testsuite/gm2/iso/run/pass/constbool4.mod
b/gcc/testsuite/gm2/iso/run/pass/constbool4.mod
new file mode 100644
index 00000000000..faf335eb85a
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/constbool4.mod
@@ -0,0 +1,17 @@
+MODULE constbool4 ;
+
+
+CONST
+ World = "W" + "o" + "r" + "l" + "d" ;
+ Hello = "Hello" + " " + World ;
+ AddressableBits = 32 ;
+ MaxBits = 32 ;
+
+ BitsInUse =
+ ORD(AddressableBits > MaxBits) * MaxBits +
+ ORD(AddressableBits <= MaxBits) * AddressableBits +
+ ORD (LENGTH (Hello) = 15) ;
+
+BEGIN
+
+END constbool4.
