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

* properly release open array value parameters on x86-64 or if they contain automated types, resolves #8664

Browse Source 
git-svn-id: trunk@7100 -
This commit is contained in:
florian 2007-04-13 19:20:56 +00:00
parent 748aa7eb2d
commit f87e96dfb0
5 changed files with 38 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8148,6 +8148,7 @@ tests/webtbs/tw8513.pp svneol=native#text/plain
tests/webtbs/tw8525.pp svneol=native#text/plain
tests/webtbs/tw8573.pp svneol=native#text/plain
tests/webtbs/tw8615.pp svneol=native#text/plain
tests/webtbs/tw8664.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain

12
compiler/i386/cgcpu.pas
View File

@ -46,6 +46,7 @@ unit cgcpu;
procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override;
procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);override;
procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);override;
procedure g_exception_reason_save(list : TAsmList; const href : treference);override;
procedure g_exception_reason_save_const(list : TAsmList; const href : treference; a: aint);override;
@ -444,6 +445,17 @@ unit cgcpu;
end;
procedure tcg386.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
begin
if use_fixed_stack then
begin
inherited g_releasevaluepara_openarray(list,l);
exit;
end;
{ Nothing to release }
end;
procedure tcg386.g_exception_reason_save(list : TAsmList; const href : treference);
begin
if not use_fixed_stack then

22
compiler/ncgutil.pas
View File

@ -1222,17 +1222,17 @@ implementation
location_get_data_ref(list,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vardef));
cg.g_decrrefcount(list,tparavarsym(p).vardef,href);
end;
end
else
if (tparavarsym(p).varspez=vs_value) and
(is_open_array(tparavarsym(p).vardef) or
is_array_of_const(tparavarsym(p).vardef)) then
begin
{ cdecl functions don't have a high pointer so it is not possible to generate
a local copy }
if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
cg.g_releasevaluepara_openarray(list,tparavarsym(p).localloc);
end;
end;
{ open arrays can contain elements requiring init/final code, so the else has been removed here }
if (tparavarsym(p).varspez=vs_value) and
(is_open_array(tparavarsym(p).vardef) or
is_array_of_const(tparavarsym(p).vardef)) then
begin
{ cdecl functions don't have a high pointer so it is not possible to generate
a local copy }
if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
cg.g_releasevaluepara_openarray(list,tparavarsym(p).localloc);
end;
end;

14
compiler/x86/cgx86.pas
View File

@ -102,7 +102,6 @@ unit cgx86;
procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : aint);override;
{ entry/exit code helpers }
procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);override;
procedure g_profilecode(list : TAsmList);override;
procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override;
procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override;
@ -491,7 +490,7 @@ unit cgx86;
end;
OS_F80 :
begin
op:=A_FSTP;
op:=A_FSTP;
s:=S_FX;
end;
OS_C64 :
@ -1713,17 +1712,6 @@ unit cgx86;
Entry/Exit Code Helpers
****************************************************************************}
procedure tcgx86.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);
begin
if (use_fixed_stack) then
begin
inherited g_releasevaluepara_openarray(list,l);
exit;
end;
{ Nothing to release }
end;
procedure tcgx86.g_profilecode(list : TAsmList);
var

13
tests/webtbs/tw8664.pp Normal file
View File

@ -0,0 +1,13 @@
{ %OPT=-gh }
program project1;
{$mode objfpc}{$H+}
procedure TLResourceListAdd(Values: array of string);
begin
end;
begin
TLResourceListAdd(['Value1']);
end.