mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 14:48:18 +02:00
* disable tail recursion optimisation if there is a copy-back parameter
* handle fparainit in tail recursion optimisation (mantis #37397) git-svn-id: trunk@45823 -
This commit is contained in:
Jonas Maebe
parent
924ffe6538
commit
dd6e6eb26a
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -18381,6 +18381,7 @@ tests/webtbs/tw37322.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw37323.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw37339.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw37393.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw37397.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3742.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3751.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3758.pp svneol=native#text/plain
|
||||
|
||||
@ -50,14 +50,35 @@ unit opttail;
|
||||
var
|
||||
usedcallnode : tcallnode;
|
||||
|
||||
function is_recursivecall(n : tnode) : boolean;
|
||||
function has_copyback_paras(call: tcallnode): boolean;
|
||||
var
|
||||
n: tcallparanode;
|
||||
begin
|
||||
result:=(n.nodetype=calln) and (tcallnode(n).procdefinition=p) and not(assigned(tcallnode(n).methodpointer));
|
||||
n:=tcallparanode(call.left);
|
||||
result:=false;
|
||||
while assigned(n) do
|
||||
begin
|
||||
if assigned(n.fparacopyback) then
|
||||
begin
|
||||
result:=true;
|
||||
exit;
|
||||
end;
|
||||
n:=tcallparanode(n.right);
|
||||
end;
|
||||
end;
|
||||
|
||||
function is_optimizable_recursivecall(n : tnode) : boolean;
|
||||
begin
|
||||
result:=
|
||||
(n.nodetype=calln) and
|
||||
(tcallnode(n).procdefinition=p) and
|
||||
not(assigned(tcallnode(n).methodpointer)) and
|
||||
not has_copyback_paras(tcallnode(n));
|
||||
if result then
|
||||
usedcallnode:=tcallnode(n)
|
||||
else
|
||||
{ obsolete type cast? }
|
||||
result:=((n.nodetype=typeconvn) and (ttypeconvnode(n).convtype=tc_equal) and is_recursivecall(ttypeconvnode(n).left));
|
||||
result:=((n.nodetype=typeconvn) and (ttypeconvnode(n).convtype=tc_equal) and is_optimizable_recursivecall(ttypeconvnode(n).left));
|
||||
end;
|
||||
|
||||
function is_resultassignment(n : tnode) : boolean;
|
||||
@ -102,9 +123,9 @@ unit opttail;
|
||||
calln,
|
||||
assignn:
|
||||
begin
|
||||
if ((n.nodetype=calln) and is_recursivecall(n)) or
|
||||
if ((n.nodetype=calln) and is_optimizable_recursivecall(n)) or
|
||||
((n.nodetype=assignn) and is_resultassignment(tbinarynode(n).left) and
|
||||
is_recursivecall(tbinarynode(n).right)) then
|
||||
is_optimizable_recursivecall(tbinarynode(n).right)) then
|
||||
begin
|
||||
{ found one! }
|
||||
{
|
||||
@ -121,6 +142,11 @@ unit opttail;
|
||||
paranode:=tcallparanode(usedcallnode.left);
|
||||
while assigned(paranode) do
|
||||
begin
|
||||
if assigned(paranode.fparainit) then
|
||||
begin
|
||||
addstatement(calcstatements,paranode.fparainit);
|
||||
paranode.fparainit:=nil;
|
||||
end;
|
||||
useaddr:=(paranode.parasym.varspez in [vs_var,vs_constref]) or
|
||||
((paranode.parasym.varspez=vs_const) and
|
||||
paramanager.push_addr_param(paranode.parasym.varspez,paranode.parasym.vardef,p.proccalloption)) or
|
||||
|
||||
255
tests/webtbs/tw37397.pp
Normal file
255
tests/webtbs/tw37397.pp
Normal file
@ -0,0 +1,255 @@
|
||||
{ %opt=-Ootailrec }
|
||||
|
||||
program gx;
|
||||
//fpc -O3 ax.pas
|
||||
// graphmath.pp(518,7) Fatal: Internal error 200108231
|
||||
|
||||
{$Mode OBJFPC} {$H+}
|
||||
{$inline on}
|
||||
|
||||
|
||||
uses types,math;
|
||||
|
||||
type
|
||||
PPoint = ^TPoint;
|
||||
TFloatPoint = Record
|
||||
X, Y : Extended;
|
||||
end;
|
||||
|
||||
TBezier = Array[0..3] of TFloatPoint;
|
||||
|
||||
const res: array[0..50] of tpoint =
|
||||
(
|
||||
(x: 1; y: 10),
|
||||
(x: 0; y: -321),
|
||||
(x: -3; y: -454),
|
||||
(x: -8; y: -567),
|
||||
(x: -16; y: -661),
|
||||
(x: -21; y: -701),
|
||||
(x: -28; y: -737),
|
||||
(x: -35; y: -769),
|
||||
(x: -44; y: -797),
|
||||
(x: -54; y: -821),
|
||||
(x: -65; y: -842),
|
||||
(x: -78; y: -858),
|
||||
(x: -93; y: -872),
|
||||
(x: -109; y: -882),
|
||||
(x: -127; y: -889),
|
||||
(x: -147; y: -893),
|
||||
(x: -168; y: -895),
|
||||
(x: -192; y: -893),
|
||||
(x: -218; y: -890),
|
||||
(x: -246; y: -884),
|
||||
(x: -276; y: -875),
|
||||
(x: -344; y: -853),
|
||||
(x: -422; y: -823),
|
||||
(x: -510; y: -788),
|
||||
(x: -611; y: -747),
|
||||
(x: -724; y: -704),
|
||||
(x: -850; y: -658),
|
||||
(x: -989; y: -611),
|
||||
(x: -1143; y: -565),
|
||||
(x: -1226; y: -542),
|
||||
(x: -1313; y: -519),
|
||||
(x: -1403; y: -497),
|
||||
(x: -1498; y: -476),
|
||||
(x: -1597; y: -456),
|
||||
(x: -1700; y: -437),
|
||||
(x: -1807; y: -419),
|
||||
(x: -1919; y: -403),
|
||||
(x: -2035; y: -388),
|
||||
(x: -2156; y: -375),
|
||||
(x: -2282; y: -363),
|
||||
(x: -2413; y: -354),
|
||||
(x: -2548; y: -346),
|
||||
(x: -2688; y: -341),
|
||||
(x: -2834; y: -339),
|
||||
(x: -2984; y: -339),
|
||||
(x: -3140; y: -341),
|
||||
(x: -3301; y: -347),
|
||||
(x: -3467; y: -355),
|
||||
(x: -3639; y: -367),
|
||||
(x: -3817; y: -382),
|
||||
(x: -4000; y: -400)
|
||||
);
|
||||
|
||||
Operator + (const Addend1, Addend2 : TFloatPoint) : TFloatPoint; inline;
|
||||
Begin
|
||||
With Result do begin
|
||||
X := Addend1.X + Addend2.X;
|
||||
Y := Addend1.Y + Addend2.Y;
|
||||
end;
|
||||
end;
|
||||
|
||||
Operator * (const Multiplicand : TFloatPoint; Multiplier : Extended) : TFloatPoint;
|
||||
Begin
|
||||
With Result do begin
|
||||
X := Multiplicand.X * Multiplier;
|
||||
Y := Multiplicand.Y * Multiplier;
|
||||
end;
|
||||
end;
|
||||
|
||||
Operator * (Multiplicand : Extended; const Multiplier : TFloatPoint) : TFloatPoint;
|
||||
Begin
|
||||
Result := Multiplier*Multiplicand;
|
||||
end;
|
||||
|
||||
Operator / (const Dividend : TFloatPoint; Divisor : Extended) : TFloatPoint;
|
||||
begin
|
||||
With Result do begin
|
||||
X := Dividend.X / Divisor;
|
||||
Y := Dividend.Y / Divisor;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Operator := (const Value : TFloatPoint) : TPoint; inline;
|
||||
begin
|
||||
Result.X := Trunc(SimpleRoundTo(Value.X, 0));
|
||||
Result.Y := Trunc(SimpleRoundTo(Value.Y, 0));
|
||||
end;
|
||||
|
||||
function Distance(const Pt1,Pt2 : TPoint) : Extended;
|
||||
begin
|
||||
Result := Sqrt(Sqr(Pt2.X - Pt1.X) + Sqr(Pt2.Y - Pt1.Y));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: Distance
|
||||
Params: PT, SP,EP
|
||||
Returns: Extended
|
||||
|
||||
Use Distance to get the distance between any point(PT) and a line defined
|
||||
by any two points(SP, EP). Intended for use in Bezier2Polyline, so params
|
||||
are TFloatPoint's, NOT TPoint's.
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
function Distance(const Pt, SP, EP : TFloatPoint) : Extended;
|
||||
var
|
||||
A, B, C : Extended;
|
||||
|
||||
function Slope(PT1,Pt2 : TFloatPoint) : Extended;
|
||||
begin
|
||||
If Pt2.X <> Pt1.X then
|
||||
Result := (Pt2.Y - Pt1.Y) / (Pt2.X - Pt1.X)
|
||||
else
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
function YIntercept(PT1,Pt2 : TFloatPoint) : Extended;
|
||||
begin
|
||||
Result := Pt1.Y - Slope(Pt1,Pt2)*Pt1.X;
|
||||
end;
|
||||
|
||||
begin
|
||||
A := -Slope(SP,EP);
|
||||
B := 1;
|
||||
C := -YIntercept(SP, EP);
|
||||
Result := ABS(A*Pt.X + B*Pt.Y + C)/Sqrt(Sqr(A) + Sqr(B));
|
||||
end;
|
||||
|
||||
|
||||
function BezierMidPoint(const Bezier : TBezier) : TFloatPoint;
|
||||
begin
|
||||
Result := (Bezier[0] + 3*Bezier[1] + 3*Bezier[2] + Bezier[3]) / 8;
|
||||
end;
|
||||
|
||||
|
||||
procedure SplitBezier(const Bezier : TBezier; var Left, Right : TBezier);
|
||||
var
|
||||
Tmp : TFloatPoint;
|
||||
begin
|
||||
Tmp := (Bezier[1] + Bezier[2]) / 2;
|
||||
|
||||
left[0] := Bezier[0];
|
||||
Left[1] := (Bezier[0] + Bezier[1]) / 2;
|
||||
left[2] := (Left[1] + Tmp) / 2;
|
||||
Left[3] := BezierMidPoint(Bezier);
|
||||
|
||||
right[3] := Bezier[3];
|
||||
right[2] := (Bezier[2] + Bezier[3]) / 2;
|
||||
Right[1] := (Right[2] + Tmp) / 2;
|
||||
right[0] := BezierMidPoint(Bezier);
|
||||
end;
|
||||
|
||||
procedure Bezier2Polyline(const Bezier : TBezier; var Points : PPoint;
|
||||
var Count : Longint);
|
||||
var
|
||||
Pt : TPoint;
|
||||
|
||||
procedure AddPoint(const Point : TFloatPoint);
|
||||
var
|
||||
P : TPoint;
|
||||
begin
|
||||
P := Point;
|
||||
if (Pt <> P) then
|
||||
begin
|
||||
Inc(Count);
|
||||
ReallocMem(Points, SizeOf(TPoint) * Count);
|
||||
Points[Count - 1] := P;
|
||||
Pt := P;
|
||||
end;
|
||||
end;
|
||||
|
||||
function Colinear(BP : TBezier; Tolerance : Extended) : Boolean;
|
||||
var
|
||||
D : Extended;
|
||||
begin
|
||||
D := SQR(Distance(BP[1], BP[0], BP[3]));
|
||||
Result := D < Tolerance;
|
||||
D := SQR(Distance(BP[2], BP[0], BP[3]));
|
||||
If Result then
|
||||
Result := Result and (D < Tolerance);
|
||||
end;
|
||||
|
||||
procedure SplitRecursive(B : TBezier);
|
||||
var
|
||||
Left,
|
||||
Right : TBezier;
|
||||
begin
|
||||
If Colinear(B, 1) then begin
|
||||
AddPoint(B[0]);
|
||||
AddPoint(B[3]);
|
||||
end
|
||||
else begin
|
||||
SplitBezier(B,left,right);
|
||||
SplitRecursive(left);
|
||||
SplitRecursive(right);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Pt := Point(-1,-1);
|
||||
If (not Assigned(Points)) or (Count <= 0) then
|
||||
begin
|
||||
Count := 0;
|
||||
|
||||
if Assigned(Points) then
|
||||
ReallocMem(Points, 0);
|
||||
end;
|
||||
SplitRecursive(Bezier);
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
points: ppoint;
|
||||
i, ppointcount: longint;
|
||||
bezier: TBezier;
|
||||
begin
|
||||
bezier[0].X := 1.0;
|
||||
bezier[0].Y := 10.0;
|
||||
bezier[1].X := 2.0;
|
||||
bezier[1].Y := -2000.0;
|
||||
bezier[2].X := -30.0;
|
||||
bezier[2].Y := 30.0;
|
||||
bezier[3].X := -4000.0;
|
||||
bezier[3].Y := -400.0;
|
||||
Bezier2Polyline(bezier,points, ppointcount);
|
||||
for i:=0 to ppointcount-1 do
|
||||
begin
|
||||
if (points[i].x <> res[i].x) and
|
||||
(points[i].y <> res[i].y) then
|
||||
halt(i+1);
|
||||
// writeln(points[i].x,' ',points[i].y);
|
||||
end;
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user