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

* don't optimize funcret with assignment result if the value is also used

Browse Source 
as a parameter and the funcret is also passed as parameter. Because in that
    case both are pointing to the same memory location

git-svn-id: trunk@10159 -
This commit is contained in:
peter 2008-02-02 17:39:28 +00:00
parent 58b3208552
commit 169516ffc0
4 changed files with 160 additions and 46 deletions

2
.gitattributes vendored
View File

@ -7916,6 +7916,8 @@ tests/webtbs/tw10681.pp svneol=native#text/plain
tests/webtbs/tw1071.pp svneol=native#text/plain
tests/webtbs/tw1073.pp svneol=native#text/plain
tests/webtbs/tw10736.pp svneol=native#text/plain
tests/webtbs/tw10753.pp svneol=native#text/plain
tests/webtbs/tw10753a.pp svneol=native#text/plain
tests/webtbs/tw1081.pp svneol=native#text/plain
tests/webtbs/tw1090.pp svneol=native#text/plain
tests/webtbs/tw1092.pp svneol=native#text/plain

134
compiler/ncal.pas
View File

@ -63,6 +63,7 @@ interface
function gen_self_tree:tnode;
function gen_vmt_tree:tnode;
procedure gen_hidden_parameters;
function funcret_can_be_reused:boolean;
procedure maybe_create_funcret_node;
procedure bind_parasym;
procedure add_init_statement(n:tnode);
@ -1651,10 +1652,95 @@ implementation
end;
function check_funcret_used_as_para(var n: tnode; arg: pointer): foreachnoderesult;
var
destsym : tsym absolute arg;
begin
result := fen_false;
if (n.nodetype=loadn) and
(tloadnode(n).symtableentry = destsym) then
result := fen_norecurse_true;
end;
function tcallnode.funcret_can_be_reused:boolean;
var
realassignmenttarget: tnode;
begin
result:=false;
{ we are processing an assignment node? }
if not(assigned(aktassignmentnode) and
(aktassignmentnode.right=self) and
(aktassignmentnode.left.resultdef=resultdef)) then
exit;
{ destination must be able to be passed as var parameter }
if not valid_for_var(aktassignmentnode.left,false) then
exit;
{ destination must be a simple load so it doesn't need a temp when
it is evaluated }
if not is_simple_para_load(aktassignmentnode.left,false) then
exit;
{ remove possible typecasts }
realassignmenttarget:=aktassignmentnode.left.actualtargetnode;
{ when it is not passed in a parameter it will only be used after the
function call }
if not paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then
begin
result:=true;
exit;
end;
{ when we substitute a function result inside an inlined function,
we may take the address of this function result. Therefore the
substituted function result may not be in a register, as we cannot
take its address in that case }
if (realassignmenttarget.nodetype=temprefn) and
not(ti_addr_taken in ttemprefnode(realassignmenttarget).tempinfo^.flags) and
not(ti_may_be_in_reg in ttemprefnode(realassignmenttarget).tempinfo^.flags) then
begin
result:=true;
exit;
end;
if (realassignmenttarget.nodetype=loadn) and
{ nested procedures may access the current procedure's locals }
(procdefinition.parast.symtablelevel=normal_function_level) and
{ must be a local variable, a value para or a hidden function result }
{ parameter (which can be passed by address, but in that case it got }
{ through these same checks at the caller side and is thus safe }
(
(tloadnode(realassignmenttarget).symtableentry.typ=localvarsym) or
(
(tloadnode(realassignmenttarget).symtableentry.typ=paravarsym) and
((tparavarsym(tloadnode(realassignmenttarget).symtableentry).varspez = vs_value) or
(vo_is_funcret in tparavarsym(tloadnode(realassignmenttarget).symtableentry).varoptions))
)
) and
{ the address may not have been taken of the variable/parameter, because }
{ otherwise it's possible that the called function can access it via a }
{ global variable or other stored state }
(
not(tabstractvarsym(tloadnode(realassignmenttarget).symtableentry).addr_taken) and
(tabstractvarsym(tloadnode(realassignmenttarget).symtableentry).varregable in [vr_none,vr_addr])
) then
begin
{ If the funcret is also used as a parameter we can't optimize becuase the funcret
and the parameter will point to the same address. That means that a change of the result variable
will result also in a change of the parameter value }
result:=not foreachnodestatic(left,@check_funcret_used_as_para,tloadnode(realassignmenttarget).symtableentry);
exit;
end;
end;
procedure tcallnode.maybe_create_funcret_node;
var
temp : ttempcreatenode;
realassignmenttarget: tnode;
begin
{ For the function result we need to create a temp node for:
- Inlined functions
@ -1681,51 +1767,7 @@ implementation
of the refcount before being assigned. This is all done after the call so there
is no issue with exceptions and possible use of the old value in the called
function }
if assigned(aktassignmentnode) then
realassignmenttarget:=aktassignmentnode.left.actualtargetnode;
if assigned(aktassignmentnode) and
(aktassignmentnode.right=self) and
(aktassignmentnode.left.resultdef=resultdef) and
valid_for_var(aktassignmentnode.left,false) and
(
{ when it is not passed in a parameter it will only be used after the
function call, but only do it when it will be a simple parameter node
and doesn't need to be in a temp }
(
not paramanager.ret_in_param(resultdef,procdefinition.proccalloption) and
{ when we substitute a function result inside an inlined function,
we may take the address of this function result. Therefore the
substituted function result may not be in a register, as we cannot
take its address in that case }
is_simple_para_load(aktassignmentnode.left,false)
) or
(
(realassignmenttarget.nodetype=temprefn) and
not(ti_addr_taken in ttemprefnode(realassignmenttarget).tempinfo^.flags) and
not(ti_may_be_in_reg in ttemprefnode(realassignmenttarget).tempinfo^.flags)
) or
(
(realassignmenttarget.nodetype=loadn) and
{ nested procedures may access the current procedure's locals }
(procdefinition.parast.symtablelevel=normal_function_level) and
{ must be a local variable, a value para or a hidden function result }
{ parameter (which can be passed by address, but in that case it got }
{ through these same checks at the caller side and is thus safe }
(
(tloadnode(realassignmenttarget).symtableentry.typ=localvarsym) or
(
(tloadnode(realassignmenttarget).symtableentry.typ=paravarsym) and
((tparavarsym(tloadnode(realassignmenttarget).symtableentry).varspez = vs_value) or
(vo_is_funcret in tparavarsym(tloadnode(realassignmenttarget).symtableentry).varoptions))
)
) and
{ the address may not have been taken of the variable/parameter, because }
{ otherwise it's possible that the called function can access it via a }
{ global variable or other stored state }
not(tabstractvarsym(tloadnode(realassignmenttarget).symtableentry).addr_taken) and
(tabstractvarsym(tloadnode(realassignmenttarget).symtableentry).varregable in [vr_none,vr_addr])
)
) then
if funcret_can_be_reused then
begin
funcretnode:=aktassignmentnode.left.getcopy;
include(funcretnode.flags,nf_is_funcret);

33
tests/webtbs/tw10753.pp Normal file
View File

@ -0,0 +1,33 @@
{$mode objfpc}{$H+}
uses
SysUtils;
var
err : boolean;
procedure p;
var
AStr,AText: string;
AValue: int64;
begin
//This goes wrong, notice the AStr input and output
AValue:=1234567890;
AStr := Format('%0.n',[1.0*AValue]); //1.234.567.890
AStr := Format('<font color="#ff0000">%s</font>',[AStr]);
Writeln('Wrong:' +AStr); //Wrong: <font color="#ff0000"></font>????
if AStr<>'<font color="#ff0000">1,234,567,890</font>' then
err:=true;
//This is Ok, notice the changed output AText
AValue:=2134567890;
AStr := Format('%0.n',[1.0*AValue]); //2.134.567.890
AText := Format('<font color="#ff0000">%s</font>',[AStr]);
Writeln('Ok:' +AText); //Ok 2.134.567.890
if Atext<>'<font color="#ff0000">2,134,567,890</font>' then
err:=true;
end;
begin
p;
if err then
halt(1);
end.

37
tests/webtbs/tw10753a.pp Normal file
View File

@ -0,0 +1,37 @@
{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
const buf: array[0..5] of char = 'abcdef';
function foo(const a: string): string;
begin
SetLength(result, 6);
Move(buf, result[1], sizeof(buf));
if a <> '1234567890' then
begin
writeln('Failed: ', a);
Halt(1);
end
else
writeln('ok');
end;
procedure test_proc(var a: string);
var
s: string;
begin
{ Don't call UniqueString(s) here because it makes the compiler assume
that address of s is taken, and assignment s := foo(s) is not optimized }
s := a; // refcount=2
a := 'whatever'; // modify source -> s.refcount becomes 1
writeln('before: ', s);
s := foo(s);
writeln(s);
end;
var
s: string;
begin
s := '1234567890';
UniqueString(s);
test_proc(s);
end.