paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 09:32:01 +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;
{ Register Allocation }
procedure make_not_regable(p : tnode);
procedure make_not_regable(p : tnode; how: tvarregable);
procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);
{ procvar handling }
@ -641,18 +641,18 @@ implementation
****************************************************************************}
{ marks an lvalue as "unregable" }
procedure make_not_regable(p : tnode);
procedure make_not_regable(p : tnode; how: tvarregable);
begin
case p.nodetype of
typeconvn :
make_not_regable(ttypeconvnode(p).left);
make_not_regable(ttypeconvnode(p).left,how);
loadn :
if (tloadnode(p).symtableentry.typ in [globalvarsym,localvarsym]) or
((tloadnode(p).symtableentry.typ = paravarsym) and
{ not a nested variable }
(assigned(tloadnode(p).left) or
not(tparavarsym(tloadnode(p).symtableentry).varspez in [vs_var,vs_out]))) then
tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
if (tloadnode(p).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) and
(tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) then
if (tloadnode(p).symtableentry.typ = paravarsym) then
tabstractvarsym(tloadnode(p).symtableentry).varregable:=how
else
tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
end;
end;
@ -1009,7 +1009,7 @@ implementation
be in a register }
if (m_tp7 in aktmodeswitches) or
(todef.size<fromdef.size) then
make_not_regable(hp)
make_not_regable(hp,vr_addr)
else
if report_errors then
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)
)
) then
make_not_regable(left);
make_not_regable(left,vr_addr);
if do_count then
begin
@ -2068,7 +2068,7 @@ type
end
else
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);
if assigned(tlocalvarsym(p).defaultconstsym) then
begin
@ -2141,7 +2141,7 @@ type
{ contents to that temp and then substitute the paramter }
{ with the temp everywhere in the function }
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
{ we can't assign to formaldef temps }
((para.parasym.vartype.def.deftype<>formaldef) and
@ -2205,9 +2205,7 @@ type
)
) then
begin
{ in theory, this is always regable, but ncgcall can't }
{ 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);
tempnode := ctempcreatenode.create(para.parasym.vartype,para.parasym.vartype.def.size,tt_persistent,not(tparavarsym(para.parasym).varregable in [vr_none,vr_addr]));
addstatement(createstatement,tempnode);
{ 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 }
@ -2235,7 +2233,7 @@ type
{ temp }
else if (paracomplexity > 1) then
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,cassignmentnode.create(ctemprefnode.create(tempnode),
caddrnode.create_internal(para.left)));

5
compiler/ncgutil.pas
View File

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

6
compiler/ncnv.pas
View File

@ -1385,7 +1385,7 @@ implementation
convtype:=tc_equal;
if not(tstoreddef(resulttype.def).is_intregable) and
not(tstoreddef(resulttype.def).is_fpuregable) then
make_not_regable(left);
make_not_regable(left,vr_addr);
exit;
end;
@ -1561,7 +1561,7 @@ implementation
not(tstoreddef(resulttype.def).is_fpuregable)) or
((left.resulttype.def.deftype = floatdef) and
(resulttype.def.deftype <> floatdef)) then
make_not_regable(left);
make_not_regable(left,vr_addr);
{ class/interface to class/interface, with checkobject support }
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
that will load the value in a new register first }
if (resulttype.def.size<left.resulttype.def.size) then
make_not_regable(left);
make_not_regable(left,vr_addr);
end;

9
compiler/nld.pas
View File

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

2
compiler/nmem.pas
View File

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

5
compiler/symconst.pas
View File

@ -345,7 +345,10 @@ type
tvarregable=(vr_none,
vr_intreg,
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 }

9
compiler/symsym.pas
View File

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