mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-22 14:53:26 +02:00
* converted code to trash variables (-gt) to operate at the node tree level,
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
parent
f2c82e32cd
commit
baa8fa39a8
@ -113,15 +113,7 @@ interface
|
||||
localvartrashing: longint = -1;
|
||||
|
||||
nroftrashvalues = 4;
|
||||
{$ifdef cpu64bitalu}
|
||||
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}
|
||||
trashintvalues: array[0..nroftrashvalues-1] of int64 = ($5555555555555555,$AAAAAAAAAAAAAAAA,$EFEFEFEFEFEFEFEF,0);
|
||||
|
||||
|
||||
type
|
||||
|
||||
@ -3633,19 +3633,12 @@ implementation
|
||||
eldef : tdef;
|
||||
list : TAsmList;
|
||||
highloc : tlocation;
|
||||
needs_inittable (*,
|
||||
do_trashing *) : boolean;
|
||||
needs_inittable : boolean;
|
||||
begin
|
||||
list:=TAsmList(arg);
|
||||
if (tsym(p).typ=paravarsym) then
|
||||
begin
|
||||
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
|
||||
vs_value :
|
||||
if needs_inittable then
|
||||
@ -3678,25 +3671,12 @@ implementation
|
||||
end;
|
||||
vs_out :
|
||||
begin
|
||||
if needs_inittable (*or
|
||||
do_trashing*) then
|
||||
if needs_inittable 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 }
|
||||
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
|
||||
if is_open_array(tparavarsym(p).vardef) then
|
||||
@ -3718,26 +3698,6 @@ implementation
|
||||
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;
|
||||
@ -3767,13 +3727,6 @@ implementation
|
||||
|
||||
if not(po_assembler in current_procinfo.procdef.procoptions) then
|
||||
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
|
||||
instead of in gen_initialize_code, because when a reference is
|
||||
intialised or trashed while the pointer to that reference is kept
|
||||
|
||||
@ -265,7 +265,7 @@ implementation
|
||||
symconst,defutil,defcmp,
|
||||
htypechk,pass_1,
|
||||
ncnv,nld,ninl,nadd,ncon,nmem,nset,nobjc,
|
||||
objcutil,
|
||||
ngenutil,objcutil,
|
||||
procinfo,cpuinfo,
|
||||
wpobase;
|
||||
|
||||
@ -3663,7 +3663,7 @@ implementation
|
||||
addstatement(inlineinitstatement,tempnode);
|
||||
|
||||
if localvartrashing <> -1 then
|
||||
addstatement(inlineinitstatement,trash_tempref(tempnode));
|
||||
cnodeutils.maybe_trash_variable(inlineinitstatement,tabstractnormalvarsym(p),ctemprefnode.create(tempnode));
|
||||
|
||||
addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode));
|
||||
{ inherit addr_taken flag }
|
||||
@ -3816,7 +3816,7 @@ implementation
|
||||
addstatement(inlineinitstatement,tempnode);
|
||||
|
||||
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(inlineinitstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
|
||||
|
||||
@ -706,106 +706,6 @@ implementation
|
||||
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
|
||||
initialize out parameters }
|
||||
procedure init_paras(p:TObject;arg:pointer);
|
||||
@ -814,93 +714,54 @@ implementation
|
||||
hsym : tparavarsym;
|
||||
eldef : tdef;
|
||||
list : TAsmList;
|
||||
needs_inittable,
|
||||
do_trashing : boolean;
|
||||
needs_inittable : boolean;
|
||||
begin
|
||||
list:=TAsmList(arg);
|
||||
if (tsym(p).typ=paravarsym) then
|
||||
begin
|
||||
needs_inittable:=is_managed_type(tparavarsym(p).vardef);
|
||||
do_trashing:=
|
||||
(localvartrashing <> -1) and
|
||||
(not assigned(tparavarsym(p).defaultconstsym)) and
|
||||
not needs_inittable;
|
||||
if not needs_inittable then
|
||||
exit;
|
||||
case tparavarsym(p).varspez of
|
||||
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
|
||||
if needs_inittable or
|
||||
do_trashing then
|
||||
{ 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
|
||||
{ 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 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
|
||||
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
|
||||
if is_open_array(tparavarsym(p).vardef) then
|
||||
begin
|
||||
hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
|
||||
eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
|
||||
if not assigned(hsym) then
|
||||
internalerror(201103033);
|
||||
cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_INITIALIZE_ARRAY');
|
||||
end
|
||||
else
|
||||
cg.g_initialize(list,tparavarsym(p).vardef,href);
|
||||
end;
|
||||
{ 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;
|
||||
else if do_trashing and
|
||||
([vo_is_funcret,vo_is_hidden_para] * tparavarsym(p).varoptions = [vo_is_funcret,vo_is_hidden_para]) then
|
||||
vs_out :
|
||||
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
|
||||
{ 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)
|
||||
}
|
||||
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);
|
||||
hsym:=tparavarsym(get_high_value_sym(tparavarsym(p)));
|
||||
eldef:=tarraydef(tparavarsym(p).vardef).elementdef;
|
||||
if not assigned(hsym) then
|
||||
internalerror(201103033);
|
||||
cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_INITIALIZE_ARRAY');
|
||||
end
|
||||
else
|
||||
cg.g_initialize(list,tparavarsym(p).vardef,href);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -1250,13 +1111,6 @@ implementation
|
||||
{$endif powerpc64}
|
||||
if not(po_assembler in current_procinfo.procdef.procoptions) then
|
||||
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
|
||||
instead of in gen_initialize_code, because when a reference is
|
||||
intialised or trashed while the pointer to that reference is kept
|
||||
|
||||
@ -28,7 +28,7 @@ interface
|
||||
|
||||
uses
|
||||
cclasses,
|
||||
node,symtype,symsym,symconst,symdef;
|
||||
node,nbas,symtype,symsym,symconst,symdef;
|
||||
|
||||
|
||||
type
|
||||
@ -49,6 +49,25 @@ interface
|
||||
initialisation via the node tree }
|
||||
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 function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
|
||||
@ -84,7 +103,7 @@ implementation
|
||||
scanner,systems,procinfo,fmodule,
|
||||
aasmbase,aasmdata,aasmtai,
|
||||
symbase,symtable,defutil,
|
||||
nadd,nbas,ncal,ncnv,ncon,nflw,nld,nmem,nobj,nutils,
|
||||
nadd,ncal,ncnv,ncon,nflw,ninl,nld,nmem,nobj,nutils,
|
||||
ppu,
|
||||
pass_1;
|
||||
|
||||
@ -247,7 +266,7 @@ implementation
|
||||
psym: tsym;
|
||||
tcinitproc: tprocdef;
|
||||
begin
|
||||
result:=n;
|
||||
result:=maybe_insert_trashing(pd,n);
|
||||
if target_info.system in systems_typed_constants_node_init then
|
||||
begin
|
||||
case pd.proctypeoption of
|
||||
@ -308,6 +327,131 @@ implementation
|
||||
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);
|
||||
var
|
||||
l : asizeint;
|
||||
|
||||
@ -114,9 +114,6 @@ interface
|
||||
rough estimation how large the tree "node" is }
|
||||
function node_count(node : tnode) : dword;
|
||||
|
||||
{ trashes the given temp. node }
|
||||
function trash_tempref(node : tnode) : tnode;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -1135,32 +1132,4 @@ implementation
|
||||
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.
|
||||
|
||||
@ -361,10 +361,6 @@ implementation
|
||||
finish_parentfpstruct(current_procinfo.procdef);
|
||||
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;
|
||||
|
||||
|
||||
@ -1074,6 +1070,13 @@ implementation
|
||||
current_filepos:=entrypos;
|
||||
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? }
|
||||
if (cs_opt_autoinline in current_settings.optimizerswitches) and
|
||||
|
||||
@ -37,7 +37,7 @@ Procedure fpc_freemem(p:pointer);compilerproc;
|
||||
|
||||
{ used by Default() in code blocks }
|
||||
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_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
|
||||
|
||||
@ -287,7 +287,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure fpc_fillmem(var data;len:ptruint;b : byte);
|
||||
procedure fpc_fillmem(out data;len:ptruint;b : byte);
|
||||
begin
|
||||
FillByte(data,len,b);
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user