paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-06 09:36:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed regvars support. Needs -doldregvars to activate. Only tested with

Browse Source 
ppc, other processors should however only require maxregvars and
    maxfpuregvars constants in cpubase.pas. Remember to take scratch-
    registers into account when defining that value.
This commit is contained in:
Jonas Maebe 2004-02-08 18:08:59 +00:00
parent a8450c695d
commit 3056a64bf0
6 changed files with 270 additions and 173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
compiler/cgobj.pas
View File

@ -903,7 +903,10 @@ implementation
begin begin
getexplicitregister(list,locpara.register); getexplicitregister(list,locpara.register);
ungetregister(list,locpara.register); ungetregister(list,locpara.register);
{
This is now a normal imaginary register, allocated the usual way (JM)
getexplicitregister(list,reg); getexplicitregister(list,reg);
}
a_load_reg_reg(list,locpara.size,locpara.size,locpara.register,reg) a_load_reg_reg(list,locpara.size,locpara.size,locpara.register,reg)
end end
else else
@ -912,9 +915,13 @@ implementation
LOC_CFPUREGISTER, LOC_CFPUREGISTER,
LOC_FPUREGISTER: LOC_FPUREGISTER:
begin begin
getexplicitregister(list,locpara.register); getexplicitregister(list,locpara.register);
ungetregister(list,locpara.register); ungetregister(list,locpara.register);
{
This is now a normal imaginary register, allocated the usual way (JM)
getexplicitregister(list,reg); getexplicitregister(list,reg);
}
a_loadfpu_reg_reg(list,locpara.size,locpara.register,reg); a_loadfpu_reg_reg(list,locpara.size,locpara.register,reg);
end; end;
LOC_MMREGISTER, LOC_MMREGISTER,
@ -922,14 +929,20 @@ implementation
begin begin
getexplicitregister(list,locpara.register); getexplicitregister(list,locpara.register);
ungetregister(list,locpara.register); ungetregister(list,locpara.register);
{
This is now a normal imaginary register, allocated the usual way (JM)
getexplicitregister(list,reg); getexplicitregister(list,reg);
}
a_loadmm_reg_reg(list,locpara.size,locpara.size,locpara.register,reg,shuffle); a_loadmm_reg_reg(list,locpara.size,locpara.size,locpara.register,reg,shuffle);
end; end;
LOC_REFERENCE, LOC_REFERENCE,
LOC_CREFERENCE: LOC_CREFERENCE:
begin begin
reference_reset_base(href,locpara.reference.index,locpara.reference.offset); reference_reset_base(href,locpara.reference.index,locpara.reference.offset);
{
This is now a normal imaginary register, allocated the usual way (JM)
getexplicitregister(list,reg); getexplicitregister(list,reg);
}
a_load_ref_reg(list,locpara.size,locpara.size,href,reg); a_load_ref_reg(list,locpara.size,locpara.size,href,reg);
end; end;
else else
@ -2138,7 +2151,13 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.155 2004-02-04 22:01:13 peter Revision 1.156 2004-02-08 18:08:59 jonas
* fixed regvars support. Needs -doldregvars to activate. Only tested with
ppc, other processors should however only require maxregvars and
maxfpuregvars constants in cpubase.pas. Remember to take scratch-
registers into account when defining that value.
Revision 1.155 2004/02/04 22:01:13 peter
* first try to get cpupara working for x86_64 * first try to get cpupara working for x86_64
Revision 1.154 2004/02/03 22:32:53 peter Revision 1.154 2004/02/03 22:32:53 peter

10
compiler/powerpc/cpubase.pas
View File

@ -106,6 +106,8 @@ uses
totherregisterset = set of tregisterindex; totherregisterset = set of tregisterindex;
const const
maxvarregs = 32-6; { 32 int registers - r0 - stackpointer - r2 - 3 scratch registers }
maxfpuvarregs = 28; { 32 fpuregisters - some scratch registers (minimally 2) }
{ Available Superregisters } { Available Superregisters }
{$i rppcsup.inc} {$i rppcsup.inc}
@ -629,7 +631,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.83 2004-01-30 13:42:03 florian Revision 1.84 2004-02-08 18:08:59 jonas
* fixed regvars support. Needs -doldregvars to activate. Only tested with
ppc, other processors should however only require maxregvars and
maxfpuregvars constants in cpubase.pas. Remember to take scratch-
registers into account when defining that value.
Revision 1.83 2004/01/30 13:42:03 florian
* fixed more alignment issues * fixed more alignment issues
Revision 1.82 2004/01/10 00:16:21 jonas Revision 1.82 2004/01/10 00:16:21 jonas

11
compiler/psub.pas
View File

@ -664,6 +664,9 @@ implementation
body is generated because the localloc is updated. body is generated because the localloc is updated.
Note: The generated code will be inserted after the code generation of Note: The generated code will be inserted after the code generation of
the body is finished, because only then the position is known } the body is finished, because only then the position is known }
{$ifdef oldregvars}
assign_regvars(code);
{$endif oldreg}
aktfilepos:=entrypos; aktfilepos:=entrypos;
gen_load_para_value(templist); gen_load_para_value(templist);
@ -1342,7 +1345,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.184 2004-02-04 22:01:13 peter Revision 1.185 2004-02-08 18:08:59 jonas
* fixed regvars support. Needs -doldregvars to activate. Only tested with
ppc, other processors should however only require maxregvars and
maxfpuregvars constants in cpubase.pas. Remember to take scratch-
registers into account when defining that value.
Revision 1.184 2004/02/04 22:01:13 peter
* first try to get cpupara working for x86_64 * first try to get cpupara working for x86_64
Revision 1.183 2004/02/03 22:32:54 peter Revision 1.183 2004/02/03 22:32:54 peter

188
compiler/regvars.pas
View File

@ -40,8 +40,8 @@ interface
procedure load_regvar(asml: TAAsmoutput; vsym: tvarsym); procedure load_regvar(asml: TAAsmoutput; vsym: tvarsym);
procedure load_regvar_reg(asml: TAAsmoutput; reg: tregister); procedure load_regvar_reg(asml: TAAsmoutput; reg: tregister);
procedure load_all_regvars(asml: TAAsmoutput); procedure load_all_regvars(asml: TAAsmoutput);
procedure free_regvars(list: taasmoutput); procedure free_regvars(list: taasmoutput);
procedure translate_regvars(list: taasmoutput; const table:Ttranstable); { procedure translate_regvars(list: taasmoutput); }
{$endif OLDREGVARS} {$endif OLDREGVARS}
{$ifdef i386} {$ifdef i386}
@ -69,17 +69,13 @@ implementation
parasym : boolean; parasym : boolean;
begin begin
parasym:=pboolean(arg)^; parasym:=pboolean(arg)^;
if (tsym(p).typ=varsym) and (vo_regable in tvarsym(p).varoptions) then if (tsym(p).typ=varsym) and
((vo_regable in tvarsym(p).varoptions) or
((tvarsym(p).varspez in [vs_var,vs_const,vs_out]) and
paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vartype.def,current_procinfo.procdef.proccalloption))) and
not tvarsym(p).vartype.def.needs_inittable then
begin begin
j:=tvarsym(p).refs; j:=tvarsym(p).refs;
{ parameter get a less value }
if parasym then
begin
if cs_littlesize in aktglobalswitches then
dec(j,1)
else
dec(j,100);
end;
{ walk through all momentary register variables } { walk through all momentary register variables }
for i:=1 to maxvarregs do for i:=1 to maxvarregs do
begin begin
@ -94,7 +90,7 @@ implementation
end; end;
{ calc the new refs { calc the new refs
tvarsym(p).refs:=j; } tvarsym(p).refs:=j; }
regvars[i]:=tvarsym(p); regvars[i]:=tsym(p);
regvars_para[i]:=parasym; regvars_para[i]:=parasym;
regvars_refs[i]:=j; regvars_refs[i]:=j;
break; break;
@ -114,13 +110,6 @@ implementation
begin begin
j:=tvarsym(p).refs; j:=tvarsym(p).refs;
{ parameter get a less value } { parameter get a less value }
if parasym then
begin
if cs_littlesize in aktglobalswitches then
dec(j,1)
else
dec(j,100);
end;
{ walk through all momentary register variables } { walk through all momentary register variables }
for i:=1 to maxfpuvarregs do for i:=1 to maxfpuvarregs do
begin begin
@ -135,7 +124,7 @@ implementation
end; end;
{ calc the new refs { calc the new refs
tvarsym(p).refs:=j; } tvarsym(p).refs:=j; }
fpuregvars[i]:=tvarsym(p); fpuregvars[i]:=tsym(p);
fpuregvars_para[i]:=parasym; fpuregvars_para[i]:=parasym;
fpuregvars_refs[i]:=j; fpuregvars_refs[i]:=j;
break; break;
@ -177,20 +166,20 @@ implementation
parasym:=true; parasym:=true;
symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchregvars,@parasym); symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchregvars,@parasym);
{ hold needed registers free } { hold needed registers free }
for i:=maxvarregs downto maxvarregs-p.registersint+1-maxintscratchregs do for i:=maxvarregs downto maxvarregs-p.registersint+1 do
begin begin
regvarinfo^.regvars[i]:=nil; regvarinfo^.regvars[i]:=nil;
regvarinfo^.regvars_para[i] := false; regvarinfo^.regvars_para[i] := false;
end; end;
{ now assign register } { now assign register }
for i:=1 to maxvarregs-p.registersint-maxintscratchregs do for i:=1 to maxvarregs-p.registersint do
begin begin
if assigned(regvarinfo^.regvars[i]) and if assigned(regvarinfo^.regvars[i]) and
{ currently we assume we can use volatile registers for all } { currently we assume we can use registers for all }
{ regvars if procedure does no call } { regvars if procedure does no call }
(not(pi_do_call in current_procinfo.flags) or (not(pi_do_call in current_procinfo.flags) or
{ otherwise, demand some (arbitrary) minimum usage } { otherwise, demand some (arbitrary) minimum usage }
(regvarinfo^.regvars[i].refs > 100)) then (tvarsym(regvarinfo^.regvars[i]).refs > 100)) then
begin begin
{ register is no longer available for } { register is no longer available for }
{ expressions } { expressions }
@ -198,22 +187,22 @@ implementation
{ unused } { unused }
{ call by reference/const ? } { call by reference/const ? }
if paramanager.push_addr_param(regvarinfo^.regvars[i].varspez,regvarinfo^.regvars[i].vartype.def,current_procinfo.procdef.proccalloption) then if paramanager.push_addr_param(tvarsym(regvarinfo^.regvars[i]).varspez,tvarsym(regvarinfo^.regvars[i]).vartype.def,current_procinfo.procdef.proccalloption) then
siz:=OS_32 siz:=OS_32
else else
if (regvarinfo^.regvars[i].vartype.def.deftype in [orddef,enumdef]) and if (tvarsym(regvarinfo^.regvars[i]).vartype.def.deftype in [orddef,enumdef]) and
(regvarinfo^.regvars[i].vartype.def.size=1) then (tvarsym(regvarinfo^.regvars[i]).vartype.def.size=1) then
siz:=OS_8 siz:=OS_8
else else
if (regvarinfo^.regvars[i].vartype.def.deftype in [orddef,enumdef]) and if (tvarsym(regvarinfo^.regvars[i]).vartype.def.deftype in [orddef,enumdef]) and
(regvarinfo^.regvars[i].vartype.def.size=2) then (tvarsym(regvarinfo^.regvars[i]).vartype.def.size=2) then
siz:=OS_16 siz:=OS_16
else else
siz:=OS_32; siz:=OS_32;
{$warning fixme regvars}
{ allocate a register for this regvar } { allocate a register for this regvar }
{ regvarinfo^.regvars[i].localloc.register:=rg.getregisterint(exprasmlist,siz);} tvarsym(regvarinfo^.regvars[i]).localloc.register:=cg.getintregister(exprasmlist,siz);
tvarsym(regvarinfo^.regvars[i]).localloc.loc:=LOC_REGISTER;
{ and make sure it can't be freed } { and make sure it can't be freed }
{ rg.makeregvarint(getsupreg(regvarinfo^.regvars[i].localloc.register));} { rg.makeregvarint(getsupreg(regvarinfo^.regvars[i].localloc.register));}
end end
@ -228,7 +217,7 @@ implementation
begin begin
parasym:=false; parasym:=false;
symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchfpuregvars,@parasym); symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchfpuregvars,@parasym);
{$ifdef dummy} {$ifndef i386}
{ this code should be never enabled because } { this code should be never enabled because }
{ 1. the caller loads parameters into registers } { 1. the caller loads parameters into registers }
{ 2. (later) the CSE loads a parameter into a } { 2. (later) the CSE loads a parameter into a }
@ -236,12 +225,13 @@ implementation
{ (FK) } { (FK) }
{ copy parameter into a register ? } { copy parameter into a register ? }
parasym:=true; parasym:=true;
symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchregvars); symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}searchregvars,@parasym);
{$endif dummy} {$endif i386}
{ hold needed registers free } { hold needed registers free }
{ in non leaf procedures we must be very careful } { in non leaf procedures we must be very careful }
{ with assigning registers } { with assigning registers }
{$ifdef i386}
if aktmaxfpuregisters=-1 then if aktmaxfpuregisters=-1 then
begin begin
if (pi_do_call in current_procinfo.flags) then if (pi_do_call in current_procinfo.flags) then
@ -250,16 +240,19 @@ implementation
regvarinfo^.fpuregvars[i]:=nil; regvarinfo^.fpuregvars[i]:=nil;
end end
else else
{$endif i386}
begin begin
for i:=maxfpuvarregs downto maxfpuvarregs-p.registersfpu do for i:=maxfpuvarregs downto maxfpuvarregs-p.registersfpu do
regvarinfo^.fpuregvars[i]:=nil; regvarinfo^.fpuregvars[i]:=nil;
end; end;
{$ifdef i386}
end end
else else
begin begin
for i:=aktmaxfpuregisters+1 to maxfpuvarregs do for i:=aktmaxfpuregisters+1 to maxfpuvarregs do
regvarinfo^.fpuregvars[i]:=nil; regvarinfo^.fpuregvars[i]:=nil;
end; end;
{$endif i386}
{ now assign register } { now assign register }
for i:=1 to maxfpuvarregs do for i:=1 to maxfpuvarregs do
begin begin
@ -267,13 +260,14 @@ implementation
begin begin
{$ifdef i386} {$ifdef i386}
{ reserve place on the FPU stack } { reserve place on the FPU stack }
{$warning fixme regvars} {$error fixme x86 fpuregvars}
{ regvarinfo^.fpuregvars[i].localloc.register:=trgcpu(rg).correct_fpuregister(NR_ST0,i);} { regvarinfo^.fpuregvars[i].localloc.register:=trgcpu(rg).correct_fpuregister(NR_ST0,i);}
{$else i386} {$else i386}
{$ifdef x86_64} {$ifdef x86_64}
{$endif x86_64} {$endif x86_64}
begin begin
regvarinfo^.fpuregvars[i].localloc.register:=fpuvarregs[i]; tvarsym(regvarinfo^.fpuregvars[i]).localloc.register:=cg.getfpuregister(exprasmlist,OS_F64);
tvarsym(regvarinfo^.fpuregvars[i]).localloc.loc:=LOC_FPUREGISTER;
{ rg.makeregvarother(regvarinfo^.fpuregvars[i].localloc.register);} { rg.makeregvarother(regvarinfo^.fpuregvars[i].localloc.register);}
end; end;
{$endif i386} {$endif i386}
@ -305,7 +299,7 @@ implementation
supreg:=getsupreg(reg); supreg:=getsupreg(reg);
for i := 1 to maxvarregs do for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) and if assigned(regvarinfo^.regvars[i]) and
(getsupreg(regvarinfo^.regvars[i].localloc.register)=supreg) then (getsupreg(tvarsym(regvarinfo^.regvars[i]).localloc.register)=supreg) then
begin begin
{$warning fixme regvar_loaded_int} {$warning fixme regvar_loaded_int}
(* if supreg in rg.regvar_loaded_int then (* if supreg in rg.regvar_loaded_int then
@ -418,6 +412,7 @@ implementation
reg_spare : tregister; reg_spare : tregister;
supreg : tsuperregister; supreg : tsuperregister;
begin begin
{
regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo); regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo);
if not assigned(regvarinfo) then if not assigned(regvarinfo) then
exit; exit;
@ -437,19 +432,24 @@ implementation
(cg.makeregsize(regvarinfo^.regvars[i].localloc.register,OS_INT) = reg_spare) then (cg.makeregsize(regvarinfo^.regvars[i].localloc.register,OS_INT) = reg_spare) then
load_regvar(asml,tvarsym(regvarinfo^.regvars[i])) load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
end; end;
}
end; end;
procedure load_all_regvars(asml: TAAsmoutput); procedure load_all_regvars(asml: TAAsmoutput);
{
var var
i: longint; i: longint;
regvarinfo: pregvarinfo; regvarinfo: pregvarinfo;
}
begin begin
{
regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo); regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo);
if not assigned(regvarinfo) then if not assigned(regvarinfo) then
exit; exit;
for i := 1 to maxvarregs do for i := 1 to maxvarregs do
if assigned(regvarinfo^.regvars[i]) then if assigned(regvarinfo^.regvars[i]) then
load_regvar(asml,tvarsym(regvarinfo^.regvars[i])) load_regvar(asml,tvarsym(regvarinfo^.regvars[i]))
}
end; end;
@ -486,6 +486,7 @@ implementation
asml.insert(tai_comment.Create(strpnew(tostr(p.registersfpu)+ asml.insert(tai_comment.Create(strpnew(tostr(p.registersfpu)+
' registers on FPU stack used by temp. expressions'))); ' registers on FPU stack used by temp. expressions')));
{$endif i386} {$endif i386}
{
for i:=1 to maxfpuvarregs do for i:=1 to maxfpuvarregs do
begin begin
if assigned(regvarinfo^.fpuregvars[i]) then if assigned(regvarinfo^.fpuregvars[i]) then
@ -501,6 +502,7 @@ implementation
end; end;
if cs_asm_source in aktglobalswitches then if cs_asm_source in aktglobalswitches then
asml.insert(tai_comment.Create(strpnew('Register variable assignment:'))); asml.insert(tai_comment.Create(strpnew('Register variable assignment:')));
}
end; end;
end; end;
@ -566,6 +568,7 @@ implementation
{ ... and clean it up } { ... and clean it up }
asml.concat(Taicpu.op_reg(A_FSTP,S_NO,NR_ST0)); asml.concat(Taicpu.op_reg(A_FSTP,S_NO,NR_ST0));
{$endif i386} {$endif i386}
(*
for i := 1 to maxvarregs do for i := 1 to maxvarregs do
begin begin
if assigned(regvars[i]) then if assigned(regvars[i]) then
@ -579,39 +582,24 @@ implementation
reg:=cg.makeregsize(reg,OS_INT); reg:=cg.makeregsize(reg,OS_INT);
regidx:=findreg_by_number(reg); regidx:=findreg_by_number(reg);
{$warning fixme regvar dealloc} {$warning fixme regvar dealloc}
(* {
if (rg.regvar_loaded_other[regidx]) then if (rg.regvar_loaded_other[regidx]) then
asml.concat(tai_regalloc.dealloc(reg)); asml.concat(tai_regalloc.dealloc(reg));
*) }
end; end;
end; end;
end; end;
*)
end; end;
end; end;
{
procedure free_regvars(list: taasmoutput); Note: this one can't really be "fixed": register colouring happens after
var stabs generation. It could still be useful to generate the "var X is
i: longint; assigned to register Y with weight ZZZ" messages though
begin
if not assigned(current_procinfo.procdef.regvarinfo) then
exit;
with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
for i := 1 to maxvarregs do
if assigned(regvars[i]) { and
(regvars[i] <> tvarsym(current_procinfo.procdef.funcretsym))} then
begin
{$warning fixme regvarexclude}
{ make sure the unget isn't just a nop }
(*
exclude(rg.is_reg_var_int,getsupreg(regvars[i].localloc.register));
*)
cg.ungetregister(list,regvars[i].localloc.register);
end;
end;
procedure translate_regvars(list: taasmoutput);
procedure translate_regvars(list: taasmoutput; const table:Ttranstable);
var var
i: longint; i: longint;
r: tregister; r: tregister;
@ -619,20 +607,64 @@ implementation
if not assigned(current_procinfo.procdef.regvarinfo) then if not assigned(current_procinfo.procdef.regvarinfo) then
exit; exit;
with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
for i := 1 to maxvarregs do begin
if assigned(regvars[i]) { and for i := 1 to maxvarregs do
(regvars[i] <> tvarsym(current_procinfo.procdef.funcretsym))} then if assigned(regvars[i]) then
begin begin
setsupreg(regvars[i].localloc.register,getsupreg(table[getsupreg(regvars[i].localloc.register)])); cg.rg[R_INTREGISTER].translate_register(tvarsym(regvars[i]).localloc.register);
r:=regvars[i].localloc.register; r:=tvarsym(regvars[i]).localloc.register;
if cs_asm_source in aktglobalswitches then if cs_asm_source in aktglobalswitches then
list.insert(tai_comment.Create(strpnew(regvars[i].name+ list.insert(tai_comment.Create(strpnew(tvarsym(regvars[i]).name+
' with weight '+tostr(regvars[i].refs)+' assigned to register '+ ' with weight '+tostr(tvarsym(regvars[i]).refs)+' assigned to register '+
std_regname(r)))); std_regname(r))));
Message3(cg_d_register_weight,std_regname(r), Message3(cg_d_register_weight,std_regname(r),
tostr(regvars[i].refs),regvars[i].name); tostr(tvarsym(regvars[i]).refs),tvarsym(regvars[i]).name);
end; end;
for i := 1 to maxfpuvarregs do
if assigned(fpuregvars[i]) then
begin
cg.rg[R_FPUREGISTER].translate_register(tvarsym(regvars[i]).localloc.register);
r:=tvarsym(fpuregvars[i]).localloc.register;
if cs_asm_source in aktglobalswitches then
list.insert(tai_comment.Create(strpnew(tvarsym(fpuregvars[i]).name+
' with weight '+tostr(tvarsym(fpuregvars[i]).refs)+' assigned to register '+
std_regname(r))));
Message3(cg_d_register_weight,std_regname(r),
tostr(tvarsym(fpuregvars[i]).refs),tvarsym(fpuregvars[i]).name);
end;
end;
end; end;
}
procedure free_regvars(list: taasmoutput);
var
i: longint;
reg: tregister;
size: tcgsize;
begin
if not assigned(current_procinfo.procdef.regvarinfo) then
exit;
with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do
begin
for i := 1 to maxvarregs do
if assigned(regvars[i]) then
begin
reg:=cg.makeregsize(tvarsym(regvars[i]).localloc.register,OS_INT);
cg.a_load_reg_reg(list,OS_INT,OS_INT,reg,reg);
cg.ungetregister(list,tvarsym(regvars[i]).localloc.register);
end;
for i := 1 to maxfpuvarregs do
if assigned(fpuregvars[i]) then
begin
reg:=tvarsym(fpuregvars[i]).localloc.register;
size:=cg.reg_cgsize(reg);
cg.a_loadfpu_reg_reg(list,size,reg,reg);
cg.ungetregister(list,reg);
end;
end;
end;
{$endif OLDREGVARS} {$endif OLDREGVARS}
@ -640,7 +672,13 @@ end.
{ {
$Log$ $Log$
Revision 1.72 2004-02-03 22:32:54 peter Revision 1.73 2004-02-08 18:08:59 jonas
* fixed regvars support. Needs -doldregvars to activate. Only tested with
ppc, other processors should however only require maxregvars and
maxfpuregvars constants in cpubase.pas. Remember to take scratch-
registers into account when defining that value.
Revision 1.72 2004/02/03 22:32:54 peter
* renamed xNNbittype to xNNinttype * renamed xNNbittype to xNNinttype
* renamed registers32 to registersint * renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ * replace some s32bit,u32bit with torddef([su]inttype).def.typ

29
compiler/symdef.pas
View File

@ -505,6 +505,21 @@ interface
end; end;
pinlininginfo = ^tinlininginfo; pinlininginfo = ^tinlininginfo;
{$ifdef oldregvars}
{ register variables }
pregvarinfo = ^tregvarinfo;
tregvarinfo = record
regvars : array[1..maxvarregs] of tsym;
regvars_para : array[1..maxvarregs] of boolean;
regvars_refs : array[1..maxvarregs] of longint;
fpuregvars : array[1..maxfpuvarregs] of tsym;
fpuregvars_para : array[1..maxfpuvarregs] of boolean;
fpuregvars_refs : array[1..maxfpuvarregs] of longint;
end;
{$endif oldregvars}
tprocdef = class(tabstractprocdef) tprocdef = class(tabstractprocdef)
private private
_mangledname : pstring; _mangledname : pstring;
@ -554,6 +569,9 @@ interface
{ info for inlining the subroutine, if this pointer is nil, { info for inlining the subroutine, if this pointer is nil,
the procedure can't be inlined } the procedure can't be inlined }
inlininginfo : pinlininginfo; inlininginfo : pinlininginfo;
{$ifdef oldregvars}
regvarinfo: pregvarinfo;
{$endif oldregvars}
constructor create(level:byte); constructor create(level:byte);
constructor ppuload(ppufile:tcompilerppufile); constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override; destructor destroy;override;
@ -1253,7 +1271,8 @@ implementation
case torddef(self).typ of case torddef(self).typ of
bool8bit,bool16bit,bool32bit, bool8bit,bool16bit,bool32bit,
u8bit,u16bit,u32bit, u8bit,u16bit,u32bit,
s8bit,s16bit,s32bit: s8bit,s16bit,s32bit,
uchar, uwidechar:
is_intregable:=true; is_intregable:=true;
end; end;
objectdef: objectdef:
@ -6077,7 +6096,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.216 2004-02-06 22:37:00 daniel Revision 1.217 2004-02-08 18:08:59 jonas
* fixed regvars support. Needs -doldregvars to activate. Only tested with
ppc, other processors should however only require maxregvars and
maxfpuregvars constants in cpubase.pas. Remember to take scratch-
registers into account when defining that value.
Revision 1.216 2004/02/06 22:37:00 daniel
* Removed not very usefull nextglobal & previousglobal fields from * Removed not very usefull nextglobal & previousglobal fields from
Tstoreddef, saving 78 kb of memory Tstoreddef, saving 78 kb of memory

184
compiler/symsym.pas
View File

@ -307,20 +307,6 @@ interface
function get_label:tasmsymbol; function get_label:tasmsymbol;
end; end;
(*
{ register variables }
pregvarinfo = ^tregvarinfo;
tregvarinfo = record
regvars : array[1..maxvarregs] of tvarsym;
regvars_para : array[1..maxvarregs] of boolean;
regvars_refs : array[1..maxvarregs] of longint;
fpuregvars : array[1..maxfpuvarregs] of tvarsym;
fpuregvars_para : array[1..maxfpuvarregs] of boolean;
fpuregvars_refs : array[1..maxfpuvarregs] of longint;
end;
*)
var var
generrorsym : tsym; generrorsym : tsym;
@ -1615,110 +1601,116 @@ implementation
threadvaroffset:string; threadvaroffset:string;
regidx:Tregisterindex; regidx:Tregisterindex;
c:char; c:char;
loc: tcgloc;
begin begin
{ set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or }
{ while stabs aren't adapted for regvars yet }
loc := localloc.loc;
if (vo_is_self in varoptions) then if (vo_is_self in varoptions) then
begin begin
if localloc.loc<>LOC_REFERENCE then case loc of
internalerror(2003091815); LOC_REGISTER:
regidx:=findreg_by_number(localloc.register);
LOC_REFERENCE: ;
else
internalerror(2003091815);
end;
if (po_classmethod in current_procinfo.procdef.procoptions) or if (po_classmethod in current_procinfo.procdef.procoptions) or
(po_staticmethod in current_procinfo.procdef.procoptions) then (po_staticmethod in current_procinfo.procdef.procoptions) then
stabstring:=stabstr_evaluate('"pvmt:p$1",${N_TSYM},0,0,$2', if (loc=LOC_REFERENCE) then
[Tstoreddef(pvmttype.def).numberstring,tostr(localloc.reference.offset)]) stabstring:=stabstr_evaluate('"pvmt:p$1",${N_TSYM},0,0,$2',
[Tstoreddef(pvmttype.def).numberstring,tostr(localloc.reference.offset)])
else
stabstring:=stabstr_evaluate('"pvmt:r$1",${N_RSYM},0,0,$2',
[Tstoreddef(pvmttype.def).numberstring,tostr(regstabs_table[regidx])])
else else
begin begin
if not(is_class(current_procinfo.procdef._class)) then if not(is_class(current_procinfo.procdef._class)) then
c:='v' c:='v'
else else
c:='p'; c:='p';
stabstring:=stabstr_evaluate('"$$t:$1",${N_TSYM},0,0,$2', if (loc=LOC_REFERENCE) then
[c+current_procinfo.procdef._class.numberstring,tostr(localloc.reference.offset)]); stabstring:=stabstr_evaluate('"$$t:$1",${N_TSYM},0,0,$2',
[c+current_procinfo.procdef._class.numberstring,tostr(localloc.reference.offset)])
else
stabstring:=stabstr_evaluate('"$$t:r$1",${N_RSYM},0,0,$2',
[c+current_procinfo.procdef._class.numberstring,tostr(regstabs_table[regidx])]);
end; end;
end end
else else
(* begin
if (localloc.loc=LOC_REGISTER) then stabstring:=nil;
begin st:=tstoreddef(vartype.def).numberstring;
regidx:=findreg_by_number(localloc.register); if (vo_is_thread_var in varoptions) then
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", } threadvaroffset:='+'+tostr(pointer_size)
{ this is the register order for GDB} else
stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2', threadvaroffset:='';
[Tstoreddef(vartype.def).numberstring,tostr(regstabs_table[regidx])]);
end
else
*)
begin
stabstring:=nil;
st:=tstoreddef(vartype.def).numberstring;
if (vo_is_thread_var in varoptions) then
threadvaroffset:='+'+tostr(pointer_size)
else
threadvaroffset:='';
case owner.symtabletype of case owner.symtabletype of
objectsymtable: objectsymtable:
if (sp_static in symoptions) then if (sp_static in symoptions) then
begin
if (cs_gdb_gsym in aktglobalswitches) then
st:='G'+st
else
st:='S'+st;
stabstring:=stabstr_evaluate('"${ownername}__${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',
[st,threadvaroffset]);
end;
globalsymtable:
begin begin
{ Here we used S instead of
because with G GDB doesn't look at the address field
but searches the same name or with a leading underscore
but these names don't exist in pascal !}
if (cs_gdb_gsym in aktglobalswitches) then if (cs_gdb_gsym in aktglobalswitches) then
st:='G'+st st:='G'+st
else else
st:='S'+st; st:='S'+st;
stabstring:=stabstr_evaluate('"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]); stabstring:=stabstr_evaluate('"${ownername}__${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',
[st,threadvaroffset]);
end; end;
staticsymtable : globalsymtable:
stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]); begin
parasymtable,localsymtable: { Here we used S instead of
begin because with G GDB doesn't look at the address field
{ There is no space allocated for not referenced locals } but searches the same name or with a leading underscore
if (owner.symtabletype=localsymtable) and (refs=0) then but these names don't exist in pascal !}
exit; if (cs_gdb_gsym in aktglobalswitches) then
st:='G'+st
else
st:='S'+st;
stabstring:=stabstr_evaluate('"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
end;
staticsymtable :
stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
parasymtable,localsymtable:
begin
{ There is no space allocated for not referenced locals }
if (owner.symtabletype=localsymtable) and (refs=0) then
exit;
if (vo_is_C_var in varoptions) then if (vo_is_C_var in varoptions) then
begin begin
stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}',[st]); stabstring:=stabstr_evaluate('"${name}:S$1",${N_LCSYM},0,${line},${mangledname}',[st]);
exit; exit;
end;
if (owner.symtabletype=parasymtable) then
begin
if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) and
not(vo_has_local_copy in varoptions) then
st := 'v'+st { should be 'i' but 'i' doesn't work }
else
st := 'p'+st;
end;
case localloc.loc of
LOC_REGISTER, LOC_FPUREGISTER :
begin
regidx:=findreg_by_number(localloc.register);
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
end;
LOC_REFERENCE :
{ offset to ebp => will not work if the framepointer is esp
so some optimizing will make things harder to debug }
stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])
else
internalerror(2003091814);
end; end;
if (owner.symtabletype=parasymtable) then
begin
if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) and
not(vo_has_local_copy in varoptions) then
st := 'v'+st { should be 'i' but 'i' doesn't work }
else
st := 'p'+st;
end;
case loc of
LOC_REGISTER, LOC_FPUREGISTER :
begin
regidx:=findreg_by_number(localloc.register);
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
end;
LOC_REFERENCE :
{ offset to ebp => will not work if the framepointer is esp
so some optimizing will make things harder to debug }
stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])
else
internalerror(2003091814);
end; end;
else end;
stabstring := inherited stabstring; else
end; stabstring := inherited stabstring;
end; end;
end;
end; end;
{$endif GDB} {$endif GDB}
@ -2363,7 +2355,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.155 2004-02-05 14:13:53 daniel Revision 1.156 2004-02-08 18:08:59 jonas
* fixed regvars support. Needs -doldregvars to activate. Only tested with
ppc, other processors should however only require maxregvars and
maxfpuregvars constants in cpubase.pas. Remember to take scratch-
registers into account when defining that value.
Revision 1.155 2004/02/05 14:13:53 daniel
* Tvarsym.highvarsym removed * Tvarsym.highvarsym removed
Revision 1.154 2004/02/04 23:01:36 daniel Revision 1.154 2004/02/04 23:01:36 daniel