mirrors/gcc
1
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-23 02:44:18 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

[PATCH] PR modula2/115536 Expression is evaluated incorrectly when encountering relops and indirection

Browse Source 
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>
This commit is contained in:
Gaius Mulley 2024-11-22 18:38:51 +00:00
parent 9fd8cd1990
commit 3adceba04e
21 changed files with 677 additions and 392 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gcc/m2/gm2-compiler/M2BasicBlock.def
View File

@ -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.

129
gcc/m2/gm2-compiler/M2BasicBlock.mod
View File

@ -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.

7
gcc/m2/gm2-compiler/M2Code.mod
View File

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

3
gcc/m2/gm2-compiler/M2GCCDeclare.def
View File

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

148
gcc/m2/gm2-compiler/M2GCCDeclare.mod
View File

@ -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.

7
gcc/m2/gm2-compiler/M2GenGCC.def
View File

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

237
gcc/m2/gm2-compiler/M2GenGCC.mod
View File

@ -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

16
gcc/m2/gm2-compiler/M2Quads.def
View File

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

229
gcc/m2/gm2-compiler/M2Quads.mod
View File

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

9
gcc/m2/gm2-compiler/M2Swig.mod
View File

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

17
gcc/m2/gm2-compiler/M2SymInit.mod
View File

@ -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 ;

9
gcc/m2/gm2-compiler/P3Build.bnf
View File

@ -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) %

15
gcc/m2/gm2-compiler/SymbolTable.def
View File

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

51
gcc/m2/gm2-compiler/SymbolTable.mod
View File

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

17
gcc/testsuite/gm2/iso/const/pass/constbool4.mod Normal file
View File

@ -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.

24
gcc/testsuite/gm2/iso/const/pass/constbool5.mod Normal file
View File

@ -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.

26
gcc/testsuite/gm2/iso/run/pass/condtest2.mod Normal file
View File

@ -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.

26
gcc/testsuite/gm2/iso/run/pass/condtest3.mod Normal file
View File

@ -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.

24
gcc/testsuite/gm2/iso/run/pass/condtest4.mod Normal file
View File

@ -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.

24
gcc/testsuite/gm2/iso/run/pass/condtest5.mod Normal file
View File

@ -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.

17
gcc/testsuite/gm2/iso/run/pass/constbool4.mod Normal file
View File

@ -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.