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

* refactor function result handling

Browse Source 
* rename methodpointerinit/done to callinitblock/callcleanupblock
  * moved checks in callnode to separate functions
  * funcretnode is now always a simple node instead of a block of
    statements
  * funcret and methodpointer are generated/optimized only in pass_1 so
    a conversion from calln to loadn is much easier
  * function result assignments are much more often optimized to use the
    assignment destination location instead of using a temp

git-svn-id: trunk@8558 -
This commit is contained in:
peter 2007-09-18 22:12:07 +00:00
parent 399a2a86fa
commit e0cf015159
9 changed files with 1296 additions and 1385 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/nbas.pas
View File

@ -94,12 +94,12 @@ interface
ttempcreatenode = class; ttempcreatenode = class;
ttempinfoflag = (ti_may_be_in_reg,ti_valid,ti_nextref_set_hookoncopy_nil,ti_is_inlined_result, ttempinfoflag = (ti_may_be_in_reg,ti_valid,ti_nextref_set_hookoncopy_nil,ti_is_funcret,
ti_addr_taken); ti_addr_taken);
ttempinfoflags = set of ttempinfoflag; ttempinfoflags = set of ttempinfoflag;
const const
tempinfostoreflags = [ti_may_be_in_reg,ti_is_inlined_result,ti_addr_taken]; tempinfostoreflags = [ti_may_be_in_reg,ti_is_funcret,ti_addr_taken];
type type
{ to allow access to the location by temp references even after the temp has } { to allow access to the location by temp references even after the temp has }
@ -133,7 +133,7 @@ type
{ to it and *not* generate a ttempdeletenode } { to it and *not* generate a ttempdeletenode }
constructor create(_typedef: tdef; _size: aint; _temptype: ttemptype;allowreg:boolean); virtual; constructor create(_typedef: tdef; _size: aint; _temptype: ttemptype;allowreg:boolean); virtual;
constructor create_withnode(_typedef: tdef; _size: aint; _temptype: ttemptype; allowreg:boolean; withnode: tnode); virtual; constructor create_withnode(_typedef: tdef; _size: aint; _temptype: ttemptype; allowreg:boolean; withnode: tnode); virtual;
constructor create_inlined_result(_typedef: tdef; _size: aint; _temptype: ttemptype; allowreg:boolean); virtual; constructor create_funcret(_typedef: tdef; _size: aint; _temptype: ttemptype; allowreg:boolean); virtual;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderefimpl;override; procedure buildderefimpl;override;
@ -742,10 +742,10 @@ implementation
end; end;
constructor ttempcreatenode.create_inlined_result(_typedef: tdef; _size: aint; _temptype: ttemptype; allowreg:boolean); constructor ttempcreatenode.create_funcret(_typedef: tdef; _size: aint; _temptype: ttemptype; allowreg:boolean);
begin begin
self.create(_typedef,_size,_temptype,allowreg); self.create(_typedef,_size,_temptype,allowreg);
include(tempinfo^.flags,ti_is_inlined_result); include(tempinfo^.flags,ti_is_funcret);
end; end;

2244
compiler/ncal.pas
View File

File diff suppressed because it is too large Load Diff

335
compiler/ncgcal.pas
View File

@ -1,4 +1,4 @@
{ {
Copyright (c) 1998-2002 by Florian Klaempfl Copyright (c) 1998-2002 by Florian Klaempfl
Generate assembler for call nodes Generate assembler for call nodes
@ -45,13 +45,13 @@ interface
tcgcallnode = class(tcallnode) tcgcallnode = class(tcallnode)
private private
procedure handle_return_value;
procedure release_unused_return_value;
procedure release_para_temps; procedure release_para_temps;
procedure pushparas; procedure pushparas;
procedure freeparas; procedure freeparas;
protected protected
framepointer_paraloc : tcgpara; framepointer_paraloc : tcgpara;
refcountedtemp : treference;
procedure handle_return_value;
{# This routine is used to push the current frame pointer {# This routine is used to push the current frame pointer
on the stack. This is used in nested routines where the on the stack. This is used in nested routines where the
value of the frame pointer is always pushed as an extra value of the frame pointer is always pushed as an extra
@ -509,190 +509,159 @@ implementation
var var
cgsize : tcgsize; cgsize : tcgsize;
retloc : tlocation; retloc : tlocation;
hregister : tregister;
tempnode : tnode;
begin begin
cgsize:=procdefinition.funcretloc[callerside].size; { Check that the return location is set when the result is passed in
a parameter }
{ structured results are easy to handle....
needed also when result_no_used !! }
if (procdefinition.proctypeoption<>potype_constructor) and if (procdefinition.proctypeoption<>potype_constructor) and
paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then
begin begin
{ Location should be setup by the funcret para }
if location.loc<>LOC_REFERENCE then if location.loc<>LOC_REFERENCE then
internalerror(200304241); internalerror(200304241);
end exit;
else end;
{ ansi/widestrings must be registered, so we can dispose them }
if resultdef.needs_inittable then
begin
if procdefinition.funcretloc[callerside].loc<>LOC_REGISTER then
internalerror(200409261);
retloc:=procdefinition.funcretloc[callerside]; { Load normal (ordinal,float,pointer) result value from accumulator }
{$ifndef cpu64bit} cgsize:=procdefinition.funcretloc[callerside].size;
if cgsize in [OS_64,OS_S64] then case procdefinition.funcretloc[callerside].loc of
begin LOC_FPUREGISTER:
{ the function result registers are already allocated } begin
if getsupreg(retloc.register64.reglo)<first_int_imreg then location_reset(location,LOC_FPUREGISTER,cgsize);
cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reglo); location.register:=procdefinition.funcretloc[callerside].register;
retloc.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,procdefinition.funcretloc[callerside].register64.reglo,retloc.register64.reglo);
if getsupreg(retloc.register64.reghi)<first_int_imreg then
cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reghi);
retloc.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,procdefinition.funcretloc[callerside].register64.reghi,retloc.register64.reghi);
end
else
{$endif cpu64bit}
begin
{ the FUNCTION_RESULT_REG is already allocated }
if getsupreg(retloc.register)<first_int_imreg then
cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register);
{ reg_ref could generate two instrcutions and allocate a register so we've to
save the result first before releasing it }
retloc.register:=cg.getaddressregister(current_asmdata.CurrAsmList);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,procdefinition.funcretloc[callerside].register,retloc.register);
end;
if not assigned(funcretnode) then
begin
location_reset(location,LOC_REFERENCE,cgsize);
location.reference:=refcountedtemp;
end
else
begin
{ in case of a regular funcretnode with ret_in_param, the }
{ original funcretnode isn't touched -> make sure it's }
{ the same here (not sure if it's necessary) }
tempnode := funcretnode.getcopy;
tempnode.pass_generate_code;
location := tempnode.location;
tempnode.free;
cg.g_decrrefcount(current_asmdata.CurrAsmList,resultdef,location.reference);
end;
{$ifndef cpu64bit}
if cgsize in [OS_64,OS_S64] then
cg64.a_load64_reg_ref(current_asmdata.CurrAsmList,retloc.register64,location.reference)
else
{$endif}
cg.a_load_reg_ref(current_asmdata.CurrAsmList,cgsize,cgsize,retloc.register,location.reference);
end
else
{ normal (ordinal,float,pointer) result value }
begin
{ we have only to handle the result if it is used }
if (cnf_return_value_used in callnodeflags) then
begin
location.loc:=procdefinition.funcretloc[callerside].loc;
case procdefinition.funcretloc[callerside].loc of
LOC_FPUREGISTER:
begin
location_reset(location,LOC_FPUREGISTER,cgsize);
location.register:=procdefinition.funcretloc[callerside].register;
{$ifdef x86} {$ifdef x86}
tcgx86(cg).inc_fpu_stack; tcgx86(cg).inc_fpu_stack;
{$else x86} {$else x86}
if getsupreg(procdefinition.funcretloc[callerside].register)<first_fpu_imreg then if getsupreg(procdefinition.funcretloc[callerside].register)<first_fpu_imreg then
cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register); cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,location.size,location.size,location.register,hregister); cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,location.size,location.size,location.register,hregister);
location.register:=hregister; location.register:=hregister;
{$endif x86} {$endif x86}
end; end;
LOC_REGISTER: LOC_REGISTER:
begin begin
if cgsize<>OS_NO then if cgsize<>OS_NO then
begin begin
location_reset(location,LOC_REGISTER,cgsize); location_reset(location,LOC_REGISTER,cgsize);
{$ifndef cpu64bit} {$ifndef cpu64bit}
if cgsize in [OS_64,OS_S64] then if cgsize in [OS_64,OS_S64] then
begin begin
retloc:=procdefinition.funcretloc[callerside]; retloc:=procdefinition.funcretloc[callerside];
if retloc.loc<>LOC_REGISTER then if retloc.loc<>LOC_REGISTER then
internalerror(200409141); internalerror(200409141);
{ the function result registers are already allocated } { the function result registers are already allocated }
if getsupreg(retloc.register64.reglo)<first_int_imreg then if getsupreg(retloc.register64.reglo)<first_int_imreg then
cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reglo); cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reglo);
location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,retloc.register64.reglo,location.register64.reglo); cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,retloc.register64.reglo,location.register64.reglo);
if getsupreg(retloc.register64.reghi)<first_int_imreg then if getsupreg(retloc.register64.reghi)<first_int_imreg then
cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reghi); cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reghi);
location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,retloc.register64.reghi,location.register64.reghi); cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,retloc.register64.reghi,location.register64.reghi);
end end
else else
{$endif cpu64bit} {$endif cpu64bit}
begin begin
{ change register size after the unget because the { change register size after the unget because the
getregister was done for the full register getregister was done for the full register
def_cgsize(resultdef) is used here because def_cgsize(resultdef) is used here because
it could be a constructor call } it could be a constructor call }
if getsupreg(procdefinition.funcretloc[callerside].register)<first_int_imreg then if getsupreg(procdefinition.funcretloc[callerside].register)<first_int_imreg then
cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register); cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
location.register:=cg.getintregister(current_asmdata.CurrAsmList,def_cgsize(resultdef)); location.register:=cg.getintregister(current_asmdata.CurrAsmList,def_cgsize(resultdef));
cg.a_load_reg_reg(current_asmdata.CurrAsmList,cgsize,def_cgsize(resultdef),procdefinition.funcretloc[callerside].register,location.register); cg.a_load_reg_reg(current_asmdata.CurrAsmList,cgsize,def_cgsize(resultdef),procdefinition.funcretloc[callerside].register,location.register);
end; end;
{$ifdef arm} {$ifdef arm}
if (resultdef.typ=floatdef) and (current_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) then if (resultdef.typ=floatdef) and (current_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) then
begin begin
location_force_mem(current_asmdata.CurrAsmList,location); location_force_mem(current_asmdata.CurrAsmList,location);
end; end;
{$endif arm} {$endif arm}
end end
else else
begin begin
if resultdef.size>0 then if resultdef.size>0 then
internalerror(200305131); internalerror(200305131);
end;
end;
LOC_MMREGISTER:
begin
location_reset(location,LOC_MMREGISTER,cgsize);
if getsupreg(procdefinition.funcretloc[callerside].register)<first_mm_imreg then
cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
location.register:=cg.getmmregister(current_asmdata.CurrAsmList,cgsize);
cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,cgsize,cgsize,procdefinition.funcretloc[callerside].register,location.register,mms_movescalar);
end;
else
internalerror(200405023);
end; end;
end end;
else
begin
{$ifdef x86}
{ release FPU stack }
if procdefinition.funcretloc[callerside].loc=LOC_FPUREGISTER then
emit_reg(A_FSTP,S_NO,NR_FPU_RESULT_REG);
{$endif x86}
if cgsize<>OS_NO then
location_free(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside]);
location_reset(location,LOC_VOID,OS_NO);
end;
end;
LOC_MMREGISTER:
begin
location_reset(location,LOC_MMREGISTER,cgsize);
if getsupreg(procdefinition.funcretloc[callerside].register)<first_mm_imreg then
cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
location.register:=cg.getmmregister(current_asmdata.CurrAsmList,cgsize);
cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,cgsize,cgsize,procdefinition.funcretloc[callerside].register,location.register,mms_movescalar);
end;
else
internalerror(200405023);
end;
{ copy value to the final location if this was already provided to the
callnode. This must be done after the call node, because the location can
also be used as parameter and may not be finalized yet }
if assigned(funcretnode) then
begin
funcretnode.pass_generate_code;
{ Decrease refcount for refcounted types, this can be skipped when
we have used a temp, because then it is already done from tempcreatenode.
Also no finalize is needed, because there is no risk of exceptions from the
function since this is code is only executed after the function call has returned }
if funcretnode.resultdef.needs_inittable and
(funcretnode.nodetype<>temprefn) then
cg.g_decrrefcount(current_asmdata.CurrAsmList,funcretnode.resultdef,funcretnode.location.reference);
case location.loc of
LOC_REGISTER :
{$ifndef cpu64bit}
if cgsize in [OS_64,OS_S64] then
cg64.a_load64_reg_loc(current_asmdata.CurrAsmList,location.register64,funcretnode.location)
else
{$endif}
cg.a_load_reg_loc(current_asmdata.CurrAsmList,cgsize,location.register,funcretnode.location);
else
internalerror(200709085);
end;
location := funcretnode.location;
end;
end;
procedure tcgcallnode.release_unused_return_value;
begin
{ When the result is not used we need to finalize the result and { When the result is not used we need to finalize the result and
can release the temp } can release the temp. This need to be after the callcleanupblock
tree is generated, because that converts the temp from persistent to normal }
if not(cnf_return_value_used in callnodeflags) then if not(cnf_return_value_used in callnodeflags) then
begin begin
if location.loc=LOC_REFERENCE then case location.loc of
begin LOC_REFERENCE :
if resultdef.needs_inittable then begin
cg.g_finalize(current_asmdata.CurrAsmList,resultdef,location.reference); if resultdef.needs_inittable then
tg.ungetiftemp(current_asmdata.CurrAsmList,location.reference) cg.g_finalize(current_asmdata.CurrAsmList,resultdef,location.reference);
end; tg.ungetiftemp(current_asmdata.CurrAsmList,location.reference);
end;
{$ifdef x86}
LOC_FPUREGISTER :
begin
{ release FPU stack }
emit_reg(A_FSTP,S_NO,NR_FPU_RESULT_REG);
tcgx86(cg).dec_fpu_stack;
end;
{$endif x86}
end;
if procdefinition.funcretloc[callerside].size<>OS_NO then
location_free(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside]);
location_reset(location,LOC_VOID,OS_NO);
end; end;
end; end;
procedure tcgcallnode.release_para_temps; procedure tcgcallnode.release_para_temps;
var var
hp : tnode; hp,
hp2 : tnode;
ppn : tcallparanode; ppn : tcallparanode;
begin begin
{ Release temps from parameters } { Release temps from parameters }
@ -714,7 +683,13 @@ implementation
begin begin
while assigned(hp) do while assigned(hp) do
begin begin
location_freetemp(current_asmdata.CurrAsmList,tarrayconstructornode(hp).left.location); hp2:=tarrayconstructornode(hp).left;
{ ignore typeconvs and addrn inserted by arrayconstructn for
passing a shortstring }
if (hp2.nodetype=typeconvn) and
(tunarynode(hp2).left.nodetype=addrn) then
hp2:=tunarynode(tunarynode(hp2).left).left;
location_freetemp(current_asmdata.CurrAsmList,hp2.location);
hp:=tarrayconstructornode(hp).right; hp:=tarrayconstructornode(hp).right;
end; end;
end; end;
@ -864,19 +839,8 @@ implementation
not procdefinition.has_paraloc_info then not procdefinition.has_paraloc_info then
internalerror(200305264); internalerror(200305264);
if assigned(methodpointerinit) then if assigned(callinitblock) then
secondpass(methodpointerinit); secondpass(callinitblock);
if resultdef.needs_inittable and
not paramanager.ret_in_param(resultdef,procdefinition.proccalloption) and
not assigned(funcretnode) then
begin
tg.gettemptyped(current_asmdata.CurrAsmList,resultdef,tt_normal,refcountedtemp);
{ finalize instead of only decrref, because if the called }
{ function throws an exception this temp will be decrref'd }
{ again (tw7100) }
cg.g_finalize(current_asmdata.CurrAsmList,resultdef,refcountedtemp);
end;
regs_to_save_int:=paramanager.get_volatile_registers_int(procdefinition.proccalloption); regs_to_save_int:=paramanager.get_volatile_registers_int(procdefinition.proccalloption);
regs_to_save_fpu:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption); regs_to_save_fpu:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption);
@ -1120,6 +1084,18 @@ implementation
else else
location_reset(location,LOC_VOID,OS_NO); location_reset(location,LOC_VOID,OS_NO);
{ convert persistent temps for parameters and function result to normal temps }
if assigned(callcleanupblock) then
secondpass(callcleanupblock);
{ release temps and finalize unused return values, must be
after the callcleanupblock because that converts temps
from persistent to normal }
release_unused_return_value;
{ release temps of paras }
release_para_temps;
{ perhaps i/o check ? } { perhaps i/o check ? }
if (cs_check_io in current_settings.localswitches) and if (cs_check_io in current_settings.localswitches) and
(po_iocheck in procdefinition.procoptions) and (po_iocheck in procdefinition.procoptions) and
@ -1132,13 +1108,6 @@ implementation
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_IOCHECK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_IOCHECK');
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end; end;
{ release temps of paras }
release_para_temps;
if assigned(methodpointerdone) then
secondpass(methodpointerdone);
end; end;

2
compiler/ncgutil.pas
View File

@ -2542,7 +2542,7 @@ implementation
if (ti_valid in ttemprefnode(n).tempinfo^.flags) and if (ti_valid in ttemprefnode(n).tempinfo^.flags) and
(ttemprefnode(n).tempinfo^.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and (ttemprefnode(n).tempinfo^.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
(ttemprefnode(n).tempinfo^.location.register = rr^.old) and (ttemprefnode(n).tempinfo^.location.register = rr^.old) and
(not(ti_is_inlined_result in ttemprefnode(n).tempinfo^.flags) or (not(ti_is_funcret in ttemprefnode(n).tempinfo^.flags) or
not(fc_exit in flowcontrol)) then not(fc_exit in flowcontrol)) then
begin begin
{$ifndef cpu64bit} {$ifndef cpu64bit}

2
compiler/ncnv.pas
View File

@ -1696,7 +1696,7 @@ implementation
if (tcallnode(left).symtableprocentry.owner.symtabletype=ObjectSymtable) then if (tcallnode(left).symtableprocentry.owner.symtabletype=ObjectSymtable) then
begin begin
if assigned(tcallnode(left).methodpointer) then if assigned(tcallnode(left).methodpointer) then
tloadnode(hp).set_mp(tcallnode(left).get_load_methodpointer) tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy)
else else
tloadnode(hp).set_mp(load_self_node); tloadnode(hp).set_mp(load_self_node);
end; end;

60
compiler/nld.pas
View File

@ -679,10 +679,7 @@ implementation
is pushed as a parameter. Using the final destination of left directly is pushed as a parameter. Using the final destination of left directly
save a temp allocation and copy of data (PFV) } save a temp allocation and copy of data (PFV) }
oldassignmentnode:=aktassignmentnode; oldassignmentnode:=aktassignmentnode;
if right.nodetype=addn then aktassignmentnode:=self;
aktassignmentnode:=self
else
aktassignmentnode:=nil;
firstpass(right); firstpass(right);
aktassignmentnode:=oldassignmentnode; aktassignmentnode:=oldassignmentnode;
if nf_assign_done_in_right in flags then if nf_assign_done_in_right in flags then
@ -695,66 +692,11 @@ implementation
if codegenerror then if codegenerror then
exit; exit;
{ if right is a function call for which the address of the result }
{ is allocated by the caller and passed to the function via an }
{ invisible function result, try to pass the x in "x:=f(...)" as }
{ that function result instead. Condition: x cannot be accessible }
{ from within f. This is the case if x is a temp, or x is a local }
{ variable or value parameter of the current block and its address }
{ is not passed to f. One problem: what if someone takes the }
{ address of x, puts it in a pointer variable/field and then }
{ accesses it that way from within the function? This is solved }
{ (in a conservative way) using the ti_addr_taken/addr_taken flags }
if (cs_opt_level1 in current_settings.optimizerswitches) and
(right.nodetype = calln) and
(right.resultdef=left.resultdef) and
{ left must be a temp, since otherwise as soon as you modify the }
{ result, the current left node is modified and that one may }
{ still be an argument to the function or even accessed in the }
{ function }
(
(
(((left.nodetype = temprefn) and
not(ti_addr_taken in ttemprefnode(left).tempinfo^.flags) and
not(ti_may_be_in_reg in ttemprefnode(left).tempinfo^.flags)) or
((left.nodetype = loadn) and
{ nested procedures may access the current procedure's locals }
(tcallnode(right).procdefinition.parast.symtablelevel=normal_function_level) and
{ must be a local variable or a value para }
((tloadnode(left).symtableentry.typ = localvarsym) or
((tloadnode(left).symtableentry.typ = paravarsym) and
(tparavarsym(tloadnode(left).symtableentry).varspez = vs_value)
)
) 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(left).symtableentry).addr_taken) and
(tabstractvarsym(tloadnode(left).symtableentry).varregable in [vr_none,vr_addr])
)
) and
paramanager.ret_in_param(right.resultdef,tcallnode(right).procdefinition.proccalloption)
) or
{ there's special support for ansi/widestrings in the callnode }
is_ansistring(right.resultdef) or
is_widestring(right.resultdef)
) then
begin
if assigned(tcallnode(right).funcretnode) then
internalerror(2007080201);
tcallnode(right).funcretnode := left;
result := right;
left := nil;
right := nil;
exit;
end;
{ assignment to refcounted variable -> inc/decref } { assignment to refcounted variable -> inc/decref }
if (not is_class(left.resultdef) and if (not is_class(left.resultdef) and
left.resultdef.needs_inittable) then left.resultdef.needs_inittable) then
include(current_procinfo.flags,pi_do_call); include(current_procinfo.flags,pi_do_call);
if (is_shortstring(left.resultdef)) then if (is_shortstring(left.resultdef)) then
begin begin
if right.resultdef.typ=stringdef then if right.resultdef.typ=stringdef then

10
compiler/nutils.pas
View File

@ -121,9 +121,9 @@ implementation
calln: calln:
begin begin
{ not in one statement, won't work because of b- } { not in one statement, won't work because of b- }
result := foreachnode(tcallnode(n).methodpointerinit,f,arg) or result; result := foreachnode(tcallnode(n).callinitblock,f,arg) or result;
result := foreachnode(tcallnode(n).methodpointer,f,arg) or result; result := foreachnode(tcallnode(n).methodpointer,f,arg) or result;
result := foreachnode(tcallnode(n).methodpointerdone,f,arg) or result; result := foreachnode(tcallnode(n).callcleanupblock,f,arg) or result;
end; end;
ifn, whilerepeatn, forn, tryexceptn, tryfinallyn: ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
begin begin
@ -169,9 +169,9 @@ implementation
end; end;
calln: calln:
begin begin
result := foreachnodestatic(procmethod,tcallnode(n).methodpointerinit,f,arg) or result; result := foreachnodestatic(procmethod,tcallnode(n).callinitblock,f,arg) or result;
result := foreachnodestatic(procmethod,tcallnode(n).methodpointer,f,arg) or result; result := foreachnodestatic(procmethod,tcallnode(n).methodpointer,f,arg) or result;
result := foreachnodestatic(procmethod,tcallnode(n).methodpointerdone,f,arg) or result; result := foreachnodestatic(procmethod,tcallnode(n).callcleanupblock,f,arg) or result;
end; end;
ifn, whilerepeatn, forn, tryexceptn, tryfinallyn: ifn, whilerepeatn, forn, tryexceptn, tryfinallyn:
begin begin
@ -267,7 +267,7 @@ implementation
method without a self pointer } method without a self pointer }
if assigned(tcallnode(p1).methodpointer) and if assigned(tcallnode(p1).methodpointer) and
(tcallnode(p1).methodpointer.nodetype<>typen) then (tcallnode(p1).methodpointer.nodetype<>typen) then
tloadnode(p2).set_mp(tcallnode(p1).get_load_methodpointer); tloadnode(p2).set_mp(tcallnode(p1).methodpointer.getcopy);
end; end;
typecheckpass(p2); typecheckpass(p2);
p1.free; p1.free;

16
compiler/opttail.pas
View File

@ -144,10 +144,10 @@ unit opttail;
oldnodetree:=n; oldnodetree:=n;
n:=internalstatements(nodes); n:=internalstatements(nodes);
if assigned(usedcallnode.methodpointerinit) then if assigned(usedcallnode.callinitblock) then
begin begin
addstatement(nodes,usedcallnode.methodpointerinit); addstatement(nodes,usedcallnode.callinitblock);
usedcallnode.methodpointerinit:=nil; usedcallnode.callinitblock:=nil;
end; end;
addstatement(nodes,calcnodes); addstatement(nodes,calcnodes);
@ -156,13 +156,13 @@ unit opttail;
{ create goto } { create goto }
addstatement(nodes,cgotonode.create(labelnode)); addstatement(nodes,cgotonode.create(labelnode));
if assigned(usedcallnode.methodpointerdone) then if assigned(usedcallnode.callcleanupblock) then
begin begin
{ methodpointerdone should contain only temp. node clean up } { callcleanupblock should contain only temp. node clean up }
checktreenodetypes(usedcallnode.methodpointerdone, checktreenodetypes(usedcallnode.callcleanupblock,
[tempdeleten,blockn,statementn,temprefn,nothingn]); [tempdeleten,blockn,statementn,temprefn,nothingn]);
addstatement(nodes,usedcallnode.methodpointerdone); addstatement(nodes,usedcallnode.callcleanupblock);
usedcallnode.methodpointerdone:=nil; usedcallnode.callcleanupblock:=nil;
end; end;
oldnodetree.free; oldnodetree.free;

2
compiler/pexpr.pas
View File

@ -1079,7 +1079,7 @@ implementation
begin begin
hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc); hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc);
if (po_methodpointer in pv.procoptions) then if (po_methodpointer in pv.procoptions) then
tloadnode(hp2).set_mp(tcallnode(hp).get_load_methodpointer); tloadnode(hp2).set_mp(tcallnode(hp).methodpointer.getcopy);
hp.destroy; hp.destroy;
{ replace the old callnode with the new loadnode } { replace the old callnode with the new loadnode }
hpp^:=hp2; hpp^:=hp2;