paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-06 11:47:19 +01:00
Code Issues Packages Projects Releases Wiki Activity

* never remove regvar-ability of parameters passed by reference

Browse Source 
(previously worked only for var/out, now also for const and
     is more generic)

git-svn-id: trunk@3554 -
This commit is contained in:
Jonas Maebe 2006-05-17 13:38:02 +00:00
parent 0bd371bf9d
commit e0250bcdb4
8 changed files with 37 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/htypechk.pas
View File

@ -124,7 +124,7 @@ interface
function isbinaryoverloaded(var t : tnode) : boolean; function isbinaryoverloaded(var t : tnode) : boolean;
{ Register Allocation } { Register Allocation }
procedure make_not_regable(p : tnode); procedure make_not_regable(p : tnode; how: tvarregable);
procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word); procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);
{ procvar handling } { procvar handling }
@ -641,18 +641,18 @@ implementation
****************************************************************************} ****************************************************************************}
{ marks an lvalue as "unregable" } { marks an lvalue as "unregable" }
procedure make_not_regable(p : tnode); procedure make_not_regable(p : tnode; how: tvarregable);
begin begin
case p.nodetype of case p.nodetype of
typeconvn : typeconvn :
make_not_regable(ttypeconvnode(p).left); make_not_regable(ttypeconvnode(p).left,how);
loadn : loadn :
if (tloadnode(p).symtableentry.typ in [globalvarsym,localvarsym]) or if (tloadnode(p).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) and
((tloadnode(p).symtableentry.typ = paravarsym) and (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) then
{ not a nested variable } if (tloadnode(p).symtableentry.typ = paravarsym) then
(assigned(tloadnode(p).left) or tabstractvarsym(tloadnode(p).symtableentry).varregable:=how
not(tparavarsym(tloadnode(p).symtableentry).varspez in [vs_var,vs_out]))) then else
tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none; tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
end; end;
end; end;
@ -1009,7 +1009,7 @@ implementation
be in a register } be in a register }
if (m_tp7 in aktmodeswitches) or if (m_tp7 in aktmodeswitches) or
(todef.size<fromdef.size) then (todef.size<fromdef.size) then
make_not_regable(hp) make_not_regable(hp,vr_addr)
else else
if report_errors then if report_errors then
CGMessagePos2(hp.fileinfo,type_e_typecast_wrong_size_for_assignment,tostr(fromdef.size),tostr(todef.size)); CGMessagePos2(hp.fileinfo,type_e_typecast_wrong_size_for_assignment,tostr(fromdef.size),tostr(todef.size));

12
compiler/ncal.pas
View File

@ -699,7 +699,7 @@ type
(tloadnode(left).is_addr_param_load) (tloadnode(left).is_addr_param_load)
) )
) then ) then
make_not_regable(left); make_not_regable(left,vr_addr);
if do_count then if do_count then
begin begin
@ -2068,7 +2068,7 @@ type
end end
else else
begin begin
tempnode := ctempcreatenode.create(tabstractvarsym(p).vartype,tabstractvarsym(p).vartype.def.size,tt_persistent,tabstractvarsym(p).varregable<>vr_none); tempnode := ctempcreatenode.create(tabstractvarsym(p).vartype,tabstractvarsym(p).vartype.def.size,tt_persistent,not(tabstractvarsym(p).varregable in [vr_none,vr_addr]));
addstatement(tempinfo^.createstatement,tempnode); addstatement(tempinfo^.createstatement,tempnode);
if assigned(tlocalvarsym(p).defaultconstsym) then if assigned(tlocalvarsym(p).defaultconstsym) then
begin begin
@ -2141,7 +2141,7 @@ type
{ contents to that temp and then substitute the paramter } { contents to that temp and then substitute the paramter }
{ with the temp everywhere in the function } { with the temp everywhere in the function }
if if
((tparavarsym(para.parasym).varregable = vr_none) and ((tparavarsym(para.parasym).varregable in [vr_none,vr_addr]) and
not(para.left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE])) or not(para.left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE])) or
{ we can't assign to formaldef temps } { we can't assign to formaldef temps }
((para.parasym.vartype.def.deftype<>formaldef) and ((para.parasym.vartype.def.deftype<>formaldef) and
@ -2205,9 +2205,7 @@ type
) )
) then ) then
begin begin
{ in theory, this is always regable, but ncgcall can't } tempnode := ctempcreatenode.create(para.parasym.vartype,para.parasym.vartype.def.size,tt_persistent,not(tparavarsym(para.parasym).varregable in [vr_none,vr_addr]));
{ handle it yet in all situations (JM) }
tempnode := ctempcreatenode.create(para.parasym.vartype,para.parasym.vartype.def.size,tt_persistent,tparavarsym(para.parasym).varregable <> vr_none);
addstatement(createstatement,tempnode); addstatement(createstatement,tempnode);
{ assign the value of the parameter to the temp, except in case of the function result } { assign the value of the parameter to the temp, except in case of the function result }
{ (in that case, para.left is a block containing the creation of a new temp, while we } { (in that case, para.left is a block containing the creation of a new temp, while we }
@ -2235,7 +2233,7 @@ type
{ temp } { temp }
else if (paracomplexity > 1) then else if (paracomplexity > 1) then
begin begin
tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent,tparavarsym(para.parasym).varregable<>vr_none); tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent,not(tparavarsym(para.parasym).varregable in [vr_none,vr_addr]));
addstatement(createstatement,tempnode); addstatement(createstatement,tempnode);
addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode), addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
caddrnode.create_internal(para.left))); caddrnode.create_internal(para.left)));

5
compiler/ncgutil.pas
View File

@ -2008,7 +2008,8 @@ implementation
begin begin
localloc.size:=cgsize; localloc.size:=cgsize;
case varregable of case varregable of
vr_intreg : vr_intreg,
vr_addr :
begin begin
localloc.loc:=LOC_CREGISTER; localloc.loc:=LOC_CREGISTER;
end; end;
@ -2057,7 +2058,7 @@ implementation
cgsize:=def_cgsize(vartype.def); cgsize:=def_cgsize(vartype.def);
{$ifndef OLDREGVARS} {$ifndef OLDREGVARS}
{ When there is assembler code we can't use regvars } { When there is assembler code we can't use regvars }
if is_regvar then if is_regvar(isaddr) then
begin begin
init_regvar_loc(tabstractnormalvarsym(sym),cgsize); init_regvar_loc(tabstractnormalvarsym(sym),cgsize);
if (st.symtabletype <> parasymtable) then if (st.symtabletype <> parasymtable) then

6
compiler/ncnv.pas
View File

@ -1385,7 +1385,7 @@ implementation
convtype:=tc_equal; convtype:=tc_equal;
if not(tstoreddef(resulttype.def).is_intregable) and if not(tstoreddef(resulttype.def).is_intregable) and
not(tstoreddef(resulttype.def).is_fpuregable) then not(tstoreddef(resulttype.def).is_fpuregable) then
make_not_regable(left); make_not_regable(left,vr_addr);
exit; exit;
end; end;
@ -1561,7 +1561,7 @@ implementation
not(tstoreddef(resulttype.def).is_fpuregable)) or not(tstoreddef(resulttype.def).is_fpuregable)) or
((left.resulttype.def.deftype = floatdef) and ((left.resulttype.def.deftype = floatdef) and
(resulttype.def.deftype <> floatdef)) then (resulttype.def.deftype <> floatdef)) then
make_not_regable(left); make_not_regable(left,vr_addr);
{ class/interface to class/interface, with checkobject support } { class/interface to class/interface, with checkobject support }
if is_class_or_interface(resulttype.def) and if is_class_or_interface(resulttype.def) and
@ -2320,7 +2320,7 @@ implementation
{ When using only a part of the value it can't be in a register since { When using only a part of the value it can't be in a register since
that will load the value in a new register first } that will load the value in a new register first }
if (resulttype.def.size<left.resulttype.def.size) then if (resulttype.def.size<left.resulttype.def.size) then
make_not_regable(left); make_not_regable(left,vr_addr);
end; end;

9
compiler/nld.pas
View File

@ -267,7 +267,7 @@ implementation
{ we can't inline the referenced parent procedure } { we can't inline the referenced parent procedure }
exclude(tprocdef(symtable.defowner).procoptions,po_inline); exclude(tprocdef(symtable.defowner).procoptions,po_inline);
{ reference in nested procedures, variable needs to be in memory } { reference in nested procedures, variable needs to be in memory }
make_not_regable(self); make_not_regable(self,vr_none);
end; end;
{ static variables referenced in procedures or from finalization, { static variables referenced in procedures or from finalization,
variable needs to be in memory. variable needs to be in memory.
@ -278,7 +278,7 @@ implementation
(symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or (symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or
(current_procinfo.procdef.proctypeoption=potype_unitfinalize) (current_procinfo.procdef.proctypeoption=potype_unitfinalize)
) then ) then
make_not_regable(self); make_not_regable(self,vr_none);
end; end;
{ fix self type which is declared as voidpointer in the { fix self type which is declared as voidpointer in the
definition } definition }
@ -361,10 +361,11 @@ implementation
if assigned(left) then if assigned(left) then
firstpass(left); firstpass(left);
if not is_addr_param_load and if not is_addr_param_load and
tabstractvarsym(symtableentry).is_regvar then tabstractvarsym(symtableentry).is_regvar(is_addr_param_load) then
begin begin
case tabstractvarsym(symtableentry).varregable of case tabstractvarsym(symtableentry).varregable of
vr_intreg : vr_intreg,
vr_addr :
expectloc:=LOC_CREGISTER; expectloc:=LOC_CREGISTER;
vr_fpureg : vr_fpureg :
expectloc:=LOC_CFPUREGISTER; expectloc:=LOC_CFPUREGISTER;

2
compiler/nmem.pas
View File

@ -340,7 +340,7 @@ implementation
if codegenerror then if codegenerror then
exit; exit;
make_not_regable(left); make_not_regable(left,vr_addr);
{ don't allow constants } { don't allow constants }
if is_constnode(left) then if is_constnode(left) then

5
compiler/symconst.pas
View File

@ -345,7 +345,10 @@ type
tvarregable=(vr_none, tvarregable=(vr_none,
vr_intreg, vr_intreg,
vr_fpureg, vr_fpureg,
vr_mmreg vr_mmreg,
{ does not mean "needs address register", but "if it's a parameter which is }
{ passed by reference, then its address can be put in a register }
vr_addr
); );
{ types of the symtables } { types of the symtables }

9
compiler/symsym.pas
View File

@ -145,7 +145,7 @@ interface
procedure buildderef;override; procedure buildderef;override;
procedure deref;override; procedure deref;override;
function getsize : longint; function getsize : longint;
function is_regvar:boolean; function is_regvar(refpara: boolean):boolean;
procedure trigger_notifications(what:Tnotification_flag); procedure trigger_notifications(what:Tnotification_flag);
function register_notification(flags:Tnotification_flags; function register_notification(flags:Tnotification_flags;
callback:Tnotification_callback):cardinal; callback:Tnotification_callback):cardinal;
@ -1268,7 +1268,7 @@ implementation
end; end;
function tabstractvarsym.is_regvar:boolean; function tabstractvarsym.is_regvar(refpara: boolean):boolean;
begin begin
{ Register variables are not allowed in the following cases: { Register variables are not allowed in the following cases:
- regvars are disabled - regvars are disabled
@ -1280,7 +1280,10 @@ implementation
not(pi_has_assembler_block in current_procinfo.flags) and not(pi_has_assembler_block in current_procinfo.flags) and
not(pi_uses_exceptions in current_procinfo.flags) and not(pi_uses_exceptions in current_procinfo.flags) and
not(vo_has_local_copy in varoptions) and not(vo_has_local_copy in varoptions) and
(varregable<>vr_none); ((refpara and
(varregable <> vr_none)) or
(not refpara and
not(varregable in [vr_none,vr_addr])));
end; end;