paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-29 23:31:46 +01:00
Code Issues Packages Projects Releases Wiki Activity

* converted code to trash variables (-gt) to operate at the node tree level,

Browse Source 
and also use this code to trash local variables in inlined routines
   o fixes mantis #22088
   o makes it possible to also implement it for the jvm target in the future

git-svn-id: trunk@21393 -
This commit is contained in:
Jonas Maebe 2012-05-26 11:32:39 +00:00
parent f2c82e32cd
commit baa8fa39a8
9 changed files with 196 additions and 281 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/globals.pas
View File

@ -113,15 +113,7 @@ interface
localvartrashing: longint = -1; localvartrashing: longint = -1;
nroftrashvalues = 4; nroftrashvalues = 4;
{$ifdef cpu64bitalu} trashintvalues: array[0..nroftrashvalues-1] of int64 = ($5555555555555555,$AAAAAAAAAAAAAAAA,$EFEFEFEFEFEFEFEF,0);
trashintvalues: array[0..nroftrashvalues-1] of aint = ($5555555555555555,aint($AAAAAAAAAAAAAAAA),aint($EFEFEFEFEFEFEFEF),0);
{$endif cpu64bitalu}
{$ifdef cpu32bitalu}
trashintvalues: array[0..nroftrashvalues-1] of aint = ($55555555,aint($AAAAAAAA),aint($EFEFEFEF),0);
{$endif cpu32bitalu}
{$ifdef cpu8bitalu}
trashintvalues: array[0..nroftrashvalues-1] of aint = ($55,aint($AA),aint($EF),0);
{$endif cpu8bitalu}
type type

51
compiler/hlcgobj.pas
View File

@ -3633,19 +3633,12 @@ implementation
eldef : tdef; eldef : tdef;
list : TAsmList; list : TAsmList;
highloc : tlocation; highloc : tlocation;
needs_inittable (*, needs_inittable : boolean;
do_trashing *) : boolean;
begin begin
list:=TAsmList(arg); list:=TAsmList(arg);
if (tsym(p).typ=paravarsym) then if (tsym(p).typ=paravarsym) then
begin begin
needs_inittable:=is_managed_type(tparavarsym(p).vardef); needs_inittable:=is_managed_type(tparavarsym(p).vardef);
(*
do_trashing:=
(localvartrashing <> -1) and
(not assigned(tparavarsym(p).defaultconstsym)) and
not needs_inittable;
*)
case tparavarsym(p).varspez of case tparavarsym(p).varspez of
vs_value : vs_value :
if needs_inittable then if needs_inittable then
@ -3678,25 +3671,12 @@ implementation
end; end;
vs_out : vs_out :
begin begin
if needs_inittable (*or if needs_inittable then
do_trashing*) then
begin begin
{ we have no idea about the alignment at the callee side, { we have no idea about the alignment at the callee side,
and the user also cannot specify "unaligned" here, so and the user also cannot specify "unaligned" here, so
assume worst case } assume worst case }
location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1); location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
(*
if do_trashing and
{ needs separate implementation to trash open arrays }
{ since their size is only known at run time }
not is_special_array(tparavarsym(p).vardef) then
{ may be an open string, even if is_open_string() returns }
{ false (for some helpers in the system unit) }
if not is_shortstring(tparavarsym(p).vardef) then
trash_reference(list,href,tparavarsym(p).vardef.size)
else
trash_reference(list,href,2);
*)
if needs_inittable then if needs_inittable then
begin begin
if is_open_array(tparavarsym(p).vardef) then if is_open_array(tparavarsym(p).vardef) then
@ -3718,26 +3698,6 @@ implementation
end; end;
end; end;
end; end;
(*
else if do_trashing and
([vo_is_funcret,vo_is_hidden_para] * tparavarsym(p).varoptions = [vo_is_funcret,vo_is_hidden_para]) then
begin
{ should always have standard alignment. If a function is assigned
to a non-aligned variable, the optimisation to pass this variable
directly as hidden function result must/cannot be performed
(see tcallnode.funcret_can_be_reused)
}
location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,
used_align(tparavarsym(p).vardef.alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax));
{ may be an open string, even if is_open_string() returns }
{ false (for some helpers in the system unit) }
if not is_shortstring(tparavarsym(p).vardef) then
trash_reference(list,href,tparavarsym(p).vardef.size)
else
{ an open string has at least size 2 }
trash_reference(list,href,2);
end
*)
end; end;
end; end;
end; end;
@ -3767,13 +3727,6 @@ implementation
if not(po_assembler in current_procinfo.procdef.procoptions) then if not(po_assembler in current_procinfo.procdef.procoptions) then
begin begin
{ has to be done here rather than in gen_initialize_code, because
the initialisation code is generated a) later and b) with
rad_backwards, so the register allocator would generate
information as if this code comes before loading the parameters
from their original registers to their local location }
// if (localvartrashing <> -1) then
// current_procinfo.procdef.localst.SymList.ForEachCall(@trash_variable,list);
{ initialize refcounted paras, and trash others. Needed here { initialize refcounted paras, and trash others. Needed here
instead of in gen_initialize_code, because when a reference is instead of in gen_initialize_code, because when a reference is
intialised or trashed while the pointer to that reference is kept intialised or trashed while the pointer to that reference is kept

6
compiler/ncal.pas
View File

@ -265,7 +265,7 @@ implementation
symconst,defutil,defcmp, symconst,defutil,defcmp,
htypechk,pass_1, htypechk,pass_1,
ncnv,nld,ninl,nadd,ncon,nmem,nset,nobjc, ncnv,nld,ninl,nadd,ncon,nmem,nset,nobjc,
objcutil, ngenutil,objcutil,
procinfo,cpuinfo, procinfo,cpuinfo,
wpobase; wpobase;
@ -3663,7 +3663,7 @@ implementation
addstatement(inlineinitstatement,tempnode); addstatement(inlineinitstatement,tempnode);
if localvartrashing <> -1 then if localvartrashing <> -1 then
addstatement(inlineinitstatement,trash_tempref(tempnode)); cnodeutils.maybe_trash_variable(inlineinitstatement,tabstractnormalvarsym(p),ctemprefnode.create(tempnode));
addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode)); addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode));
{ inherit addr_taken flag } { inherit addr_taken flag }
@ -3816,7 +3816,7 @@ implementation
addstatement(inlineinitstatement,tempnode); addstatement(inlineinitstatement,tempnode);
if localvartrashing <> -1 then if localvartrashing <> -1 then
addstatement(inlineinitstatement,trash_tempref(tempnode)); cnodeutils.maybe_trash_variable(inlineinitstatement,para.parasym,ctemprefnode.create(tempnode));
addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode)); addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode));
addstatement(inlineinitstatement,cassignmentnode.create(ctemprefnode.create(tempnode), addstatement(inlineinitstatement,cassignmentnode.create(ctemprefnode.create(tempnode),

214
compiler/ncgutil.pas
View File

@ -706,106 +706,6 @@ implementation
end; end;
procedure trash_reference(list: TAsmList; const ref: treference; size: aint);
var
countreg, valuereg: tregister;
hl: tasmlabel;
trashintval: aint;
tmpref: treference;
begin
trashintval := trashintvalues[localvartrashing];
case size of
0: ; { empty record }
1: cg.a_load_const_ref(list,OS_8,byte(trashintval),ref);
2: cg.a_load_const_ref(list,OS_16,word(trashintval),ref);
4: cg.a_load_const_ref(list,OS_32,longint(trashintval),ref);
{$ifdef cpu64bitalu}
8: cg.a_load_const_ref(list,OS_64,int64(trashintval),ref);
{$endif cpu64bitalu}
else
begin
countreg := cg.getintregister(list,OS_ADDR);
valuereg := cg.getintregister(list,OS_8);
cg.a_load_const_reg(list,OS_INT,size,countreg);
cg.a_load_const_reg(list,OS_8,byte(trashintval),valuereg);
current_asmdata.getjumplabel(hl);
tmpref := ref;
if (tmpref.index <> NR_NO) then
internalerror(200607201);
tmpref.index := countreg;
dec(tmpref.offset);
cg.a_label(list,hl);
cg.a_load_reg_ref(list,OS_8,OS_8,valuereg,tmpref);
cg.a_op_const_reg(list,OP_SUB,OS_INT,1,countreg);
cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,countreg,hl);
cg.a_reg_sync(list,tmpref.base);
cg.a_reg_sync(list,valuereg);
end;
end;
end;
{ trash contents of local variables or parameters (function result) }
procedure trash_variable(p:TObject;arg:pointer);
var
trashintval: aint;
list: TAsmList absolute arg;
begin
if ((tsym(p).typ=localvarsym) or
((tsym(p).typ=paravarsym) and
(vo_is_funcret in tparavarsym(p).varoptions))) and
not(is_managed_type(tabstractnormalvarsym(p).vardef)) and
not(assigned(tabstractnormalvarsym(p).defaultconstsym)) then
begin
trashintval := trashintvalues[localvartrashing];
case tabstractnormalvarsym(p).initialloc.loc of
LOC_CREGISTER :
{$push}
{$q-}
begin
{ avoid problems with broken x86 shifts }
case tcgsize2size[tabstractnormalvarsym(p).initialloc.size] of
1: cg.a_load_const_reg(list,OS_8,byte(trashintval),tabstractnormalvarsym(p).initialloc.register);
2: cg.a_load_const_reg(list,OS_16,word(trashintval),tabstractnormalvarsym(p).initialloc.register);
4: cg.a_load_const_reg(list,OS_32,longint(trashintval),tabstractnormalvarsym(p).initialloc.register);
8:
begin
{$ifdef cpu64bitalu}
cg.a_load_const_reg(list,OS_64,aint(trashintval),tabstractnormalvarsym(p).initialloc.register);
{$else}
cg64.a_load64_const_reg(list,int64(trashintval) shl 32 or int64(trashintval),tabstractnormalvarsym(p).initialloc.register64);
{$endif}
end;
else
internalerror(2010060801);
end;
end;
{$pop}
LOC_REFERENCE :
begin
if ((tsym(p).typ=localvarsym) and
not(vo_is_funcret in tabstractvarsym(p).varoptions)) or
not is_shortstring(tabstractnormalvarsym(p).vardef) then
trash_reference(list,tabstractnormalvarsym(p).initialloc.reference,
tlocalvarsym(p).getsize)
else
{ may be an open string, even if is_open_string() returns }
{ false (for some helpers in the system unit) }
{ an open string has at least size 2 }
trash_reference(list,tabstractnormalvarsym(p).initialloc.reference,
2);
end;
LOC_CMMREGISTER :
;
LOC_CFPUREGISTER :
;
else
internalerror(200410124);
end;
end;
end;
{ generates the code for incrementing the reference count of parameters and { generates the code for incrementing the reference count of parameters and
initialize out parameters } initialize out parameters }
procedure init_paras(p:TObject;arg:pointer); procedure init_paras(p:TObject;arg:pointer);
@ -814,93 +714,54 @@ implementation
hsym : tparavarsym; hsym : tparavarsym;
eldef : tdef; eldef : tdef;
list : TAsmList; list : TAsmList;
needs_inittable, needs_inittable : boolean;
do_trashing : boolean;
begin begin
list:=TAsmList(arg); list:=TAsmList(arg);
if (tsym(p).typ=paravarsym) then if (tsym(p).typ=paravarsym) then
begin begin
needs_inittable:=is_managed_type(tparavarsym(p).vardef); needs_inittable:=is_managed_type(tparavarsym(p).vardef);
do_trashing:= if not needs_inittable then
(localvartrashing <> -1) and exit;
(not assigned(tparavarsym(p).defaultconstsym)) and
not needs_inittable;
case tparavarsym(p).varspez of case tparavarsym(p).varspez of
vs_value : vs_value :
if needs_inittable then
begin
{ variants are already handled by the call to fpc_variant_copy_overwrite if
they are passed by reference }
if not((tparavarsym(p).vardef.typ=variantdef) and
paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
begin
hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
if is_open_array(tparavarsym(p).vardef) then
begin
{ open arrays do not contain correct element count in their rtti,
the actual count must be passed separately. }
hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
if not assigned(hsym) then
internalerror(201003031);
cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_ADDREF_ARRAY');
end
else
cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
end;
end;
vs_out :
begin begin
if needs_inittable or { variants are already handled by the call to fpc_variant_copy_overwrite if
do_trashing then they are passed by reference }
if not((tparavarsym(p).vardef.typ=variantdef) and
paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then
begin begin
{ we have no idea about the alignment at the callee side, hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint));
and the user also cannot specify "unaligned" here, so if is_open_array(tparavarsym(p).vardef) then
assume worst case }
hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
if do_trashing and
{ needs separate implementation to trash open arrays }
{ since their size is only known at run time }
not is_special_array(tparavarsym(p).vardef) then
{ may be an open string, even if is_open_string() returns }
{ false (for some helpers in the system unit) }
if not is_shortstring(tparavarsym(p).vardef) then
trash_reference(list,href,tparavarsym(p).vardef.size)
else
trash_reference(list,href,2);
if needs_inittable then
begin begin
if is_open_array(tparavarsym(p).vardef) then { open arrays do not contain correct element count in their rtti,
begin the actual count must be passed separately. }
hsym:=tparavarsym(get_high_value_sym(tparavarsym(p))); hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
eldef:=tarraydef(tparavarsym(p).vardef).elementdef; eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
if not assigned(hsym) then if not assigned(hsym) then
internalerror(201103033); internalerror(201003031);
cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_INITIALIZE_ARRAY'); cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_ADDREF_ARRAY');
end end
else else
cg.g_initialize(list,tparavarsym(p).vardef,href); cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
end;
end; end;
end; end;
else if do_trashing and vs_out :
([vo_is_funcret,vo_is_hidden_para] * tparavarsym(p).varoptions = [vo_is_funcret,vo_is_hidden_para]) then begin
{ we have no idea about the alignment at the callee side,
and the user also cannot specify "unaligned" here, so
assume worst case }
hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,1);
if is_open_array(tparavarsym(p).vardef) then
begin begin
{ should always have standard alignment. If a function is assigned hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
to a non-aligned variable, the optimisation to pass this variable eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
directly as hidden function result must/cannot be performed if not assigned(hsym) then
(see tcallnode.funcret_can_be_reused) internalerror(201103033);
} cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_INITIALIZE_ARRAY');
hlcg.location_get_data_ref(list,tparavarsym(p).vardef,tparavarsym(p).initialloc,href,true,
used_align(tparavarsym(p).vardef.alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax));
{ may be an open string, even if is_open_string() returns }
{ false (for some helpers in the system unit) }
if not is_shortstring(tparavarsym(p).vardef) then
trash_reference(list,href,tparavarsym(p).vardef.size)
else
{ an open string has at least size 2 }
trash_reference(list,href,2);
end end
else
cg.g_initialize(list,tparavarsym(p).vardef,href);
end;
end; end;
end; end;
end; end;
@ -1250,13 +1111,6 @@ implementation
{$endif powerpc64} {$endif powerpc64}
if not(po_assembler in current_procinfo.procdef.procoptions) then if not(po_assembler in current_procinfo.procdef.procoptions) then
begin begin
{ has to be done here rather than in gen_initialize_code, because
the initialisation code is generated a) later and b) with
rad_backwards, so the register allocator would generate
information as if this code comes before loading the parameters
from their original registers to their local location }
if (localvartrashing <> -1) then
current_procinfo.procdef.localst.SymList.ForEachCall(@trash_variable,list);
{ initialize refcounted paras, and trash others. Needed here { initialize refcounted paras, and trash others. Needed here
instead of in gen_initialize_code, because when a reference is instead of in gen_initialize_code, because when a reference is
intialised or trashed while the pointer to that reference is kept intialised or trashed while the pointer to that reference is kept

150
compiler/ngenutil.pas
View File

@ -28,7 +28,7 @@ interface
uses uses
cclasses, cclasses,
node,symtype,symsym,symconst,symdef; node,nbas,symtype,symsym,symconst,symdef;
type type
@ -49,6 +49,25 @@ interface
initialisation via the node tree } initialisation via the node tree }
class function wrap_proc_body(pd: tprocdef; n: tnode): tnode; virtual; class function wrap_proc_body(pd: tprocdef; n: tnode): tnode; virtual;
{ trashes a paravarsym or localvarsym if possible (not a managed type,
"out" in case of parameter, ...) }
class procedure maybe_trash_variable(var stat: tstatementnode; p: tabstractnormalvarsym; trashn: tnode); virtual;
strict protected
{ called from wrap_proc_body to insert the trashing for the wrapped
routine's local variables and parameters }
class function maybe_insert_trashing(pd: tprocdef; n: tnode): tnode; virtual;
{ callback called for every local variable and parameter by
maybe_insert_trashing(), calls through to maybe_trash_variable() }
class procedure maybe_trash_variable_callback(p: TObject; statn: pointer);
{ returns whether a particular sym can be trashed. If not,
maybe_trash_variable won't do anything }
class function trashable_sym(p: tsym): boolean; virtual;
{ trashing for 1/2/3/4/8-byte sized variables }
class procedure trash_small(var stat: tstatementnode; trashn: tnode; trashvaln: tnode); virtual;
{ trashing for differently sized variables that those handled by
trash_small() }
class procedure trash_large(var stat: tstatementnode; trashn, sizen: tnode; trashintval: int64); virtual;
public
class procedure insertbssdata(sym : tstaticvarsym); virtual; class procedure insertbssdata(sym : tstaticvarsym); virtual;
class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual; class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
@ -84,7 +103,7 @@ implementation
scanner,systems,procinfo,fmodule, scanner,systems,procinfo,fmodule,
aasmbase,aasmdata,aasmtai, aasmbase,aasmdata,aasmtai,
symbase,symtable,defutil, symbase,symtable,defutil,
nadd,nbas,ncal,ncnv,ncon,nflw,nld,nmem,nobj,nutils, nadd,ncal,ncnv,ncon,nflw,ninl,nld,nmem,nobj,nutils,
ppu, ppu,
pass_1; pass_1;
@ -247,7 +266,7 @@ implementation
psym: tsym; psym: tsym;
tcinitproc: tprocdef; tcinitproc: tprocdef;
begin begin
result:=n; result:=maybe_insert_trashing(pd,n);
if target_info.system in systems_typed_constants_node_init then if target_info.system in systems_typed_constants_node_init then
begin begin
case pd.proctypeoption of case pd.proctypeoption of
@ -308,6 +327,131 @@ implementation
end; end;
class function tnodeutils.maybe_insert_trashing(pd: tprocdef; n: tnode): tnode;
var
stat: tstatementnode;
begin
result:=n;
if (localvartrashing<>-1) and
not(po_assembler in pd.procoptions) then
begin
result:=internalstatements(stat);
pd.parast.SymList.ForEachCall(@maybe_trash_variable_callback,@stat);
pd.localst.SymList.ForEachCall(@maybe_trash_variable_callback,@stat);
addstatement(stat,n);
end;
end;
class function tnodeutils.trashable_sym(p: tsym): boolean;
begin
result:=
((p.typ=localvarsym) or
((p.typ=paravarsym) and
((vo_is_funcret in tabstractnormalvarsym(p).varoptions) or
(tabstractnormalvarsym(p).varspez=vs_out)))) and
not is_managed_type(tabstractnormalvarsym(p).vardef) and
not assigned(tabstractnormalvarsym(p).defaultconstsym);
end;
class procedure tnodeutils.maybe_trash_variable(var stat: tstatementnode; p: tabstractnormalvarsym; trashn: tnode);
var
size: asizeint;
trashintval: int64;
begin
if trashable_sym(p) then
begin
trashintval:=trashintvalues[localvartrashing];
if (p.vardef.typ=procvardef) and
([m_tp_procvar,m_mac_procvar]*current_settings.modeswitches<>[]) then
begin
if tprocvardef(p.vardef).is_addressonly then
{ in tp/delphi mode, you need @procvar to get at the contents of
a procvar ... }
trashn:=caddrnode.create(trashn)
else
{ ... but if it's a procedure of object, that will only return
the procedure address -> cast to tmethod instead }
trashn:=ctypeconvnode.create_explicit(trashn,methodpointertype);
end;
if ((p.typ=localvarsym) and
(not(vo_is_funcret in p.varoptions) or
not is_shortstring(p.vardef))) or
((p.typ=paravarsym) and
not is_shortstring(p.vardef)) then
begin
size:=p.getsize;
case size of
0:
begin
{ open array -> at least size 1. Can also be zero-sized
record, so check it's actually an array }
if p.vardef.typ=arraydef then
trash_large(stat,trashn,caddnode.create(addn,cinlinenode.create(in_high_x,false,trashn.getcopy),genintconstnode(1)),trashintval)
else
trashn.free;
end;
1: trash_small(stat,
ctypeconvnode.create_internal(trashn,s8inttype),
genintconstnode(shortint(trashintval)));
2: trash_small(stat,
ctypeconvnode.create_internal(trashn,s16inttype),
genintconstnode(smallint(trashintval)));
4: trash_small(stat,
ctypeconvnode.create_internal(trashn,s32inttype),
genintconstnode(longint(trashintval)));
8: trash_small(stat,
ctypeconvnode.create_internal(trashn,s64inttype),
genintconstnode(int64(trashintval)));
else
trash_large(stat,trashn,genintconstnode(size),trashintval);
end;
end
else
begin
{ may be an open string, even if is_open_string() returns false
(for some helpers in the system unit) }
{ an open string has at least size 2 }
trash_small(stat,
cvecnode.create(trashn.getcopy,genintconstnode(0)),
cordconstnode.create(tconstexprint(byte(trashintval)),cansichartype,false));
trash_small(stat,
cvecnode.create(trashn,genintconstnode(1)),
cordconstnode.create(tconstexprint(byte(trashintval)),cansichartype,false));
end;
end
else
trashn.free;
end;
class procedure tnodeutils.maybe_trash_variable_callback(p:TObject;statn:pointer);
var
stat: ^tstatementnode absolute statn;
begin
if not(tsym(p).typ in [localvarsym,paravarsym]) then
exit;
maybe_trash_variable(stat^,tabstractnormalvarsym(p),cloadnode.create(tsym(p),tsym(p).owner));
end;
class procedure tnodeutils.trash_small(var stat: tstatementnode; trashn: tnode; trashvaln: tnode);
begin
addstatement(stat,cassignmentnode.create(trashn,trashvaln));
end;
class procedure tnodeutils.trash_large(var stat: tstatementnode; trashn, sizen: tnode; trashintval: int64);
begin
addstatement(stat,ccallnode.createintern('fpc_fillmem',
ccallparanode.Create(cordconstnode.create(tconstexprint(byte(trashintval)),u8inttype,false),
ccallparanode.Create(sizen,
ccallparanode.Create(trashn,nil)))
));
end;
class procedure tnodeutils.insertbssdata(sym: tstaticvarsym); class procedure tnodeutils.insertbssdata(sym: tstaticvarsym);
var var
l : asizeint; l : asizeint;

31
compiler/nutils.pas
View File

@ -114,9 +114,6 @@ interface
rough estimation how large the tree "node" is } rough estimation how large the tree "node" is }
function node_count(node : tnode) : dword; function node_count(node : tnode) : dword;
{ trashes the given temp. node }
function trash_tempref(node : tnode) : tnode;
implementation implementation
uses uses
@ -1135,32 +1132,4 @@ implementation
end; end;
function trash_tempref(node : tnode) : tnode;
var
trashintval: aint;
begin
if node.nodetype<>tempcreaten then
internalerror(2012051901);
trashintval := trashintvalues[localvartrashing];
case ttempcreatenode(node).size of
0: ; { empty record }
1: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
ctypeconvnode.create_internal(cordconstnode.create(tconstexprint(byte(trashintval)),u8inttype,false),ttempcreatenode(node).tempinfo^.typedef));
2: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
ctypeconvnode.create_internal(cordconstnode.create(word(trashintval),u16inttype,false),ttempcreatenode(node).tempinfo^.typedef));
4: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
ctypeconvnode.create_internal(cordconstnode.create(dword(trashintval),u32inttype,false),ttempcreatenode(node).tempinfo^.typedef));
8: result:=cassignmentnode.create(ctemprefnode.create(ttempcreatenode(node)),
ctypeconvnode.create_internal(cordconstnode.create(qword(trashintval),u64inttype,false),ttempcreatenode(node).tempinfo^.typedef));
else
begin
result:=ccallnode.createintern('fpc_fillmem',
ccallparanode.Create(cordconstnode.create(tconstexprint(byte(trashintval)),u8inttype,false),
ccallparanode.Create(cordconstnode.create(ttempcreatenode(node).size,uinttype,false),
ccallparanode.Create(ctemprefnode.create(ttempcreatenode(node)),nil)))
);
end;
end;
end;
end. end.

11
compiler/psub.pas
View File

@ -361,10 +361,6 @@ implementation
finish_parentfpstruct(current_procinfo.procdef); finish_parentfpstruct(current_procinfo.procdef);
end; end;
end; end;
{ init/final code must be wrapped later (after code for main proc body
has been generated }
if not(current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
block:=cnodeutils.wrap_proc_body(current_procinfo.procdef,block);
end; end;
@ -1074,6 +1070,13 @@ implementation
current_filepos:=entrypos; current_filepos:=entrypos;
current_structdef:=procdef.struct; current_structdef:=procdef.struct;
{ add wrapping code if necessary (initialization of typed constants on
some platforms, initing of local variables and out parameters with
trashing values, ... }
{ init/final code must be wrapped later (after code for main proc body
has been generated }
if not(current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then
code:=cnodeutils.wrap_proc_body(procdef,code);
{ automatic inlining? } { automatic inlining? }
if (cs_opt_autoinline in current_settings.optimizerswitches) and if (cs_opt_autoinline in current_settings.optimizerswitches) and

2
rtl/inc/compproc.inc
View File

@ -37,7 +37,7 @@ Procedure fpc_freemem(p:pointer);compilerproc;
{ used by Default() in code blocks } { used by Default() in code blocks }
procedure fpc_zeromem(p:pointer;len:ptruint);compilerproc; procedure fpc_zeromem(p:pointer;len:ptruint);compilerproc;
procedure fpc_fillmem(var data;len:ptruint;b : byte);compilerproc; procedure fpc_fillmem(out data;len:ptruint;b : byte);compilerproc;
procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc; procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc; procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;

2
rtl/inc/system.inc
View File

@ -287,7 +287,7 @@ begin
end; end;
procedure fpc_fillmem(var data;len:ptruint;b : byte); procedure fpc_fillmem(out data;len:ptruint;b : byte);
begin begin
FillByte(data,len,b); FillByte(data,len,b);
end; end;