paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-31 17:30:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Register allocator finished

Browse Source
This commit is contained in:
daniel 2003-06-03 13:01:59 +00:00
parent 7f072488e3
commit 41e0bc4cec
27 changed files with 1546 additions and 282 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
compiler/aasmtai.pas
View File

@ -178,6 +178,8 @@ interface
{ Buffer type used for alignment }
tfillbuffer = array[0..63] of char;
Tspill_temp_list=array[0..255] of Treference;
{ abstract assembler item }
tai = class(TLinkedListItem)
{$ifndef NOOPT}
@ -402,6 +404,11 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
end;
Taasmoutput=class;
Trggetproc=procedure(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister) of object;
Trgungetproc=procedure(list:Taasmoutput;position:Tai;const r:Tregister) of object;
{ Class template for assembler instructions
}
taicpu_abstract = class(tailineinfo)
@ -436,6 +443,13 @@ interface
procedure loadreg(opidx:longint;r:tregister);
procedure loadoper(opidx:longint;o:toper);
function is_nop:boolean;virtual;abstract;
function is_move:boolean;virtual;abstract;
function spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsupregset;
var unusedregsint:Tsupregset;
const spilltemplist:Tspill_temp_list):boolean;virtual;abstract;
end;
{ alignment for operator }
@ -1635,13 +1649,13 @@ uses
procedure taicpu_abstract.derefimpl;
var
i : integer;
begin
for i:=1 to ops do
ppuderefoper(oper[i-1]);
end;
var i:byte;
begin
for i:=1 to ops do
ppuderefoper(oper[i-1]);
end;
{****************************************************************************
tai_align_abstract
@ -1816,7 +1830,10 @@ uses
end.
{
$Log$
Revision 1.28 2003-05-12 18:13:57 peter
Revision 1.29 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.28 2003/05/12 18:13:57 peter
* create rtti label using newasmsymboldata and update binding
only when calling tai_symbol.create
* tai_symbol.create_global added

50
compiler/cg64f32.pas
View File

@ -50,10 +50,10 @@ unit cg64f32;
procedure a_reg_dealloc(list : taasmoutput;r : tregister64);override;
procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);override;
procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);override;
procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64{$ifdef newra};delete:boolean{$endif});override;
procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64{$ifdef newra};delete:boolean{$endif});override;
procedure a_load64_const_reg(list : taasmoutput;value: qword;reg : tregister64);override;
procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);override;
procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64{$ifdef newra};delete: boolean{$endif});override;
procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);override;
procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);override;
procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);override;
@ -97,7 +97,7 @@ unit cg64f32;
globtype,globals,systems,
cgbase,
verbose,
symbase,symconst,symdef,defutil,rgobj;
symbase,symconst,symdef,defutil,rgobj,tgobj;
function joinreg64(reglo,reghi : tregister) : tregister64;
@ -150,7 +150,7 @@ unit cg64f32;
end;
procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);
procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64{$ifdef newra};delete:boolean{$endif});
var
tmpreg: tregister;
tmpref: treference;
@ -164,10 +164,6 @@ unit cg64f32;
end;
got_scratch:=false;
tmpref := ref;
if tmpref.base.enum<>R_INTREGISTER then
internalerror(200302035);
if reg.reglo.enum<>R_INTREGISTER then
internalerror(200302035);
if (tmpref.base.number=reg.reglo.number) then
begin
{$ifdef newra}
@ -196,6 +192,13 @@ unit cg64f32;
end;
cg.a_load_ref_reg(list,OS_32,tmpref,reg.reglo);
inc(tmpref.offset,4);
{$ifdef newra}
if delete then
begin
tg.ungetiftemp(list,tmpref);
reference_release(list,tmpref);
end;
{$endif}
cg.a_load_ref_reg(list,OS_32,tmpref,reg.reghi);
{$ifdef newra}
if got_scratch then
@ -207,10 +210,18 @@ unit cg64f32;
end;
procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);
procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64{$ifdef newra};delete:boolean{$endif});
begin
{$ifdef newra}
if delete then
rg.ungetregisterint(list,regsrc.reglo);
{$endif}
cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reglo,regdst.reglo);
{$ifdef newra}
if delete then
rg.ungetregisterint(list,regsrc.reghi);
{$endif}
cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reghi,regdst.reghi);
end;
@ -221,14 +232,14 @@ unit cg64f32;
cg.a_load_const_reg(list,OS_32,hi(value),reg.reghi);
end;
procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);
procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64{$ifdef newra};delete :boolean{$endif});
begin
case l.loc of
LOC_REFERENCE, LOC_CREFERENCE:
a_load64_ref_reg(list,l.reference,reg);
a_load64_ref_reg(list,l.reference,reg{$ifdef newra},delete{$endif});
LOC_REGISTER,LOC_CREGISTER:
a_load64_reg_reg(list,l.register64,reg);
a_load64_reg_reg(list,l.register64,reg{$ifdef newra},delete{$endif});
LOC_CONSTANT :
a_load64_const_reg(list,l.valueqword,reg);
else
@ -271,7 +282,7 @@ unit cg64f32;
LOC_REFERENCE, LOC_CREFERENCE:
a_load64_reg_ref(list,reg,l.reference);
LOC_REGISTER,LOC_CREGISTER:
a_load64_reg_reg(list,reg,l.register64);
a_load64_reg_reg(list,reg,l.register64{$ifdef newra},false{$endif});
else
internalerror(200112293);
end;
@ -419,7 +430,7 @@ unit cg64f32;
tempreg.reghi := cg.get_scratch_reg_int(list,OS_INT);
tempreg.reglo := cg.get_scratch_reg_int(list,OS_INT);
{$endif}
a_load64_ref_reg(list,ref,tempreg);
a_load64_ref_reg(list,ref,tempreg{$ifdef newra},false{$endif});
a_op64_reg_reg(list,op,tempreg,reg);
{$ifdef newra}
rg.ungetregisterint(list,tempreg.reglo);
@ -442,7 +453,7 @@ unit cg64f32;
tempreg.reghi := cg.get_scratch_reg_int(list,OS_INT);
tempreg.reglo := cg.get_scratch_reg_int(list,OS_INT);
{$endif}
a_load64_ref_reg(list,ref,tempreg);
a_load64_ref_reg(list,ref,tempreg{$ifdef newra},false{$endif});
a_op64_reg_reg(list,op,reg,tempreg);
a_load64_reg_ref(list,tempreg,ref);
{$ifdef newra}
@ -466,7 +477,7 @@ unit cg64f32;
tempreg.reghi := cg.get_scratch_reg_int(list,OS_INT);
tempreg.reglo := cg.get_scratch_reg_int(list,OS_INT);
{$endif}
a_load64_ref_reg(list,ref,tempreg);
a_load64_ref_reg(list,ref,tempreg{$ifdef newra},false{$endif});
a_op64_const_reg(list,op,value,tempreg);
a_load64_reg_ref(list,tempreg,ref);
{$ifdef newra}
@ -898,7 +909,10 @@ begin
end.
{
$Log$
Revision 1.45 2003-06-01 21:38:06 peter
Revision 1.46 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.45 2003/06/01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates

21
compiler/cgobj.pas
View File

@ -437,10 +437,10 @@ unit cgobj;
procedure a_reg_dealloc(list : taasmoutput;r : tregister64);virtual;abstract;
procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);virtual;abstract;
procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);virtual;abstract;
procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);virtual;abstract;
procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);virtual;abstract;
procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64{$ifdef newra};delete : boolean{$endif});virtual;abstract;
procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64{$ifdef newra};delete : boolean{$endif});virtual;abstract;
procedure a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);virtual;abstract;
procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);virtual;abstract;
procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64{$ifdef newra};delete : boolean{$endif});virtual;abstract;
procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);virtual;abstract;
procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);virtual;abstract;
procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);virtual;abstract;
@ -1172,10 +1172,10 @@ unit cgobj;
else
begin
{$ifdef newra}
tmpreg := rg.getregisterint(list);
a_load_reg_reg(list,size,src2,tmpreg);
tmpreg := rg.getregisterint(list,size);
a_load_reg_reg(list,size,size,src2,tmpreg);
a_op_reg_reg(list,op,size,src1,tmpreg);
a_load_reg_reg,tmpreg,dst);
a_load_reg_reg(list,size,size,tmpreg,dst);
rg.ungetregisterint(list,tmpreg);
{$else newra}
internalerror(200305011);
@ -1691,14 +1691,14 @@ unit cgobj;
procedure tcg64.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;
regsrc,regdst : tregister64);
begin
a_load64_reg_reg(list,regsrc,regdst);
a_load64_reg_reg(list,regsrc,regdst{$ifdef newra},false{$endif});
a_op64_const_reg(list,op,value,regdst);
end;
procedure tcg64.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
begin
a_load64_reg_reg(list,regsrc2,regdst);
a_load64_reg_reg(list,regsrc2,regdst{$ifdef newra},false{$endif});
a_op64_reg_reg(list,op,regsrc1,regdst);
end;
@ -1712,7 +1712,10 @@ finalization
end.
{
$Log$
Revision 1.105 2003-06-01 21:38:06 peter
Revision 1.106 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.105 2003/06/01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates

7
compiler/i386/ag386nsm.pas
View File

@ -384,7 +384,7 @@ interface
found,
do_line,
quoted : boolean;
regstr:string[5];
regstr:string[6];
begin
if not assigned(p) then
exit;
@ -926,7 +926,10 @@ initialization
end.
{
$Log$
Revision 1.34 2003-05-26 19:37:57 peter
Revision 1.35 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.34 2003/05/26 19:37:57 peter
* don't generate align in .bss
Revision 1.33 2003/04/22 10:09:35 daniel

8
compiler/i386/cpubase.inc
View File

@ -147,7 +147,10 @@
{# Stack pointer register }
NR_STACK_POINTER_REG = NR_ESP;
RS_STACK_POINTER_REG = RS_ESP;
{# Frame pointer register }
frame_pointer_reg = R_EBP;
RS_FRAME_POINTER_REG = RS_EBP;
NR_FRAME_POINTER_REG = NR_EBP;
{# Register for addressing absolute data in a position independant way,
such as in PIC code. The exact meaning is ABI specific. For
@ -202,7 +205,10 @@
{
$Log$
Revision 1.5 2003-05-31 15:05:28 peter
Revision 1.6 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.5 2003/05/31 15:05:28 peter
* FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
Revision 1.4 2003/05/30 23:57:08 peter

46
compiler/i386/n386add.pas
View File

@ -350,7 +350,13 @@ interface
var
cmpop : boolean;
{$ifdef newra}
r : Tregister;
i : Tsuperregister;
{$else}
pushed : Tpushedsavedint;
{$endif}
regstopush : Tsupregset;
begin
{ string operations are not commutative }
if nf_swaped in flags then
@ -362,16 +368,37 @@ interface
ltn,lten,gtn,gten,equaln,unequaln :
begin
cmpop := true;
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
{$endif newra}
secondpass(left);
location_release(exprasmlist,left.location);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(2));
secondpass(right);
location_release(exprasmlist,right.location);
cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(1));
rg.saveintregvars(exprasmlist,all_intregisters);
{$ifdef newra}
r.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
r.number:=i shl 8 or R_SUBWHOLE;
rg.getexplicitregisterint(exprasmlist,r.number);
end;
{$else}
rg.saveintregvars(exprasmlist,regstopush);
{$endif}
cg.a_call_name(exprasmlist,'FPC_SHORTSTR_COMPARE');
rg.restoreusedintregisters(exprasmlist,pushed);
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
r.number:=i shl 8 or R_SUBWHOLE;
rg.ungetregisterint(exprasmlist,r);
end;
{$else}
rg.restoreusedintregisters(exprasmlist,pushed);
{$endif}
location_freetemp(exprasmlist,left.location);
location_freetemp(exprasmlist,right.location);
end;
@ -820,7 +847,7 @@ interface
pushedfpu,
mboverflow,
cmpop,
unsigned : boolean;
unsigned,delete:boolean;
r:Tregister;
procedure firstjmp64bitcmp;
@ -944,14 +971,22 @@ interface
{ we can reuse a CREGISTER for comparison }
if not((left.location.loc=LOC_CREGISTER) and cmpop) then
begin
{$ifdef newra}
delete:=left.location.loc<>LOC_CREGISTER;
{$else}
if (left.location.loc<>LOC_CREGISTER) then
begin
location_freetemp(exprasmlist,left.location);
location_release(exprasmlist,left.location);
end;
{$endif}
hregister:=rg.getregisterint(exprasmlist,OS_INT);
hregister2:=rg.getregisterint(exprasmlist,OS_INT);
{$ifdef newra}
cg64.a_load64_loc_reg(exprasmlist,left.location,joinreg64(hregister,hregister2),delete);
{$else}
cg64.a_load64_loc_reg(exprasmlist,left.location,joinreg64(hregister,hregister2));
{$endif}
location_reset(left.location,LOC_REGISTER,OS_64);
left.location.registerlow:=hregister;
left.location.registerhigh:=hregister2;
@ -1607,7 +1642,10 @@ begin
end.
{
$Log$
Revision 1.69 2003-05-30 23:49:18 jonas
Revision 1.70 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.69 2003/05/30 23:49:18 jonas
* a_load_loc_reg now has an extra size parameter for the destination
register (properly fixes what I worked around in revision 1.106 of
ncgutil.pas)

8
compiler/i386/n386inl.pas
View File

@ -331,8 +331,9 @@ implementation
else
emit_reg_reg(asmop,S_L,hregister,tcallparanode(left).left.location.register);
{$ifdef newra}
if scratch_reg then
{ if scratch_reg then}
rg.ungetregisterint(exprasmlist,hregister);
location_release(exprasmlist,Tcallparanode(left).left.location);
{$else}
if scratch_reg then
cg.free_scratch_reg(exprasmlist,hregister);
@ -346,7 +347,10 @@ begin
end.
{
$Log$
Revision 1.62 2003-06-01 21:38:06 peter
Revision 1.63 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.62 2003/06/01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates

21
compiler/i386/n386mat.pas
View File

@ -164,7 +164,7 @@ implementation
else
begin
hreg1:=rg.getregisterint(exprasmlist,right.location.size);
cg.a_load_loc_reg(exprasmlist,right.location,hreg1);
cg.a_load_loc_reg(exprasmlist,OS_32,right.location,hreg1);
rg.ungetregisterint(exprasmlist,hreg1);
emit_reg(op,S_L,hreg1);
end;
@ -430,13 +430,7 @@ implementation
begin
secondpass(left);
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif}
secondpass(right);
{$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs);
{$endif newra}
{ determine operator }
if nodetype=shln then
@ -452,10 +446,6 @@ implementation
location_force_reg(exprasmlist,left.location,OS_64,false);
hregisterhigh:=left.location.registerhigh;
hregisterlow:=left.location.registerlow;
if hregisterhigh.enum<>R_INTREGISTER then
internalerror(200302056);
if hregisterlow.enum<>R_INTREGISTER then
internalerror(200302056);
{ shifting by a constant directly coded: }
if (right.nodetype=ordconstn) then
@ -504,7 +494,7 @@ implementation
begin
{ load right operators in a register }
hregister2:=rg.getexplicitregisterint(exprasmlist,NR_ECX);
cg.a_load_loc_reg(exprasmlist,right.location,hregister2);
cg.a_load_loc_reg(exprasmlist,OS_32,right.location,hregister2);
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
@ -576,7 +566,7 @@ implementation
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
hregister2:=rg.getexplicitregisterint(exprasmlist,NR_ECX);
cg.a_load_loc_reg(exprasmlist,right.location,hregister2);
cg.a_load_loc_reg(exprasmlist,OS_32,right.location,hregister2);
{ right operand is in ECX }
emit_reg_reg(op,S_L,r2,location.register);
@ -1183,7 +1173,10 @@ begin
end.
{
$Log$
Revision 1.55 2003-05-31 15:04:31 peter
Revision 1.56 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.55 2003/05/31 15:04:31 peter
* load_loc_reg update
Revision 1.54 2003/05/22 21:32:29 peter

39
compiler/i386/rgcpu.pas
View File

@ -39,8 +39,10 @@ unit rgcpu;
fpuvaroffset : byte;
{ to keep the same allocation order as with the old routines }
{$ifdef newra}
procedure add_constraints(reg:Tnewregister);override;
{$else}
function getregisterint(list:Taasmoutput;size:Tcgsize):Tregister;override;
{$ifndef newra}
function getaddressregister(list:Taasmoutput):Tregister;override;
procedure ungetregisterint(list:Taasmoutput;r:Tregister); override;
function getexplicitregisterint(list:Taasmoutput;r:Tnewregister):Tregister;override;
@ -59,30 +61,37 @@ unit rgcpu;
function makeregsize(reg: tregister; size: tcgsize): tregister; override;
{ pushes and restores registers }
{$ifndef newra}
procedure pushusedintregisters(list:Taasmoutput;
var pushed:Tpushedsavedint;
const s:Tsupregset);
{$endif}
{$ifdef SUPPORT_MMX}
procedure pushusedotherregisters(list:Taasmoutput;
var pushed:Tpushedsavedother;
const s:Tregisterset);
{$endif SUPPORT_MMX}
{$ifndef newra}
procedure popusedintregisters(list:Taasmoutput;
const pushed:Tpushedsavedint);
{$endif}
{$ifdef SUPPORT_MMX}
procedure popusedotherregisters(list:Taasmoutput;
const pushed:Tpushedsavedother);
{$endif SUPPORT_MMX}
{$ifndef newra}
procedure saveusedintregisters(list:Taasmoutput;
var saved:Tpushedsavedint;
const s:Tsupregset);override;
{$endif}
procedure saveusedotherregisters(list:Taasmoutput;
var saved:Tpushedsavedother;
const s:Tregisterset);override;
{$ifndef newra}
procedure restoreusedintregisters(list:Taasmoutput;
const saved:Tpushedsavedint);override;
{$endif}
procedure restoreusedotherregisters(list:Taasmoutput;
const saved:Tpushedsavedother);override;
@ -168,16 +177,15 @@ unit rgcpu;
{************************************************************************}
{$ifdef newra}
function Trgcpu.getregisterint(list:Taasmoutput;size:Tcgsize):Tregister;
procedure Trgcpu.add_constraints(reg:Tnewregister);
begin
getregisterint:=inherited getregisterint(list,size);
if size in [OS_8,OS_S8] then
if reg and $ff in [R_SUBL,R_SUBH] then
begin
{These registers have no 8-bit subregister, so add interferences.}
add_edge(getregisterint.number shr 8,RS_ESI);
add_edge(getregisterint.number shr 8,RS_EDI);
add_edge(getregisterint.number shr 8,RS_EBP);
add_edge(reg shr 8,RS_ESI);
add_edge(reg shr 8,RS_EDI);
add_edge(reg shr 8,RS_EBP);
end;
end;
{$endif}
@ -350,7 +358,7 @@ unit rgcpu;
ungetregisterint(list,ref.index);
end;
{$ifndef newra}
procedure trgcpu.pushusedintregisters(list:Taasmoutput;
var pushed:Tpushedsavedint;
const s:Tsupregset);
@ -383,6 +391,7 @@ unit rgcpu;
testregisters;
{$endif TEMPREGDEBUG}
end;
{$endif}
{$ifdef SUPPORT_MMX}
procedure trgcpu.pushusedotherregisters(list:Taasmoutput;
@ -422,6 +431,7 @@ unit rgcpu;
end;
{$endif SUPPORT_MMX}
{$ifndef newra}
procedure trgcpu.popusedintregisters(list:Taasmoutput;
const pushed:Tpushedsavedint);
@ -448,6 +458,7 @@ unit rgcpu;
testregisters;
{$endif TEMPREGDEBUG}
end;
{$endif}
{$ifdef SUPPORT_MMX}
procedure trgcpu.popusedotherregisters(list:Taasmoutput;
@ -482,6 +493,7 @@ unit rgcpu;
end;
{$endif SUPPORT_MMX}
{$ifndef newra}
procedure trgcpu.saveusedintregisters(list:Taasmoutput;
var saved:Tpushedsavedint;
const s:Tsupregset);
@ -493,6 +505,7 @@ unit rgcpu;
else
inherited saveusedintregisters(list,saved,s);
end;
{$endif}
procedure trgcpu.saveusedotherregisters(list:Taasmoutput;var saved:Tpushedsavedother;
@ -508,7 +521,7 @@ unit rgcpu;
inherited saveusedotherregisters(list,saved,s);
end;
{$ifndef newra}
procedure trgcpu.restoreusedintregisters(list:Taasmoutput;
const saved:tpushedsavedint);
@ -519,6 +532,7 @@ unit rgcpu;
else
inherited restoreusedintregisters(list,saved);
end;
{$endif}
procedure trgcpu.restoreusedotherregisters(list:Taasmoutput;
const saved:tpushedsavedother);
@ -581,7 +595,10 @@ end.
{
$Log$
Revision 1.23 2003-06-01 21:38:06 peter
Revision 1.24 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.23 2003/06/01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates

9
compiler/m68k/cpubase.pas
View File

@ -366,10 +366,6 @@ uses
lvaluelocations = [LOC_REFERENCE,LOC_CFPUREGISTER,LOC_CREGISTER];
{# Constant defining possibly all registers which might require saving }
ALL_REGISTERS = [R_D1..R_FPCR];
ALL_INTREGISTERS = [1..255];
general_registers = [R_D0..R_D7];
general_superregisters = [RS_D0..RS_D7];
@ -709,7 +705,10 @@ implementation
end.
{
$Log$
Revision 1.20 2003-04-23 13:40:33 peter
Revision 1.21 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.20 2003/04/23 13:40:33 peter
* fix m68k compile
Revision 1.19 2003/04/23 12:35:35 florian

9
compiler/ncal.pas
View File

@ -2300,8 +2300,10 @@ type
{ procedure does a call }
if not (block_type in [bt_const,bt_type]) then
{$ifndef newra}
include(current_procinfo.flags,pi_do_call);
rg.incrementintregisterpushed(all_intregisters);
{$endif}
rg.incrementotherregisterpushed(all_registers);
end
else
@ -2336,7 +2338,9 @@ type
end;
{ It doesn't hurt to calculate it already though :) (JM) }
{$ifndef newra}
rg.incrementintregisterpushed(tprocdef(procdefinition).usedintregisters);
{$endif}
rg.incrementotherregisterpushed(tprocdef(procdefinition).usedotherregisters);
end;
@ -2569,7 +2573,10 @@ begin
end.
{
$Log$
Revision 1.162 2003-05-26 21:17:17 peter
Revision 1.163 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.162 2003/05/26 21:17:17 peter
* procinlinenode removed
* aktexit2label removed, fast exit removed
+ tcallnode.inlined_pass_2 added

186
compiler/ncgcal.pas
View File

@ -497,7 +497,7 @@ implementation
location.registerhigh:=rg.getregisterint(exprasmlist,OS_INT);
{$endif newra}
cg64.a_load64_reg_reg(exprasmlist,joinreg64(r,hregister),
location.register64);
location.register64{$ifdef newra},false{$endif});
end
else
{$endif cpu64bit}
@ -508,7 +508,7 @@ implementation
r.enum:=R_INTREGISTER;
r.number:=nr;
{$ifdef newra}
rg.getexplicitregisterint(exprasmlist,nr);
{ rg.getexplicitregisterint(exprasmlist,nr);}
rg.ungetregisterint(exprasmlist,r);
location.register:=rg.getregisterint(exprasmlist,cgsize);
{$else newra}
@ -573,26 +573,34 @@ implementation
end;
ppn:=tcallparanode(ppn.right);
end;
end;
procedure tcgcallnode.normal_pass_2;
var
regs_to_push_int : Tsupregset;
regs_to_push_other : tregisterset;
unusedstate: pointer;
pushedother : tpushedsavedother;
{$ifdef newra}
i:Tsuperregister;
regs_to_alloc,regs_to_free:Tsupregset;
{$else}
regs_to_push_int : Tsupregset;
pushedint : tpushedsavedint;
pushedregs : tmaybesave;
{$endif}
pushedother : tpushedsavedother;
oldpushedparasize : longint;
{ adress returned from an I/O-error }
iolabel : tasmlabel;
{ help reference pointer }
href : treference;
pushedregs : tmaybesave;
href,helpref : treference;
hp : tnode;
pp : tcallparanode;
store_parast_fixup,
para_alignment,
pop_size : longint;
accreg : tregister;
r,accreg,
vmtreg,vmtreg2 : tregister;
oldaktcallnode : tcallnode;
begin
if not assigned(procdefinition) then
@ -605,7 +613,7 @@ implementation
{ already here, we avoid later a push/pop }
if is_widestring(resulttype.def) then
begin
tg.GetTemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
tg.gettemp(exprasmlist,pointer_size,tt_widestring,refcountedtemp);
cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp,false);
end
else if is_ansistring(resulttype.def) then
@ -634,10 +642,12 @@ implementation
else
iolabel:=nil;
{$ifdef newra}
regs_to_alloc:=Tprocdef(procdefinition).usedintregisters;
{$else}
{ save all used registers and possible registers
used for the return value }
regs_to_push_int := tprocdef(procdefinition).usedintregisters;
regs_to_push_other := tprocdef(procdefinition).usedotherregisters;
if (not is_void(resulttype.def)) and
(not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
begin
@ -652,25 +662,35 @@ implementation
include(regs_to_push_int,RS_FUNCTION_RESULT_REG);
end;
rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
{$endif}
regs_to_push_other := tprocdef(procdefinition).usedotherregisters;
rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
{ on the ppc, ever procedure saves the non-volatile registers it uses itself }
{ and must make sure it saves its volatile registers before doing a call }
{$ifdef i386}
{ give used registers through }
{$ifndef newra}
rg.usedintinproc:=rg.usedintinproc + tprocdef(procdefinition).usedintregisters;
{$endif}
rg.usedinproc:=rg.usedinproc + tprocdef(procdefinition).usedotherregisters;
{$endif i386}
end
else
begin
regs_to_push_int := all_intregisters;
regs_to_push_other := all_registers;
{No procedure is allowed to destroy ebp.}
{$ifdef newra}
regs_to_alloc:=ALL_INTREGISTERS-[RS_FRAME_POINTER_REG];
{$else}
regs_to_push_int := all_intregisters-[RS_FRAME_POINTER_REG];
rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
{$endif}
regs_to_push_other := all_registers;
rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
{$ifdef i386}
{$ifndef newra}
rg.usedinproc:=all_registers;
{$endif i386}
{$endif}
{ no IO check for methods and procedure variables }
iolabel:=nil;
end;
@ -693,6 +713,7 @@ implementation
if assigned(right) then
secondpass(right);
{$ifdef disabled}
if (po_virtualmethod in procdefinition.procoptions) and
assigned(methodpointer) then
begin
@ -711,6 +732,7 @@ implementation
not(is_cppclass(tprocdef(procdefinition)._class)) then
cg.g_maybe_testvmt(exprasmlist,methodpointer.location.register,tprocdef(procdefinition)._class);
end;
{$endif disabled}
if assigned(left) then
begin
@ -744,43 +766,124 @@ implementation
((tprocdef(procdefinition).parast.symtablelevel)>normal_function_level) then
push_framepointer;
{$ifndef newra}
rg.saveintregvars(exprasmlist,regs_to_push_int);
{$endif}
rg.saveotherregvars(exprasmlist,regs_to_push_other);
if (po_virtualmethod in procdefinition.procoptions) and
assigned(methodpointer) then
begin
secondpass(methodpointer);
location_force_reg(exprasmlist,methodpointer.location,OS_ADDR,false);
vmtreg:=methodpointer.location.register;
{ virtual methods require an index }
if tprocdef(procdefinition).extnumber=-1 then
internalerror(200304021);
{ VMT should already be loaded in a register }
if vmtreg.number=NR_NO then
internalerror(200304022);
{ test validity of VMT }
if not(is_interface(tprocdef(procdefinition)._class)) and
not(is_cppclass(tprocdef(procdefinition)._class)) then
cg.g_maybe_testvmt(exprasmlist,vmtreg,tprocdef(procdefinition)._class);
{$ifdef newra}
{ release self }
rg.ungetaddressregister(exprasmlist,vmtreg);
vmtreg2:=rg.getabtregisterint(exprasmlist,OS_ADDR);
rg.ungetregisterint(exprasmlist,vmtreg2);
cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,vmtreg,vmtreg2);
for i:=first_supreg to last_supreg do
if i in regs_to_alloc then
begin
r.number:=i shl 8 or R_SUBWHOLE;
rg.getexplicitregisterint(exprasmlist,r.number);
end;
{$endif}
{ call method }
reference_reset_base(href,methodpointer.location.register,
reference_reset_base(href,{$ifdef newra}vmtreg2{$else}vmtreg{$endif},
tprocdef(procdefinition)._class.vmtmethodoffset(tprocdef(procdefinition).extnumber));
cg.a_call_ref(exprasmlist,href);
{ release vmt register }
rg.ungetaddressregister(exprasmlist,methodpointer.location.register);
{$ifndef newra}
{ release self }
rg.ungetaddressregister(exprasmlist,vmtreg);
{$endif}
end
else
begin
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i in regs_to_alloc then
begin
r.number:=i shl 8 or R_SUBWHOLE;
rg.getexplicitregisterint(exprasmlist,r.number);
end;
{$endif}
{ Calling interrupt from the same code requires some
extra code }
if (po_interrupt in procdefinition.procoptions) then
extra_interrupt_code;
cg.a_call_name(exprasmlist,tprocdef(procdefinition).mangledname);
end;
end
else
{ now procedure variable case }
begin
secondpass(right);
{$ifdef newra}
if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
begin
helpref:=right.location.reference;
if helpref.index.number<>NR_NO then
begin
rg.ungetregisterint(exprasmlist,helpref.index);
helpref.index:=rg.getabtregisterint(exprasmlist,OS_ADDR);
cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,
right.location.reference.index,helpref.index);
end;
if helpref.base.number<>NR_NO then
begin
rg.ungetregisterint(exprasmlist,helpref.base);
helpref.base:=rg.getabtregisterint(exprasmlist,OS_ADDR);
cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,
right.location.reference.base,helpref.base);
end;
end
else
rg.ungetregisterint(exprasmlist,right.location.register);
reference_release(exprasmlist,helpref);
location_freetemp(exprasmlist,right.location);
for i:=first_supreg to last_supreg do
if i in regs_to_alloc then
begin
r.number:=i shl 8 or R_SUBWHOLE;
rg.getexplicitregisterint(exprasmlist,r.number);
end;
{$endif}
{ Calling interrupt from the same code requires some
extra code }
if (po_interrupt in procdefinition.procoptions) then
extra_interrupt_code;
rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
cg.a_call_loc(exprasmlist,right.location);
location_release(exprasmlist,right.location);
location_freetemp(exprasmlist,right.location);
{$ifndef newra}
helpref:=right.location.reference;
rg.saveintregvars(exprasmlist,ALL_INTREGISTERS);
{$endif}
rg.saveotherregvars(exprasmlist,ALL_REGISTERS);
if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
cg.a_call_ref(exprasmlist,helpref)
else
cg.a_call_reg(exprasmlist,right.location.register);
{ cg.a_call_loc(exprasmlist,right.location);}
{$ifndef newra}
location_release(exprasmlist,right.location);
location_freetemp(exprasmlist,right.location);
{$endif newra}
end;
{ Need to remove the parameters from the stack? }
@ -811,6 +914,26 @@ implementation
testregisters32;
{$endif TEMPREGDEBUG}
{$ifdef newra}
regs_to_free:=regs_to_alloc;
exclude(regs_to_alloc,RS_STACK_POINTER_REG);
if (not is_void(resulttype.def)) and
(not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
begin
exclude(regs_to_free,RS_FUNCTION_RESULT_REG);
{$ifndef cpu64bit}
if resulttype.def.size>sizeof(aword) then
exclude(regs_to_free,RS_FUNCTION_RESULT64_HIGH_REG);
{$endif cpu64bit}
end;
r.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
if i in regs_to_free then
begin
r.number:=i shl 8 or R_SUBWHOLE;
rg.ungetregisterint(exprasmlist,r);
end;
{$endif}
{ handle function results }
if (not is_void(resulttype.def)) then
handle_return_value
@ -827,7 +950,9 @@ implementation
{ restore registers }
rg.restoreusedotherregisters(exprasmlist,pushedother);
{$ifndef newra}
rg.restoreusedintregisters(exprasmlist,pushedint);
{$endif}
{ release temps of paras }
release_para_temps;
@ -866,7 +991,9 @@ implementation
regs_to_push_other : tregisterset;
unusedstate: pointer;
pushedother : tpushedsavedother;
{$ifndef newra}
pushedint : tpushedsavedint;
{$endif}
oldpushedparasize : longint;
{ adress returned from an I/O-error }
iolabel : tasmlabel;
@ -1045,7 +1172,9 @@ implementation
{$endif cpu64bit}
include(regs_to_push_int,RS_FUNCTION_RESULT_REG);
end;
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
{$endif}
rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
{$ifdef i386}
@ -1087,7 +1216,9 @@ implementation
end;
aktcallnode:=oldaktcallnode;
{$ifndef newra}
rg.saveintregvars(exprasmlist,regs_to_push_int);
{$endif}
rg.saveotherregvars(exprasmlist,regs_to_push_other);
{ takes care of local data initialization }
@ -1164,7 +1295,9 @@ implementation
{ restore registers }
rg.restoreusedotherregisters(exprasmlist,pushedother);
{$ifndef newra}
rg.restoreusedintregisters(exprasmlist,pushedint);
{$endif}
{ release temps of paras }
release_para_temps;
@ -1242,7 +1375,10 @@ begin
end.
{
$Log$
Revision 1.81 2003-06-01 21:38:06 peter
Revision 1.82 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.81 2003/06/01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates

24
compiler/ncgld.pas
View File

@ -68,7 +68,9 @@ implementation
i : longint;
href : treference;
newsize : tcgsize;
{$ifndef newra}
pushed : tpushedsavedint;
{$endif}
dorelocatelab,
norelocatelab : tasmlabel;
begin
@ -143,19 +145,30 @@ implementation
cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
cg.a_jmp_always(exprasmlist,norelocatelab);
cg.a_label(exprasmlist,dorelocatelab);
if hregister.enum<>R_INTREGISTER then
internalerror(200301171);
{ don't save the allocated register else the result will be destroyed later }
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,[RS_FUNCTION_RESULT_REG]-[hregister.number shr 8]);
{$endif}
reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(symtableentry).mangledname),0);
cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(1));
{$ifdef newra}
rg.ungetregisterint(exprasmlist,hregister);
r:=rg.getexplicitregisterint(exprasmlist,NR_EAX);
{$endif}
{ the called procedure isn't allowed to change }
{ any register except EAX }
cg.a_call_reg(exprasmlist,hregister);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,r);
hregister:=rg.getregisterint(exprasmlist,OS_ADDR);
{$else}
r.enum:=R_INTREGISTER;
r.number:=NR_FUNCTION_RESULT_REG;
{$endif}
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_ADDR,r,hregister);
{$ifndef newra}
rg.restoreusedintregisters(exprasmlist,pushed);
{$endif}
cg.a_label(exprasmlist,norelocatelab);
location.reference.base:=hregister;
end
@ -539,7 +552,7 @@ implementation
cgsize:=def_cgsize(left.resulttype.def);
if cgsize in [OS_64,OS_S64] then
cg64.a_load64_ref_reg(exprasmlist,
right.location.reference,left.location.register64)
right.location.reference,left.location.register64{$ifdef newra},false{$endif})
else
cg.a_load_ref_reg(exprasmlist,cgsize,
right.location.reference,left.location.register);
@ -922,7 +935,10 @@ begin
end.
{
$Log$
Revision 1.64 2003-05-30 23:57:08 peter
Revision 1.65 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.64 2003/05/30 23:57:08 peter
* more sparc cleanup
* accumulator removed, splitted in function_return_reg (called) and
function_result_reg (caller)

120
compiler/ncgmem.pas
View File

@ -455,7 +455,10 @@ implementation
poslabel,
neglabel : tasmlabel;
hreg : tregister;
i:Tsuperregister;
{$ifndef newra}
pushed : tpushedsavedint;
{$endif}
begin
if is_open_array(left.resulttype.def) or
is_array_of_const(left.resulttype.def) then
@ -506,12 +509,33 @@ implementation
else
if is_dynamic_array(left.resulttype.def) then
begin
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
{$endif}
cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(2));
cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(1));
{$ifdef newra}
hreg.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.getexplicitregisterint(exprasmlist,hreg.number);
end;
{$else}
rg.saveintregvars(exprasmlist,all_intregisters);
{$endif}
cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK');
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.ungetregisterint(exprasmlist,hreg);
end;
{$else}
rg.restoreusedintregisters(exprasmlist,pushed);
{$endif}
end
else
cg.g_rangecheck(exprasmlist,right,left.resulttype.def);
@ -524,7 +548,12 @@ implementation
extraoffset : longint;
t : tnode;
href : treference;
{$ifdef newra}
hreg:Tregister;
i:Tsuperregister;
{$else}
pushed : tpushedsavedint;
{$endif}
isjump : boolean;
otl,ofl : tasmlabel;
newsize : tcgsize;
@ -546,11 +575,32 @@ implementation
begin
if left.location.loc<>LOC_REFERENCE then
internalerror(200304236);
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
{$endif}
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(1));
{$ifdef newra}
hreg.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.getexplicitregisterint(exprasmlist,hreg.number);
end;
{$else}
rg.saveintregvars(exprasmlist,all_intregisters);
{$endif}
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.ungetregisterint(exprasmlist,hreg);
end;
{$else}
rg.restoreusedintregisters(exprasmlist,pushed);
{$endif}
end;
case left.location.loc of
@ -572,11 +622,32 @@ implementation
we can use the ansistring routine here }
if (cs_check_range in aktlocalswitches) then
begin
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
{$endif}
cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
{$ifdef newra}
hreg.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.getexplicitregisterint(exprasmlist,hreg.number);
end;
{$else}
rg.saveintregvars(exprasmlist,all_intregisters);
cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
{$endif}
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.ungetregisterint(exprasmlist,hreg);
end;
{$else}
rg.restoreusedintregisters(exprasmlist,pushed);
{$endif}
end;
{ in ansistrings/widestrings S[1] is p<w>char(S)[0] !! }
@ -649,14 +720,35 @@ implementation
st_widestring,
st_ansistring:
begin
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
{$endif}
cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(2));
href:=location.reference;
dec(href.offset,7);
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
{$ifdef newra}
hreg.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.getexplicitregisterint(exprasmlist,hreg.number);
end;
{$else}
rg.saveintregvars(exprasmlist,all_intregisters);
{$endif}
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.ungetregisterint(exprasmlist,hreg);
end;
{$else}
rg.restoreusedintregisters(exprasmlist,pushed);
{$endif}
end;
st_shortstring:
@ -783,14 +875,35 @@ implementation
st_widestring,
st_ansistring:
begin
{$ifndef newra}
rg.saveusedintregisters(exprasmlist,pushed,all_intregisters);
{$endif}
cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(2));
href:=location.reference;
dec(href.offset,7);
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
{$ifdef newra}
hreg.enum:=R_INTREGISTER;
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.getexplicitregisterint(exprasmlist,hreg.number);
end;
{$else}
rg.saveintregvars(exprasmlist,all_intregisters);
{$endif}
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
{$ifdef newra}
for i:=first_supreg to last_supreg do
if i<>RS_FRAME_POINTER_REG then
begin
hreg.number:=i shl 8 or R_SUBWHOLE;
rg.ungetregisterint(exprasmlist,hreg);
end;
{$else}
rg.restoreusedintregisters(exprasmlist,pushed);
{$endif}
end;
st_shortstring:
begin
@ -824,7 +937,10 @@ begin
end.
{
$Log$
Revision 1.57 2003-06-02 22:35:45 florian
Revision 1.58 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.57 2003/06/02 22:35:45 florian
* better handling of CREGISTER in subscript nodes
Revision 1.56 2003/06/01 21:38:06 peter

6
compiler/ncgopt.pas
View File

@ -196,14 +196,16 @@ begin
location_copy(location,left.location);
end;
begin
caddsstringcharoptnode := tcgaddsstringcharoptnode;
end.
{
$Log$
Revision 1.4 2003-06-01 21:38:06 peter
Revision 1.5 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.4 2003/06/01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates

212
compiler/ncgutil.pas
View File

@ -63,8 +63,9 @@ interface
para_offset:longint;alignment : longint;
const locpara : tparalocation);
procedure genentrycode(list : TAAsmoutput;stackframe:longint;inlined : boolean);
procedure genexitcode(list : TAAsmoutput;inlined:boolean);
procedure genentrycode(list:TAAsmoutput;inlined:boolean);
procedure gen_stackalloc_code(list:Taasmoutput;stackframe:cardinal);
procedure genexitcode(list:Taasmoutput;inlined:boolean);
procedure geninlineentrycode(list : TAAsmoutput;stackframe:longint);
procedure geninlineexitcode(list : TAAsmoutput;inlined:boolean);
@ -382,7 +383,7 @@ implementation
hreg64.reglo:=hregister;
hreg64.reghi:=hregisterhi;
{ load value in new register }
cg64.a_load64_loc_reg(list,l,hreg64);
cg64.a_load64_loc_reg(list,l,hreg64{$ifdef newra},false{$endif});
location_reset(l,LOC_REGISTER,dst_size);
l.registerlow:=hregister;
l.registerhigh:=hregisterhi;
@ -430,6 +431,9 @@ implementation
hregister:=rg.getregisterint(list,dst_size);
end;
hregister.number:=(hregister.number and not $ff) or cgsize2subreg(dst_size);
{$ifdef newra}
rg.add_constraints(hregister.number);
{$endif}
{ load value in new register }
case l.loc of
LOC_FLAGS :
@ -596,6 +600,22 @@ implementation
end;
{$endif cpu64bit}
{$ifdef newra}
procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
var oldloc:Tlocation;
begin
oldloc:=l;
location_force(list, l, dst_size, maybeconst);
{ release previous location before demanding a new register }
if (oldloc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
begin
location_freetemp(list,oldloc);
location_release(list,oldloc);
end;
end;
{$else}
procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
begin
{ release previous location before demanding a new register }
@ -606,7 +626,7 @@ implementation
end;
location_force(list, l, dst_size, maybeconst)
end;
{$endif}
procedure location_force_fpureg(list: TAAsmoutput;var l: tlocation;maybeconst:boolean);
var
@ -1286,7 +1306,7 @@ implementation
r2.enum:=R_INTREGISTER;
r2.number:=NR_FUNCTION_RETURN64_HIGH_REG;
cg.a_reg_alloc(list,r2);
cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
cg64.a_load64_ref_reg(list,resloc,joinreg64(r,r2){$ifdef newra},false{$endif});
end
else
{$endif cpu64bit}
@ -1323,7 +1343,11 @@ implementation
r2.enum:=R_INTREGISTER;
r2.number:=NR_FUNCTION_RETURN64_HIGH_REG;
cg.a_reg_alloc(list,r2);
<<<<<<< ncgutil.pas
cg64.a_load64_ref_reg(list,href,joinreg64(r,r2){$ifdef newra},false{$endif});
=======
cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
>>>>>>> 1.117
end
else
{$endif cpu64bit}
@ -1339,17 +1363,13 @@ implementation
end;
procedure genentrycode(list : TAAsmoutput;stackframe:longint;inlined : boolean);
procedure genentrycode(list:TAAsmoutput;inlined:boolean);
var
hs : string;
href : treference;
stackalloclist : taasmoutput;
hp : tparaitem;
rsp : tregister;
begin
if not inlined then
stackalloclist:=taasmoutput.Create;
{ the actual stack allocation code, symbol entry point and
gdb stabs information is generated AFTER the rest of this
code, since temp. allocation might occur before - carl
@ -1515,81 +1535,81 @@ implementation
if inlined then
load_regvars(list,nil);
{************************* Stack allocation **************************}
{ and symbol entry point as well as debug information }
{ will be inserted in front of the rest of this list. }
{ Insert alignment and assembler names }
if not inlined then
begin
{ Align, gprof uses 16 byte granularity }
if (cs_profile in aktmoduleswitches) then
stackalloclist.concat(Tai_align.Create(16))
else
stackalloclist.concat(Tai_align.Create(aktalignment.procalign));
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
if (po_public in current_procdef.procoptions) then
tprocsym(current_procdef.procsym).is_global:=true;
current_procdef.concatstabto(stackalloclist);
tprocsym(current_procdef.procsym).isstabwritten:=true;
end;
{$endif GDB}
repeat
hs:=current_procdef.aliasnames.getfirst;
if hs='' then
break;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) and
target_info.use_function_relative_addresses then
stackalloclist.concat(Tai_stab_function_name.Create(strpnew(hs)));
{$endif GDB}
if (cs_profile in aktmoduleswitches) or
(po_public in current_procdef.procoptions) then
stackalloclist.concat(Tai_symbol.Createname_global(hs,0))
else
stackalloclist.concat(Tai_symbol.Createname(hs,0));
until false;
stackframe:=stackframe+tg.gettempsize;
{$ifndef m68k}
{ give a warning if the limit of local variables is reached }
if stackframe > maxlocalsize then
Message(cg_w_localsize_too_big);
{$endif}
{$ifndef powerpc}
{ at least for the ppc this applies always, so this code isn't usable (FK) }
{ omit stack frame ? }
if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
begin
CGMessage(cg_d_stackframe_omited);
if stackframe<>0 then
cg.g_stackpointer_alloc(stackalloclist,stackframe);
end
else
{$endif powerpc}
begin
if (po_interrupt in current_procdef.procoptions) then
cg.g_interrupt_stackframe_entry(stackalloclist);
cg.g_stackframe_entry(stackalloclist,stackframe);
{ never call stack checking before the standard system unit
has not been initialized
}
if (cs_check_stack in aktlocalswitches) and (current_procdef.proctypeoption<>potype_proginit) then
cg.g_stackcheck(stackalloclist,stackframe);
end;
list.insertlist(stackalloclist);
stackalloclist.free;
end;
{************************* End Stack allocation **************************}
end;
procedure gen_stackalloc_code(list:Taasmoutput;stackframe:cardinal);
var hs:string;
begin
{************************* Stack allocation **************************}
{ and symbol entry point as well as debug information }
{ will be inserted in front of the rest of this list. }
{ Insert alignment and assembler names }
{ Align, gprof uses 16 byte granularity }
if (cs_profile in aktmoduleswitches) then
list.concat(Tai_align.create(16))
else
list.concat(Tai_align.create(aktalignment.procalign));
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
if (po_public in current_procdef.procoptions) then
Tprocsym(current_procdef.procsym).is_global:=true;
current_procdef.concatstabto(list);
Tprocsym(current_procdef.procsym).isstabwritten:=true;
end;
{$endif GDB}
repeat
hs:=current_procdef.aliasnames.getfirst;
if hs='' then
break;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) and
target_info.use_function_relative_addresses then
list.concat(Tai_stab_function_name.create(strpnew(hs)));
{$endif GDB}
if (cs_profile in aktmoduleswitches) or
(po_public in current_procdef.procoptions) then
list.concat(Tai_symbol.createname_global(hs,0))
else
list.concat(Tai_symbol.createname(hs,0));
until false;
stackframe:=stackframe+tg.gettempsize;
{$ifndef m68k}
{ give a warning if the limit of local variables is reached }
if stackframe>maxlocalsize then
message(cg_w_localsize_too_big);
{$endif}
{$ifndef powerpc}
{ at least for the ppc this applies always, so this code isn't usable (FK) }
{ omit stack frame ? }
if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
begin
CGmessage(cg_d_stackframe_omited);
if stackframe<>0 then
cg.g_stackpointer_alloc(list,stackframe);
end
else
{$endif powerpc}
begin
if (po_interrupt in current_procdef.procoptions) then
cg.g_interrupt_stackframe_entry(list);
cg.g_stackframe_entry(list,stackframe);
{Never call stack checking before the standard system unit
has been initialized.}
if (cs_check_stack in aktlocalswitches) and (current_procdef.proctypeoption<>potype_proginit) then
cg.g_stackcheck(list,stackframe);
end;
end;
procedure genexitcode(list : TAAsmoutput;inlined:boolean);
procedure genexitcode(list : TAAsmoutput;inlined:boolean);
var
{$ifdef GDB}
stabsendlabel : tasmlabel;
@ -1601,10 +1621,14 @@ implementation
srsym : tsym;
usesacc,
usesacchi,
usesfpu : boolean;
rsp,r : Tregister;
retsize : longint;
usesself,usesfpu : boolean;
pd : tprocdef;
rsp,tmpreg,r : Tregister;
retsize:cardinal;
nostackframe:boolean;
begin
{ nostackframe:=current_procinfo.framepointer.number=NR_STACK_POINTER_REG;}
if aktexitlabel.is_used then
cg.a_label(list,aktexitlabel);
@ -1709,11 +1733,10 @@ implementation
if (current_procinfo.framepointer.number=NR_STACK_POINTER_REG) then
begin
if (tg.gettempsize<>0) then
cg.a_op_const_reg(list,OP_ADD,OS_ADDR,tg.gettempsize,current_procinfo.framepointer);
cg.a_op_const_reg(list,OP_ADD,OS_32,tg.gettempsize,current_procinfo.framepointer);
end
else
cg.g_restore_frame_pointer(list);
if not (po_assembler in current_procdef.procoptions) then
end;
{$endif}
@ -1848,7 +1871,11 @@ implementation
begin
r:=rg.getregisterint(list,OS_INT);
r2:=rg.getregisterint(list,OS_INT);
<<<<<<< ncgutil.pas
cg64.a_load64_ref_reg(list,href,joinreg64(r,r2){$ifdef newra},false{$endif});
=======
cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
>>>>>>> 1.117
end
else
{$endif cpu64bit}
@ -1877,7 +1904,11 @@ implementation
begin
r:=rg.getregisterint(list,OS_INT);
r2:=rg.getregisterint(list,OS_INT);
<<<<<<< ncgutil.pas
cg64.a_load64_ref_reg(list,href,joinreg64(r,r2){$ifdef newra},false{$endif});
=======
cg64.a_load64_loc_reg(list,resloc,joinreg64(r,r2));
>>>>>>> 1.117
end
else
{$endif cpu64bit}
@ -1952,7 +1983,10 @@ implementation
end.
{
$Log$
Revision 1.117 2003-06-02 21:42:05 jonas
Revision 1.118 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.117 2003/06/02 21:42:05 jonas
* function results can now also be regvars
- removed tprocinfo.return_offset, never use it again since it's invalid
if the result is a regvar

14
compiler/pass_2.pas
View File

@ -287,6 +287,15 @@ implementation
{$ifndef i386}
cleanup_regvars(current_procinfo.aktexitcode);
{$endif i386}
{$ifdef newra}
if current_procinfo.framepointer.number=NR_EBP then
begin
{Make sure the register allocator won't allocate registers
into ebp.}
include(rg.usedintinproc,RS_EBP);
exclude(rg.unusedregsint,RS_EBP);
end;
{$endif}
do_secondpass(p);
@ -300,7 +309,10 @@ implementation
end.
{
$Log$
Revision 1.53 2003-05-26 21:17:17 peter
Revision 1.54 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.53 2003/05/26 21:17:17 peter
* procinlinenode removed
* aktexit2label removed, fast exit removed
+ tcallnode.inlined_pass_2 added

10
compiler/pmodules.pas
View File

@ -793,7 +793,8 @@ implementation
{ generate a dummy function }
objectlibrary.getlabel(aktexitlabel);
include(current_procinfo.flags,pi_do_call);
genentrycode(list,0,false);
gen_stackalloc_code(list,0);
genentrycode(list,false);
genexitcode(list,false);
list.convert_registers;
release_main_proc(pd);
@ -867,7 +868,7 @@ implementation
{ handle the global switches }
setupglobalswitches;
Message1(unit_u_loading_interface_units,current_module.modulename^);
message1(unit_u_loading_interface_units,current_module.modulename^);
{ update status }
status.currentmodule:=current_module.realmodulename^;
@ -1474,7 +1475,10 @@ So, all parameters are passerd into registers in sparc architecture.}
end.
{
$Log$
Revision 1.109 2003-05-26 21:17:17 peter
Revision 1.110 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.109 2003/05/26 21:17:17 peter
* procinlinenode removed
* aktexit2label removed, fast exit removed
+ tcallnode.inlined_pass_2 added

49
compiler/psub.pas
View File

@ -554,6 +554,8 @@ implementation
oldexitlabel : tasmlabel;
oldaktmaxfpuregisters : longint;
oldfilepos : tfileposinfo;
stackalloccode : Taasmoutput;
begin
{ the initialization procedure can be empty, then we
don't need to generate anything. When it was an empty
@ -584,7 +586,9 @@ implementation
rg.usedinproc:=[];
rg.usedintinproc:=[];
rg.usedbyproc:=[];
{$ifndef newra}
rg.usedintbyproc:=[];
{$endif}
{ set the start offset to the start of the temp area in the stack }
tg.setfirsttemp(current_procinfo.firsttemp_offset);
@ -594,7 +598,7 @@ implementation
{ first generate entry code with the correct position and switches }
aktfilepos:=current_procinfo.entrypos;
aktlocalswitches:=current_procinfo.entryswitches;
genentrycode(current_procinfo.aktentrycode,0,false);
genentrycode(current_procinfo.aktentrycode,false);
{ now generate exit code with the correct position and switches }
aktfilepos:=current_procinfo.exitpos;
@ -602,8 +606,8 @@ implementation
genexitcode(current_procinfo.aktexitcode,false);
{ now all the registers used are known }
current_procdef.usedintregisters:=rg.usedintinproc;
current_procdef.usedotherregisters:=rg.usedinproc;
{ current_procdef.usedintregisters:=rg.usedintinproc;
current_procdef.usedotherregisters:=rg.usedinproc;}
current_procinfo.aktproccode.insertlist(current_procinfo.aktentrycode);
current_procinfo.aktproccode.concatlist(current_procinfo.aktexitcode);
{$ifdef newra}
@ -617,13 +621,7 @@ implementation
rg.prepare_colouring;
rg.colour_registers;
rg.epilogue_colouring;
{Are there spilled registers? We cannot do that yet.}
if rg.spillednodes<>'' then
internalerror(200304221);
{if not try_fast_spill(rg) then
slow_spill(rg);
}
until rg.spillednodes='';
until (rg.spillednodes='') or not rg.spill_registers(current_procinfo.aktproccode,rg.spillednodes);
current_procinfo.aktproccode.translate_registers(rg.colour);
current_procinfo.aktproccode.convert_registers;
{$else newra}
@ -637,6 +635,21 @@ implementation
{$endif newra}
end;
stackalloccode:=Taasmoutput.create;
gen_stackalloc_code(stackalloccode,0);
stackalloccode.convert_registers;
current_procinfo.aktproccode.insertlist(stackalloccode);
stackalloccode.destroy;
{ now all the registers used are known }
{ Remove all imaginary registers from the used list.}
{$ifdef newra}
current_procdef.usedintregisters:=rg.usedintinproc*ALL_INTREGISTERS-rg.savedbyproc;
{$else}
current_procdef.usedintregisters:=rg.usedintinproc;
{$endif}
current_procdef.usedotherregisters:=rg.usedinproc;
{ save local data (casetable) also in the same file }
if assigned(current_procinfo.aktlocaldata) and
(not current_procinfo.aktlocaldata.empty) then
@ -648,8 +661,8 @@ implementation
{ add the procedure to the codesegment }
if (cs_create_smart in aktmoduleswitches) then
codeSegment.concat(Tai_cut.Create);
codeSegment.concatlist(current_procinfo.aktproccode);
codesegment.concat(Tai_cut.Create);
codesegment.concatlist(current_procinfo.aktproccode);
{ all registers can be used again }
rg.resetusableregisters;
@ -751,6 +764,7 @@ implementation
procedure tcgprocinfo.parse_body;
var
oldprocdef : tprocdef;
stackalloccode : Taasmoutput;
oldprocinfo : tprocinfo;
begin
oldprocdef:=current_procdef;
@ -785,6 +799,12 @@ implementation
{ constant symbols are inserted in this symboltable }
constsymtable:=symtablestack;
{ reset the temporary memory }
rg.cleartempgen;
rg.usedintinproc:=[];
rg.usedinproc:=[];
rg.usedbyproc:=[];
{ save entry info }
entrypos:=aktfilepos;
entryswitches:=aktlocalswitches;
@ -1213,7 +1233,10 @@ begin
end.
{
$Log$
Revision 1.121 2003-05-31 20:23:39 jonas
Revision 1.122 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.121 2003/05/31 20:23:39 jonas
* added pi_do_call if a procedure has a value shortstring parameter
(it's copied to the local stackframe with a helper)

7
compiler/regvars.pas
View File

@ -150,6 +150,7 @@ implementation
r : Tregister;
siz : tcgsize;
begin
{$ifndef newra}
{ max. optimizations }
{ only if no asm is used }
{ and no try statement }
@ -298,6 +299,7 @@ implementation
end;
end;
end;
{$endif}
end;
@ -606,7 +608,10 @@ end.
{
$Log$
Revision 1.53 2003-05-31 20:33:57 jonas
Revision 1.54 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.53 2003/05/31 20:33:57 jonas
* temp fix/hack for nested procedures (disable regvars in all procedures
that have nested procedures)
* leave register parameters in their own register (instead of storing

458
compiler/rgobj.pas
View File

@ -86,6 +86,10 @@ unit rgobj;
{$endif}
;
const ALL_REGISTERS=[firstreg..lastreg];
ALL_INTREGISTERS=[first_supreg..last_supreg]-[RS_STACK_POINTER_REG];
type
@ -101,7 +105,9 @@ unit rgobj;
end;
tpushedsavedother = array[firstreg..lastreg] of tpushedsavedloc;
{$ifndef newra}
Tpushedsavedint = array[first_supreg..last_supreg] of Tpushedsavedloc;
{$endif}
Tinterferencebitmap=array[Tsuperregister] of set of Tsuperregister;
Tinterferenceadjlist=array[Tsuperregister] of Pstring;
@ -128,6 +134,9 @@ unit rgobj;
ms_worklist_moves,ms_active_moves);
Tmoveins=class(Tlinkedlistitem)
moveset:Tmoveset;
{ $ifdef ra_debug}
x,y:Tsuperregister;
{ $endif}
instruction:Taicpu;
end;
@ -168,13 +177,19 @@ unit rgobj;
}
usedbyproc,
usedinproc : tregisterset;
{$ifdef newra}
savedbyproc,
{$else}
usedintbyproc,
{$endif}
usedaddrbyproc,
usedintinproc,
usedaddrinproc:Tsupregset;
reg_pushes_other : regvarother_longintarray;
{$ifndef newra}
reg_pushes_int : regvarint_longintarray;
{$endif}
is_reg_var_other : regvarother_booleanarray;
is_reg_var_int:Tsupregset;
regvar_loaded_other: regvarother_booleanarray;
@ -194,7 +209,20 @@ unit rgobj;
An internalerror will be generated if there
is no more free registers which can be allocated
}
function getregisterint(list:Taasmoutput;size:Tcgsize):Tregister;virtual;
function getregisterint(list:Taasmoutput;size:Tcgsize):Tregister;{$ifndef newra}virtual;{$endif}
{$ifdef newra}
procedure add_constraints(reg:Tnewregister);virtual;
{# Allocate an ABT register
An internalerror will be generated if there
is no more free registers which can be allocated
An explanantion of abt registers can be found near the implementation.
}
function getabtregisterint(list:Taasmoutput;size:Tcgsize):Tregister;
{$endif}
{# Free a general purpose register
@param(r register to free)
@ -279,7 +307,9 @@ unit rgobj;
{# saves register variables (restoring happens automatically) }
{$ifndef newra}
procedure saveintregvars(list:Taasmoutput;const s:Tsupregset);
{$endif}
procedure saveotherregvars(list:Taasmoutput;const s:Tregisterset);
{# Saves in temporary references (allocated via the temp. allocator)
@ -293,9 +323,11 @@ unit rgobj;
@param(saved) Array of saved register information
@param(s) Registers which might require saving
}
{$ifndef newra}
procedure saveusedintregisters(list:Taasmoutput;
var saved:Tpushedsavedint;
const s:Tsupregset);virtual;
{$endif}
procedure saveusedotherregisters(list:Taasmoutput;
var saved:Tpushedsavedother;
const s:Tregisterset);virtual;
@ -305,13 +337,17 @@ unit rgobj;
On processors which have instructions which manipulate the stack,
this routine should be overriden for performance reasons.
}
{$ifndef newra}
procedure restoreusedintregisters(list:Taasmoutput;
const saved:Tpushedsavedint);virtual;
{$endif}
procedure restoreusedotherregisters(list:Taasmoutput;
const saved:Tpushedsavedother);virtual;
{ used when deciding which registers to use for regvars }
{$ifndef newra}
procedure incrementintregisterpushed(const s:Tsupregset);
{$endif}
procedure incrementotherregisterpushed(const s: tregisterset);
procedure clearregistercount;
procedure resetusableregisters;virtual;
@ -332,6 +368,7 @@ unit rgobj;
procedure prepare_colouring;
procedure epilogue_colouring;
procedure colour_registers;
function spill_registers(list:Taasmoutput;const regs_to_spill:string):boolean;
{$endif newra}
protected
cpu_registers:byte;
@ -342,6 +379,7 @@ unit rgobj;
simplifyworklist,freezeworklist,spillworklist:string;
coalescednodes:string;
selectstack:string;
abtlist:string;
movelist:array[Tsuperregister] of Pmovelist;
worklist_moves,active_moves,frozen_moves,
coalesced_moves,constrained_moves:Tlinkedlist;
@ -352,7 +390,7 @@ unit rgobj;
var unusedregs:Tregisterset;var countunusedregs:byte): tregister;
function getregistergenint(list:Taasmoutput;subreg:Tsubregister;
const lowreg,highreg:Tsuperregister;
var fusedinproc,fusedbyproc,unusedregs:Tsupregset
var fusedinproc,{$ifndef newra}fusedbyproc,{$endif}unusedregs:Tsupregset
{$ifndef newra};var countunusedregs:byte{$endif}):Tregister;
procedure ungetregistergen(list: taasmoutput; const r: tregister;
const usableregs:tregisterset;var unusedregs: tregisterset; var countunusedregs: byte);
@ -360,6 +398,10 @@ unit rgobj;
const usableregs:Tsupregset;
var unusedregs:Tsupregset
{$ifndef newra};var countunusedregs:byte{$endif});
{$ifdef newra}
procedure getregisterintinline(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister);
procedure ungetregisterintinline(list:Taasmoutput;position:Tai;const r:Tregister);
{$endif}
{$ifdef TEMPREGDEBUG}
reg_user : regvar_ptreearray;
reg_releaser : regvar_ptreearray;
@ -388,6 +430,7 @@ unit rgobj;
procedure freeze;
procedure select_spill;
procedure assign_colours;
procedure clear_interferences(u:Tsuperregister);
{$endif}
end;
@ -495,6 +538,7 @@ unit rgobj;
fillchar(degree,sizeof(degree),0);
fillchar(movelist,sizeof(movelist),0);
worklist_moves:=Tlinkedlist.create;
abtlist:='';
{$endif}
end;
@ -525,7 +569,7 @@ unit rgobj;
function Trgobj.getregistergenint(list:Taasmoutput;
subreg:Tsubregister;
const lowreg,highreg:Tsuperregister;
var fusedinproc,fusedbyproc,unusedregs:Tsupregset
var fusedinproc,{$ifndef newra}fusedbyproc,{$endif}unusedregs:Tsupregset
{$ifndef newra};var countunusedregs:byte{$endif}):Tregister;
{$ifdef powerpc}
@ -551,12 +595,12 @@ unit rgobj;
i:=lowreg
else
inc(i);
if i in unusedregs then
if (i in unusedregs) {$ifdef newra} and (pos(char(i),abtlist)=0) {$endif} then
begin
exclude(unusedregs,i);
include(fusedinproc,i);
include(fusedbyproc,i);
{$ifndef newra}
include(fusedbyproc,i);
dec(countunusedregs);
{$endif}
r.enum:=R_INTREGISTER;
@ -623,7 +667,7 @@ unit rgobj;
{$ifdef EXTTEMPREGDEBUG}
begin
comment(v_debug,'register freed twice '+supreg_name(supreg));
testregisters32;
testregisters32
exit;
end
{$else EXTTEMPREGDEBUG}
@ -666,8 +710,8 @@ unit rgobj;
{$else}
first_supreg,
last_supreg,
{$endif}
usedintbyproc,
{$endif}
usedintinproc,
unusedregsint{$ifndef newra},
countunusedregsint{$endif});
@ -675,8 +719,17 @@ unit rgobj;
reg_user[result]:=curptree^;
testregisters32;
{$endif TEMPREGDEBUG}
{$ifdef newra}
add_constraints(getregisterint.number);
{$endif}
end;
{$ifdef newra}
procedure Trgobj.add_constraints(reg:Tnewregister);
begin
end;
{$endif}
procedure trgobj.ungetregisterint(list : taasmoutput; r : tregister);
@ -708,7 +761,9 @@ unit rgobj;
{$endif newra}
exclude(unusedregsint,r shr 8);
include(usedintinproc,r shr 8);
{$ifndef newra}
include(usedintbyproc,r shr 8);
{$endif}
r2.enum:=R_INTREGISTER;
r2.number:=r;
list.concat(tai_regalloc.alloc(r2));
@ -846,6 +901,7 @@ unit rgobj;
unusedregsfpu:=usableregsfpu;
unusedregsmm:=usableregsmm;
{$ifdef newra}
savedbyproc:=[];
for i:=low(Tsuperregister) to high(Tsuperregister) do
begin
if igraph.adjlist[i]<>nil then
@ -857,6 +913,7 @@ unit rgobj;
fillchar(igraph,sizeof(igraph),0);
fillchar(degree,sizeof(degree),0);
worklist_moves.clear;
abtlist:='';
{$endif}
end;
@ -870,7 +927,7 @@ unit rgobj;
ungetregisterint(list,ref.index);
end;
{$ifndef newra}
procedure trgobj.saveintregvars(list:Taasmoutput;const s:Tsupregset);
var r:Tsuperregister;
@ -887,6 +944,7 @@ unit rgobj;
store_regvar(list,hr);
end;
end;
{$endif}
procedure trgobj.saveotherregvars(list: taasmoutput; const s: tregisterset);
var
@ -906,7 +964,7 @@ unit rgobj;
store_regvar(list,r);
end;
{$ifndef newra}
procedure trgobj.saveusedintregisters(list:Taasmoutput;
var saved:Tpushedsavedint;
const s:Tsupregset);
@ -935,15 +993,14 @@ unit rgobj;
cg.a_load_reg_ref(list,OS_INT,r2,hr);
cg.a_reg_dealloc(list,r2);
include(unusedregsint,r);
{$ifndef newra}
inc(countunusedregsint);
{$endif}
end;
end;
{$ifdef TEMPREGDEBUG}
testregisters32;
{$endif TEMPREGDEBUG}
end;
{$endif}
procedure trgobj.saveusedotherregisters(list: taasmoutput;
var saved : tpushedsavedother; const s: tregisterset);
@ -1004,7 +1061,7 @@ unit rgobj;
{$endif TEMPREGDEBUG}
end;
{$ifndef newra}
procedure trgobj.restoreusedintregisters(list:Taasmoutput;
const saved:Tpushedsavedint);
@ -1031,9 +1088,7 @@ unit rgobj;
may not be real (JM) }
else
begin
{$ifndef newra}
dec(countunusedregsint);
{$endif}
exclude(unusedregsint,r);
end;
tg.UnGetTemp(list,hr);
@ -1043,6 +1098,7 @@ unit rgobj;
testregisters32;
{$endif TEMPREGDEBUG}
end;
{$endif}
procedure trgobj.restoreusedotherregisters(list : taasmoutput;
const saved : tpushedsavedother);
@ -1104,7 +1160,7 @@ unit rgobj;
{$endif TEMPREGDEBUG}
end;
{$ifndef newra}
procedure trgobj.incrementintregisterpushed(const s:Tsupregset);
var regi:Tsuperregister;
@ -1118,6 +1174,7 @@ unit rgobj;
end;
{$endif i386}
end;
{$endif}
procedure trgobj.incrementotherregisterpushed(const s:Tregisterset);
@ -1145,14 +1202,18 @@ unit rgobj;
procedure trgobj.clearregistercount;
begin
{$ifndef newra}
fillchar(reg_pushes_int,sizeof(reg_pushes_int),0);
{$endif}
fillchar(reg_pushes_other,sizeof(reg_pushes_other),0);
{ifndef i386}
{ all used registers will have to be saved at the start and restored }
{ at the end, but otoh regpara's do not have to be saved to memory }
{ at the start (there is a move from regpara to regvar most of the }
{ time though) -> set cost to 100+20 }
{$ifndef newra}
filldword(reg_pushes_int[firstsaveintreg],lastsaveintreg-firstsaveintreg+1,120);
{$endif}
filldword(reg_pushes_other[firstsavefpureg],ord(lastsavefpureg)-ord(firstsavefpureg)+1,120);
{endif not i386}
fillchar(is_reg_var_other,sizeof(is_reg_var_other),false);
@ -1254,7 +1315,9 @@ unit rgobj;
psavedstate(state)^.countusableregsmm := countusableregsmm;
psavedstate(state)^.usedinproc := usedinproc;
psavedstate(state)^.usedbyproc := usedbyproc;
{$ifndef newra}
psavedstate(state)^.reg_pushes_int := reg_pushes_int;
{$endif}
psavedstate(state)^.reg_pushes_other := reg_pushes_other;
psavedstate(state)^.is_reg_var_int := is_reg_var_int;
psavedstate(state)^.is_reg_var_other := is_reg_var_other;
@ -1285,7 +1348,9 @@ unit rgobj;
countusableregsmm := psavedstate(state)^.countusableregsmm;
usedinproc := psavedstate(state)^.usedinproc;
usedbyproc := psavedstate(state)^.usedbyproc;
{$ifndef newra}
reg_pushes_int := psavedstate(state)^.reg_pushes_int;
{$endif}
reg_pushes_other := psavedstate(state)^.reg_pushes_other;
is_reg_var_int := psavedstate(state)^.is_reg_var_int;
is_reg_var_other := psavedstate(state)^.is_reg_var_other;
@ -1370,7 +1435,7 @@ unit rgobj;
var i:Tsuperregister;
begin
for i:=1 to 255 do
for i:=1 to maxintreg do
if not(i in unusedregsint) then
add_edge(u,i);
end;
@ -1443,7 +1508,11 @@ unit rgobj;
ssupreg:=instr.oper[0].reg.number shr 8;
add_to_movelist(ssupreg,i);
dsupreg:=instr.oper[1].reg.number shr 8;
add_to_movelist(dsupreg,i);
if ssupreg<>dsupreg then
{Avoid adding the same move instruction twice to a single register.}
add_to_movelist(dsupreg,i);
i.x:=ssupreg;
i.y:=dsupreg;
end;
function Trgobj.move_related(n:Tsuperregister):boolean;
@ -1469,8 +1538,10 @@ unit rgobj;
var n:Tsuperregister;
begin
{If we have 7 cpu registers, and the degree of a node is 7, we cannot
assign it to any of the registers, thus it is significant.}
for n:=first_imreg to maxintreg do
if degree[n]>cpu_registers then
if degree[n]>=cpu_registers then
spillworklist:=spillworklist+char(n)
else if move_related(n) then
freezeworklist:=freezeworklist+char(n)
@ -1518,7 +1589,7 @@ unit rgobj;
var adj:Pstring;
d:byte;
i:byte;
i,p:byte;
n:char;
begin
@ -1537,8 +1608,14 @@ unit rgobj;
if (pos(n,selectstack) or pos(n,coalescednodes))=0 then
enable_moves(Tsuperregister(n));
end;
{In case the node is in the spillworklist, delete it.}
delete(spillworklist,pos(char(m),spillworklist),1);
{Remove the node from the spillworklist.}
p:=pos(char(m),spillworklist);
if p=0 then
internalerror(200305301); {must be found}
if length(spillworklist)>1 then
spillworklist[p]:=spillworklist[length(spillworklist)];
dec(spillworklist[0]);
if move_related(m) then
freezeworklist:=freezeworklist+char(m)
else
@ -1586,7 +1663,7 @@ unit rgobj;
begin
m:=adj^[i];
if (pos(m,selectstack) or pos(m,coalescednodes))=0 then
decrement_degree(Tsuperregister(m));
decrement_degree(Tsuperregister(m));
end;
end;
@ -1716,8 +1793,8 @@ unit rgobj;
t:=adj^[i];
if (pos(t,selectstack) or pos(t,coalescednodes))=0 then
begin
add_edge(Tsuperregister(t),u);
decrement_degree(Tsuperregister(t));
add_edge(Tsuperregister(t),u);
end;
end;
p:=pos(char(u),freezeworklist);
@ -1882,6 +1959,8 @@ unit rgobj;
colour[n]:=k;
dec(spillednodes[0]); {Colour found: no spill.}
include(colourednodes,n);
if n in usedintinproc then
include(usedintinproc,k);
break;
end;
end;
@ -1889,10 +1968,15 @@ unit rgobj;
for i:=1 to length(coalescednodes) do
begin
n:=Tsuperregister(coalescednodes[i]);
colour[n]:=colour[get_alias(n)];
k:=get_alias(n);
colour[n]:=colour[k];
if n in usedintinproc then
include(usedintinproc,colour[k]);
end;
{$ifdef ra_debug}
for i:=first_imreg to maxintreg do
writeln(i:4,' ',colour[i]:4)
{$endif}
end;
procedure Trgobj.colour_registers;
@ -1917,7 +2001,33 @@ unit rgobj;
procedure Trgobj.epilogue_colouring;
{
procedure move_to_worklist_moves(list:Tlinkedlist);
var p:Tlinkedlistitem;
begin
p:=list.first;
while p<>nil do
begin
Tmoveins(p).moveset:=ms_worklist_moves;
p:=p.next;
end;
worklist_moves.concatlist(list);
end;
}
var i:Tsuperregister;
begin
worklist_moves.clear;
{$ifdef Principle_wrong_by_definition}
{Move everything back to worklist_moves.}
move_to_worklist_moves(active_moves);
move_to_worklist_moves(frozen_moves);
move_to_worklist_moves(coalesced_moves);
move_to_worklist_moves(constrained_moves);
{$endif}
active_moves.destroy;
active_moves:=nil;
frozen_moves.destroy;
@ -1926,10 +2036,303 @@ unit rgobj;
coalesced_moves:=nil;
constrained_moves.destroy;
constrained_moves:=nil;
for i:=0 to 255 do
if movelist[i]<>nil then
begin
dispose(movelist[i]);
movelist[i]:=0;
end;
end;
{$endif newra}
procedure Trgobj.clear_interferences(u:Tsuperregister);
{Remove node u from the interference graph and remove all collected
move instructions it is associated with.}
var i:byte;
j,k,count:cardinal;
v:Tsuperregister;
m,n:Tmoveins;
begin
if igraph.adjlist[u]<>nil then
begin
for i:=1 to length(igraph.adjlist[u]^) do
begin
v:=Tsuperregister(igraph.adjlist[u]^[i]);
{Remove (u,v) and (v,u) from bitmap.}
exclude(igraph.bitmap[u],v);
exclude(igraph.bitmap[v],u);
{Remove (v,u) from adjacency list.}
if igraph.adjlist[v]<>nil then
begin
delete(igraph.adjlist[v]^,pos(char(v),igraph.adjlist[v]^),1);
if length(igraph.adjlist[v]^)=0 then
begin
dispose(igraph.adjlist[v]);
igraph.adjlist[v]:=nil;
end;
end;
end;
{Remove ( u,* ) from adjacency list.}
dispose(igraph.adjlist[u]);
igraph.adjlist[u]:=nil;
end;
{$ifdef Principle_wrong_by_definition}
{Now remove the moves.}
if movelist[u]<>nil then
begin
for j:=0 to movelist[u]^.count-1 do
begin
m:=Tmoveins(movelist[u]^.data[j]);
{Get the other register of the move instruction.}
v:=m.instruction.oper[0].reg.number shr 8;
if v=u then
v:=m.instruction.oper[1].reg.number shr 8;
repeat
repeat
if (u<>v) and (movelist[v]<>nil) then
begin
{Remove the move from it's movelist.}
count:=movelist[v]^.count-1;
for k:=0 to count do
if m=movelist[v]^.data[k] then
begin
if k<>count then
movelist[v]^.data[k]:=movelist[v]^.data[count];
dec(movelist[v]^.count);
if count=0 then
begin
dispose(movelist[v]);
movelist[v]:=nil;
end;
break;
end;
end;
{The complexity is enourmous: the register might have been
coalesced. In that case it's movelists have been added to
it's coalescing alias. (DM)}
v:=alias[v];
until v=0;
{And also register u might have been coalesced.}
u:=alias[u];
until u=0;
case m.moveset of
ms_coalesced_moves:
coalesced_moves.remove(m);
ms_constrained_moves:
constrained_moves.remove(m);
ms_frozen_moves:
frozen_moves.remove(m);
ms_worklist_moves:
worklist_moves.remove(m);
ms_active_moves:
active_moves.remove(m);
end;
end;
dispose(movelist[u]);
movelist[u]:=nil;
end;
{$endif}
end;
procedure Trgobj.getregisterintinline(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister);
var i:Tsuperregister;
r:Tregister;
begin
if not (lastintreg in [first_imreg..last_imreg]) then
lastintreg:=first_imreg;
i:=lastintreg;
repeat
if i=last_imreg then
i:=first_imreg
else
inc(i);
if (i in unusedregsint) and (pos(char(i),abtlist)=0) then
begin
exclude(unusedregsint,i);
include(usedintinproc,i);
r.enum:=R_INTREGISTER;
r.number:=i shl 8 or subreg;
if position=nil then
list.insert(Tai_regalloc.alloc(r))
else
list.insertafter(Tai_regalloc.alloc(r),position);
result:=r;
lastintreg:=i;
if i>maxintreg then
maxintreg:=i;
add_edges_used(i);
add_constraints(result.number);
exit;
end;
until i=lastintreg;
internalerror(10);
end;
{In some cases we can get in big trouble. See this example:
; register reg23d released
; register eax allocated
; register ebx allocated
; register ecx allocated
; register edx allocated
; register esi allocated
; register edi allocated
call [reg23d]
This code is ok, *except* when reg23d is spilled. In that case the
spilled would introduce a help register which can never get
allocated to a real register because it interferes with all of them.
To solve this we introduce the ABT ("avoid big trouble :)" ) registers.
If you allocate an ABT register you get a register that has less
than cpu_register interferences and will not be allocated ever again
by the normal register get procedures. In other words it is for sure it
will never get spilled.}
function Trgobj.getabtregisterint(list:Taasmoutput;size:Tcgsize):Tregister;
var i:Tsuperregister;
r:Tregister;
found:boolean;
begin
if not (lastintreg in [first_imreg..last_imreg]) then
lastintreg:=first_imreg;
found:=false;
for i:=1 to length(abtlist) do
if Tsuperregister(abtlist[i]) in unusedregsint then
begin
found:=true;
break;
end;
i:=lastintreg;
repeat
if i=last_imreg then
i:=first_imreg
else
inc(i);
if (i in unusedregsint) and ((igraph.adjlist[i]=nil) or (length(igraph.adjlist[i]^)<cpu_registers)) then
begin
found:=true;
break;
end;
until i=lastintreg;
if found then
begin
exclude(unusedregsint,i);
include(usedintinproc,i);
r.enum:=R_INTREGISTER;
r.number:=i shl 8 or cgsize2subreg(size);
list.concat(Tai_regalloc.alloc(r));
getabtregisterint:=r;
lastintreg:=i;
if i>maxintreg then
maxintreg:=i;
add_edges_used(i);
if pos(char(i),abtlist)=0 then
abtlist:=abtlist+char(i);
end
else
internalerror(10);
{$ifdef newra}
add_constraints(getabtregisterint.number);
{$endif}
end;
procedure Trgobj.ungetregisterintinline(list:Taasmoutput;position:Tai;const r:Tregister);
var supreg:Tsuperregister;
begin
if r.enum<=lastreg then
internalerror(2003010803);
supreg:=r.number shr 8;
{ takes much time }
include(unusedregsint,supreg);
if position=nil then
list.insert(Tai_regalloc.dealloc(r))
else
list.insertafter(Tai_regalloc.dealloc(r),position);
add_edges_used(supreg);
end;
function Trgobj.spill_registers(list:Taasmoutput;const regs_to_spill:string):boolean;
{Returns true if any help registers have been used.}
var i:byte;
r:Tsuperregister;
p,q:Tai;
regs_to_spill_set:Tsupregset;
spill_temps:^Tspill_temp_list;
begin
spill_registers:=false;
unusedregsint:=[0..255];
fillchar(degree,sizeof(degree),0);
if current_procinfo.framepointer.number=NR_FRAME_POINTER_REG then
{Make sure the register allocator won't allocate registers into ebp.}
exclude(rg.unusedregsint,RS_FRAME_POINTER_REG);
new(spill_temps);
fillchar(spill_temps^,sizeof(spill_temps^),0);
regs_to_spill_set:=[];
for i:=1 to length(regs_to_spill) do
begin
{Alternative representation.}
include(regs_to_spill_set,Tsuperregister(regs_to_spill[i]));
{Clear all interferences of the spilled register.}
clear_interferences(Tsuperregister(regs_to_spill[i]));
{Get a temp for the spilled register.}
tg.gettemp(list,4,tt_noreuse,spill_temps^[Tsuperregister(regs_to_spill[i])]);
end;
p:=Tai(list.first);
while assigned(p) do
begin
case p.typ of
ait_regalloc:
begin
{A register allocation of a spilled register can be removed.}
if (Tai_regalloc(p).reg.number shr 8) in regs_to_spill_set then
begin
q:=p;
p:=Tai(p.next);
list.remove(q);
continue;
end
else
if Tai_regalloc(p).allocation then
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8)
else
include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
end;
ait_instruction:
begin
if Taicpu_abstract(p).spill_registers(list,@getregisterintinline,
@ungetregisterintinline,
regs_to_spill_set,
unusedregsint,
spill_temps^) then
spill_registers:=true;
if Taicpu_abstract(p).is_move then
add_move_instruction(Taicpu(p));
end;
end;
p:=Tai(p.next);
end;
for i:=1 to length(regs_to_spill) do
begin
tg.ungettemp(list,spill_temps^[Tsuperregister(regs_to_spill[i])]);
end;
dispose(spill_temps);
end;
{$endif newra}
{****************************************************************************
TReference
@ -2060,7 +2463,10 @@ end.
{
$Log$
Revision 1.48 2003-06-01 21:38:06 peter
Revision 1.49 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.48 2003/06/01 21:38:06 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates

12
compiler/symdef.pas
View File

@ -764,7 +764,8 @@ implementation
{$endif GDB}
fmodule,
{ other }
gendef
gendef,
rgobj
;
@ -3420,7 +3421,7 @@ implementation
end;
lastref:=defref;
{ first, we assume that all registers are used }
usedintregisters:=ALL_INTREGISTERS;
usedintregisters:=ALL_INTREGISTERS-[RS_FRAME_POINTER_REG];
usedotherregisters:=ALL_REGISTERS;
forwarddef:=true;
interfacedef:=false;
@ -3555,7 +3556,7 @@ implementation
{ set all registers to used for simplified compilation PM }
if simplify_ppu then
begin
usedintregisters:=ALL_INTREGISTERS;
usedintregisters:=ALL_INTREGISTERS-[RS_FRAME_POINTER_REG];
usedotherregisters:=ALL_REGISTERS;
end;
@ -5740,7 +5741,10 @@ implementation
end.
{
$Log$
Revision 1.147 2003-06-02 22:55:28 florian
Revision 1.148 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.147 2003/06/02 22:55:28 florian
* classes and interfaces can be stored in integer registers
Revision 1.146 2003/05/26 21:17:18 peter

27
compiler/tgobj.pas
View File

@ -66,8 +66,8 @@ unit tgobj;
private
{ contains all free temps using nextfree links }
tempfreelist : ptemprecord;
function AllocTemp(list: taasmoutput; size : longint; temptype : ttemptype) : longint;
procedure FreeTemp(list: taasmoutput; pos:longint;temptypes:ttemptypeset);
function alloctemp(list: taasmoutput; size : longint; temptype : ttemptype) : longint;
procedure freetemp(list: taasmoutput; pos:longint;temptypes:ttemptypeset);
public
{ contains all temps }
templist : ptemprecord;
@ -88,11 +88,11 @@ unit tgobj;
procedure setfirsttemp(l : longint);
function gettempsize : longint;
procedure GetTemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
procedure UnGetTemp(list: taasmoutput; const ref : treference);
procedure gettemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
procedure ungettemp(list: taasmoutput; const ref : treference);
function SizeOfTemp(list: taasmoutput; const ref: treference): longint;
function ChangeTempType(list: taasmoutput; const ref:treference;temptype:ttemptype):boolean;
function sizeoftemp(list: taasmoutput; const ref: treference): longint;
function changetemptype(list: taasmoutput; const ref:treference;temptype:ttemptype):boolean;
{# Returns TRUE if the reference ref is allocated in temporary volatile memory space,
otherwise returns FALSE.
@ -244,7 +244,7 @@ unit tgobj;
if freetype=tt_none then
internalerror(200208201);
{ Align needed size on 4 bytes }
size:=Align(size,4);
size:=align(size,4);
{ First check the tmpfreelist, but not when
we don't want to reuse an already allocated block }
if assigned(tempfreelist) and
@ -438,7 +438,7 @@ unit tgobj;
end;
procedure ttgobj.GetTemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
procedure ttgobj.gettemp(list: taasmoutput; size : longint;temptype:ttemptype;var ref : treference);
begin
reference_reset_base(ref,current_procinfo.framepointer,alloctemp(list,size,temptype));
@ -471,7 +471,7 @@ unit tgobj;
end;
function ttgobj.SizeOfTemp(list: taasmoutput; const ref: treference): longint;
function ttgobj.sizeoftemp(list: taasmoutput; const ref: treference): longint;
var
hp : ptemprecord;
begin
@ -481,13 +481,13 @@ unit tgobj;
begin
if (hp^.pos=ref.offset) then
begin
SizeOfTemp := hp^.size;
sizeoftemp := hp^.size;
exit;
end;
hp := hp^.next;
end;
{$ifdef EXTDEBUG}
Comment(V_Debug,'tgobj: (SizeOfTemp) temp at pos '+tostr(ref.offset)+' not found !');
comment(v_debug,'tgobj: (SizeOfTemp) temp at pos '+tostr(ref.offset)+' not found !');
list.concat(tai_tempalloc.allocinfo(ref.offset,0,'temp not found'));
{$endif}
end;
@ -554,7 +554,10 @@ finalization
end.
{
$Log$
Revision 1.34 2003-05-17 13:30:08 jonas
Revision 1.35 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.34 2003/05/17 13:30:08 jonas
* changed tt_persistant to tt_persistent :)
* tempcreatenode now doesn't accept a boolean anymore for persistent
temps, but a ttemptype, so you can also create ansistring temps etc

378
compiler/x86/aasmcpu.pas
View File

@ -194,6 +194,14 @@ interface
function Pass1(offset:longint):longint;virtual;
procedure Pass2(sec:TAsmObjectdata);virtual;
procedure SetOperandOrder(order:TOperandOrder);
function is_nop:boolean;override;
function is_move:boolean;override;
function spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsupregset;
var unusedregsint:Tsupregset;
const spilltemplist:Tspill_temp_list):boolean;override;
protected
procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);override;
procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);override;
@ -212,10 +220,8 @@ interface
function NeedAddrPrefix(opidx:byte):boolean;
procedure Swapoperands;
{$endif NOAG386BIN}
function is_nop:boolean;override;
end;
procedure InitAsm;
procedure DoneAsm;
@ -1968,12 +1974,373 @@ implementation
begin
{We do not check the number of operands; we assume that nobody constructs
a mov or xchg instruction with less than 2 operands.}
a mov or xchg instruction with less than 2 operands. (DM)}
is_nop:=(opcode=A_NOP) or
(opcode=A_MOV) and (oper[0].typ=top_reg) and (oper[1].typ=top_reg) and (oper[0].reg.number=oper[1].reg.number) or
(opcode=A_XCHG) and (oper[0].typ=top_reg) and (oper[1].typ=top_reg) and (oper[0].reg.number=oper[1].reg.number);
end;
function Taicpu.is_move:boolean;
begin
{We do not check the number of operands; we assume that nobody constructs
a mov, movzx or movsx instruction with less than 2 operands. Note that
a move between a reference and a register is not a move that is of
interrest to the register allocation, therefore we only return true
for a move between two registers. (DM)}
is_move:=((opcode=A_MOV) or (opcode=A_MOVZX) or (opcode=A_MOVSX)) and
((oper[0].typ=top_reg) and (oper[1].typ=top_reg));
end;
function Taicpu.spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsupregset;
var unusedregsint:Tsupregset;
const spilltemplist:Tspill_temp_list):boolean;
{Spill the registers in r in this instruction. Returns true if any help
registers are used. This procedure has become one big hack party, because
of the huge amount of situations you can have. The irregularity of the i386
instruction set doesn't help either. (DM)}
function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister):Tai;
var back:Tsupregset;
begin
back:=unusedregsint;
get_insert_pos:=p;
while (p<>nil) and (p.typ=ait_regalloc) do
begin
{Rewind the register allocation.}
if Tai_regalloc(p).allocation then
include(unusedregsint,Tai_regalloc(p).reg.number shr 8)
else
begin
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8);
if Tai_regalloc(p).reg.number shr 8=huntfor1 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
if Tai_regalloc(p).reg.number shr 8=huntfor2 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
if Tai_regalloc(p).reg.number shr 8=huntfor3 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
end;
p:=Tai(p.previous);
end;
unusedregsint:=back;
end;
procedure forward_allocation(p:Tai);
begin
{Forward the register allocation again.}
while (p<>self) do
begin
if p.typ<>ait_regalloc then
internalerror(200305311);
if Tai_regalloc(p).allocation then
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8)
else
include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
p:=Tai(p.next);
end;
end;
var i:byte;
supreg:Tsuperregister;
subreg:Tsubregister;
helpreg:Tregister;
helpins:Taicpu;
op:Tasmop;
hopsize:Topsize;
pos:Tai;
begin
{Situation examples are in intel notation, so operand order:
mov eax , ebx
^^^ ^^^
oper[1] oper[0]
(DM)}
spill_registers:=false;
case ops of
1:
begin
if oper[0].typ=top_reg then
begin
supreg:=oper[0].reg.number shr 8;
if supreg in r then
begin
{Situation example:
push r20d ; r20d must be spilled into [ebp-12]
Change into:
push [ebp-12] ; Replace register by reference }
{ hopsize:=reg2opsize(oper[0].reg);}
oper[0].typ:=top_ref;
new(oper[0].ref);
oper[0].ref^:=spilltemplist[supreg];
{ oper[0].ref^.size:=hopsize;}
end;
end;
if oper[0].typ=top_ref then
begin
supreg:=oper[0].ref^.base.number shr 8;
if supreg in r then
begin
{Situation example:
push [r21d+4*r22d] ; r21d must be spilled into [ebp-12]
Change into:
mov r23d,[ebp-12] ; Use a help register
push [r23d+4*r22d] ; Replace register by helpregister }
subreg:=oper[0].ref^.base.number and $ff;
if oper[0].ref^.index.number=NR_NO then
pos:=Tai(previous)
else
pos:=get_insert_pos(Tai(previous),oper[0].ref^.index.number shr 8,0,0);
rgget(list,pos,subreg,helpreg);
spill_registers:=true;
helpins:=Taicpu.op_ref_reg(A_MOV,reg2opsize(oper[0].ref^.base),spilltemplist[supreg],helpreg);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
rgunget(list,helpins,helpreg);
forward_allocation(Tai(helpins.next));
oper[0].ref^.base:=helpreg;
end;
supreg:=oper[0].ref^.index.number shr 8;
if supreg in r then
begin
{Situation example:
push [r21d+4*r22d] ; r22d must be spilled into [ebp-12]
Change into:
mov r23d,[ebp-12] ; Use a help register
push [r21d+4*r23d] ; Replace register by helpregister }
subreg:=oper[0].ref^.index.number and $ff;
if oper[0].ref^.base.number=NR_NO then
pos:=Tai(previous)
else
pos:=get_insert_pos(Tai(previous),oper[0].ref^.base.number shr 8,0,0);
rgget(list,pos,subreg,helpreg);
spill_registers:=true;
helpins:=Taicpu.op_ref_reg(A_MOV,reg2opsize(oper[0].ref^.index),spilltemplist[supreg],helpreg);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
rgunget(list,helpins,helpreg);
forward_allocation(Tai(helpins.next));
oper[0].ref^.index:=helpreg;
end;
end;
end;
2:
begin
if oper[0].typ=top_reg then
begin
supreg:=oper[0].reg.number shr 8;
subreg:=oper[0].reg.number and $ff;
if supreg in r then
if oper[1].typ=top_ref then
begin
{Situation example:
add [r20d],r21d ; r21d must be spilled into [ebp-12]
Change into:
mov r22d,[ebp-12] ; Use a help register
add [r20d],r22d ; Replace register by helpregister }
pos:=get_insert_pos(Tai(previous),oper[0].reg.number shr 8,
oper[1].ref^.base.number shr 8,oper[1].ref^.index.number shr 8);
rgget(list,pos,subreg,helpreg);
spill_registers:=true;
helpins:=Taicpu.op_ref_reg(A_MOV,reg2opsize(oper[0].reg),spilltemplist[supreg],helpreg);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
oper[0].reg:=helpreg;
rgunget(list,helpins,helpreg);
forward_allocation(Tai(helpins.next));
end
else
begin
{Situation example:
add r20d,r21d ; r21d must be spilled into [ebp-12]
Change into:
add r20d,[ebp-12] ; Replace register by reference }
oper[0].typ:=top_ref;
new(oper[0].ref);
oper[0].ref^:=spilltemplist[supreg];
end;
end;
if oper[1].typ=top_reg then
begin
supreg:=oper[1].reg.number shr 8;
subreg:=oper[1].reg.number and $ff;
if supreg in r then
begin
if oper[0].typ=top_ref then
begin
{Situation example:
add r20d,[r21d] ; r20d must be spilled into [ebp-12]
Change into:
mov r22d,[r21d] ; Use a help register
add [ebp-12],r22d ; Replace register by helpregister }
pos:=get_insert_pos(Tai(previous),oper[0].ref^.base.number shr 8,
oper[0].ref^.index.number shr 8,0);
rgget(list,pos,subreg,helpreg);
spill_registers:=true;
op:=A_MOV;
hopsize:=opsize; {Save old value...}
if (opcode=A_MOVZX) or (opcode=A_MOVSX) or (opcode=A_LEA) then
begin
{Because 'movzx memory,register' does not exist...}
op:=opcode;
opcode:=A_MOV;
opsize:=reg2opsize(oper[1].reg);
end;
helpins:=Taicpu.op_ref_reg(op,hopsize,oper[0].ref^,helpreg);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
dispose(oper[0].ref);
oper[0].typ:=top_reg;
oper[0].reg:=helpreg;
oper[1].typ:=top_ref;
new(oper[1].ref);
oper[1].ref^:=spilltemplist[supreg];
rgunget(list,helpins,helpreg);
forward_allocation(Tai(helpins.next));
end
else
begin
{Situation example:
add r20d,r21d ; r20d must be spilled into [ebp-12]
Change into:
add [ebp-12],r21d ; Replace register by reference }
oper[1].typ:=top_ref;
new(oper[1].ref);
oper[1].ref^:=spilltemplist[supreg];
end;
{The i386 instruction set never gets boring... IMUL does
not support a memory location as destination. Check if
the opcode is IMUL and fix it. (DM)}
if opcode=A_IMUL then
begin
{Yikes! We just changed the destination register into
a memory location above here.
Situation example:
imul [ebp-12],r21d ; We need a help register
Change into:
mov r22d,[ebp-12] ; Use a help instruction (only for IMUL)
imul r22d,r21d ; Replace reference by helpregister
mov [ebp-12],r22d ; Use another help instruction}
rgget(list,Tai(previous),subreg,helpreg);
{First help instruction.}
helpins:=Taicpu.op_ref_reg(A_MOV,opsize,oper[1].ref^,helpreg);
if previous=nil then
list.insert(helpins)
else
list.insertafter(helpins,previous);
{Second help instruction.}
helpins:=Taicpu.op_reg_ref(A_MOV,opsize,helpreg,oper[1].ref^);
dispose(oper[1].ref);
oper[1].typ:=top_reg;
oper[1].reg:=helpreg;
list.insertafter(helpins,self);
end;
end;
end;
for i:=0 to 1 do
if oper[i].typ=top_ref then
begin
supreg:=oper[i].ref^.base.number shr 8;
if supreg in r then
begin
{Situation example:
add r20d,[r21d+4*r22d] ; r21d must be spilled into [ebp-12]
Change into:
mov r23d,[ebp-12] ; Use a help register
add r20d,[r23d+4*r22d] ; Replace register by helpregister }
subreg:=oper[i].ref^.base.number and $ff;
if i=1 then
pos:=get_insert_pos(Tai(previous),oper[i].ref^.index.number shr 8,oper[0].reg.number shr 8,0)
else
pos:=get_insert_pos(Tai(previous),oper[i].ref^.index.number shr 8,0,0);
rgget(list,pos,subreg,helpreg);
spill_registers:=true;
helpins:=Taicpu.op_ref_reg(A_MOV,reg2opsize(oper[i].ref^.base),spilltemplist[supreg],helpreg);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
oper[i].ref^.base:=helpreg;
rgunget(list,helpins,helpreg);
forward_allocation(Tai(helpins.next));
end;
supreg:=oper[i].ref^.index.number shr 8;
if supreg in r then
begin
{Situation example:
add r20d,[r21d+4*r22d] ; r22d must be spilled into [ebp-12]
Change into:
mov r23d,[ebp-12] ; Use a help register
add r20d,[r21d+4*r23d] ; Replace register by helpregister }
subreg:=oper[i].ref^.index.number and $ff;
if i=1 then
pos:=get_insert_pos(Tai(previous),oper[i].ref^.base.number shr 8,oper[0].reg.number shr 8,0)
else
pos:=get_insert_pos(Tai(previous),oper[i].ref^.base.number shr 8,0,0);
rgget(list,pos,subreg,helpreg);
spill_registers:=true;
helpins:=Taicpu.op_ref_reg(A_MOV,reg2opsize(oper[i].ref^.index),spilltemplist[supreg],helpreg);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
oper[i].ref^.index:=helpreg;
rgunget(list,helpins,helpreg);
forward_allocation(Tai(helpins.next));
end;
end;
end;
3:
begin
{$warning todo!!}
end;
end;
end;
{*****************************************************************************
Instruction table
@ -2024,7 +2391,10 @@ implementation
end.
{
$Log$
Revision 1.4 2003-05-30 23:57:08 peter
Revision 1.5 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.4 2003/05/30 23:57:08 peter
* more sparc cleanup
* accumulator removed, splitted in function_return_reg (called) and
function_result_reg (caller)

60
compiler/x86/cgx86.pas
View File

@ -1800,21 +1800,33 @@ unit cgx86;
var r,rsp:Tregister;
begin
r.enum:=R_INTREGISTER;
r.number:=NR_EBP;
rsp.enum:=R_INTREGISTER;
rsp.number:=NR_ESP;
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
list.concat(Taicpu.Op_reg_reg(A_MOV,S_L,rsp,r));
if localsize>0 then
g_stackpointer_alloc(list,localsize);
r.enum:=R_INTREGISTER;
r.number:=NR_EBP;
{$ifdef newra}
list.concat(tai_regalloc.alloc(r));
include(rg.savedbyproc,RS_EBP);
{$endif}
rsp.enum:=R_INTREGISTER;
rsp.number:=NR_ESP;
list.concat(Taicpu.op_reg(A_PUSH,S_L,r));
list.concat(Taicpu.op_reg_reg(A_MOV,S_L,rsp,r));
if localsize>0 then
g_stackpointer_alloc(list,localsize);
end;
procedure tcgx86.g_restore_frame_pointer(list : taasmoutput);
begin
list.concat(Taicpu.Op_none(A_LEAVE,S_NO));
end;
var r:Tregister;
begin
{$ifdef newra}
r.enum:=R_INTREGISTER;
r.number:=NR_EBP;
list.concat(tai_regalloc.dealloc(r));
{$endif}
list.concat(Taicpu.op_none(A_LEAVE,S_NO));
end;
procedure tcgx86.g_return_from_proc(list : taasmoutput;parasize : aword);
@ -1847,14 +1859,19 @@ unit cgx86;
var r:Tregister;
begin
r.enum:=R_INTREGISTER;
r.number:=NR_EBX;
if (RS_EBX in usedinproc) then
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
r.number:=NR_ESI;
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
r.number:=NR_EDI;
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
r.enum:=R_INTREGISTER;
r.number:=NR_EBX;
if (RS_EBX in usedinproc) then
list.concat(Taicpu.op_reg(A_PUSH,S_L,r));
r.number:=NR_ESI;
list.concat(Taicpu.op_reg(A_PUSH,S_L,r));
r.number:=NR_EDI;
list.concat(Taicpu.op_reg(A_PUSH,S_L,r));
{$ifdef newra}
include(rg.savedbyproc,RS_EBX);
include(rg.savedbyproc,RS_ESI);
include(rg.savedbyproc,RS_EDI);
{$endif}
end;
@ -1936,7 +1953,10 @@ unit cgx86;
end.
{
$Log$
Revision 1.49 2003-06-01 21:38:07 peter
Revision 1.50 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.49 2003/06/01 21:38:07 peter
* getregisterfpu size parameter added
* op_const_reg size parameter added
* sparc updates

9
compiler/x86/cpubase.pas
View File

@ -170,7 +170,11 @@ uses
{Number of first and last superregister.}
first_supreg = $01;
{$ifdef x86_64}
last_supreg = $10;
{$else}
last_supreg = $08;
{$endif}
{Number of first and last imaginary register.}
first_imreg = $12;
last_imreg = $ff;
@ -712,7 +716,10 @@ implementation
end.
{
$Log$
Revision 1.5 2003-05-30 23:57:08 peter
Revision 1.6 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.5 2003/05/30 23:57:08 peter
* more sparc cleanup
* accumulator removed, splitted in function_return_reg (called) and
function_result_reg (caller)

7
compiler/x86_64/cpubase.inc
View File

@ -165,6 +165,8 @@ const
{# Stack pointer register }
NR_STACK_POINTER_REG = NR_RSP;
{# Frame pointer register }
frame_pointer_reg = R_RBP;
RS_FRAME_POINTER_REG = RS_EBP;
NR_FRAME_POINTER_REG = NR_RBP;
{ Register for addressing absolute data in a position independant way,
such as in PIC code. The exact meaning is ABI specific. For
@ -205,7 +207,10 @@ const
{
$Log$
Revision 1.5 2003-05-31 15:05:28 peter
Revision 1.6 2003-06-03 13:01:59 daniel
* Register allocator finished
Revision 1.5 2003/05/31 15:05:28 peter
* FUNCTION_RESULT64_LOW/HIGH_REG added for int64 results
Revision 1.4 2003/05/30 23:57:08 peter