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

* symtable allocation rewritten

Browse Source 
* loading of parameters to local temps/regs cleanup
  * regvar support for parameters
  * regvar support for staticsymtable (main body)
This commit is contained in:
peter 2004-10-10 20:22:53 +00:00
parent 0573c742e4
commit b0c25b50a0
7 changed files with 386 additions and 348 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

123
compiler/cgobj.pas
View File

@ -189,11 +189,6 @@ unit cgobj;
second the destination second the destination
} }
{ Copy a parameter to a (temporary) reference }
procedure a_loadany_param_ref(list : taasmoutput;const paraloc : TCGPara;const ref:treference;shuffle : pmmshuffle);virtual;
{ Copy a parameter to a register }
procedure a_loadany_param_reg(list : taasmoutput;const paraloc : TCGPara;const reg:tregister;shuffle : pmmshuffle);virtual;
{# Emits instruction to call the method specified by symbol name. {# Emits instruction to call the method specified by symbol name.
This routine must be overriden for each new target cpu. This routine must be overriden for each new target cpu.
@ -838,116 +833,6 @@ implementation
end; end;
procedure tcg.a_loadany_param_ref(list : taasmoutput;const paraloc : TCGPara;const ref:treference;shuffle : pmmshuffle);
procedure gen_load(paraloc:TCGParaLocation;const ref:treference);
var
href : treference;
begin
case paraloc.loc of
LOC_CREGISTER,
LOC_REGISTER:
begin
if getsupreg(paraloc.register)<first_int_imreg then
begin
getcpuregister(list,paraloc.register);
ungetcpuregister(list,paraloc.register);
end;
a_load_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref);
end;
LOC_MMREGISTER,
LOC_CMMREGISTER:
begin
if getsupreg(paraloc.register)<first_mm_imreg then
begin
getcpuregister(list,paraloc.register);
ungetcpuregister(list,paraloc.register);
end;
a_loadmm_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref,shuffle);
end;
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
begin
if getsupreg(paraloc.register)<first_fpu_imreg then
begin
getcpuregister(list,paraloc.register);
ungetcpuregister(list,paraloc.register);
end;
a_loadfpu_reg_ref(list,paraloc.size,paraloc.register,ref);
end;
LOC_REFERENCE:
begin
reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset);
{ use concatcopy, because it can also be a float which fails when
load_ref_ref is used }
g_concatcopy(list,href,ref,tcgsize2size[paraloc.size],false);
end;
else
internalerror(2002081302);
end;
end;
var
href : treference;
begin
href:=ref;
gen_load(paraloc.location^,href);
if assigned(paraloc.location^.next) then
begin
inc(href.offset,TCGSize2Size[paraloc.location^.size]);
gen_load(paraloc.location^.next^,href);
end;
end;
procedure tcg.a_loadany_param_reg(list : taasmoutput;const paraloc : TCGPara;const reg:tregister;shuffle : pmmshuffle);
var
href : treference;
begin
paraloc.check_simple_location;
case paraloc.location^.loc of
LOC_CREGISTER,
LOC_REGISTER:
begin
if getsupreg(paraloc.location^.register)<first_int_imreg then
begin
getcpuregister(list,paraloc.location^.register);
ungetcpuregister(list,paraloc.location^.register);
end;
a_load_reg_reg(list,paraloc.location^.size,paraloc.location^.size,paraloc.location^.register,reg)
end;
LOC_CFPUREGISTER,
LOC_FPUREGISTER:
begin
if getsupreg(paraloc.location^.register)<first_fpu_imreg then
begin
getcpuregister(list,paraloc.location^.register);
ungetcpuregister(list,paraloc.location^.register);
end;
a_loadfpu_reg_reg(list,paraloc.location^.size,paraloc.location^.register,reg);
end;
LOC_MMREGISTER,
LOC_CMMREGISTER:
begin
if getsupreg(paraloc.location^.register)<first_mm_imreg then
begin
getcpuregister(list,paraloc.location^.register);
ungetcpuregister(list,paraloc.location^.register);
end;
a_loadmm_reg_reg(list,paraloc.location^.size,paraloc.location^.size,paraloc.location^.register,reg,shuffle);
end;
LOC_REFERENCE,
LOC_CREFERENCE:
begin
reference_reset_base(href,paraloc.location^.reference.index,paraloc.location^.reference.offset);
a_load_ref_reg(list,paraloc.location^.size,paraloc.location^.size,href,reg);
end;
else
internalerror(2003053010);
end
end;
{**************************************************************************** {****************************************************************************
some generic implementations some generic implementations
****************************************************************************} ****************************************************************************}
@ -2226,7 +2111,13 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.174 2004-10-05 20:41:01 peter Revision 1.175 2004-10-10 20:22:53 peter
* symtable allocation rewritten
* loading of parameters to local temps/regs cleanup
* regvar support for parameters
* regvar support for staticsymtable (main body)
Revision 1.174 2004/10/05 20:41:01 peter
* more spilling rewrites * more spilling rewrites
Revision 1.173 2004/09/29 18:55:40 florian Revision 1.173 2004/09/29 18:55:40 florian

36
compiler/ncal.pas
View File

@ -549,18 +549,24 @@ type
valid_for_var(left); valid_for_var(left);
end; end;
if paraitem.paratyp in [vs_var,vs_const] then if paraitem.paratyp = vs_var then
begin set_unique(left);
{ Causes problems with const ansistrings if also }
{ done for vs_const (JM) }
if paraitem.paratyp = vs_var then
set_unique(left);
make_not_regable(left);
end;
{ ansistrings out paramaters doesn't need to be } { When the address needs to be pushed then the register is
{ unique, they are finalized } not regable. Exception is when the location is also a var
if paraitem.paratyp=vs_out then parameter and we can pass the address transparently }
if (
not(
paraitem.is_hidden and
(left.resulttype.def.deftype in [pointerdef,classrefdef])
) and
paramanager.push_addr_param(paraitem.paratyp,paraitem.paratype.def,
aktcallnode.procdefinition.proccalloption) and
not(
(left.nodetype=loadn) and
(tloadnode(left).is_addr_param_load)
)
) then
make_not_regable(left); make_not_regable(left);
if do_count then if do_count then
@ -2386,7 +2392,13 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.249 2004-10-08 17:09:43 peter Revision 1.250 2004-10-10 20:22:53 peter
* symtable allocation rewritten
* loading of parameters to local temps/regs cleanup
* regvar support for parameters
* regvar support for staticsymtable (main body)
Revision 1.249 2004/10/08 17:09:43 peter
* tvarsym.varregable added, split vo_regable from varoptions * tvarsym.varregable added, split vo_regable from varoptions
Revision 1.248 2004/09/21 17:25:12 peter Revision 1.248 2004/09/21 17:25:12 peter

501
compiler/ncgutil.pas
View File

@ -98,12 +98,10 @@ interface
procedure insertconstdata(sym : ttypedconstsym); procedure insertconstdata(sym : ttypedconstsym);
procedure insertbssdata(sym : tvarsym); procedure insertbssdata(sym : tvarsym);
procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable); procedure gen_alloc_symtable(list:TAAsmoutput;st:tsymtable);
procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable); procedure gen_free_symtable(list:TAAsmoutput;st:tsymtable);
procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
procedure gen_alloc_inline_parast(list:TAAsmoutput;pd:tprocdef); procedure gen_alloc_inline_parast(list:TAAsmoutput;pd:tprocdef);
procedure gen_alloc_inline_funcret(list:TAAsmoutput;pd:tprocdef); procedure gen_alloc_inline_funcret(list:TAAsmoutput;pd:tprocdef);
procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
{ rtti and init/final } { rtti and init/final }
procedure generate_rtti(p:Ttypesym); procedure generate_rtti(p:Ttypesym);
@ -1079,7 +1077,7 @@ implementation
begin begin
cg.getcpuregister(list,resloc.registerlow); cg.getcpuregister(list,resloc.registerlow);
cg.ungetcpuregister(list,resloc.registerlow); cg.ungetcpuregister(list,resloc.registerlow);
// for the optimizer { for the optimizer }
cg.a_reg_alloc(list,resloc.registerlow); cg.a_reg_alloc(list,resloc.registerlow);
end; end;
case restmploc.loc of case restmploc.loc of
@ -1099,7 +1097,7 @@ implementation
begin begin
cg.getcpuregister(list,resloc.registerhigh); cg.getcpuregister(list,resloc.registerhigh);
cg.ungetcpuregister(list,resloc.registerhigh); cg.ungetcpuregister(list,resloc.registerhigh);
// for the optimizer { for the optimizer }
cg.a_reg_alloc(list,resloc.registerhigh); cg.a_reg_alloc(list,resloc.registerhigh);
end; end;
case restmploc.loc of case restmploc.loc of
@ -1124,7 +1122,7 @@ implementation
begin begin
cg.getcpuregister(list,funcretloc^.register); cg.getcpuregister(list,funcretloc^.register);
cg.ungetcpuregister(list,hreg); cg.ungetcpuregister(list,hreg);
// for the optimizer { for the optimizer }
cg.a_reg_alloc(list,funcretloc^.register); cg.a_reg_alloc(list,funcretloc^.register);
end; end;
cg.a_load_loc_reg(list,restmploc.size,restmploc,hreg); cg.a_load_loc_reg(list,restmploc.size,restmploc,hreg);
@ -1159,70 +1157,176 @@ implementation
procedure gen_load_para_value(list:TAAsmoutput); procedure gen_load_para_value(list:TAAsmoutput);
var
hp : tparaitem;
hiparaloc, procedure get_para(const paraloc:TCGParaLocation);
paraloc : pcgparalocation; begin
begin case paraloc.loc of
{ Store register parameters in reference or in register variable } LOC_REGISTER :
if assigned(current_procinfo.procdef.parast) and begin
not (po_assembler in current_procinfo.procdef.procoptions) then if getsupreg(paraloc.register)<first_int_imreg then
begin cg.getcpuregister(list,paraloc.register);
{ move register parameters which aren't regable into memory }
{ we do this before init_paras because that one calls routines which may overwrite these }
{ registers and it also expects the values to be in memory }
hp:=tparaitem(current_procinfo.procdef.para.first);
while assigned(hp) do
begin
paraloc:=hp.paraloc[calleeside].location;
if not assigned(paraloc) then
internalerror(200408203);
hiparaloc:=paraloc^.next;
case tvarsym(hp.parasym).localloc.loc of
LOC_REGISTER,
LOC_MMREGISTER,
LOC_FPUREGISTER:
begin
{ cg.a_load_param_reg will first allocate and then deallocate paraloc }
{ register (if the parameter resides in a register) and then allocate }
{ the regvar (which is currently not allocated) }
cg.a_loadany_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register,mms_movescalar);
end;
LOC_REFERENCE :
begin
if paraloc^.loc<>LOC_REFERENCE then
begin
if getregtype(paraloc^.register)=R_INTREGISTER then
begin
{ Release parameter register }
if getsupreg(paraloc^.register)<first_int_imreg then
begin
{$ifndef cpu64bit}
if assigned(hiparaloc) then
begin
cg.getcpuregister(list,hiparaloc^.register);
cg.ungetcpuregister(list,hiparaloc^.register);
end;
{$endif cpu64bit}
cg.getcpuregister(list,paraloc^.register);
cg.ungetcpuregister(list,paraloc^.register);
end;
end;
cg.a_loadany_param_ref(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.reference,mms_movescalar);
end;
end;
else
internalerror(200309185);
end; end;
hp:=tparaitem(hp.next); LOC_MMREGISTER :
begin
if getsupreg(paraloc.register)<first_mm_imreg then
cg.getcpuregister(list,paraloc.register);
end;
LOC_FPUREGISTER :
begin
if getsupreg(paraloc.register)<first_fpu_imreg then
cg.getcpuregister(list,paraloc.register);
end;
end;
end;
procedure unget_para(const paraloc:TCGParaLocation);
begin
case paraloc.loc of
LOC_REGISTER :
begin
if getsupreg(paraloc.register)<first_int_imreg then
cg.ungetcpuregister(list,paraloc.register);
end;
LOC_MMREGISTER :
begin
if getsupreg(paraloc.register)<first_mm_imreg then
cg.ungetcpuregister(list,paraloc.register);
end;
LOC_FPUREGISTER :
begin
if getsupreg(paraloc.register)<first_fpu_imreg then
cg.ungetcpuregister(list,paraloc.register);
end;
end;
end;
procedure gen_load_ref(const paraloc:TCGParaLocation;const ref:treference);
var
href : treference;
begin
case paraloc.loc of
LOC_REGISTER :
cg.a_load_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref);
LOC_MMREGISTER :
cg.a_loadmm_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref,mms_movescalar);
LOC_FPUREGISTER :
cg.a_loadfpu_reg_ref(list,paraloc.size,paraloc.register,ref);
LOC_REFERENCE :
begin
reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset);
{ use concatcopy, because it can also be a float which fails when
load_ref_ref is used. Don't copy data when the references are equal }
if not((href.base=ref.base) and (href.offset=ref.offset)) then
cg.g_concatcopy(list,href,ref,tcgsize2size[paraloc.size],false);
end;
else
internalerror(2002081302);
end;
end;
procedure gen_load_reg(const paraloc:TCGParaLocation;reg:tregister);
var
href : treference;
begin
case paraloc.loc of
LOC_REGISTER :
cg.a_load_reg_reg(list,paraloc.size,paraloc.size,paraloc.register,reg);
LOC_MMREGISTER :
cg.a_loadmm_reg_reg(list,paraloc.size,paraloc.size,paraloc.register,reg,mms_movescalar);
LOC_FPUREGISTER :
cg.a_loadfpu_reg_reg(list,paraloc.size,paraloc.register,reg);
LOC_REFERENCE :
begin
reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset);
cg.a_load_ref_reg(list,paraloc.size,paraloc.size,href,reg);
end;
else
internalerror(2002081302);
end;
end;
var
hp : tparaitem;
paraloc : pcgparalocation;
href : treference;
begin
if (po_assembler in current_procinfo.procdef.procoptions) then
exit;
{ Allocate registers used by parameters }
hp:=tparaitem(current_procinfo.procdef.para.first);
while assigned(hp) do
begin
paraloc:=hp.paraloc[calleeside].location;
while assigned(paraloc) do
begin
if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then
get_para(paraloc^);
paraloc:=paraloc^.next;
end; end;
hp:=tparaitem(hp.next);
end;
{ Copy parameters to local references/registers }
hp:=tparaitem(current_procinfo.procdef.para.first);
while assigned(hp) do
begin
paraloc:=hp.paraloc[calleeside].location;
if not assigned(paraloc) then
internalerror(200408203);
case tvarsym(hp.parasym).localloc.loc of
LOC_REFERENCE :
begin
href:=tvarsym(hp.parasym).localloc.reference;
while assigned(paraloc) do
begin
unget_para(paraloc^);
gen_load_ref(paraloc^,href);
inc(href.offset,TCGSize2Size[paraloc^.size]);
paraloc:=paraloc^.next;
end;
end;
LOC_CREGISTER,
LOC_CMMREGISTER,
LOC_CFPUREGISTER :
begin
href:=tvarsym(hp.parasym).localloc.reference;
{$ifndef cpu64bit}
if tvarsym(hp.parasym).localloc.size in [OS_64,OS_S64] then
begin
{ First 32bits }
unget_para(paraloc^);
if (target_info.endian=ENDIAN_BIG) then
gen_load_reg(paraloc^,tvarsym(hp.parasym).localloc.registerhigh)
else
gen_load_reg(paraloc^,tvarsym(hp.parasym).localloc.registerlow);
{ Second 32bits }
if not assigned(paraloc^.next) then
internalerror(200410104);
unget_para(paraloc^);
if (target_info.endian=ENDIAN_BIG) then
gen_load_reg(paraloc^,tvarsym(hp.parasym).localloc.registerlow)
else
gen_load_reg(paraloc^,tvarsym(hp.parasym).localloc.registerhigh);
end
else
{$endif cpu64bit}
begin
unget_para(paraloc^);
gen_load_reg(paraloc^,tvarsym(hp.parasym).localloc.register);
if assigned(paraloc^.next) then
internalerror(200410105);
end;
end;
end;
hp:=tparaitem(hp.next);
end; end;
{ generate copies of call by value parameters, must be done before { generate copies of call by value parameters, must be done before
the initialization and body is parsed because the refcounts are the initialization and body is parsed because the refcounts are
incremented using the local copies } incremented using the local copies }
if not(po_assembler in current_procinfo.procdef.procoptions) then current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
current_procinfo.procdef.parast.foreach_static({$ifndef TP}@{$endif}copyvalueparas,list);
end; end;
@ -1706,47 +1810,125 @@ implementation
end; end;
procedure gen_alloc_localst(list:TAAsmoutput;st:tlocalsymtable); procedure gen_alloc_symtable(list:TAAsmoutput;st:tsymtable);
function getregvar(v:tvarregable;size:tcgsize):tregister;
begin
case v of
vr_intreg :
result:=cg.getintregister(list,size);
vr_fpureg :
result:=cg.getfpuregister(list,size);
vr_mmreg :
result:=cg.getmmregister(list,size);
end;
end;
var var
sym : tsym; sym : tsym;
isaddr : boolean;
cgsize : tcgsize;
begin begin
sym:=tsym(st.symindex.first); sym:=tsym(st.symindex.first);
while assigned(sym) do while assigned(sym) do
begin begin
{ Only allocate space for referenced locals } if (sym.typ=varsym) then
if (sym.typ=varsym) and
(tvarsym(sym).refs>0) then
begin begin
with tvarsym(sym) do with tvarsym(sym) do
begin begin
{$ifndef OLDREGVARS} { Parameters passed to assembler procedures need to be kept
{ When there is assembler code we can't use regvars } in the original location }
if (cs_regvars in aktglobalswitches) and if (st.symtabletype=parasymtable) and
not(pi_has_assembler_block in current_procinfo.flags) and (po_assembler in current_procinfo.procdef.procoptions) then
not(pi_uses_exceptions in current_procinfo.flags) and
(varregable<>vr_none) then
begin begin
localloc.loc:=LOC_CREGISTER; paraitem.paraloc[calleeside].get_location(localloc);
localloc.size:=def_cgsize(vartype.def);
localloc.register:=cg.getintregister(list,localloc.size);
if cs_asm_source in aktglobalswitches then
begin
if (cs_no_regalloc in aktglobalswitches) then
list.concat(Tai_comment.Create(strpnew('Local '+realname+' located in register '+
std_regname(localloc.register))))
else
list.concat(Tai_comment.Create(strpnew('Local '+realname+' located in register')));
end;
end end
else else
{$endif NOT OLDREGVARS}
begin begin
localloc.loc:=LOC_REFERENCE; isaddr:=(st.symtabletype=parasymtable) and
localloc.size:=def_cgsize(vartype.def); paramanager.push_addr_param(varspez,vartype.def,current_procinfo.procdef.proccalloption);
tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference); if isaddr then
if cs_asm_source in aktglobalswitches then cgsize:=OS_ADDR
list.concat(Tai_comment.Create(strpnew('Local '+realname+' located at '+ else
std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset)))); cgsize:=def_cgsize(vartype.def);
{$ifndef OLDREGVARS}
{ When there is assembler code we can't use regvars }
if (cs_regvars in aktglobalswitches) and
not(pi_has_assembler_block in current_procinfo.flags) and
not(pi_uses_exceptions in current_procinfo.flags) and
(varregable<>vr_none) then
begin
localloc.loc:=LOC_CREGISTER;
localloc.size:=cgsize;
{$ifndef cpu64bit}
if cgsize in [OS_64,OS_S64] then
begin
localloc.registerlow:=getregvar(varregable,OS_32);
localloc.registerhigh:=getregvar(varregable,OS_32);
end
else
{$endif cpu64bit}
localloc.register:=getregvar(varregable,cgsize);
end
else
{$endif NOT OLDREGVARS}
begin
localloc.loc:=LOC_REFERENCE;
localloc.size:=cgsize;
case st.symtabletype of
parasymtable :
begin
{ Reuse the parameter location for values to are at a single location on the stack }
if (paraitem.paraloc[calleeside].is_simple_reference) then
begin
reference_reset_base(localloc.reference,paraitem.paraloc[calleeside].location^.reference.index,
paraitem.paraloc[calleeside].location^.reference.offset);
end
else
begin
if isaddr then
tg.GetLocal(list,sizeof(aint),voidpointertype.def,localloc.reference)
else
tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference);
end;
end;
localsymtable,
stt_exceptsymtable :
begin
tg.GetLocal(list,getvaluesize,vartype.def,localloc.reference);
end;
staticsymtable :
begin
{ PIC, DLL and Threadvar need extra code and are handled in ncgld }
if not(cs_create_pic in aktmoduleswitches) and
not(vo_is_dll_var in varoptions) and
not(vo_is_thread_var in varoptions) then
reference_reset_symbol(localloc.reference,objectlibrary.newasmsymbol(mangledname,AB_EXTERNAL,AT_DATA),0);
end;
else
internalerror(200410103);
end;
end;
end;
if cs_asm_source in aktglobalswitches then
begin
case localloc.loc of
LOC_REGISTER,
LOC_CREGISTER :
begin
if (cs_no_regalloc in aktglobalswitches) then
list.concat(Tai_comment.Create(strpnew('Var '+realname+' located in register '+
std_regname(localloc.register))))
else
list.concat(Tai_comment.Create(strpnew('Var '+realname+' located in register')));
end;
LOC_REFERENCE :
begin
if not assigned(localloc.reference.symbol) then
list.concat(Tai_comment.Create(strpnew('Var '+realname+' located at '+
std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
end;
end;
end; end;
end; end;
end; end;
@ -1755,15 +1937,14 @@ implementation
end; end;
procedure gen_free_localst(list:TAAsmoutput;st:tlocalsymtable); procedure gen_free_symtable(list:TAAsmoutput;st:tsymtable);
var var
sym : tsym; sym : tsym;
begin begin
sym:=tsym(st.symindex.first); sym:=tsym(st.symindex.first);
while assigned(sym) do while assigned(sym) do
begin begin
if (sym.typ=varsym) and if (sym.typ=varsym) then
(tvarsym(sym).refs>0) then
begin begin
with tvarsym(sym) do with tvarsym(sym) do
begin begin
@ -1774,92 +1955,15 @@ implementation
LOC_CREGISTER : LOC_CREGISTER :
cg.a_reg_sync(list,localloc.register); cg.a_reg_sync(list,localloc.register);
LOC_REFERENCE : LOC_REFERENCE :
tg.Ungetlocal(list,localloc.reference); begin
end; case st.symtabletype of
end; localsymtable,
end; parasymtable,
sym:=tsym(sym.indexnext); stt_exceptsymtable :
end; tg.Ungetlocal(list,localloc.reference);
end;
procedure gen_alloc_parast(list:TAAsmoutput;st:tparasymtable);
var
sym : tsym;
begin
sym:=tsym(st.symindex.first);
while assigned(sym) do
begin
if sym.typ=varsym then
begin
with tvarsym(sym) do
begin
if not(po_assembler in current_procinfo.procdef.procoptions) then
begin
case paraitem.paraloc[calleeside].location^.loc of
{$ifdef powerpc}
LOC_REFERENCE,
{$endif powerpc}
LOC_MMREGISTER,
LOC_FPUREGISTER,
LOC_REGISTER:
begin
(*
if paraitem.paraloc[calleeside].register=NR_NO then
begin
paraitem.paraloc[calleeside].loc:=LOC_REGISTER;
paraitem.paraloc[calleeside].size:=paraitem.paraloc[calleeside].size;
{$ifndef cpu64bit}
if paraitem.paraloc[calleeside].size in [OS_64,OS_S64] then
begin
paraitem.paraloc[calleeside].registerlow:=cg.getregisterint(list,OS_32);
paraitem.paraloc[calleeside].registerhigh:=cg.getregisterint(list,OS_32);
end
else
{$endif cpu64bit}
paraitem.paraloc[calleeside].register:=cg.getregisterint(list,localloc.size);
end;
*)
(*
{$warning TODO Allocate register paras}
localloc.loc:=LOC_REGISTER;
localloc.size:=paraitem.paraloc[calleeside].size;
{$ifndef cpu64bit}
if localloc.size in [OS_64,OS_S64] then
begin
localloc.registerlow:=cg.getregisterint(list,OS_32);
localloc.registerhigh:=cg.getregisterint(list,OS_32);
end
else
{$endif cpu64bit}
localloc.register:=cg.getregisterint(list,localloc.size);
*)
localloc.loc:=LOC_REFERENCE;
if paramanager.push_addr_param(paraitem.paratyp,vartype.def,current_procinfo.procdef.proccalloption) then
begin
localloc.size:=OS_ADDR;
tg.GetLocal(list,tcgsize2size[localloc.size],voidpointertype.def,localloc.reference);
end
else
begin
localloc.size:=paraitem.paraloc[calleeside].size;
tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
end;
end;
else
paraitem.paraloc[calleeside].get_location(localloc);
end;
end
else
paraitem.paraloc[calleeside].get_location(localloc);
if cs_asm_source in aktglobalswitches then
case localloc.loc of
LOC_REFERENCE :
begin
list.concat(Tai_comment.Create(strpnew('Para '+realname+' located at '+
std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset))));
end; end;
end; end;
end;
end; end;
end; end;
sym:=tsym(sym.indexnext); sym:=tsym(sym.indexnext);
@ -1997,33 +2101,6 @@ implementation
end; end;
procedure gen_free_parast(list:TAAsmoutput;st:tparasymtable);
var
sym : tsym;
begin
sym:=tsym(st.symindex.first);
while assigned(sym) do
begin
if sym.typ=varsym then
begin
with tvarsym(sym) do
begin
{ Note: We need to keep the data available in memory
for the sub procedures that can access local data
in the parent procedures }
case localloc.loc of
LOC_REGISTER :
cg.a_reg_sync(list,localloc.register);
LOC_REFERENCE :
tg.UngetLocal(list,localloc.reference);
end;
end;
end;
sym:=tsym(sym.indexnext);
end;
end;
{ persistent rtti generation } { persistent rtti generation }
procedure generate_rtti(p:Ttypesym); procedure generate_rtti(p:Ttypesym);
var var
@ -2098,7 +2175,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.222 2004-10-09 10:51:13 olle Revision 1.223 2004-10-10 20:22:53 peter
* symtable allocation rewritten
* loading of parameters to local temps/regs cleanup
* regvar support for parameters
* regvar support for staticsymtable (main body)
Revision 1.222 2004/10/09 10:51:13 olle
* Refs to DEBUGINFO_<x> is now not inserted for target MacOS * Refs to DEBUGINFO_<x> is now not inserted for target MacOS
Revision 1.221 2004/10/08 20:52:07 florian Revision 1.221 2004/10/08 20:52:07 florian

19
compiler/nld.pas
View File

@ -47,6 +47,7 @@ interface
procedure buildderefimpl;override; procedure buildderefimpl;override;
procedure derefimpl;override; procedure derefimpl;override;
procedure set_mp(p:tnode); procedure set_mp(p:tnode);
function is_addr_param_load:boolean;
function getcopy : tnode;override; function getcopy : tnode;override;
function pass_1 : tnode;override; function pass_1 : tnode;override;
function det_resulttype:tnode;override; function det_resulttype:tnode;override;
@ -227,6 +228,16 @@ implementation
end; end;
function tloadnode.is_addr_param_load:boolean;
begin
result:=(symtable.symtabletype=parasymtable) and
(symtableentry.typ=varsym) and
not(vo_has_local_copy in tvarsym(symtableentry).varoptions) and
not(nf_load_self_pointer in flags) and
paramanager.push_addr_param(tvarsym(symtableentry).varspez,tvarsym(symtableentry).vartype.def,tprocdef(symtable.defowner).proccalloption);
end;
function tloadnode.det_resulttype:tnode; function tloadnode.det_resulttype:tnode;
begin begin
result:=nil; result:=nil;
@ -1145,7 +1156,13 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.131 2004-10-08 17:09:43 peter Revision 1.132 2004-10-10 20:22:53 peter
* symtable allocation rewritten
* loading of parameters to local temps/regs cleanup
* regvar support for parameters
* regvar support for staticsymtable (main body)
Revision 1.131 2004/10/08 17:09:43 peter
* tvarsym.varregable added, split vo_regable from varoptions * tvarsym.varregable added, split vo_regable from varoptions
Revision 1.130 2004/10/06 19:26:50 jonas Revision 1.130 2004/10/06 19:26:50 jonas

23
compiler/parabase.pas
View File

@ -57,6 +57,7 @@ unit parabase;
destructor done; destructor done;
procedure reset; procedure reset;
procedure check_simple_location; procedure check_simple_location;
function is_simple_reference:boolean;
function add_location:pcgparalocation; function add_location:pcgparalocation;
procedure get_location(var newloc:tlocation); procedure get_location(var newloc:tlocation);
end; end;
@ -145,6 +146,20 @@ implementation
end; end;
function tcgpara.is_simple_reference:boolean;
begin
if not assigned(location) then
internalerror(200410102);
{$ifdef powerpc}
{ Powerpc always needs a copy in a local temp }
result:=false;
{$else}
result:=not assigned(location^.next) and
(location^.loc=LOC_REFERENCE);
{$endif}
end;
procedure tcgpara.get_location(var newloc:tlocation); procedure tcgpara.get_location(var newloc:tlocation);
begin begin
if not assigned(location) then if not assigned(location) then
@ -192,7 +207,13 @@ end.
{ {
$Log$ $Log$
Revision 1.2 2004-09-21 17:25:12 peter Revision 1.3 2004-10-10 20:22:53 peter
* symtable allocation rewritten
* loading of parameters to local temps/regs cleanup
* regvar support for parameters
* regvar support for staticsymtable (main body)
Revision 1.2 2004/09/21 17:25:12 peter
* paraloc branch merged * paraloc branch merged
Revision 1.1.2.2 2004/09/14 19:09:37 jonas Revision 1.1.2.2 2004/09/14 19:09:37 jonas

18
compiler/psub.pas
View File

@ -678,9 +678,8 @@ implementation
{ Allocate space in temp/registers for parast and localst } { Allocate space in temp/registers for parast and localst }
aktfilepos:=entrypos; aktfilepos:=entrypos;
gen_alloc_parast(aktproccode,tparasymtable(procdef.parast)); gen_alloc_symtable(aktproccode,tparasymtable(procdef.parast));
if procdef.localst.symtabletype=localsymtable then gen_alloc_symtable(aktproccode,tlocalsymtable(procdef.localst));
gen_alloc_localst(aktproccode,tlocalsymtable(procdef.localst));
{ Store temp offset for information about 'real' temps } { Store temp offset for information about 'real' temps }
tempstart:=tg.lasttemp; tempstart:=tg.lasttemp;
@ -774,9 +773,8 @@ implementation
{ Free space in temp/registers for parast and localst, must be { Free space in temp/registers for parast and localst, must be
done after gen_entry_code } done after gen_entry_code }
aktfilepos:=exitpos; aktfilepos:=exitpos;
if procdef.localst.symtabletype=localsymtable then gen_free_symtable(aktproccode,tlocalsymtable(procdef.localst));
gen_free_localst(aktproccode,tlocalsymtable(procdef.localst)); gen_free_symtable(aktproccode,tparasymtable(procdef.parast));
gen_free_parast(aktproccode,tparasymtable(procdef.parast));
{ The procedure body is finished, we can now { The procedure body is finished, we can now
allocate the registers } allocate the registers }
@ -1393,7 +1391,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.207 2004-09-26 17:45:30 peter Revision 1.208 2004-10-10 20:22:53 peter
* symtable allocation rewritten
* loading of parameters to local temps/regs cleanup
* regvar support for parameters
* regvar support for staticsymtable (main body)
Revision 1.207 2004/09/26 17:45:30 peter
* simple regvar support, not yet finished * simple regvar support, not yet finished
Revision 1.206 2004/09/21 17:25:12 peter Revision 1.206 2004/09/21 17:25:12 peter

14
compiler/symsym.pas
View File

@ -1627,7 +1627,11 @@ implementation
_vartype := newtype; _vartype := newtype;
{ can we load the value into a register ? } { can we load the value into a register ? }
if not assigned(owner) or if not assigned(owner) or
(owner.symtabletype in [localsymtable,parasymtable]) then (owner.symtabletype in [localsymtable,parasymtable]) or
(
(owner.symtabletype=staticsymtable) and
not(cs_create_pic in aktmoduleswitches)
) then
begin begin
if tstoreddef(vartype.def).is_intregable then if tstoreddef(vartype.def).is_intregable then
varregable:=vr_intreg varregable:=vr_intreg
@ -2218,7 +2222,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.181 2004-10-10 09:31:28 peter Revision 1.182 2004-10-10 20:22:53 peter
* symtable allocation rewritten
* loading of parameters to local temps/regs cleanup
* regvar support for parameters
* regvar support for staticsymtable (main body)
Revision 1.181 2004/10/10 09:31:28 peter
regvar ppu writing doesn't affect any crc regvar ppu writing doesn't affect any crc
Revision 1.180 2004/10/08 17:09:43 peter Revision 1.180 2004/10/08 17:09:43 peter