[PATCH] 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.

(cherry picked from commit 9f168b412f)

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

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.

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 *)
+                   Scope      : CARDINAL ;  (* Scope associated with the block.  *)
-                   EndQuad    : CARDINAL ;  (* End Quad in Basic 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) ;
+   Assert (b#NIL) ;
-   RETURN( b )
+   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 *)
+         CurrentBB := New (ScopeSym, First) ;  (* Get a new Basic Block.  *)
-                                  (* At least one quad in this 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.

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 () ;
 

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) ;
 
 
 (*

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) ;
+         TraverseDependants(sym)
-(*
-         WatchIncludeList(sym, todolist)
-*)
       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
+      bb := InitBasicBlocks (sb) ;
-      END ;
+      ConstantResolved := FALSE ;
-      (* we need to evaluate some constant expressions to resolve these types *)
+      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
+   UNTIL (NOT ConstantResolved) AND EqualGroup (copy, GlobalGroup) ;
-         EqualGroup (copy, GlobalGroup) ;
+   KillGroup (copy) ;
-   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.

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,
+FROM M2BasicBlock IMPORT BasicBlock ;
-                 GetHighFromUnbounded, StringToChar,
-                 LValueToGenericPtr, ZConstToTypedConst,
-                 PrepareCopyString ;
 
 
 (*
@@ -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 ;
 
 
 (*

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)
+         IF TypeCheckBecomes (p, quad)
-      ELSE
+         THEN
-         GetQuad (quad, op, des, op2, expr) ;
+            PerformFoldBecomes (p, quad)
-         RemoveQuad (p, des, 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) ;
+            SubQuad (quad)
-            PushValue (right) ;
-            IF Less (tokenno)
-            THEN
-               PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
-            ELSE
-               SubQuad (quad)
-            END
          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) ;
+            SubQuad (quad)
-            PushValue (right) ;
-            IF Gre (tokenno)
-            THEN
-               PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
-            ELSE
-               SubQuad (quad)
-            END
          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) ;
+            SubQuad (quad)
-            PushValue (right) ;
-            IF LessEqu (tokenno)
-            THEN
-               PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
-            ELSE
-               SubQuad (quad)
-            END
          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) ;
+            SubQuad (quad)
-            PushValue (right) ;
-            IF GreEqu (tokenno)
-            THEN
-               PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
-            ELSE
-               SubQuad (quad)
-            END
          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) ;
+               SubQuad (quad)
-               IF SetIn (tokenno, left)
-               THEN
-                  PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
-               ELSE
-                  SubQuad (quad)
-               END
             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.  *)
+            (* We can take advantage of the known values and evaluate the
-            IF IsBooleanRelOpPattern (quad)
+               condition.  *)
+            PushValue (right) ;
+            IF NOT SetIn (tokenno, left)
             THEN
-               FoldBooleanRelopPattern (p, quad)
+               PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
             ELSE
-               PushValue (right) ;
+               SubQuad (quad)
-               IF NOT SetIn (tokenno, left)
-               THEN
-                  PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
-               ELSE
-                  SubQuad (quad)
-               END
             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.  *)
+            SubQuad (quad)
-            PushValue (left) ;
-            PushValue (right) ;
-            IF Equ (tokenno)
-            THEN
-               PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
-            ELSE
-               SubQuad (quad)
-            END
          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.  *)
+            SubQuad (quad)
-            PushValue (left) ;
-            PushValue (right) ;
-            IF NotEqu (tokenno)
-            THEN
-               PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
-            ELSE
-               SubQuad (quad)
-            END
          END ;
          NoChange := FALSE
       END

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.
 *)

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
+   RemoveReference - remove the reference by quadruple q to wherever
-                     it was pointing to.
+                     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,
+         (* This might be inside a const expression.  *)
-                      destok, UnknownTokenNo, exptok)
+         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      if r1      op1     op2     t2
-                           q+1  Goto                       f2
+                           q+1    Goto                       f2
-                           q+2  if r2      op3     op4     t1
+                           ...
-                           q+3  Goto                       f1
+                           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      if r1      op1     op2     q+2
-                           q+1  Goto                       q+4
+                           q+1    Goto                       q+n+2
-                           q+2  if r2      op3     op4     f
+                           q+2    ...
-                           q+3  Goto                       t
+                           ...    ...
-                           q+4  if r2      op3     op4     t
+                           q+n    if r2      op3     op4     f
-                           q+5  Goto                       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) ;

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 *)

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 ;
+      start := GetBasicBlockStart (bb) ;
-      end := End ;
+      end := GetBasicBlockEnd (bb) ;
       first := high = 0 ;
-      endCall := IsCall (End) ;
+      endCall := IsCall (end) ;
-      endGoto := IsGoto (End) ;
+      endGoto := IsGoto (end) ;
-      endCond := IsConditional (End) ;
+      endCond := IsConditional (end) ;
-      topOfLoop := IsBackReference (Start) ;
+      topOfLoop := IsBackReference (start) ;
       trashQuad := 0 ;
       indexBB := high + 1 ;
       nextQuad := 0 ;

gcc/m2/gm2-compiler/P3Build.bnf

@@ -679,9 +679,12 @@ ConstExpression :=                                                         % VAR
                                                                            % PopInConstExpression %
                 =:
 
-Relation := "="                                                            % PushTtok(EqualTok, GetTokenNo() -1) %
+Relation := "="                                                            % PushTtok(EqualTok, GetTokenNo() -1) ;
-            | "#"                                                          % PushTtok(HashTok, GetTokenNo() -1) %
+                                                                             RecordOp %
-            | "<>"                                                         % PushTtok(LessGreaterTok, GetTokenNo() -1) %
+            | "#"                                                          % PushTtok(HashTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
+            | "<>"                                                         % PushTtok(LessGreaterTok, GetTokenNo() -1) ;
+                                                                             RecordOp %
             | "<"                                                          % PushTtok(LessTok, GetTokenNo() -1) %
             | "<="                                                         % PushTtok(LessEqualTok, GetTokenNo() -1) %
             | ">"                                                          % PushTtok(GreaterTok, GetTokenNo() -1) %

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.
 *)

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?           *)

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.

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.

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.

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.

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.

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.

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.