SubQuad, PutQuad, MustCheckOverflow, GetQuadOtok,
GetQuadOTypetok,
QuadToTokenNo, DisplayQuad, GetQuadtok,
- GetM2OperatorDesc, GetQuadOp ;
+ GetM2OperatorDesc, GetQuadOp,
+ IsQuadConstExpr, IsBecomes, IsGoto, IsConditional,
+ IsDummy,
+ GetQuadOp1, GetQuadOp3, GetQuadDest, SetQuadConstExpr ;
FROM M2Check IMPORT ParameterTypeCompatible, AssignmentTypeCompatible, ExpressionTypeCompatible ;
FROM M2SSA IMPORT EnableSSA ;
+FROM M2Optimize IMPORT FoldBranches ;
CONST
CheckReferenced(q, op) ;
IF GetDebugTraceQuad ()
THEN
- printf0('building: ') ;
- DisplayQuad(q)
+ printf0 ('building: ') ;
+ DisplayQuad (q)
END ;
CASE op OF
THEN
tokenno := QuadToTokenNo (quad)
END ;
+ IF GetDebugTraceQuad ()
+ THEN
+ printf0('examining fold: ') ;
+ DisplayQuad (quad)
+ END ;
GetQuadtok (quad, op, op1, op2, op3,
op1pos, op2pos, op3pos) ;
CASE op OF
CastOp : FoldCast (tokenno, p, quad, op1, op2, op3) |
InclOp : FoldIncl (tokenno, p, quad, op1, op3) |
ExclOp : FoldExcl (tokenno, p, quad, op1, op3) |
- IfLessOp : FoldIfLess (tokenno, quad, op1, op2, op3) |
- IfInOp : FoldIfIn (tokenno, quad, op1, op2, op3) |
- IfNotInOp : FoldIfNotIn (tokenno, quad, op1, op2, op3) |
+ IfEquOp : FoldIfEqu (tokenno, p, quad, op1, op2, op3) |
+ IfNotEquOp : FoldIfNotEqu (tokenno, p, quad, op1, op2, op3) |
+ IfLessOp : FoldIfLess (tokenno, p, quad, op1, op2, op3) |
+ IfLessEquOp : FoldIfLessEqu (tokenno, p, quad, op1, op2, op3) |
+ IfGreOp : FoldIfGre (tokenno, p, quad, op1, op2, op3) |
+ IfGreEquOp : FoldIfGreEqu (tokenno, p, quad, op1, op2, op3) |
+ IfInOp : FoldIfIn (tokenno, p, quad, op1, op2, op3) |
+ IfNotInOp : FoldIfNotIn (tokenno, p, quad, op1, op2, op3) |
LogicalShiftOp : FoldSetShift(tokenno, p, quad, op1, op2, op3) |
LogicalRotateOp : FoldSetRotate (tokenno, p, quad, op1, op2, op3) |
ParamOp : FoldBuiltinFunction (tokenno, p, quad, op1, op2, op3) |
PROCEDURE CodeInline (quad: CARDINAL) ;
VAR
+ constExpr,
overflowChecking: BOOLEAN ;
op : QuadOperator ;
op1, op2, GnuAsm: CARDINAL ;
labels : Tree ;
location : location_t ;
BEGIN
- GetQuadOtok (quad, asmpos, op, op1, op2, GnuAsm, overflowChecking,
+ GetQuadOtok (quad, asmpos, op, op1, op2, GnuAsm,
+ overflowChecking, constExpr,
op1pos, op2pos, op3pos) ;
location := TokenToLocation (asmpos) ;
inputs := BuildTreeFromInterface (GetGnuAsmInput (GnuAsm)) ;
PROCEDURE CodeReturnValue (quad: CARDINAL) ;
VAR
op : QuadOperator ;
+ constExpr,
overflowChecking : BOOLEAN ;
expr, none, procedure : CARDINAL ;
combinedpos,
value, length : Tree ;
location : location_t ;
BEGIN
- GetQuadOtok (quad, returnpos, op, expr, none, procedure, overflowChecking,
+ GetQuadOtok (quad, returnpos, op, expr, none, procedure,
+ overflowChecking, constExpr,
exprpos, nonepos, procpos) ;
combinedpos := MakeVirtualTok (returnpos, returnpos, exprpos) ;
location := TokenToLocation (combinedpos) ;
parampos : CARDINAL ;
nth : CARDINAL ;
compatible,
+ constExpr,
overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, parampos, op,
- nth, procedure, parameter, overflow,
+ nth, procedure, parameter,
+ overflow, constExpr,
nopos, nopos, nopos) ;
compatible := TRUE ;
IF nth=0
stroppos,
despos, nonepos,
exprpos : CARDINAL ;
+ constExpr,
overflowChecking: BOOLEAN ;
location : location_t ;
BEGIN
- GetQuadOtok (quad, stroppos, op, des, none, expr, overflowChecking,
+ GetQuadOtok (quad, stroppos, op, des, none, expr,
+ overflowChecking, constExpr,
despos, nonepos, exprpos) ;
IF IsConstStr (expr) AND IsConstStrKnown (expr)
THEN
despos, nonepos,
exprpos : CARDINAL ;
s : String ;
+ constExpr,
overflowChecking: BOOLEAN ;
BEGIN
- GetQuadOtok (quad, stroppos, op, des, none, expr, overflowChecking,
+ GetQuadOtok (quad, stroppos, op, des, none, expr,
+ overflowChecking, constExpr,
despos, nonepos, exprpos) ;
IF IsConstStr (expr) AND IsConstStrKnown (expr)
THEN
despos, nonepos,
exprpos : CARDINAL ;
s : String ;
+ constExpr,
overflowChecking: BOOLEAN ;
BEGIN
- GetQuadOtok (quad, stroppos, op, des, none, expr, overflowChecking,
+ GetQuadOtok (quad, stroppos, op, des, none, expr,
+ overflowChecking, constExpr,
despos, nonepos, exprpos) ;
IF IsConstStr (expr) AND IsConstStrKnown (expr)
THEN
op : QuadOperator ;
des, op2, expr: CARDINAL ;
BEGIN
- IF DeclaredOperandsBecomes (p, quad)
+ IF DeclaredOperandsBecomes (p, quad) AND (NOT IsQuadConstExpr (quad))
THEN
IF TypeCheckBecomes (p, quad)
THEN
PROCEDURE DeclaredOperandsBecomes (p: WalkAction; quad: CARDINAL) : BOOLEAN ;
VAR
des, op2, expr : CARDINAL ;
+ constExpr,
overflowChecking : BOOLEAN ;
despos, op2pos,
exprpos, becomespos: CARDINAL ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, becomespos, op,
- des, op2, expr, overflowChecking,
+ des, op2, expr,
+ overflowChecking, constExpr,
despos, op2pos, exprpos) ;
Assert (op2pos = UnknownTokenNo) ;
TryDeclareConst (exprpos, expr) ;
PROCEDURE TypeCheckBecomes (p: WalkAction; quad: CARDINAL) : BOOLEAN ;
VAR
des, op2, expr : CARDINAL ;
+ constExpr,
overflowChecking : BOOLEAN ;
despos, op2pos,
exprpos, becomespos: CARDINAL ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, becomespos, op,
- des, op2, expr, overflowChecking,
+ des, op2, expr,
+ overflowChecking, constExpr,
despos, op2pos, exprpos) ;
Assert (op2pos = UnknownTokenNo) ;
IF StrictTypeChecking AND
PROCEDURE PerformFoldBecomes (p: WalkAction; quad: CARDINAL) ;
VAR
des, op2, expr : CARDINAL ;
+ constExpr,
overflowChecking : BOOLEAN ;
despos, op2pos,
exprpos, becomespos,
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, becomespos, op,
- des, op2, expr, overflowChecking,
+ des, op2, expr,
+ overflowChecking, constExpr,
despos, op2pos, exprpos) ;
Assert (op2pos = UnknownTokenNo) ;
IF IsConst (des) AND IsConstString (expr)
PROCEDURE CodeBecomes (quad: CARDINAL) ;
VAR
+ constExpr,
overflowChecking: BOOLEAN ;
op : QuadOperator ;
des, op2, expr : CARDINAL ;
exprt : Tree ;
location : location_t ;
BEGIN
- GetQuadOtok (quad, becomespos, op, des, op2, expr, overflowChecking,
+ GetQuadOtok (quad, becomespos, op, des, op2, expr,
+ overflowChecking, constExpr,
despos, op2pos, exprpos) ;
Assert (op2pos = UnknownTokenNo) ;
DeclareConstant (exprpos, expr) ; (* Check to see whether expr is a constant and declare it. *)
righttype,
des, left, right: CARDINAL ;
typeChecking,
+ constExpr,
overflowChecking: BOOLEAN ;
despos, leftpos,
rightpos,
op : QuadOperator ;
BEGIN
GetQuadOTypetok (quad, operatorpos, op,
- des, left, right, overflowChecking, typeChecking,
+ des, left, right,
+ overflowChecking, typeChecking, constExpr,
despos, leftpos, rightpos) ;
IF typeChecking AND (op # LogicalRotateOp) AND (op # LogicalShiftOp)
THEN
lefttype,
righttype,
ignore, left, right: CARDINAL ;
+ constExpr,
overflowChecking: BOOLEAN ;
ignorepos,
leftpos,
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, operatorpos, op,
- left, right, ignore, overflowChecking,
+ left, right, ignore,
+ overflowChecking, constExpr,
leftpos, rightpos, ignorepos) ;
subexprpos := MakeVirtualTok (operatorpos, leftpos, rightpos) ;
lefttype := GetType (left) ;
quad: CARDINAL) ;
VAR
location : location_t ;
+ constExpr,
overflowChecking: BOOLEAN ;
op : QuadOperator ;
virttoken,
rightpos,
operatorpos : CARDINAL ;
BEGIN
- GetQuadOtok (quad, operatorpos, op, des, left, right, overflowChecking,
+ GetQuadOtok (quad, operatorpos, op, des, left, right,
+ overflowChecking, constExpr,
despos, leftpos, rightpos) ;
(* Firstly ensure that constant literals are declared. *)
if op1 < op2 then goto op3.
*)
-PROCEDURE FoldIfLess (tokenno: CARDINAL;
+PROCEDURE FoldIfLess (tokenno: CARDINAL; p: WalkAction;
quad: CARDINAL; left, right, destQuad: CARDINAL) ;
BEGIN
- (* firstly ensure that constant literals are declared *)
+ (* Firstly ensure that constant literals are declared. *)
TryDeclareConstant(tokenno, left) ;
TryDeclareConstant(tokenno, right) ;
IF IsConst (left) AND IsConst (right)
THEN
IF IsValueSolved (left) AND IsValueSolved (right)
THEN
- (* fine, we can take advantage of this and evaluate the condition *)
+ (* We can take advantage of the known values and evaluate the condition. *)
PushValue (left) ;
PushValue (right) ;
IF Less (tokenno)
PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
SubQuad (quad)
- END
+ END ;
+ NoChange := FALSE
END
END
END FoldIfLess ;
+(*
+ IsBooleanRelOpPattern - return TRUE if the pattern:
+ q If left right q+2
+ q+1 Goto q+4
+ q+2 Becomes des[i] TRUE[i]
+ q+3 Goto q+5
+ q+4 Becomes des[i] FALSE[i]
+*)
+
+PROCEDURE IsBooleanRelOpPattern (quad: CARDINAL) : BOOLEAN ;
+BEGIN
+ IF IsQuadConstExpr (quad)
+ THEN
+ IF IsConditional (quad) AND
+ (IsGoto (quad+1) OR IsDummy (quad+1)) AND
+ IsBecomes (quad+2) AND IsGoto (quad+3) AND
+ IsBecomes (quad+4) AND
+ (GetQuadDest (quad) = quad+2) AND
+ (GetQuadDest (quad+1) = quad+4) AND
+ (GetQuadDest (quad+3) = quad+5) AND
+ (GetQuadOp1 (quad+2) = GetQuadOp1 (quad+4))
+ THEN
+ RETURN TRUE
+ END
+ END ;
+ RETURN FALSE
+END IsBooleanRelOpPattern ;
+
+
+(*
+ FoldBooleanRelopPattern - fold the boolean relop pattern of quadruples
+ above to:
+ q+2 Becomes des[i] TRUE[i]
+ or
+ q+4 Becomes des[i] FALSE[i]
+ depending upon the condition in quad.
+*)
+
+PROCEDURE FoldBooleanRelopPattern (p: WalkAction; quad: CARDINAL) ;
+VAR
+ des: CARDINAL ;
+BEGIN
+ des := GetQuadOp1 (quad+2) ;
+ IF QuadCondition (quad)
+ THEN
+ SetQuadConstExpr (quad+2, FALSE) ;
+ SubQuad (quad+4) (* Remove des := FALSE. *)
+ ELSE
+ SetQuadConstExpr (quad+4, FALSE) ;
+ SubQuad (quad+2) (* Remove des := TRUE. *)
+ END ;
+ RemoveQuad (p, des, quad) ;
+ SubQuad (quad+1) ;
+ SubQuad (quad+3)
+END FoldBooleanRelopPattern ;
+
+
+(*
+ QuadCondition - Pre-condition: left, right operands are constants
+ which have been resolved.
+ Post-condition: return TRUE if the condition at
+ quad is TRUE.
+*)
+
+PROCEDURE QuadCondition (quad: CARDINAL) : BOOLEAN ;
+VAR
+ left, right, dest, combined,
+ leftpos, rightpos, destpos : CARDINAL ;
+ constExpr, overflow : BOOLEAN ;
+ op : QuadOperator ;
+BEGIN
+ GetQuadOtok (quad, combined, op,
+ left, right, dest, overflow,
+ constExpr,
+ leftpos, rightpos, destpos) ;
+ CASE op OF
+
+ IfInOp : PushValue (right) ;
+ RETURN SetIn (left, combined) |
+ IfNotInOp : PushValue (right) ;
+ RETURN NOT SetIn (left, combined)
+
+ ELSE
+ END ;
+ PushValue (left) ;
+ PushValue (right) ;
+ CASE op OF
+
+ IfGreOp : RETURN Gre (combined) |
+ IfLessOp : RETURN Less (combined) |
+ IfLessEquOp: RETURN LessEqu (combined) |
+ IfGreEquOp : RETURN GreEqu (combined) |
+ IfEquOp : RETURN GreEqu (combined) |
+ IfNotEquOp : RETURN NotEqu (combined)
+
+ ELSE
+ InternalError ('unrecognized comparison operator')
+ END ;
+ RETURN FALSE
+END QuadCondition ;
+
+
+(*
+ FoldIfGre - check to see if it is possible to evaluate
+ if op1 > op2 then goto op3.
+*)
+
+PROCEDURE FoldIfGre (tokenno: CARDINAL; p: WalkAction;
+ quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+ (* Firstly ensure that constant literals are declared. *)
+ TryDeclareConstant(tokenno, left) ;
+ TryDeclareConstant(tokenno, right) ;
+ IF IsConst (left) AND IsConst (right)
+ THEN
+ IF IsValueSolved (left) AND IsValueSolved (right)
+ THEN
+ (* We can take advantage of the known values and evaluate the condition. *)
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
+ ELSE
+ PushValue (left) ;
+ PushValue (right) ;
+ IF Gre (tokenno)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
+ END ;
+ NoChange := FALSE
+ END
+ END
+END FoldIfGre ;
+
+
+(*
+ FoldIfLessEqu - check to see if it is possible to evaluate
+ if op1 <= op2 then goto op3.
+*)
+
+PROCEDURE FoldIfLessEqu (tokenno: CARDINAL; p: WalkAction;
+ quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+ (* Firstly ensure that constant literals are declared. *)
+ TryDeclareConstant(tokenno, left) ;
+ TryDeclareConstant(tokenno, right) ;
+ IF IsConst (left) AND IsConst (right)
+ THEN
+ IF IsValueSolved (left) AND IsValueSolved (right)
+ THEN
+ (* We can take advantage of the known values and evaluate the condition. *)
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
+ ELSE
+ PushValue (left) ;
+ PushValue (right) ;
+ IF LessEqu (tokenno)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
+ END ;
+ NoChange := FALSE
+ END
+ END
+END FoldIfLessEqu ;
+
+
+(*
+ FoldIfGreEqu - check to see if it is possible to evaluate
+ if op1 >= op2 then goto op3.
+*)
+
+PROCEDURE FoldIfGreEqu (tokenno: CARDINAL; p: WalkAction;
+ quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+ (* Firstly ensure that constant literals are declared. *)
+ TryDeclareConstant(tokenno, left) ;
+ TryDeclareConstant(tokenno, right) ;
+ IF IsConst (left) AND IsConst (right)
+ THEN
+ IF IsValueSolved (left) AND IsValueSolved (right)
+ THEN
+ (* We can take advantage of the known values and evaluate the condition. *)
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
+ ELSE
+ PushValue (left) ;
+ PushValue (right) ;
+ IF GreEqu (tokenno)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
+ END ;
+ NoChange := FALSE
+ END
+ END
+END FoldIfGreEqu ;
+
+
(*
FoldIfIn - check whether we can fold the IfInOp
if op1 in op2 then goto op3
*)
-PROCEDURE FoldIfIn (tokenno: CARDINAL;
+PROCEDURE FoldIfIn (tokenno: CARDINAL; p: WalkAction;
quad: CARDINAL; left, right, destQuad: CARDINAL) ;
BEGIN
- (* firstly ensure that constant literals are declared *)
+ (* Firstly ensure that constant literals are declared. *)
TryDeclareConstant (tokenno, left) ;
TryDeclareConstant (tokenno, right) ;
IF IsConst (left) AND IsConst (right)
THEN
IF CheckBinaryExpressionTypes (quad, NoWalkProcedure)
THEN
- (* fine, we can take advantage of this and evaluate the condition *)
- PushValue (right) ;
- IF SetIn (tokenno, left)
+ (* We can take advantage of the known values and evaluate the condition. *)
+ IF IsBooleanRelOpPattern (quad)
THEN
- PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ FoldBooleanRelopPattern (p, quad)
ELSE
- SubQuad (quad)
+ PushValue (right) ;
+ IF SetIn (tokenno, left)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
END
ELSE
SubQuad (quad)
- END
+ END ;
+ NoChange := FALSE
END
END
END FoldIfIn ;
if not (op1 in op2) then goto op3
*)
-PROCEDURE FoldIfNotIn (tokenno: CARDINAL;
+PROCEDURE FoldIfNotIn (tokenno: CARDINAL; p: WalkAction;
quad: CARDINAL; left, right, destQuad: CARDINAL) ;
BEGIN
- (* firstly ensure that constant literals are declared *)
+ (* Firstly ensure that constant literals are declared. *)
TryDeclareConstant (tokenno, left) ;
TryDeclareConstant (tokenno, right) ;
IF IsConst (left) AND IsConst (right)
THEN
IF CheckBinaryExpressionTypes (quad, NoWalkProcedure)
THEN
- (* fine, we can take advantage of this and evaluate the condition *)
+ (* We can take advantage of the known values and evaluate the condition. *)
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
+ ELSE
+ PushValue (right) ;
+ IF NOT SetIn (tokenno, left)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
+ END
+ ELSE
+ SubQuad (quad)
+ END ;
+ NoChange := FALSE
+ END
+ END
+END FoldIfNotIn ;
+
+
+(*
+ FoldIfEqu - check to see if it is possible to evaluate
+ if op1 = op2 then goto op3.
+*)
+
+PROCEDURE FoldIfEqu (tokenno: CARDINAL; p: WalkAction;
+ quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+ (* Firstly ensure that constant literals are declared. *)
+ TryDeclareConstant(tokenno, left) ;
+ TryDeclareConstant(tokenno, right) ;
+ IF IsConst (left) AND IsConst (right)
+ THEN
+ IF IsValueSolved (left) AND IsValueSolved (right)
+ THEN
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
+ ELSE
+ (* We can take advantage of the known values and evaluate the condition. *)
+ PushValue (left) ;
PushValue (right) ;
- IF NOT SetIn (tokenno, left)
+ IF Equ (tokenno)
THEN
PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
SubQuad (quad)
END
+ END ;
+ NoChange := FALSE
+ END
+ END
+END FoldIfEqu ;
+
+
+(*
+ FoldIfNotEqu - check to see if it is possible to evaluate
+ if op1 # op2 then goto op3.
+*)
+
+PROCEDURE FoldIfNotEqu (tokenno: CARDINAL; p: WalkAction;
+ quad: CARDINAL; left, right, destQuad: CARDINAL) ;
+BEGIN
+ (* Firstly ensure that constant literals are declared. *)
+ TryDeclareConstant(tokenno, left) ;
+ TryDeclareConstant(tokenno, right) ;
+ IF IsConst (left) AND IsConst (right)
+ THEN
+ IF IsValueSolved (left) AND IsValueSolved (right)
+ THEN
+ IF IsBooleanRelOpPattern (quad)
+ THEN
+ FoldBooleanRelopPattern (p, quad)
ELSE
- SubQuad (quad)
- END
+ (* We can take advantage of the known values and evaluate the condition. *)
+ PushValue (left) ;
+ PushValue (right) ;
+ IF NotEqu (tokenno)
+ THEN
+ PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
+ ELSE
+ SubQuad (quad)
+ END
+ END ;
+ NoChange := FALSE
END
END
-END FoldIfNotIn ;
+END FoldIfNotEqu ;
(*
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, combined, op,
left, right, dest, overflow,
+ constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
THEN
BuildGoto(location, string(CreateLabelName(dest)))
ELSE
- (* fall through *)
+ (* Fall through. *)
END
ELSIF IsConstSet(left) OR (IsVar(left) AND IsSet(SkipType(GetType(left)))) OR
IsConstSet(right) OR (IsVar(right) AND IsSet(SkipType(GetType(right))))
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest, overflow, constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst(left) AND IsConst(right)
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ overflow, constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst(left) AND IsConst(right)
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ overflow, constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst(left) AND IsConst(right)
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ overflow, constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst (left) AND IsConst (right)
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
(* Ensure that any remaining undeclared constant literal is declared. *)
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ constExpr, overflow,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst (left) AND IsConst (right)
lefttype, righttype,
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
(* Ensure that any remaining undeclared constant literal is declared. *)
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ constExpr, overflow,
leftpos, rightpos, destpos) ;
DeclareConstant (leftpos, left) ;
DeclareConstant (rightpos, right) ;
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
(* Ensure that any remaining undeclared constant literal is declared. *)
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ constExpr, overflow,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst(left) AND IsConst(right)
location : location_t ;
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
- overflow : BOOLEAN ;
+ constExpr, overflow : BOOLEAN ;
op : QuadOperator ;
BEGIN
(* Ensure that any remaining undeclared constant literal is declared. *)
GetQuadOtok (quad, combined, op,
- left, right, dest, overflow,
+ left, right, dest,
+ overflow, constExpr,
leftpos, rightpos, destpos) ;
location := TokenToLocation (combined) ;
IF IsConst(left) AND IsConst(right)
PROCEDURE CodeXIndr (quad: CARDINAL) ;
VAR
+ constExpr,
overflowChecking: BOOLEAN ;
op : QuadOperator ;
tokenno,
newstr : Tree ;
location : location_t ;
BEGIN
- GetQuadOtok (quad, xindrpos, op, left, type, right, overflowChecking,
+ GetQuadOtok (quad, xindrpos, op, left, type, right,
+ overflowChecking, constExpr,
leftpos, typepos, rightpos) ;
tokenno := MakeVirtualTok (xindrpos, leftpos, rightpos) ;
location := TokenToLocation (tokenno) ;
LineNo : CARDINAL ; (* Line No of source text. *)
TokenNo : CARDINAL ; (* Token No of source text. *)
NoOfTimesReferenced: CARDINAL ; (* No of times quad is referenced. *)
+ ConstExpr, (* Must backend resolve this at *)
+ (* compile time? *)
CheckType,
CheckOverflow : BOOLEAN ; (* should backend check overflow *)
op1pos,
TryStack,
CatchStack,
ExceptStack,
- ConstStack,
+ ConstExprStack,
+ ConstParamStack,
AutoStack,
RepeatStack,
WhileStack,
LogicalXorTok, (* Internal _LXOR token. *)
LogicalDifferenceTok : Name ; (* Internal _LDIFF token. *)
InConstExpression,
+ InConstParameters,
IsAutoOn, (* Should parser automatically push *)
(* idents? *)
MustNotCheckBounds : BOOLEAN ;
END IsFinallyEnd ;
+(*
+ IsBecomes - return TRUE if QuadNo is a BecomesOp.
+*)
+
+PROCEDURE IsBecomes (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN IsQuadA (QuadNo, BecomesOp)
+END IsBecomes ;
+
+
+(*
+ IsDummy - return TRUE if QuadNo is a DummyOp.
+*)
+
+PROCEDURE IsDummy (QuadNo: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN IsQuadA (QuadNo, DummyOp)
+END IsDummy ;
+
+
+(*
+ IsQuadConstExpr - returns TRUE if QuadNo is part of a constant expression.
+*)
+
+PROCEDURE IsQuadConstExpr (QuadNo: CARDINAL) : BOOLEAN ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (QuadNo) ;
+ RETURN f^.ConstExpr
+END IsQuadConstExpr ;
+
+
+(*
+ SetQuadConstExpr - sets the constexpr field to value.
+*)
+
+PROCEDURE SetQuadConstExpr (QuadNo: CARDINAL; value: BOOLEAN) ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (QuadNo) ;
+ f^.ConstExpr := value
+END SetQuadConstExpr ;
+
+
+(*
+ GetQuadDest - returns the jump destination associated with quad.
+*)
+
+PROCEDURE GetQuadDest (QuadNo: CARDINAL) : CARDINAL ;
+BEGIN
+ RETURN GetQuadOp3 (QuadNo)
+END GetQuadDest ;
+
+
+(*
+ GetQuadOp1 - returns the 1st operand associated with quad.
+*)
+
+PROCEDURE GetQuadOp1 (QuadNo: CARDINAL) : CARDINAL ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (QuadNo) ;
+ RETURN f^.Operand1
+END GetQuadOp1 ;
+
+
+(*
+ GetQuadOp2 - returns the 2nd operand associated with quad.
+*)
+
+PROCEDURE GetQuadOp2 (QuadNo: CARDINAL) : CARDINAL ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (QuadNo) ;
+ RETURN f^.Operand2
+END GetQuadOp2 ;
+
+
+(*
+ GetQuadOp3 - returns the 3rd operand associated with quad.
+*)
+
+PROCEDURE GetQuadOp3 (QuadNo: CARDINAL) : CARDINAL ;
+VAR
+ f: QuadFrame ;
+BEGIN
+ f := GetQF (QuadNo) ;
+ RETURN f^.Operand3
+END GetQuadOp3 ;
+
+
(*
IsInitialisingConst - returns TRUE if the quadruple is setting
a const (op1) with a value.
VAR tok: CARDINAL;
VAR Op: QuadOperator;
VAR Oper1, Oper2, Oper3: CARDINAL;
- VAR overflowChecking: BOOLEAN ;
+ VAR overflowChecking, constExpr: BOOLEAN ;
VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
VAR
f: QuadFrame ;
Op2Pos := op2pos ;
Op3Pos := op3pos ;
tok := TokenNo ;
- overflowChecking := CheckOverflow
+ overflowChecking := CheckOverflow ;
+ constExpr := ConstExpr
END
END GetQuadOtok ;
tok: CARDINAL;
Op: QuadOperator;
Oper1, Oper2, Oper3: CARDINAL;
- overflowChecking: BOOLEAN ;
+ overflowChecking, constExpr: BOOLEAN ;
Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
VAR
f: QuadFrame ;
op1pos := Op1Pos ;
op2pos := Op2Pos ;
op3pos := Op3Pos ;
- TokenNo := tok
+ TokenNo := tok ;
+ ConstExpr := constExpr
END
END
END PutQuadOtok ;
Operand2 := Oper2 ;
Operand3 := Oper3 ;
CheckOverflow := overflow ;
- CheckType := checktype
+ CheckType := checktype ;
+ ConstExpr := IsInConstExpression ()
END
END
END PutQuadOType ;
(*
- GetQuadOtok - returns the fields associated with quadruple QuadNo.
+ GetQuadOTypetok - returns the fields associated with quadruple QuadNo.
*)
PROCEDURE GetQuadOTypetok (QuadNo: CARDINAL;
VAR tok: CARDINAL;
VAR Op: QuadOperator;
VAR Oper1, Oper2, Oper3: CARDINAL;
- VAR overflowChecking, typeChecking: BOOLEAN ;
+ VAR overflowChecking, typeChecking, constExpr: BOOLEAN ;
VAR Op1Pos, Op2Pos, Op3Pos: CARDINAL) ;
VAR
f: QuadFrame ;
Op3Pos := op3pos ;
tok := TokenNo ;
overflowChecking := CheckOverflow ;
- typeChecking := CheckType
+ typeChecking := CheckType ;
+ constExpr := ConstExpr
END
END GetQuadOTypetok ;
Trash := 0 ;
op1pos := UnknownTokenNo ;
op2pos := UnknownTokenNo ;
- op3pos := UnknownTokenNo
+ op3pos := UnknownTokenNo ;
+ ConstExpr := FALSE
END
END EraseQuad ;
CASE Operator OF
SubrangeLowOp : Operand3 := CollectLow (Operand3) ;
- Operator := BecomesOp |
+ Operator := BecomesOp ;
+ ConstExpr := FALSE |
SubrangeHighOp: Operand3 := CollectHigh (Operand3) ;
- Operator := BecomesOp |
+ Operator := BecomesOp ;
+ ConstExpr := FALSE |
OptParamOp : Operand3 := GetOptArgInit (Operand3) ;
Operator := ParamOp
PopTtok (Des, destok) ;
(* Conditional Boolean Assignment. *)
BackPatch (t, NextQuad) ;
- IF GetMode (Des) = RightValue
+ IF GetMode (Des) = LeftValue
THEN
- GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, True, checkOverflow)
- ELSE
CheckPointerThroughNil (destok, Des) ;
GenQuadO (destok, XIndrOp, Des, Boolean, True, checkOverflow)
+ ELSE
+ GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, True, checkOverflow)
END ;
GenQuadO (destok, GotoOp, NulSym, NulSym, NextQuad+2, checkOverflow) ;
BackPatch (f, NextQuad) ;
- IF GetMode (Des) = RightValue
+ IF GetMode (Des) = LeftValue
THEN
- GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, False, checkOverflow)
- ELSE
CheckPointerThroughNil (destok, Des) ;
GenQuadO (destok, XIndrOp, Des, Boolean, False, checkOverflow)
+ ELSE
+ GenQuadO (becomesTokNo, BecomesOp, Des, NulSym, False, checkOverflow)
END
ELSE
PopTrwtok (Exp, r, exptok) ;
f : BoolFrame ;
BEGIN
Assert (IsBoolean (i)) ;
- (*
- need to convert it to a variable containing the result.
- Des will be a boolean type
- *)
- Des := MakeTemporary (tok, RightValue) ;
+ (* We need to convert the boolean top of stack into a variable or
+ constant boolean. *)
+ Des := MakeTemporary (tok, AreConstant (IsInConstExpression ())) ;
PutVar (Des, Boolean) ;
PushTtok (Des, tok) ; (* we have just increased the stack so we must use i+1 *)
f := PeepAddress (BoolStack, i+1) ;
BuildAssignmentWithoutBounds (tok, FALSE, TRUE) ; (* restored stack *)
f := PeepAddress (BoolStack, i) ;
WITH f^ DO
- TrueExit := Des ; (* alter Stack(i) to contain the variable *)
+ TrueExit := Des ; (* Alter Stack(i) to contain the variable. *)
FalseExit := Boolean ;
- BooleanOp := FALSE ; (* no longer a Boolean True|False pair *)
+ BooleanOp := FALSE ; (* No longer a Boolean True|False pair. *)
Unbounded := NulSym ;
Dimension := 0 ;
ReadWrite := NulSym ;
f := GetQF(BufferQuad) ;
WITH f^ DO
WriteOperator(Operator) ;
- fprintf1 (GetDumpFile (), ' [%d] ', NoOfTimesReferenced) ;
+ fprintf1 (GetDumpFile (), ' [%d]', NoOfTimesReferenced) ;
+ IF ConstExpr
+ THEN
+ fprintf0 (GetDumpFile (), ' const ')
+ ELSE
+ fprintf0 (GetDumpFile (), ' ')
+ END ;
CASE Operator OF
HighOp : WriteOperand(Operand1) ;
PROCEDURE PushInConstExpression ;
BEGIN
- PushWord(ConstStack, InConstExpression) ;
+ PushWord(ConstExprStack, InConstExpression) ;
InConstExpression := TRUE
END PushInConstExpression ;
PROCEDURE PopInConstExpression ;
BEGIN
- InConstExpression := PopWord(ConstStack)
+ InConstExpression := PopWord(ConstExprStack)
END PopInConstExpression ;
END IsInConstExpression ;
+(*
+ PushInConstParameters - push the InConstParameters flag and then set it to TRUE.
+*)
+
+PROCEDURE PushInConstParameters ;
+BEGIN
+ PushWord (ConstParamStack, InConstParameters) ;
+ InConstParameters := TRUE
+END PushInConstParameters ;
+
+
+(*
+ PopInConstParameters - restores the previous value of the InConstParameters.
+*)
+
+PROCEDURE PopInConstParameters ;
+BEGIN
+ InConstParameters := PopWord(ConstParamStack)
+END PopInConstParameters ;
+
+
+(*
+ IsInConstParameters - returns the value of the InConstParameters.
+*)
+
+PROCEDURE IsInConstParameters () : BOOLEAN ;
+BEGIN
+ RETURN( InConstParameters )
+END IsInConstParameters ;
+
+
(*
MustCheckOverflow - returns TRUE if the quadruple should test for overflow.
*)
CatchStack := InitStackWord() ;
ExceptStack := InitStackWord() ;
ConstructorStack := InitStackAddress() ;
- ConstStack := InitStackWord() ;
+ ConstParamStack := InitStackWord () ;
+ ConstExprStack := InitStackWord () ;
(* StressStack ; *)
SuppressWith := FALSE ;
Head := 1 ;
AutoStack := InitStackWord() ;
IsAutoOn := TRUE ;
InConstExpression := FALSE ;
+ InConstParameters := FALSE ;
FreeLineList := NIL ;
InitList(VarientFields) ;
VarientFieldNo := 0 ;
projects / thirdparty / gcc.git / commitdiff
