paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 00:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: resolve multi add expressions without stack

Browse Source 
git-svn-id: trunk@49027 -
(cherry picked from commit 786688eef6)
This commit is contained in:
Mattias Gaertner 2021-03-21 20:10:01 +00:00 committed by Florian Klämpfl
parent 63534c35a8
commit 5795a143dd
2 changed files with 102 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
packages/fcl-passrc/src/pasresolveeval.pas
View File

@ -1524,6 +1524,8 @@ function TResExprEvaluator.EvalBinaryExpr(Expr: TBinaryExpr;
Flags: TResEvalFlags): TResEvalValue; Flags: TResEvalFlags): TResEvalValue;
var var
LeftValue, RightValue: TResEvalValue; LeftValue, RightValue: TResEvalValue;
Left: TPasExpr;
SubBin: TBinaryExpr;
begin begin
Result:=nil; Result:=nil;
if (Expr.Kind=pekBinary) and (Expr.OpCode=eopSubIdent) then if (Expr.Kind=pekBinary) and (Expr.OpCode=eopSubIdent) then
@ -1534,6 +1536,52 @@ begin
LeftValue:=nil; LeftValue:=nil;
RightValue:=nil; RightValue:=nil;
try try
if Expr.OpCode=eopAdd then
begin
// handle multi adds without stack
Left:=Expr.left;
while Left.ClassType=TBinaryExpr do
begin
SubBin:=TBinaryExpr(Left);
if SubBin.OpCode<>eopAdd then break;
Left:=SubBin.left;
end;
LeftValue:=Eval(Expr.left,Flags);
while LeftValue<>nil do
begin
SubBin:=TBinaryExpr(Left.Parent);
RightValue:=Eval(SubBin.right,Flags);
if RightValue=nil then exit;
if LeftValue.Kind=revkExternal then
begin
if [refConst,refConstExt]*Flags=[refConst] then
RaiseConstantExprExp(20210321205928,Expr.left);
Result:=LeftValue;
LeftValue:=nil;
exit;
end;
if RightValue.Kind=revkExternal then
begin
if [refConst,refConstExt]*Flags=[refConst] then
RaiseConstantExprExp(20210321205948,Expr.right);
Result:=RightValue;
RightValue:=nil;
exit;
end;
Result:=EvalBinaryAddExpr(SubBin,LeftValue,RightValue);
ReleaseEvalValue(LeftValue);
if SubBin=Expr then exit;
LeftValue:=Result;
Result:=nil;
Left:=SubBin;
end;
exit;
end;
LeftValue:=Eval(Expr.left,Flags); LeftValue:=Eval(Expr.left,Flags);
if LeftValue=nil then exit; if LeftValue=nil then exit;
RightValue:=Eval(Expr.right,Flags); RightValue:=Eval(Expr.right,Flags);

59
packages/fcl-passrc/src/pasresolver.pp
View File

@ -10585,6 +10585,9 @@ end;
procedure TPasResolver.ResolveBinaryExpr(El: TBinaryExpr; procedure TPasResolver.ResolveBinaryExpr(El: TBinaryExpr;
Access: TResolvedRefAccess); Access: TResolvedRefAccess);
var
Left, Next: TPasExpr;
Bin: TBinaryExpr;
begin begin
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
//writeln('TPasResolver.ResolveBinaryExpr left=',GetObjName(El.left),' right=',GetObjName(El.right),' opcode=',OpcodeStrings[El.OpCode]); //writeln('TPasResolver.ResolveBinaryExpr left=',GetObjName(El.left),' right=',GetObjName(El.right),' opcode=',OpcodeStrings[El.OpCode]);
@ -10611,7 +10614,26 @@ begin
RaiseNotYetImplemented(20160922163456,El); RaiseNotYetImplemented(20160922163456,El);
end; end;
end; end;
eopAdd, eopAdd:
begin
Left:=El.left;
while (Left.ClassType=TBinaryExpr) do
begin
Bin:=TBinaryExpr(Left);
if Bin.OpCode<>eopAdd then break;
Next:=TBinaryExpr(Left).left;
if Next.Parent<>Left then
RaiseNotYetImplemented(20210321201257,Left);
Left:=Next;
end;
ResolveExpr(Left,rraRead);
repeat
Bin:=TBinaryExpr(Left.Parent);
if Bin.right<>nil then
ResolveExpr(Bin.right,rraRead);
Left:=Bin;
until Left=El;
end;
eopSubtract, eopSubtract,
eopMultiply, eopMultiply,
eopDivide, eopDivide,
@ -12939,6 +12961,8 @@ procedure TPasResolver.ComputeBinaryExpr(Bin: TBinaryExpr; out
StartEl: TPasElement); StartEl: TPasElement);
var var
LeftResolved, RightResolved: TPasResolverResult; LeftResolved, RightResolved: TPasResolverResult;
Left: TPasExpr;
SubBin: TBinaryExpr;
begin begin
if (Bin.OpCode=eopSubIdent) if (Bin.OpCode=eopSubIdent)
or ((Bin.OpCode=eopNone) and (Bin.left is TInheritedExpr)) then or ((Bin.OpCode=eopNone) and (Bin.left is TInheritedExpr)) then
@ -12958,11 +12982,36 @@ begin
exit; exit;
end; end;
ComputeElement(Bin.left,LeftResolved,Flags-[rcNoImplicitProc],StartEl); if Bin.OpCode=eopAdd then
ComputeElement(Bin.right,RightResolved,Flags-[rcNoImplicitProc],StartEl); begin
// ToDo: check operator overloading // handle multi-adds without stack
Left:=Bin.left;
while Left.ClassType=TBinaryExpr do
begin
SubBin:=TBinaryExpr(Left);
if SubBin.OpCode<>eopAdd then break;
Left:=SubBin.left;
end;
// Left is now left-most of multi add
ComputeElement(Left,LeftResolved,Flags-[rcNoImplicitProc],StartEl);
repeat
SubBin:=TBinaryExpr(Left.Parent);
ComputeElement(Bin.right,RightResolved,Flags-[rcNoImplicitProc],StartEl);
ComputeBinaryExprRes(Bin,ResolvedEl,Flags,LeftResolved,RightResolved); // ToDo: check operator overloading
ComputeBinaryExprRes(SubBin,ResolvedEl,Flags,LeftResolved,RightResolved);
LeftResolved:=ResolvedEl;
Left:=SubBin;
until Left=Bin;
end
else
begin
ComputeElement(Bin.left,LeftResolved,Flags-[rcNoImplicitProc],StartEl);
ComputeElement(Bin.right,RightResolved,Flags-[rcNoImplicitProc],StartEl);
// ToDo: check operator overloading
ComputeBinaryExprRes(Bin,ResolvedEl,Flags,LeftResolved,RightResolved);
end;
end; end;
procedure TPasResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out procedure TPasResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out