*)
FROM M2Scope IMPORT ScopeBlock ;
-EXPORT QUALIFIED BasicBlock, BasicBlockProc,
- InitBasicBlocks, InitBasicBlocksFromRange,
- KillBasicBlocks, FreeBasicBlocks,
- ForeachBasicBlockDo ;
TYPE
BasicBlock ;
- BasicBlockProc = PROCEDURE (CARDINAL, CARDINAL) ;
+ BasicBlockProc = PROCEDURE (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.
IsReturn, IsNewLocalVar, IsKillLocalVar,
IsCatchBegin, IsCatchEnd,
IsInitStart, IsInitEnd, IsFinallyStart, IsFinallyEnd,
- IsInitialisingConst,
+ IsInitialisingConst, IsConditionalBooleanQuad,
IsPseudoQuad, IsDefOrModFile,
GetNextQuad, GetQuad, QuadOperator,
SubQuad, DisplayQuadRange ;
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 ;
HeadOfBasicBlock: BasicBlock ;
+PROCEDURE stop ;
+END stop ;
+
+
(*
InitBasicBlocks - converts a list of quadruples as defined by
scope blocks into a set of basic blocks.
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 ;
PROCEDURE ConvertQuads2BasicBlock (ScopeSym: CARDINAL; Start, End: CARDINAL) ;
VAR
+ First,
LastQuadDefMod,
LastQuadConditional,
LastQuadCall,
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.
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
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 *)
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) ;
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) ;
b := bb ;
REPEAT
WITH b^ DO
- p (StartQuad, EndQuad)
+ p (b)
END ;
b := b^.Right
UNTIL b=bb
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.
*)
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.
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 () ;
FROM SYSTEM IMPORT WORD ;
FROM m2tree IMPORT Tree ;
+FROM M2BasicBlock IMPORT BasicBlock ;
TYPE
WalkAction = PROCEDURE (WORD) ;
FoldConstants - a wrapper for ResolveConstantExpressions.
*)
-PROCEDURE FoldConstants (start, end: CARDINAL) ;
+PROCEDURE FoldConstants (bb: BasicBlock) ;
(*
NoOfElementsInSet, IsElementInSet, ForeachElementInSetDo,
DuplicateSet, EqualSet ;
+FROM M2BasicBlock IMPORT BasicBlock, InitBasicBlocks, KillBasicBlocks, ForeachBasicBlockDo ;
+
FROM SymbolTable IMPORT NulSym,
ModeOfAddr,
GetMode,
WatchList : Set ; (* Set of symbols being watched. *)
EnumerationIndex : Index ;
action : IsAction ;
+ ConstantResolved,
enumDeps : BOOLEAN ;
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
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,
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 ;
THEN
RETURN
END ;
- TraverseDependants(sym) ;
-(*
- WatchIncludeList(sym, todolist)
-*)
+ TraverseDependants(sym)
ELSE
TryDeclareConst(tokenno, sym)
END
TryEvaluateValue(sym) ;
IF NOT IsConstructorDependants(sym, IsFullyDeclared)
THEN
-(*
- WatchIncludeList(sym, todolist) ;
-*)
TraverseDependants(sym) ;
RETURN
END ;
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.
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 ;
VAR
copy: Group ;
loop: CARDINAL ;
+ sb : ScopeBlock ;
+ bb : BasicBlock ;
BEGIN
IF TraceQuadruples
THEN
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 ;
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 ;
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.
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 ;
(*
p(sym) is invoked.
*)
-PROCEDURE ResolveConstantExpressions (p: WalkAction; start, end: CARDINAL) : BOOLEAN ;
+PROCEDURE ResolveConstantExpressions (p: WalkAction; bb: BasicBlock) : BOOLEAN ;
(*
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 ;
p(sym) is invoked.
*)
-PROCEDURE ResolveConstantExpressions (p: WalkAction; start, end: CARDINAL) : BOOLEAN ;
+PROCEDURE ResolveConstantExpressions (p: WalkAction; bb: BasicBlock) : BOOLEAN ;
VAR
tokenno: CARDINAL ;
quad : CARDINAL ;
op2pos,
op3pos : CARDINAL ;
Changed: BOOLEAN ;
+ start,
+ end : CARDINAL ;
BEGIN
InitBuiltinSyms (BuiltinTokenNo) ;
+ start := GetBasicBlockStart (bb) ;
+ end := GetBasicBlockEnd (bb) ;
Changed := FALSE ;
REPEAT
NoChange := TRUE ;
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) |
ELSE
(* ignore quadruple as it is not associated with a constant expression *)
END ;
- quad := GetNextQuad(quad)
+ quad := GetNextQuad (quad)
END ;
IF NOT NoChange
THEN
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 ;
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
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
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.
*)
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) ;
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
*)
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) ;
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
*)
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) ;
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
*)
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) ;
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)
*)
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) ;
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)
*)
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) ;
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
*)
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) ;
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
IsOptimizeOn,
IsPseudoQuad,
IsDefOrModFile,
- IsInitialisingConst,
+ IsInitialisingConst, IsConstQuad, IsConditionalBooleanQuad,
IsQuadConstExpr,
IsBecomes,
IsDummy,
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.
*)
ForeachFieldEnumerationDo, ForeachLocalSymDo,
GetExported, PutImported, GetSym, GetLibName,
GetTypeMode,
+ IsVarConditional, PutVarConditional,
IsUnused,
NulSym ;
CONST
DebugStackOn = TRUE ;
DebugVarients = FALSE ;
- BreakAtQuad = 140 ;
+ BreakAtQuad = 200 ;
DebugTokPos = FALSE ;
TYPE
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,
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 ;
(*
Operand3 := Oper3 ;
CheckOverflow := overflow ;
CheckType := checktype ;
- ConstExpr := IsInConstExpression ()
+ ConstExpr := FALSE ; (* IsInConstExpression () *)
END
END
END PutQuadOType ;
i : CARDINAL ;
f, g: QuadFrame ;
BEGIN
+ IF QuadNo = BreakAtQuad
+ THEN
+ stop
+ END ;
f := GetQF(QuadNo) ;
WITH f^ DO
AlterReference(Head, QuadNo, f^.Next) ;
(*
- 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) ;
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)
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 ;
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
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 ;
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
(*
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.
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 ;
(*
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.
*)
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. *)
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.
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 =)
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:
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) ;
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) ;
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
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.
(*
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) ;
NulSym ;
FROM M2BasicBlock IMPORT BasicBlock, InitBasicBlocks, KillBasicBlocks,
- ForeachBasicBlockDo ;
+ ForeachBasicBlockDo,
+ GetBasicBlockStart, GetBasicBlockEnd ;
TYPE
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 *)
FROM M2BasicBlock IMPORT BasicBlock,
InitBasicBlocks, InitBasicBlocksFromRange,
KillBasicBlocks, FreeBasicBlocks,
- ForeachBasicBlockDo ;
+ ForeachBasicBlockDo,
+ GetBasicBlockStart, GetBasicBlockEnd ;
IMPORT Indexing ;
FROM Indexing IMPORT Index ;
AppendEntry -
*)
-PROCEDURE AppendEntry (Start, End: CARDINAL) ;
+PROCEDURE AppendEntry (bb: BasicBlock) ;
VAR
bbPtr: bbEntry ;
high : CARDINAL ;
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 ;
% 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) %
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.
*)
(* 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 *)
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 *)
Scope := GetCurrentScope() ; (* Procedure or Module? *)
AtAddress := FALSE ;
Address := NulSym ; (* Address at which declared. *)
+ IsConditional := FALSE ;
IsTemp := FALSE ;
IsComponentRef := FALSE ;
IsParam := FALSE ;
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
Value := InitValue() ;
Type := NulSym ;
IsSet := FALSE ;
+ IsConditional := FALSE ;
IsConstructor := FALSE ;
FromType := NulSym ; (* type is determined FromType *)
UnresFromType := FALSE ; (* is Type resolved? *)
--- /dev/null
+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.
--- /dev/null
+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.
--- /dev/null
+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.
--- /dev/null
+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.
--- /dev/null
+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.
--- /dev/null
+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.
--- /dev/null
+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.
projects / thirdparty / gcc.git / commitdiff
