paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 14:27:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

* enable tail recursion optimization also for const and constref open arrays

Browse Source 
+ added test

git-svn-id: trunk@44011 -
This commit is contained in:
svenbarth 2020-01-21 21:29:56 +00:00
parent 01302bc47d
commit 4fc02d3d09
3 changed files with 78 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -13033,6 +13033,7 @@ tests/tbs/tb0664.pp svneol=native#text/pascal
tests/tbs/tb0665.pp svneol=native#text/pascal
tests/tbs/tb0666a.pp svneol=native#text/pascal
tests/tbs/tb0666b.pp svneol=native#text/pascal
tests/tbs/tb0667.pp svneol=native#text/pascal
tests/tbs/ub0060.pp svneol=native#text/plain
tests/tbs/ub0069.pp svneol=native#text/plain
tests/tbs/ub0119.pp svneol=native#text/plain

14
compiler/opttail.pas
View File

@ -77,6 +77,7 @@ unit opttail;
tempnode : ttempcreatenode;
loadnode : tloadnode;
oldnodetree : tnode;
useaddr : boolean;
begin
{ no tail call found and replaced so far }
result:=false;
@ -120,7 +121,10 @@ unit opttail;
paranode:=tcallparanode(usedcallnode.left);
while assigned(paranode) do
begin
if paranode.parasym.varspez=vs_var then
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));
if useaddr then
begin
tempnode:=ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
addstatement(calcstatements,tempnode);
@ -146,7 +150,7 @@ unit opttail;
include(tloadnode(loadnode).loadnodeflags,loadnf_isinternal_ignoreconst);
{ load the address of the symbol instead of symbol }
if paranode.parasym.varspez=vs_var then
if useaddr then
include(tloadnode(loadnode).loadnodeflags,loadnf_load_addr);
addstatement(copystatements,
cassignmentnode.create_internal(
@ -206,14 +210,12 @@ unit opttail;
{ check if the parameters actually would support tail recursion elimination }
for i:=0 to p.paras.count-1 do
with tparavarsym(p.paras[i]) do
if (varspez in [vs_out,{vs_var,}vs_constref]) or
((varspez=vs_const) and
(paramanager.push_addr_param(varspez,vardef,p.proccalloption)) or
if (varspez=vs_out) or
{ parameters requiring tables are too complicated to handle
and slow down things anyways so a tail recursion call
makes no sense
}
is_managed_type(vardef)) then
is_managed_type(vardef) then
exit;
labelsym:=clabelsym.create('$opttail');

69
tests/tbs/tb0667.pp Normal file
View File

@ -0,0 +1,69 @@
{ %OPT=-Ootailrec }
program tb0667;
var
stack: Pointer = Nil;
function Test1(var Values: array of LongInt; Res: LongInt): LongInt;
begin
if not Assigned(stack) then
stack := get_frame
else if stack <> get_frame then
Halt(1);
if Length(Values) = 0 then
Test1 := Res
else
Test1 := Test1(Values[0..High(Values) - 1], Res + Values[High(Values)]);
end;
function Test1(Values: array of LongInt): LongInt;
begin
Test1 := Test1(Values, 0);
end;
function Test2(constref Values: array of LongInt; Res: LongInt): LongInt;
begin
if not Assigned(stack) then
stack := get_frame
else if stack <> get_frame then
Halt(3);
if Length(Values) = 0 then
Test2 := Res
else
Test2 := Test2(Values[0..High(Values) - 1], Res + Values[High(Values)]);
end;
function Test2(constref Values: array of LongInt): LongInt;
begin
Test2 := Test2(Values, 0);
end;
function Test3(const Values: array of LongInt; Res: LongInt): LongInt;
begin
if not Assigned(stack) then
stack := get_frame
else if stack <> get_frame then
Halt(5);
if Length(Values) = 0 then
Test3 := Res
else
Test3 := Test3(Values[0..High(Values) - 1], Res + Values[High(Values)]);
end;
function Test3(const Values: array of LongInt): LongInt;
begin
Test3 := Test3(Values, 0);
end;
begin
if Test1([1, 2, 3, 4]) <> 10 then
Halt(2);
stack := Nil;
if Test2([1, 2, 3, 4]) <> 10 then
Halt(4);
stack := Nil;
if Test3([1, 2, 3, 4]) <> 10 then
Halt(6);
writeln('ok');
end.