paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 07:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Implemented the actual register allocator

Browse Source 
+ Scratch registers unavailable when new register allocator used
  + maybe_save/maybe_restore unavailable when new register allocator used
This commit is contained in:
daniel 2003-04-22 10:09:34 +00:00
parent 4aec360876
commit 25059e21b6
26 changed files with 1351 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
compiler/aasmtai.pas
View File

@ -435,6 +435,7 @@ interface
procedure loadref(opidx:longint;const r:treference);
procedure loadreg(opidx:longint;r:tregister);
procedure loadoper(opidx:longint;o:toper);
function is_nop:boolean;virtual;abstract;
end;
{ alignment for operator }
@ -450,9 +451,12 @@ interface
function calculatefillbuf(var buf : tfillbuffer):pchar;virtual;
end;
Ttranstable=array[Tsuperregister] of Tsuperregister;
taasmoutput = class(tlinkedlist)
function getlasttaifilepos : pfileposinfo;
procedure convert_registers;
procedure translate_registers(const table:Ttranstable);
end;
@ -1767,10 +1771,56 @@ uses
end;
end;
procedure Taasmoutput.translate_registers(const table:Ttranstable);
var p,q:Tai;
i:shortint;
r:Preference;
begin
p:=Tai(first);
while assigned(p) do
begin
case p.typ of
ait_regalloc:
Tai_regalloc(p).reg.number:=(Tai_regalloc(p).reg.number and $ff) or
(table[Tai_regalloc(p).reg.number shr 8] shl 8);
ait_instruction:
begin
for i:=0 to Taicpu_abstract(p).ops-1 do
if Taicpu_abstract(p).oper[i].typ=Top_reg then
Taicpu_abstract(p).oper[i].reg.number:=(Taicpu_abstract(p).oper[i].reg.number and $ff) or
(table[Taicpu_abstract(p).oper[i].reg.number shr 8] shl 8)
else if Taicpu_abstract(p).oper[i].typ=Top_ref then
begin
r:=Taicpu_abstract(p).oper[i].ref;
r^.base.number:=(r^.base.number and $ff) or
(table[r^.base.number shr 8] shl 8);
r^.index.number:=(r^.index.number and $ff) or
(table[r^.index.number shr 8] shl 8);
end;
if Taicpu_abstract(p).is_nop then
begin
q:=p;
p:=Tai(p.next);
remove(q);
continue;
end;
end;
end;
p:=Tai(p.next);
end;
end;
end.
{
$Log$
Revision 1.21 2003-02-19 22:00:14 daniel
Revision 1.22 2003-04-22 10:09:34 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.21 2003/02/19 22:00:14 daniel
* Code generator converted to new register notation
- Horribily outdated todo.txt removed

79
compiler/cg64f32.pas
View File

@ -97,7 +97,7 @@ unit cg64f32;
globtype,globals,systems,
cgbase,
verbose,
symbase,symconst,symdef,defutil;
symbase,symconst,symdef,defutil,rgobj;
function joinreg64(reglo,reghi : tregister) : tregister64;
@ -170,7 +170,11 @@ unit cg64f32;
internalerror(200302035);
if (tmpref.base.number=reg.reglo.number) then
begin
{$ifdef newra}
tmpreg:=rg.getaddressregister(list);
{$else}
tmpreg := cg.get_scratch_reg_address(list);
{$endif}
got_scratch:=true;
cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.base,tmpreg);
tmpref.base:=tmpreg;
@ -181,7 +185,11 @@ unit cg64f32;
{ implementation FK }
if (tmpref.index.number=reg.reglo.number) then
begin
{$ifdef newra}
tmpreg:=rg.getaddressregister(list);
{$else}
tmpreg:=cg.get_scratch_reg_address(list);
{$endif}
got_scratch:=true;
cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.index,tmpreg);
tmpref.index:=tmpreg;
@ -189,8 +197,13 @@ unit cg64f32;
cg.a_load_ref_reg(list,OS_32,tmpref,reg.reglo);
inc(tmpref.offset,4);
cg.a_load_ref_reg(list,OS_32,tmpref,reg.reghi);
{$ifdef newra}
if got_scratch then
rg.ungetregisterint(list,tmpreg);
{$else}
if got_scratch then
cg.free_scratch_reg(list,tmpreg);
{$endif}
end;
@ -399,12 +412,22 @@ unit cg64f32;
var
tempreg: tregister64;
begin
{$ifdef newra}
tempreg.reghi:=rg.getregisterint(list,OS_INT);
tempreg.reglo:=rg.getregisterint(list,OS_INT);
{$else}
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_op64_reg_reg(list,op,tempreg,reg);
{$ifdef newra}
rg.ungetregisterint(list,tempreg.reglo);
rg.ungetregisterint(list,tempreg.reghi);
{$else}
cg.free_scratch_reg(list,tempreg.reglo);
cg.free_scratch_reg(list,tempreg.reghi);
{$endif}
end;
@ -412,13 +435,23 @@ unit cg64f32;
var
tempreg: tregister64;
begin
{$ifdef newra}
tempreg.reghi:=rg.getregisterint(list,OS_INT);
tempreg.reglo:=rg.getregisterint(list,OS_INT);
{$else}
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_op64_reg_reg(list,op,reg,tempreg);
a_load64_reg_ref(list,tempreg,ref);
{$ifdef newra}
rg.ungetregisterint(list,tempreg.reglo);
rg.ungetregisterint(list,tempreg.reghi);
{$else}
cg.free_scratch_reg(list,tempreg.reglo);
cg.free_scratch_reg(list,tempreg.reghi);
{$endif}
end;
@ -426,13 +459,23 @@ unit cg64f32;
var
tempreg: tregister64;
begin
{$ifdef newra}
tempreg.reghi:=rg.getregisterint(list,OS_INT);
tempreg.reglo:=rg.getregisterint(list,OS_INT);
{$else}
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_op64_const_reg(list,op,value,tempreg);
a_load64_reg_ref(list,tempreg,ref);
{$ifdef newra}
rg.ungetregisterint(list,tempreg.reglo);
rg.ungetregisterint(list,tempreg.reghi);
{$else}
cg.free_scratch_reg(list,tempreg.reglo);
cg.free_scratch_reg(list,tempreg.reghi);
{$endif}
end;
procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);
@ -539,7 +582,11 @@ unit cg64f32;
end
else
begin
{$ifdef newra}
hreg:=rg.getregisterint(list,OS_INT);
{$else}
hreg := cg.get_scratch_reg_int(list,OS_INT);
{$endif}
got_scratch := true;
a_load64high_ref_reg(list,p.location.reference,hreg);
end;
@ -555,8 +602,13 @@ unit cg64f32;
cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,aword(-1),hreg,neglabel);
end;
{ !!! freeing of register should happen directly after compare! (JM) }
{$ifdef newra}
if got_scratch then
rg.ungetregisterint(list,hreg);
{$else}
if got_scratch then
cg.free_scratch_reg(list,hreg);
{$endif}
{ For all other values we have a range check error }
cg.a_call_name(list,'FPC_RANGEERROR');
@ -587,7 +639,11 @@ unit cg64f32;
end
else
begin
{$ifdef newra}
hreg:=rg.getregisterint(list,OS_INT);
{$else}
hreg := cg.get_scratch_reg_int(list,OS_INT);
{$endif}
got_scratch := true;
a_load64low_ref_reg(list,p.location.reference,hreg);
end;
@ -595,8 +651,13 @@ unit cg64f32;
objectlibrary.getlabel(neglabel);
cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
{ !!! freeing of register should happen directly after compare! (JM) }
{$ifdef newra}
if got_scratch then
rg.ungetregisterint(list,hreg);
{$else}
if got_scratch then
cg.free_scratch_reg(list,hreg);
{$endif}
cg.a_call_name(list,'FPC_RANGEERROR');
@ -641,7 +702,11 @@ unit cg64f32;
end
else
begin
{$ifdef newra}
hreg:=rg.getregisterint(list,OS_INT);
{$else}
hreg := cg.get_scratch_reg_int(list,OS_INT);
{$endif}
got_scratch := true;
opsize := def_cgsize(p.resulttype.def);
@ -654,8 +719,13 @@ unit cg64f32;
cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
{ !!! freeing of register should happen directly after compare! (JM) }
{$ifdef newra}
if got_scratch then
rg.ungetregisterint(list,hreg);
{$else}
if got_scratch then
cg.free_scratch_reg(list,hreg);
{$endif}
cg.a_call_name(list,'FPC_RANGEERROR');
cg.a_label(list,poslabel);
end;
@ -766,7 +836,12 @@ begin
end.
{
$Log$
Revision 1.38 2003-04-07 08:52:58 jonas
Revision 1.39 2003-04-22 10:09:34 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.38 2003/04/07 08:52:58 jonas
* fixed compiling error
Revision 1.37 2003/04/07 08:45:09 jonas

131
compiler/cgobj.pas
View File

@ -59,9 +59,11 @@ unit cgobj;
sould be @link(tcg64f32) and not @var(tcg).
}
tcg = class
{$ifndef newra}
scratch_register_array_pointer : aword;
{# List of currently unused scratch registers }
unusedscratchregisters:Tsupregset;
{$endif}
alignment : talignment;
{************************************************}
@ -79,6 +81,7 @@ unit cgobj;
{# Deallocates register r by inserting a pa_regdealloc record}
procedure a_reg_dealloc(list : taasmoutput;r : tregister);
{$ifndef newra}
{# @abstract(Returns an int register for use as scratch register)
This routine returns a register which can be used by
the code generator as a general purpose scratch register.
@ -102,6 +105,7 @@ unit cgobj;
was previously allocated using @link(get_scratch_reg).
}
procedure free_scratch_reg(list : taasmoutput;r : tregister);
{$endif newra}
{# Pass a parameter, which is located in a register, to a routine.
This routine should push/send the parameter to the routine, as
@ -503,7 +507,9 @@ unit cgobj;
rgobj,cutils;
const
{$ifndef newra}
max_scratch_regs = high(scratch_regs) - low(scratch_regs) + 1;
{$endif}
{ Please leave this here, this module should NOT use
exprasmlist, the lists are always passed as arguments.
@ -520,9 +526,11 @@ unit cgobj;
i : longint;
begin
{$ifndef newra}
scratch_register_array_pointer:=1;
for i:=low(scratch_regs) to high(scratch_regs) do
include(unusedscratchregisters,scratch_regs[i]);
{$endif}
end;
procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister);
@ -543,6 +551,7 @@ unit cgobj;
list.concat(tai_label.create(l));
end;
{$ifndef newra}
function tcg.get_scratch_reg_int(list:taasmoutput;size:Tcgsize):tregister;
var
@ -587,6 +596,7 @@ unit cgobj;
include(unusedscratchregisters,r.number shr 8);
a_reg_dealloc(list,r);
end;
{$endif newra}
{*****************************************************************************
for better code generation these methods should be overridden
@ -626,20 +636,36 @@ unit cgobj;
hr : tregister;
begin
{$ifdef newra}
hr:=rg.getregisterint(list,size);
{$else}
hr:=get_scratch_reg_int(list,size);
{$endif}
a_load_const_reg(list,size,a,hr);
a_param_reg(list,size,hr,locpara);
{$ifdef newra}
rg.ungetregisterint(list,hr);
{$else}
free_scratch_reg(list,hr);
{$endif}
end;
procedure tcg.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
var
hr : tregister;
begin
{$ifdef newra}
hr:=rg.getregisterint(list,size);
{$else}
hr:=get_scratch_reg_int(list,size);
{$endif}
a_load_ref_reg(list,size,r,hr);
a_param_reg(list,size,hr,locpara);
{$ifdef newra}
rg.ungetregisterint(list,hr);
{$else}
free_scratch_reg(list,hr);
{$endif}
end;
@ -664,10 +690,18 @@ unit cgobj;
var
hr : tregister;
begin
{$ifdef newra}
hr:=rg.getaddressregister(list);
{$else newra}
hr:=get_scratch_reg_address(list);
{$endif}
a_loadaddr_ref_reg(list,r,hr);
a_param_reg(list,OS_ADDR,hr,locpara);
{$ifdef newra}
rg.ungetregisterint(list,hr);
{$else}
free_scratch_reg(list,hr);
{$endif}
end;
@ -732,7 +766,11 @@ unit cgobj;
tmpreg := rg.getregisterint(list,size)
else
{$endif i386}
{$ifdef newra}
tmpreg:=rg.getregisterint(list,size);
{$else}
tmpreg := get_scratch_reg_int(list,size);
{$endif}
a_load_ref_reg(list,size,sref,tmpreg);
a_load_reg_ref(list,size,tmpreg,dref);
{$ifdef i386}
@ -745,7 +783,11 @@ unit cgobj;
end
else
{$endif i386}
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
free_scratch_reg(list,tmpreg);
{$endif}
end;
@ -755,10 +797,18 @@ unit cgobj;
tmpreg: tregister;
begin
{$ifdef newra}
tmpreg:=rg.getregisterint(list,size);
{$else}
tmpreg := get_scratch_reg_int(list,size);
{$endif}
a_load_const_reg(list,size,a,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
free_scratch_reg(list,tmpreg);
{$endif}
end;
@ -949,11 +999,19 @@ unit cgobj;
tmpreg: tregister;
begin
{$ifdef newra}
tmpreg:=rg.getregisterint(list,size);
{$else}
tmpreg := get_scratch_reg_int(list,size);
{$endif}
a_load_ref_reg(list,size,ref,tmpreg);
a_op_const_reg(list,op,a,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
free_scratch_reg(list,tmpreg);
{$endif}
end;
@ -977,11 +1035,19 @@ unit cgobj;
tmpreg: tregister;
begin
{$ifdef newra}
tmpreg:=rg.getregisterint(list,size);
{$else}
tmpreg := get_scratch_reg_int(list,size);
{$endif}
a_load_ref_reg(list,size,ref,tmpreg);
a_op_reg_reg(list,op,size,reg,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
free_scratch_reg(list,tmpreg);
{$endif}
end;
@ -1000,10 +1066,18 @@ unit cgobj;
end;
else
begin
{$ifdef newra}
tmpreg:=rg.getregisterint(list,size);
{$else}
tmpreg := get_scratch_reg_int(list,size);
{$endif}
a_load_ref_reg(list,size,ref,tmpreg);
a_op_reg_reg(list,op,size,tmpreg,reg);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
free_scratch_reg(list,tmpreg);
{$endif}
end;
end;
end;
@ -1034,10 +1108,18 @@ unit cgobj;
a_op_ref_reg(list,op,loc.size,ref,loc.register);
LOC_REFERENCE,LOC_CREFERENCE:
begin
{$ifdef newra}
tmpreg:=rg.getregisterint(list,loc.size);
{$else}
tmpreg := get_scratch_reg_int(list,loc.size);
{$endif}
a_load_ref_reg(list,loc.size,ref,tmpreg);
a_op_reg_ref(list,op,loc.size,tmpreg,loc.reference);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
free_scratch_reg(list,tmpreg);
{$endif}
end;
else
internalerror(200109061);
@ -1067,10 +1149,18 @@ unit cgobj;
tmpreg: tregister;
begin
{$ifdef newra}
tmpreg:=rg.getregisterint(list,size);
{$else}
tmpreg := get_scratch_reg_int(list,size);
{$endif}
a_load_ref_reg(list,size,ref,tmpreg);
a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
free_scratch_reg(list,tmpreg);
{$endif}
end;
procedure tcg.a_cmp_const_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const loc : tlocation;
@ -1093,10 +1183,18 @@ unit cgobj;
tmpreg: tregister;
begin
{$ifdef newra}
tmpreg:=rg.getregisterint(list,size);
{$else}
tmpreg := get_scratch_reg_int(list,size);
{$endif}
a_load_ref_reg(list,size,ref,tmpreg);
a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
free_scratch_reg(list,tmpreg);
{$endif}
end;
procedure tcg.a_cmp_loc_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
@ -1128,6 +1226,12 @@ unit cgobj;
a_cmp_ref_reg_label(list,size,cmp_op,ref,loc.register,l);
LOC_REFERENCE,LOC_CREFERENCE:
begin
{$ifdef newra}
tmpreg := rg.getregisterint(list,size);
a_load_ref_reg(list,size,loc.reference,tmpreg);
a_cmp_ref_reg_label(list,size,cmp_op,ref,tmpreg,l);
rg.ungetregisterint(list,tmpreg);
{$else newra}
{$ifdef i386}
{ the following is done with defines to avoid a speed penalty, }
{ since all this is only necessary for the 80x86 (because EDI }
@ -1145,7 +1249,8 @@ unit cgobj;
rg.ungetregisterint(list,tmpreg)
else
{$endif i386}
free_scratch_reg(list,tmpreg);
free_scratch_reg(list,tmpreg);
{$endif newra}
end
else
internalerror(200109061);
@ -1392,8 +1497,11 @@ unit cgobj;
if lto < 0 then
lto := 0;
end;
{$ifdef newra}
hreg:=rg.getregisterint(list,OS_INT);
{$else}
hreg := get_scratch_reg_int(list,OS_INT);
{$endif}
if (p.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
a_op_const_reg_reg(list,OP_SUB,def_cgsize(p.resulttype.def),
aword(lto),p.location.register,hreg)
@ -1406,7 +1514,11 @@ unit cgobj;
objectlibrary.getlabel(neglabel);
a_cmp_const_reg_label(list,OS_INT,OC_BE,aword(hto-lto),hreg,neglabel);
{ !!! should happen right after the compare (JM) }
{$ifdef newra}
rg.ungetregisterint(list,hreg);
{$else}
free_scratch_reg(list,hreg);
{$endif}
a_call_name(list,'FPC_RANGEERROR');
a_label(list,neglabel);
end;
@ -1425,10 +1537,18 @@ unit cgobj;
var
tmpreg : tregister;
begin
{$ifdef newra}
tmpreg:=rg.getregisterint(list,size);
{$else}
tmpreg := get_scratch_reg_int(list,size);
{$endif}
g_flags2reg(list,size,f,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
free_scratch_reg(list,tmpreg);
{$endif}
end;
@ -1719,7 +1839,12 @@ finalization
end.
{
$Log$
Revision 1.81 2003-04-06 21:11:23 olle
Revision 1.82 2003-04-22 10:09:34 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.81 2003/04/06 21:11:23 olle
* changed newasmsymbol to newasmsymboldata for data symbols
Revision 1.80 2003/03/28 19:16:56 peter

19
compiler/i386/aasmcpu.pas
View File

@ -199,6 +199,7 @@ interface
function NeedAddrPrefix(opidx:byte):boolean;
procedure Swapoperands;
{$endif NOAG386BIN}
function is_nop:boolean;override;
end;
@ -1898,6 +1899,17 @@ implementation
end;
{$endif NOAG386BIN}
function Taicpu.is_nop:boolean;
begin
{We do not check the number of operands; we assume that nobody constructs
a mov or xchg instruction with less than 2 operands.}
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;
{*****************************************************************************
Instruction table
*****************************************************************************}
@ -1947,7 +1959,12 @@ implementation
end.
{
$Log$
Revision 1.15 2003-03-26 12:50:54 armin
Revision 1.16 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.15 2003/03/26 12:50:54 armin
* avoid problems with the ide in init/dome
Revision 1.14 2003/03/08 08:59:07 daniel

9
compiler/i386/ag386nsm.pas
View File

@ -460,7 +460,7 @@ interface
else
regstr:=std_reg2str[tai_regalloc(hp).reg.enum];
if (cs_asm_regalloc in aktglobalswitches) then
AsmWriteLn(target_asm.comment+'Register '+regstr+
AsmWriteLn(#9#9+target_asm.comment+'Register '+regstr+
allocstr[tai_regalloc(hp).allocation]);
end;
@ -921,7 +921,12 @@ initialization
end.
{
$Log$
Revision 1.32 2003-03-08 13:59:17 daniel
Revision 1.33 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.32 2003/03/08 13:59:17 daniel
* Work to handle new register notation in ag386nsm
+ Added newra version of Ti386moddivnode

9
compiler/i386/cpubase.pas
View File

@ -552,8 +552,10 @@ uses
{# Registers which are defined as scratch and no need to save across
routine calls or in assembler blocks.
}
{$ifndef newra}
max_scratch_regs = 1;
scratch_regs : array[1..max_scratch_regs] of Tsuperregister = (RS_EDI);
{$endif}
{*****************************************************************************
@ -814,7 +816,12 @@ implementation
end.
{
$Log$
Revision 1.46 2003-04-21 19:16:50 peter
Revision 1.47 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.46 2003/04/21 19:16:50 peter
* count address regs separate
Revision 1.45 2003/03/28 19:16:57 peter

15
compiler/i386/n386add.pas
View File

@ -84,13 +84,17 @@ interface
secondpass(left);
{ are too few registers free? }
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif newra}
if location.loc=LOC_FPUREGISTER then
pushedfpu:=maybe_pushfpu(exprasmlist,right.registersfpu,left.location)
else
pushedfpu:=false;
secondpass(right);
{$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs);
{$endif}
end;
@ -476,7 +480,9 @@ interface
falselabel:=ofl;
end;
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif}
isjump:=(right.location.loc=LOC_JUMP);
if isjump then
begin
@ -486,7 +492,9 @@ interface
objectlibrary.getlabel(falselabel);
end;
secondpass(right);
{$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs);
{$endif newra}
if right.location.loc in [LOC_FLAGS,LOC_JUMP] then
location_force_reg(exprasmlist,right.location,opsize_2_cgsize[opsize],false);
if isjump then
@ -1642,7 +1650,12 @@ begin
end.
{
$Log$
Revision 1.61 2003-04-17 10:02:48 daniel
Revision 1.62 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.61 2003/04/17 10:02:48 daniel
* Tweaked register allocate/deallocate positition to less interferences
are generated.

23
compiler/i386/n386cal.pas
View File

@ -146,9 +146,17 @@ implementation
{ better than an add on all processors }
if pop_size=4 then
begin
{$ifdef newra}
hreg:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
exprasmlist.concat(taicpu.op_reg(A_POP,S_L,hreg));
{$ifdef newra}
rg.ungetregisterint(exprasmlist,hreg);
{$else}
cg.free_scratch_reg(exprasmlist,hreg);
{$endif newra}
end
{ the pentium has two pipes and pop reg is pairable }
{ but the registers must be different! }
@ -158,9 +166,17 @@ implementation
(aktoptprocessor=ClassP5) and
(rg.countunusedregsint>0) then
begin
{$ifdef newra}
hreg:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
exprasmlist.concat(taicpu.op_reg(A_POP,S_L,hreg));
{$ifdef newra}
rg.ungetregisterint(exprasmlist,hreg);
{$else}
cg.free_scratch_reg(exprasmlist,hreg);
{$endif}
hreg:=rg.getregisterint(exprasmlist,OS_INT);
exprasmlist.concat(taicpu.op_reg(A_POP,S_L,hreg));
rg.ungetregisterint(exprasmlist,hreg);
@ -185,7 +201,12 @@ begin
end.
{
$Log$
Revision 1.87 2003-04-04 15:38:56 peter
Revision 1.88 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.87 2003/04/04 15:38:56 peter
* moved generic code from n386cal to ncgcal, i386 now also
uses the generic ncgcal

28
compiler/i386/n386cnv.pas
View File

@ -117,7 +117,11 @@ implementation
hregister:=left.location.register;
else
begin
{$ifdef newra}
hregister:=rg.getregisterint(exprasmlist,OS_32);
{$else}
hregister:=cg.get_scratch_reg_int(exprasmlist,OS_32);
{$endif}
freereg:=true;
cg.a_load_reg_reg(exprasmlist,left.location.size,OS_32,left.location.register,hregister);
end;
@ -126,7 +130,11 @@ implementation
LOC_REFERENCE,
LOC_CREFERENCE :
begin
{$ifdef newra}
hregister:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hregister:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif newra}
freereg:=true;
if left.location.size in [OS_64,OS_S64] then
begin
@ -147,8 +155,13 @@ implementation
{ for 64 bit integers, the high dword is already pushed }
exprasmlist.concat(taicpu.op_reg(A_PUSH,S_L,hregister));
{$ifdef newra}
if freereg then
rg.ungetregisterint(exprasmlist,hregister);
{$else}
if freereg then
cg.free_scratch_reg(exprasmlist,hregister);
{$endif}
r.enum:=R_INTREGISTER;
r.number:=NR_ESP;
reference_reset_base(href,r,0);
@ -268,10 +281,18 @@ implementation
begin
if left.location.size in [OS_64,OS_S64] then
begin
{$ifdef newra}
hregister:=rg.getregisterint(exprasmlist,OS_32);
{$else}
hregister:=cg.get_scratch_reg_int(exprasmlist,OS_32);
{$endif}
cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,left.location.registerlow,hregister);
cg.a_op_reg_reg(exprasmlist,OP_OR,OS_32,left.location.registerhigh,hregister);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,hregister);
{$else}
cg.free_scratch_reg(exprasmlist,hregister);
{$endif}
end
else
cg.a_op_reg_reg(exprasmlist,OP_OR,left.location.size,left.location.register,left.location.register);
@ -432,7 +453,12 @@ begin
end.
{
$Log$
Revision 1.57 2003-03-13 19:52:23 jonas
Revision 1.58 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.57 2003/03/13 19:52:23 jonas
* and more new register allocator fixes (in the i386 code generator this
time). At least now the ppc cross compiler can compile the linux
system unit again, but I haven't tested it.

20
compiler/i386/n386inl.pas
View File

@ -288,10 +288,14 @@ implementation
else
begin
{ generate code for the element to set }
{$ifndef newra}
maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32,
tcallparanode(left).left.location,pushedregs);
{$endif}
secondpass(tcallparanode(tcallparanode(left).right).left);
{$ifndef newra}
maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs);
{$endif}
{ determine asm operator }
if inlinenumber=in_include_x_y then
asmop:=A_BTS
@ -316,15 +320,24 @@ implementation
else
begin
scratch_reg := TRUE;
{$ifdef newra}
hregister:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hregister:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif newra}
end;
cg.a_load_loc_reg(exprasmlist,tcallparanode(tcallparanode(left).right).left.location,hregister);
if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
emit_reg_ref(asmop,S_L,hregister,tcallparanode(left).left.location.reference)
else
emit_reg_reg(asmop,S_L,hregister,tcallparanode(left).left.location.register);
{$ifdef newra}
if scratch_reg then
rg.ungetregisterint(exprasmlist,hregister);
{$else}
if scratch_reg then
cg.free_scratch_reg(exprasmlist,hregister);
{$endif newra}
end;
end;
@ -334,7 +347,12 @@ begin
end.
{
$Log$
Revision 1.56 2003-02-19 22:00:15 daniel
Revision 1.57 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.56 2003/02/19 22:00:15 daniel
* Code generator converted to new register notation
- Horribily outdated todo.txt removed

24
compiler/i386/n386mat.pas
View File

@ -77,9 +77,7 @@ implementation
secondpass(left);
if codegenerror then
exit;
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
secondpass(right);
maybe_restore(exprasmlist,left.location,pushedregs);
if codegenerror then
exit;
@ -154,15 +152,22 @@ implementation
emit_none(A_CDQ,S_NO);
{Division depends on the right type.}
if torddef(right.resulttype.def).typ=u32bit then
if Torddef(right.resulttype.def).typ=u32bit then
op:=A_DIV
else
op:=A_IDIV;
if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
emit_ref(op,S_L,right.location.reference)
else if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
emit_reg(op,S_L,right.location.register)
else
emit_reg(op,S_L,right.location.register);
begin
hreg1:=rg.getregisterint(exprasmlist,right.location.size);
cg.a_load_loc_reg(exprasmlist,right.location,hreg1);
rg.ungetregisterint(exprasmlist,hreg1);
emit_reg(op,S_L,hreg1);
end;
location_release(exprasmlist,right.location);
{Copy the result into a new register. Release EAX & EDX.}
@ -425,9 +430,13 @@ 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
@ -1172,7 +1181,12 @@ begin
end.
{
$Log$
Revision 1.50 2003-04-21 19:15:26 peter
Revision 1.51 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.50 2003/04/21 19:15:26 peter
* when ecx is not available allocated another register
Revision 1.49 2003/04/17 10:02:48 daniel

11
compiler/i386/n386set.pas
View File

@ -200,9 +200,13 @@ implementation
{ Only process the right if we are not generating jumps }
if not genjumps then
begin
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif}
secondpass(right);
{$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs);
{$endif newra}
end;
if codegenerror then
exit;
@ -720,7 +724,12 @@ begin
end.
{
$Log$
Revision 1.51 2003-03-13 19:52:23 jonas
Revision 1.52 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.51 2003/03/13 19:52:23 jonas
* and more new register allocator fixes (in the i386 code generator this
time). At least now the ppc cross compiler can compile the linux
system unit again, but I haven't tested it.

13
compiler/i386/rgcpu.pas
View File

@ -329,9 +329,9 @@ unit rgcpu;
procedure trgcpu.ungetreference(list: taasmoutput; const ref : treference);
begin
if ref.base.number<>NR_NO then
if (ref.base.number<>NR_NO) and (ref.base.number<>NR_FRAME_POINTER_REG) then
ungetregisterint(list,ref.base);
if ref.index.number<>NR_NO then
if (ref.index.number<>NR_NO) and (ref.index.number<>NR_FRAME_POINTER_REG) then
ungetregisterint(list,ref.index);
end;
@ -557,12 +557,17 @@ unit rgcpu;
initialization
rg := trgcpu.create;
rg := trgcpu.create(7); {We use 7 int registers on i386.}
end.
{
$Log$
Revision 1.18 2003-04-21 19:16:50 peter
Revision 1.19 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.18 2003/04/21 19:16:50 peter
* count address regs separate
Revision 1.17 2003/03/28 19:16:57 peter

9
compiler/m68k/rgcpu.pas
View File

@ -210,12 +210,17 @@ unit rgcpu;
initialization
rg := trgcpu.create;
rg := trgcpu.create(16);
end.
{
$Log$
Revision 1.7 2003-02-19 22:00:16 daniel
Revision 1.8 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.7 2003/02/19 22:00:16 daniel
* Code generator converted to new register notation
- Horribily outdated todo.txt removed

64
compiler/ncgcal.pas
View File

@ -171,11 +171,19 @@ implementation
begin
if calloption=pocall_inline then
begin
{$ifdef newra}
tmpreg:=rg.getaddressregister(exprasmlist);
{$else}
tmpreg:=cg.get_scratch_reg_address(exprasmlist);
{$endif newra}
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,tmpreg);
{$else}
cg.free_scratch_reg(exprasmlist,tmpreg);
{$endif}
end
else
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
@ -202,11 +210,19 @@ implementation
inc(pushedparasize,POINTER_SIZE);
if calloption=pocall_inline then
begin
{$ifdef newra}
tmpreg:=rg.getaddressregister(exprasmlist);
{$else}
tmpreg:=cg.get_scratch_reg_address(exprasmlist);
{$endif}
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,tmpreg);
{$else}
cg.free_scratch_reg(exprasmlist,tmpreg);
{$endif}
end
else
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
@ -250,11 +266,19 @@ implementation
inc(pushedparasize,POINTER_SIZE);
if calloption=pocall_inline then
begin
{$ifdef newra}
tmpreg:=rg.getaddressregister(exprasmlist);
{$else}
tmpreg:=cg.get_scratch_reg_address(exprasmlist);
{$endif}
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,tmpreg);
reference_reset_base(href,procinfo.framepointer,para_offset-pushedparasize);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,tmpreg);
{$else}
cg.free_scratch_reg(exprasmlist,tmpreg);
{$endif}
end
else
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.paraloc);
@ -719,6 +743,14 @@ implementation
r.number:=NR_ACCUMULATOR;
hregister.enum:=R_INTREGISTER;
hregister.number:=NR_ACCUMULATORHIGH;
{$ifdef newra}
rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR);
rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATORHIGH);
rg.ungetregisterint(exprasmlist,r);
rg.ungetregisterint(exprasmlist,hregister);
location.registerlow:=rg.getregisterint(exprasmlist,OS_INT);
location.registerhigh:=rg.getregisterint(exprasmlist,OS_INT);
{$else newra}
cg.a_reg_alloc(exprasmlist,r);
cg.a_reg_alloc(exprasmlist,hregister);
if RS_ACCUMULATOR in rg.unusedregsint then
@ -729,6 +761,7 @@ implementation
location.registerhigh:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATORHIGH)
else
location.registerhigh:=rg.getregisterint(exprasmlist,OS_INT);
{$endif newra}
cg64.a_load64_reg_reg(exprasmlist,joinreg64(r,hregister),
location.register64);
end
@ -740,11 +773,17 @@ implementation
nr:=RS_ACCUMULATOR shl 8 or cgsize2subreg(cgsize);
r.enum:=R_INTREGISTER;
r.number:=nr;
{$ifdef newra}
rg.getexplicitregisterint(exprasmlist,nr);
rg.ungetregisterint(exprasmlist,r);
location.register:=rg.getregisterint(exprasmlist,cgsize);
{$else newra}
cg.a_reg_alloc(exprasmlist,r);
if RS_ACCUMULATOR in rg.unusedregsint then
location.register:=rg.getexplicitregisterint(exprasmlist,nr)
else
location.register:=rg.getregisterint(exprasmlist,cgsize);
{$endif newra}
cg.a_load_reg_reg(exprasmlist,cgsize,cgsize,r,location.register);
end;
end;
@ -783,12 +822,18 @@ implementation
else
begin
location_reset(location,LOC_REGISTER,OS_INT);
r.enum:=R_INTREGISTER;
r.number:=NR_ACCUMULATOR;
{$ifdef newra}
rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR);
rg.ungetregisterint(exprasmlist,r);
location.register:=rg.getregisterint(exprasmlist,OS_INT);
{$else newra}
if RS_ACCUMULATOR in rg.unusedregsint then
location.register:=rg.getexplicitregisterint(exprasmlist,NR_ACCUMULATOR)
else
location.register:=rg.getregisterint(exprasmlist,OS_INT);
r.enum:=R_INTREGISTER;
r.number:=NR_ACCUMULATOR;
{$endif newra}
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,r,location.register);
end;
end;
@ -999,11 +1044,19 @@ implementation
by function itself ! }
if inlined then
begin
{$ifdef newra}
hregister:=rg.getaddressregister(exprasmlist);
{$else}
hregister:=cg.get_scratch_reg_address(exprasmlist);
{$endif}
cg.a_loadaddr_ref_reg(exprasmlist,funcretref,hregister);
reference_reset_base(href,procinfo.framepointer,inlinecode.retoffset);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,href);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,hregister);
{$else}
cg.free_scratch_reg(exprasmlist,hregister);
{$endif}
end
else
cg.a_paramaddr_ref(exprasmlist,funcretref,paramanager.getfuncretparaloc(procdefinition));
@ -1423,7 +1476,12 @@ begin
end.
{
$Log$
Revision 1.47 2003-04-22 09:49:44 peter
Revision 1.48 2003-04-22 10:09:34 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.47 2003/04/22 09:49:44 peter
* do not load self when calling a non-inherited class constructor
Revision 1.46 2003/04/21 20:03:32 peter

32
compiler/ncginl.pas
View File

@ -390,10 +390,14 @@ implementation
{ second_ argument specified?, must be a s32bit in register }
if assigned(tcallparanode(left).right) then
begin
{$ifndef newra}
maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32,
tcallparanode(left).left.location,pushedregs);
{$endif}
secondpass(tcallparanode(tcallparanode(left).right).left);
{$ifndef newra}
maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs);
{$endif}
{ when constant, just multiply the addvalue }
if is_constintnode(tcallparanode(tcallparanode(left).right).left) then
addvalue:=addvalue*get_ordinal_value(tcallparanode(tcallparanode(left).right).left)
@ -504,13 +508,21 @@ implementation
(tenumdef(tcallparanode(tcallparanode(left).right).left.resulttype.def).max<=32));
{ generate code for the element to set }
{$ifndef newra}
maybe_save(exprasmlist,tcallparanode(tcallparanode(left).right).left.registers32,
tcallparanode(left).left.location,pushedregs);
{$endif newra}
secondpass(tcallparanode(tcallparanode(left).right).left);
{$ifndef newra}
maybe_restore(exprasmlist,tcallparanode(left).left.location,pushedregs);
{$endif newra}
{ bitnumber - which must be loaded into register }
{$ifdef newra}
hregister:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hregister := cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
hregister2 := rg.getregisterint(exprasmlist,OS_INT);
case tcallparanode(tcallparanode(left).right).left.location.loc of
@ -568,7 +580,11 @@ implementation
}
{ hregister contains the bitnumber (div 32 to get the correct offset) }
cg.a_op_const_reg(exprasmlist, OP_SHR, 5, hregister);
{$ifdef newra}
addrreg:=rg.getaddressregister(exprasmlist);
{$else}
addrreg := cg.get_scratch_reg_address(exprasmlist);
{$endif}
{ calculate the correct address of the operand }
cg.a_loadaddr_ref_reg(exprasmlist, tcallparanode(left).left.location.reference,addrreg);
cg.a_op_reg_reg(exprasmlist, OP_ADD, OS_INT, hregister, addrreg);
@ -583,10 +599,17 @@ implementation
cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2, hregister2);
cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, hregister2, href);
end;
{$ifdef newra}
rg.ungetregisterint(exprasmlist,addrreg);
{$else}
cg.free_scratch_reg(exprasmlist, addrreg);
{$endif}
end;
{$ifdef newra}
rg.ungetregisterint(exprasmlist,hregister);
{$else}
cg.free_scratch_reg(exprasmlist,hregister);
{$endif}
rg.ungetregisterint(exprasmlist,hregister2);
end;
end;
@ -646,7 +669,12 @@ end.
{
$Log$
Revision 1.23 2003-04-06 21:11:23 olle
Revision 1.24 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.23 2003/04/06 21:11:23 olle
* changed newasmsymbol to newasmsymboldata for data symbols
Revision 1.22 2003/03/28 19:16:56 peter

39
compiler/ncgld.pas
View File

@ -363,10 +363,18 @@ implementation
rg.ungetregisterint(exprasmlist,hregister);
{ load address of the function }
reference_reset_symbol(href,objectlibrary.newasmsymbol(tprocdef(resulttype.def).mangledname),0);
{$ifdef newra}
hregister:=rg.getaddressregister(exprasmlist);
{$else}
hregister:=cg.get_scratch_reg_address(exprasmlist);
{$endif}
cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,hregister,location.reference);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,hregister);
{$else newra}
cg.free_scratch_reg(exprasmlist,hregister);
{$endif}
end;
end
else
@ -443,12 +451,16 @@ implementation
begin
{ left can't be never a 64 bit LOC_REGISTER, so the 3. arg }
{ can be false }
{$ifndef newra}
maybe_save(exprasmlist,left.registers32,right.location,pushedregs);
{$endif}
secondpass(left);
{ decrement destination reference counter }
if (left.resulttype.def.needs_inittable) then
cg.g_decrrefcount(exprasmlist,left.resulttype.def,left.location.reference);
{$ifndef newra}
maybe_restore(exprasmlist,right.location,pushedregs);
{$endif newra}
if codegenerror then
exit;
end;
@ -469,14 +481,18 @@ implementation
{ left can't be never a 64 bit LOC_REGISTER, so the 3. arg }
{ can be false }
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif newra}
secondpass(right);
{ increment source reference counter, this is
useless for string constants}
if (right.resulttype.def.needs_inittable) and
(right.nodetype<>stringconstn) then
cg.g_incrrefcount(exprasmlist,right.resulttype.def,right.location.reference);
{$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs);
{$endif}
if codegenerror then
exit;
@ -633,9 +649,13 @@ implementation
{ generate the leftnode for the true case, and
release the location }
cg.a_label(exprasmlist,truelabel);
{$ifndef newra}
maybe_save(exprasmlist,left.registers32,right.location,pushedregs);
{$endif newra}
secondpass(left);
{$ifndef newra}
maybe_restore(exprasmlist,right.location,pushedregs);
{$endif newra}
if codegenerror then
exit;
cg.a_load_const_loc(exprasmlist,1,left.location);
@ -643,9 +663,13 @@ implementation
cg.a_jmp_always(exprasmlist,hlabel);
{ generate the leftnode for the false case }
cg.a_label(exprasmlist,falselabel);
{$ifndef newra}
maybe_save(exprasmlist,left.registers32,right.location,pushedregs);
{$endif}
secondpass(left);
{$ifndef newra}
maybe_restore(exprasmlist,right.location,pushedregs);
{$endif newra}
if codegenerror then
exit;
cg.a_load_const_loc(exprasmlist,0,left.location);
@ -910,10 +934,18 @@ implementation
if vaddr then
begin
location_force_mem(exprasmlist,hp.left.location);
{$ifdef newra}
tmpreg:=rg.getaddressregister(exprasmlist);
{$else}
tmpreg:=cg.get_scratch_reg_address(exprasmlist);
{$endif}
cg.a_loadaddr_ref_reg(exprasmlist,hp.left.location.reference,tmpreg);
cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,href);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,tmpreg);
{$else}
cg.free_scratch_reg(exprasmlist,tmpreg);
{$endif}
location_release(exprasmlist,hp.left.location);
if freetemp then
location_freetemp(exprasmlist,hp.left.location);
@ -970,7 +1002,12 @@ begin
end.
{
$Log$
Revision 1.47 2003-04-06 21:11:23 olle
Revision 1.48 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.47 2003/04/06 21:11:23 olle
* changed newasmsymbol to newasmsymboldata for data symbols
Revision 1.46 2003/03/28 19:16:56 peter

24
compiler/ncgmat.pas
View File

@ -257,9 +257,13 @@ implementation
secondpass(left);
if codegenerror then
exit;
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif}
secondpass(right);
{$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs);
{$endif newra}
if codegenerror then
exit;
location_copy(location,left.location);
@ -350,9 +354,13 @@ implementation
begin
freescratch:=false;
secondpass(left);
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif newra}
secondpass(right);
{$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs);
{$endif}
{ determine operator }
case nodetype of
shln: op:=OP_SHL;
@ -428,15 +436,24 @@ implementation
begin
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
{$ifdef newra}
hcountreg:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hcountreg:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
freescratch := true;
cg.a_load_loc_reg(exprasmlist,right.location,hcountreg);
end
else
hcountreg:=right.location.register;
cg.a_op_reg_reg(exprasmlist,op,OS_INT,hcountreg,location.register);
{$ifdef newra}
if freescratch then
rg.ungetregisterint(exprasmlist,hcountreg);
{$else}
if freescratch then
cg.free_scratch_reg(exprasmlist,hcountreg);
{$endif}
end;
end;
end;
@ -450,7 +467,12 @@ begin
end.
{
$Log$
Revision 1.7 2003-03-28 19:16:56 peter
Revision 1.8 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.7 2003/03/28 19:16:56 peter
* generic constructor working for i386
* remove fixed self register
* esi added as address register for i386

32
compiler/ncgmem.pas
View File

@ -406,12 +406,20 @@ implementation
usetemp:=true;
if is_class_or_interface(left.resulttype.def) then
begin
{$ifdef newra}
tmpreg:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
tmpreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
cg.a_load_loc_reg(exprasmlist,left.location,tmpreg)
end
else
begin
{$ifdef newra}
tmpreg:=rg.getaddressregister(exprasmlist);
{$else}
tmpreg := cg.get_scratch_reg_address(exprasmlist);
{$endif newra}
cg.a_loadaddr_ref_reg(exprasmlist,
left.location.reference,tmpreg);
end;
@ -444,7 +452,11 @@ implementation
tg.GetTemp(exprasmlist,pointer_size,tt_persistant,withreference);
{ move to temp reference }
cg.a_load_reg_ref(exprasmlist,OS_ADDR,tmpreg,withreference);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,tmpreg);
{$else}
cg.free_scratch_reg(exprasmlist,tmpreg);
{$endif}
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
@ -580,7 +592,11 @@ implementation
hreg:=right.location.register
else
begin
{$ifdef newra}
hreg:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
freereg:=true;
cg.a_load_loc_reg(exprasmlist,right.location,hreg);
end;
@ -588,8 +604,13 @@ implementation
objectlibrary.getlabel(poslabel);
cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_LT,0,hreg,poslabel);
cg.a_cmp_loc_reg_label(exprasmlist,OS_INT,OC_BE,hightree.location,hreg,neglabel);
{$ifdef newra}
if freereg then
rg.ungetregisterint(exprasmlist,hreg);
{$else}
if freereg then
cg.free_scratch_reg(exprasmlist,hreg);
{$endif}
cg.a_label(exprasmlist,poslabel);
cg.a_call_name(exprasmlist,'FPC_RANGEERROR');
cg.a_label(exprasmlist,neglabel);
@ -843,9 +864,13 @@ implementation
ofl:=falselabel;
objectlibrary.getlabel(falselabel);
end;
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,location,pushedregs);
{$endif}
secondpass(right);
{$ifndef newra}
maybe_restore(exprasmlist,location,pushedregs);
{$endif}
if cs_check_range in aktlocalswitches then
begin
@ -919,7 +944,12 @@ begin
end.
{
$Log$
Revision 1.45 2003-04-06 21:11:23 olle
Revision 1.46 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.45 2003/04/06 21:11:23 olle
* changed newasmsymbol to newasmsymboldata for data symbols
Revision 1.44 2003/03/28 19:16:56 peter

58
compiler/ncgset.pas
View File

@ -110,11 +110,15 @@ implementation
{ also a second value ? }
if assigned(right) then
begin
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif}
secondpass(right);
if codegenerror then
exit;
{$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs);
{$endif newra}
if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
location_force_reg(exprasmlist,right.location,OS_32,false);
end;
@ -264,9 +268,13 @@ implementation
{ Only process the right if we are not generating jumps }
if not genjumps then
begin
{$ifndef newra}
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
{$endif}
secondpass(right);
{$ifndef newra}
maybe_restore(exprasmlist,left.location,pushedregs);
{$endif}
end;
if codegenerror then
exit;
@ -312,7 +320,11 @@ implementation
else
begin
{ load the value in a register }
{$ifdef newra}
pleftreg:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
pleftreg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
opsize := OS_INT;
cg.a_load_ref_reg(exprasmlist,def_cgsize(left.resulttype.def),left.location.reference,pleftreg);
end;
@ -340,7 +352,11 @@ implementation
if (left.location.loc = LOC_CREGISTER) and
(hr.enum <> pleftreg.enum) then
begin
{$ifdef newra}
hr:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hr:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
cg.a_op_const_reg_reg(exprasmlist,OP_SUB,opsize,setparts[i].start,pleftreg,hr);
pleftreg:=hr;
opsize := OS_INT;
@ -388,13 +404,21 @@ implementation
cg.a_label(exprasmlist,l3);
case left.location.loc of
LOC_CREGISTER :
{$ifdef newra}
rg.ungetregisterint(exprasmlist,pleftreg);
{$else}
cg.free_scratch_reg(exprasmlist,pleftreg);
{$endif}
LOC_REGISTER :
rg.ungetregister(exprasmlist,pleftreg);
else
begin
reference_release(exprasmlist,left.location.reference);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,pleftreg);
{$else}
cg.free_scratch_reg(exprasmlist,pleftreg);
{$endif}
end;
end;
end
@ -412,7 +436,11 @@ implementation
begin
{ clear the register value, indicating result is FALSE }
cg.a_load_const_reg(exprasmlist,OS_INT,0,location.register);
{$ifdef newra}
hr:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hr:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
case right.location.loc of
LOC_REGISTER,
LOC_CREGISTER:
@ -444,14 +472,23 @@ implementation
LOC_REGISTER,
LOC_CREGISTER:
begin
hr3:=rg.makeregsize(left.location.register,OS_INT);
hr3.enum:=R_INTREGISTER;
hr3.number:=(left.location.register.number and not $ff) or R_SUBWHOLE;
cg.a_load_reg_reg(exprasmlist,left.location.size,OS_INT,left.location.register,hr3);
{$ifdef newra}
hr:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hr:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,hr3,hr);
end;
else
begin
{$ifdef newra}
hr:=rg.getregisterint(exprasmlist,OS_INT);
{$else}
hr:=cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
cg.a_load_ref_reg(exprasmlist,def_cgsize(left.resulttype.def),
left.location.reference,hr);
location_release(exprasmlist,left.location);
@ -496,7 +533,11 @@ implementation
internalerror(2002032210);
end;
{ free bitnumber register }
{$ifdef newra}
rg.ungetregisterint(exprasmlist,hr);
{$else}
cg.free_scratch_reg(exprasmlist,hr);
{$endif}
end;
end
else
@ -683,9 +724,17 @@ implementation
begin
last:=0;
first:=true;
{$ifdef newra}
scratch_reg:=rg.getregisterint(exprasmlist,OS_INT);
{$else newra}
scratch_reg := cg.get_scratch_reg_int(exprasmlist,OS_INT);
{$endif}
genitem(hp);
{$ifdef newra}
rg.ungetregisterint(exprasmlist,scratch_reg);
{$else}
cg.free_scratch_reg(exprasmlist,scratch_reg);
{$endif}
cg.a_jmp_always(exprasmlist,elselabel);
end;
end;
@ -1063,7 +1112,12 @@ begin
end.
{
$Log$
Revision 1.26 2003-02-19 22:00:14 daniel
Revision 1.27 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.26 2003/02/19 22:00:14 daniel
* Code generator converted to new register notation
- Horribily outdated todo.txt removed

35
compiler/ncgutil.pas
View File

@ -52,8 +52,10 @@ interface
procedure location_force_reg(list: TAAsmoutput;var l:tlocation;dst_size:TCGSize;maybeconst:boolean);
procedure location_force_mem(list: TAAsmoutput;var l:tlocation);
{$ifndef newra}
procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
procedure maybe_restore(list:taasmoutput;var l:tlocation;const s:tmaybesave);
{$endif}
function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
procedure push_value_para(list:taasmoutput;p:tnode;calloption:tproccalloption;
@ -607,6 +609,7 @@ implementation
Maybe_Save
*****************************************************************************}
{$ifndef newra}
procedure maybe_save(list:taasmoutput;needed:integer;var l:tlocation;var s:tmaybesave);
begin
s.saved:=false;
@ -707,6 +710,7 @@ implementation
end;
tg.ungetiftemp(list,s.ref);
end;
{$endif newra}
function maybe_pushfpu(list:taasmoutput;needed : byte;var l:tlocation) : boolean;
@ -1064,11 +1068,19 @@ implementation
vs_out :
begin
reference_reset_base(href,procinfo.framepointer,tvarsym(p).address+procinfo.para_offset);
{$ifdef newra}
tmpreg:=rg.getaddressregister(list);
{$else}
tmpreg:=cg.get_scratch_reg_address(list);
{$endif}
cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
reference_reset_base(href,tmpreg,0);
cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
cg.free_scratch_reg(list,tmpreg);
{$endif newra}
end;
end;
end;
@ -1518,14 +1530,22 @@ function returns in a register and the caller receives it in an other one}
reference_reset_base(href,procinfo.framepointer,procinfo.inheritedflag_offset);
cg.a_cmp_const_ref_label(list,OS_ADDR,OC_EQ,0,href,inheriteddesctructorlabel);
reference_reset_base(href,procinfo.framepointer,procinfo.selfpointer_offset);
{$ifdef newra}
tmpreg:=rg.getaddressregister(list);
{$else}
tmpreg:=cg.get_scratch_reg_address(list);
{$endif}
cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
cg.a_param_reg(list,OS_ADDR,tmpreg,paramanager.getintparaloc(1));
reference_reset_base(href,tmpreg,0);
cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
reference_reset_base(href,tmpreg,72);
cg.a_call_ref(list,href);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
cg.free_scratch_reg(list,tmpreg);
{$endif}
cg.a_label(list,inheriteddesctructorlabel);
end;
@ -1801,11 +1821,19 @@ function returns in a register and the caller receives it in an other one}
cg.a_load_ref_reg(list,OS_ADDR,href,r);
cg.a_param_reg(list,OS_ADDR,r,paramanager.getintparaloc(1));
reference_reset_base(href,r,0);
{$ifdef newra}
tmpreg:=rg.getaddressregister(list);
{$else newra}
tmpreg:=cg.get_scratch_reg_address(list);
{$endif}
cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
reference_reset_base(href,tmpreg,68);
cg.a_call_ref(list,href);
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
cg.free_scratch_reg(list,tmpreg);
{$endif}
end;
{ return the self pointer }
cg.a_label(list,inheritedconstructorlabel);
@ -2018,7 +2046,12 @@ function returns in a register and the caller receives it in an other one}
end.
{
$Log$
Revision 1.84 2003-04-16 09:26:55 jonas
Revision 1.85 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.84 2003/04/16 09:26:55 jonas
* assembler procedures now again get a stackframe if they have local
variables. No space is reserved for a function result however.
Also, the register parameters aren't automatically saved on the stack

9
compiler/powerpc/rgcpu.pas
View File

@ -70,12 +70,17 @@ unit rgcpu;
end;
initialization
rg := trgcpu.create;
rg := trgcpu.create(32); {PPC has 32 registers.}
end.
{
$Log$
Revision 1.5 2003-02-19 22:00:16 daniel
Revision 1.6 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.5 2003/02/19 22:00:16 daniel
* Code generator converted to new register notation
- Horribily outdated todo.txt removed

26
compiler/psub.pas
View File

@ -373,10 +373,26 @@ implementation
procinfo.aktproccode.insertlist(procinfo.aktentrycode);
procinfo.aktproccode.concatlist(procinfo.aktexitcode);
{$ifdef newra}
rg.writegraph;
{ rg.writegraph;}
{$endif}
if not(cs_no_regalloc in aktglobalswitches) then
begin
{$ifdef newra}
{Do register allocation.}
repeat
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='';
procinfo.aktproccode.translate_registers(rg.colour);
procinfo.aktproccode.convert_registers;
{$else newra}
procinfo.aktproccode.convert_registers;
{$ifndef NoOpt}
if (cs_optimize in aktglobalswitches) and
@ -384,6 +400,7 @@ implementation
((procinfo.flags and pi_is_assembler)=0) then
optimize(procinfo.aktproccode);
{$endif NoOpt}
{$endif newra}
end;
{ save local data (casetable) also in the same file }
if assigned(procinfo.aktlocaldata) and
@ -867,7 +884,12 @@ implementation
end.
{
$Log$
Revision 1.98 2003-04-17 07:50:24 daniel
Revision 1.99 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.98 2003/04/17 07:50:24 daniel
* Some work on interference graph construction
Revision 1.97 2003/04/16 09:26:55 jonas

607
compiler/rgobj.pas
View File

@ -42,8 +42,7 @@ published by Cambridge University Press.
Reading this book is recommended for a complete understanding. Here is a small
introduction.
The code generator thinks it has an infinite amount of registers. Our processor
has a limited amount of registers. Therefore we must reduce the amount of
The code generator thinks it has an infinite amount of registers. Our processorhas a limited amount of registers. Therefore we must reduce the amount of
registers until there are less enough to fit into the processors registers.
Registers can interfere or not interfere. If two imaginary registers interfere
@ -61,7 +60,7 @@ if two registers interfere there is a connection between them in the graph.
In addition to the imaginary registers in the code generator, the psysical
CPU registers are also present in this graph. This allows us to make
interferences between imaginary registers and cpu registers. This is very
usefull for describing archtectural constrains, like for example that
usefull for describing archtectural constraints, like for example that
the div instruction modifies edx, so variables that are in use at that time
cannot be stored into edx. This can be modelled by making edx interfere
with those variables.
@ -108,8 +107,21 @@ unit rgobj;
end;
Pinterferencegraph=^Tinterferencegraph;
Tmovelist=record
count:cardinal;
data:array[0..$ffff] of Tlinkedlistitem;
end;
Pmovelist=^Tmovelist;
{In the register allocator we keep track of move instructions.
These instructions are moved between five linked lists. There
is also a linked list per register to keep track about the moves
it is associated with. Because we need to determine quickly in
which of the five lists it is we add anu enumeradtion to each
move instruction.}
Tmoveset=(ms_coalesced_moves,ms_constrained_moves,ms_frozen_moves,
ms_worklist_moves,ms_activemoves);
ms_worklist_moves,ms_active_moves);
Tmoveins=class(Tlinkedlistitem)
moveset:Tmoveset;
instruction:Taicpu;
@ -129,7 +141,7 @@ unit rgobj;
{ aren't currently allocated to a regvar. The "unusedregsxxx" }
{ contain all registers of type "xxx" that aren't currenly }
{ allocated }
lastintreg:Tsuperregister;
lastintreg,maxintreg:Tsuperregister;
unusedregsint,usableregsint:Tsupregset;
unusedregsaddr,usableregsaddr:Tsupregset;
unusedregsfpu,usableregsfpu : tregisterset;
@ -161,12 +173,15 @@ unit rgobj;
is_reg_var_int:Tsupregset;
regvar_loaded: regvar_booleanarray;
regvar_loaded_int: Tsupregset;
{$ifdef newra}
colour:array[Tsuperregister] of Tsuperregister;
spillednodes:string;
{$endif}
{ tries to hold the amount of times which the current tree is processed }
t_times: longint;
constructor create;
constructor create(Acpu_registers:byte);
{# Allocate a general purpose register
@ -245,7 +260,12 @@ unit rgobj;
}
procedure ungetreference(list: taasmoutput; const ref : treference); virtual;
{# Reset the register allocator information (usable registers etc) }
{# Reset the register allocator information (usable registers etc).
Please note that it is mortal sins to call cleartempgen during
graph colouring (that is between prepare_colouring and
epilogue_colouring).
}
procedure cleartempgen;virtual;
{# Convert a register to a specified register size, and return that register size }
@ -299,13 +319,26 @@ unit rgobj;
procedure saveUnusedState(var state: pointer);virtual;
procedure restoreUnusedState(var state: pointer);virtual;
{$ifdef newra}
{$ifdef ra_debug}
procedure writegraph;
{$endif}
procedure add_move_instruction(instr:Taicpu);
procedure prepare_colouring;
procedure epilogue_colouring;
procedure colour_registers;
{$endif newra}
protected
cpu_registers:byte;
{$ifdef newra}
igraph:Tinterferencegraph;
movelist:array[Tsuperregister] of Tlinkedlist;
worklistmoves:Tlinkedlist;
degree:array[0..255] of byte;
alias:array[Tsuperregister] of Tsuperregister;
simplifyworklist,freezeworklist,spillworklist:string;
coalescednodes:string;
selectstack:string;
movelist:array[Tsuperregister] of Pmovelist;
worklist_moves,active_moves,frozen_moves,
coalesced_moves,constrained_moves:Tlinkedlist;
{$endif}
{ the following two contain the common (generic) code for all }
{ get- and ungetregisterxxx functions/procedures }
@ -332,6 +365,23 @@ unit rgobj;
{$ifdef newra}
procedure add_edge(u,v:Tsuperregister);
procedure add_edges_used(u:Tsuperregister);
procedure add_to_movelist(u:Tsuperregister;data:Tlinkedlistitem);
function move_related(n:Tsuperregister):boolean;
procedure make_work_list;
procedure enable_moves(n:Tsuperregister);
procedure decrement_degree(m:Tsuperregister);
procedure simplify;
function get_alias(n:Tsuperregister):Tsuperregister;
procedure add_worklist(u:Tsuperregister);
function adjacent_ok(u,v:Tsuperregister):boolean;
function conservative(u,v:Tsuperregister):boolean;
procedure combine(u,v:Tsuperregister);
procedure coalesce;
procedure freeze_moves(u:Tsuperregister);
procedure freeze;
procedure select_spill;
procedure assign_colours;
{$endif}
end;
@ -415,7 +465,7 @@ unit rgobj;
globals,verbose,
cgobj,tgobj,regvars;
constructor trgobj.create;
constructor Trgobj.create(Acpu_registers:byte);
begin
usedinproc := [];
@ -423,14 +473,17 @@ unit rgobj;
t_times := 0;
resetusableregisters;
lastintreg:=0;
maxintreg:=first_imreg;
cpu_registers:=Acpu_registers;
{$ifdef TEMPREGDEBUG}
fillchar(reg_user,sizeof(reg_user),0);
fillchar(reg_releaser,sizeof(reg_releaser),0);
{$endif TEMPREGDEBUG}
{$ifdef newra}
fillchar(igraph,sizeof(igraph),0);
fillchar(degree,sizeof(degree),0);
fillchar(movelist,sizeof(movelist),0);
worklistmoves.create;
worklist_moves:=Tlinkedlist.create;
{$endif}
end;
@ -487,6 +540,8 @@ unit rgobj;
list.concat(Tai_regalloc.alloc(r));
result:=r;
lastintreg:=i;
if i>maxintreg then
maxintreg:=i;
{$ifdef newra}
add_edges_used(i);
{$endif}
@ -749,6 +804,8 @@ unit rgobj;
countunusedregsint:=countusableregsint;
countunusedregsfpu:=countusableregsfpu;
countunusedregsmm:=countusableregsmm;
lastintreg:=0;
maxintreg:=first_imreg;
{$ifdef newra}
unusedregsint:=[0..255];
{$else}
@ -762,10 +819,12 @@ unit rgobj;
if igraph.adjlist[i]<>nil then
dispose(igraph.adjlist[i]);
if movelist[i]<>nil then
movelist[i].destroy;
dispose(movelist[i]);
end;
fillchar(movelist,sizeof(movelist),0);
fillchar(igraph,sizeof(igraph),0);
worklistmoves.destroy;
fillchar(degree,sizeof(degree),0);
worklist_moves.clear;
{$endif}
end;
@ -1224,9 +1283,15 @@ unit rgobj;
include(igraph.bitmap[v],u);
{Precoloured nodes are not stored in the interference graph.}
if not(u in [first_supreg..last_supreg]) then
addadj(u,v);
begin
addadj(u,v);
inc(degree[u]);
end;
if not(v in [first_supreg..last_supreg]) then
addadj(v,u);
begin
addadj(v,u);
inc(degree[v]);
end;
end;
end;
@ -1240,13 +1305,18 @@ unit rgobj;
add_edge(u,i);
end;
{$ifdef ra_debug}
procedure Trgobj.writegraph;
{This procedure writes out the current interference graph in the
register allocator.}
var f:text;
i,j:Tsuperregister;
begin
assign(f,'igraph');
assign(f,'igraph'+char(48+random(10))+char(48+random(10)));
rewrite(f);
writeln(f,'Interference graph');
writeln(f);
@ -1273,6 +1343,502 @@ unit rgobj;
end;
{$endif}
procedure Trgobj.add_to_movelist(u:Tsuperregister;data:Tlinkedlistitem);
begin
if movelist[u]=nil then
begin
getmem(movelist[u],64);
movelist[u]^.count:=0;
end
else if (movelist[u]^.count and 15)=15 then
reallocmem(movelist[u],(movelist[u]^.count+1)*4+64);
movelist[u]^.data[movelist[u]^.count]:=data;
inc(movelist[u]^.count);
end;
procedure Trgobj.add_move_instruction(instr:Taicpu);
{This procedure notifies a certain as a move instruction so the
register allocator can try to eliminate it.}
var i:Tmoveins;
ssupreg,dsupreg:Tsuperregister;
begin
i:=Tmoveins.create;
i.moveset:=ms_worklist_moves;
i.instruction:=instr;
worklist_moves.insert(i);
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);
end;
function Trgobj.move_related(n:Tsuperregister):boolean;
var i:cardinal;
begin
move_related:=false;
if movelist[n]<>nil then
begin
for i:=0 to movelist[n]^.count-1 do
if Tmoveins(movelist[n]^.data[i]).moveset in
[ms_worklist_moves,ms_active_moves] then
begin
move_related:=true;
break;
end;
end;
end;
procedure Trgobj.make_work_list;
var n:Tsuperregister;
begin
for n:=first_imreg to maxintreg do
if degree[n]>cpu_registers then
spillworklist:=spillworklist+char(n)
else if move_related(n) then
freezeworklist:=freezeworklist+char(n)
else
simplifyworklist:=simplifyworklist+char(n);
end;
procedure Trgobj.prepare_colouring;
begin
make_work_list;
active_moves:=Tlinkedlist.create;
frozen_moves:=Tlinkedlist.create;
coalesced_moves:=Tlinkedlist.create;
constrained_moves:=Tlinkedlist.create;
fillchar(alias,sizeof(alias),0);
coalescednodes:='';
selectstack:='';
end;
procedure Trgobj.enable_moves(n:Tsuperregister);
var m:Tlinkedlistitem;
i:cardinal;
begin
if movelist[n]<>nil then
for i:=0 to movelist[n]^.count-1 do
begin
m:=movelist[n]^.data[i];
if Tmoveins(m).moveset in [ms_worklist_moves,ms_active_moves] then
begin
if Tmoveins(m).moveset=ms_active_moves then
begin
{Move m from the set active_moves to the set worklist_moves.}
active_moves.remove(m);
Tmoveins(m).moveset:=ms_worklist_moves;
worklist_moves.concat(m);
end;
end;
end;
end;
procedure Trgobj.decrement_degree(m:Tsuperregister);
var adj:Pstring;
d:byte;
i:byte;
n:char;
begin
d:=degree[m];
dec(degree[m]);
if d=cpu_registers then
begin
{Enable moves for m.}
enable_moves(m);
{Enable moves for adjacent.}
adj:=igraph.adjlist[m];
if adj<>nil then
for i:=1 to length(adj^) do
begin
n:=adj^[i];
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);
if move_related(m) then
freezeworklist:=freezeworklist+char(m)
else
simplifyworklist:=simplifyworklist+char(m);
end;
end;
procedure Trgobj.simplify;
var adj:Pstring;
i:byte;
m:char;
n:Tsuperregister;
begin
{We need to take a random element out of the simplifyworklist. We take
the last element. Dirty code!}
n:=Tsuperregister(simplifyworklist[byte(simplifyworklist[0])]);
dec(simplifyworklist[0]);
{Push it on the selectstack.}
selectstack:=selectstack+char(n);
adj:=igraph.adjlist[n];
if adj<>nil then
for i:=1 to length(adj^) do
begin
m:=adj^[i];
if (pos(m,selectstack) or pos(m,coalescednodes))=0 then
decrement_degree(Tsuperregister(m));
end;
end;
function Trgobj.get_alias(n:Tsuperregister):Tsuperregister;
begin
while pos(char(n),coalescednodes)<>0 do
n:=alias[n];
get_alias:=n;
end;
procedure Trgobj.add_worklist(u:Tsuperregister);
begin
if not(u in [first_supreg..last_supreg]) and not move_related(u) and
(degree[u]<cpu_registers) then
begin
delete(freezeworklist,pos(char(u),freezeworklist),1);
simplifyworklist:=simplifyworklist+char(u);
end;
end;
function Trgobj.adjacent_ok(u,v:Tsuperregister):boolean;
{Check wether u and v should be coalesced. u is precoloured.}
function ok(t,r:Tsuperregister):boolean;
begin
ok:=(degree[t]<cpu_registers) or
(t in [first_supreg..last_supreg]) or
(r in igraph.bitmap[t]);
end;
var adj:Pstring;
i:byte;
t:char;
begin
adjacent_ok:=true;
adj:=igraph.adjlist[v];
if adj<>nil then
for i:=1 to length(adj^) do
begin
t:=adj^[i];
if (pos(t,selectstack) or pos(t,coalescednodes))=0 then
if not ok(Tsuperregister(t),u) then
begin
adjacent_ok:=false;
break;
end;
end;
end;
function Trgobj.conservative(u,v:Tsuperregister):boolean;
var adj:Pstring;
done:set of char; {To prevent that we count nodes twice.}
i,k:byte;
n:char;
begin
k:=0;
done:=[];
adj:=igraph.adjlist[u];
if adj<>nil then
for i:=1 to length(adj^) do
begin
n:=adj^[i];
if (pos(n,selectstack) or pos(n,coalescednodes))=0 then
begin
include(done,n);
if degree[Tsuperregister(n)]>=cpu_registers then
inc(k);
end;
end;
adj:=igraph.adjlist[v];
if adj<>nil then
for i:=1 to length(adj^) do
begin
n:=adj^[i];
if ((pos(n,selectstack) or pos(n,coalescednodes))=0) and
not (n in done) and
(degree[Tsuperregister(n)]>=cpu_registers) then
inc(k);
end;
conservative:=(k<cpu_registers);
end;
procedure Trgobj.combine(u,v:Tsuperregister);
var add:boolean;
adj:Pstring;
i,p:byte;
n,o:cardinal;
t:char;
begin
p:=pos(char(v),freezeworklist);
if p<>0 then
delete(freezeworklist,p,1)
else
delete(spillworklist,pos(char(v),spillworklist),1);
coalescednodes:=coalescednodes+char(v);
alias[v]:=u;
{Combine both movelists. Since the movelists are sets, only add
elements that are not already present.}
for n:=0 to movelist[v]^.count-1 do
begin
add:=true;
for o:=0 to movelist[u]^.count-1 do
if movelist[u]^.data[o]=movelist[v]^.data[n] then
begin
add:=false;
break;
end;
if add then
add_to_movelist(u,movelist[v]^.data[n]);
end;
enable_moves(v);
adj:=igraph.adjlist[v];
if adj<>nil then
for i:=1 to length(adj^) do
begin
t:=adj^[i];
if (pos(t,selectstack) or pos(t,coalescednodes))=0 then
begin
add_edge(Tsuperregister(t),u);
decrement_degree(Tsuperregister(t));
end;
end;
p:=pos(char(u),freezeworklist);
if (degree[u]>=cpu_registers) and (p<>0) then
begin
delete(freezeworklist,p,1);
spillworklist:=spillworklist+char(u);
end;
end;
procedure Trgobj.coalesce;
var m:Tmoveins;
x,y,u,v:Tsuperregister;
begin
m:=Tmoveins(worklist_moves.getfirst);
x:=get_alias(m.instruction.oper[0].reg.number shr 8);
y:=get_alias(m.instruction.oper[1].reg.number shr 8);
if y in [first_supreg..last_supreg] then
begin
u:=y;
v:=x;
end
else
begin
u:=x;
v:=y;
end;
if (u=v) then
begin
m.moveset:=ms_coalesced_moves; {Already coalesced.}
coalesced_moves.insert(m);
add_worklist(u);
end
{Do u and v interfere? In that case the move is constrained. Two
precoloured nodes interfere allways. If v is precoloured, by the above
code u is precoloured, thus interference...}
else if (v in [first_supreg..last_supreg]) or (u in igraph.bitmap[v]) then
begin
m.moveset:=ms_constrained_moves; {Cannot coalesce yet...}
constrained_moves.insert(m);
add_worklist(u);
add_worklist(v);
end
{Next test: is it possible and a good idea to coalesce??}
else if ((u in [first_supreg..last_supreg]) and adjacent_ok(u,v)) or
(not(u in [first_supreg..last_supreg]) and conservative(u,v)) then
begin
m.moveset:=ms_coalesced_moves; {Move coalesced!}
coalesced_moves.insert(m);
combine(u,v);
add_worklist(u);
end
else
begin
m.moveset:=ms_active_moves;
active_moves.insert(m);
end;
end;
procedure Trgobj.freeze_moves(u:Tsuperregister);
var i:cardinal;
m:Tlinkedlistitem;
v,x,y:Tsuperregister;
begin
for i:=0 to movelist[u]^.count-1 do
begin
m:=movelist[u]^.data[i];
if Tmoveins(m).moveset in [ms_worklist_moves,ms_active_moves] then
begin
x:=Tmoveins(m).instruction.oper[0].reg.number shr 8;
y:=Tmoveins(m).instruction.oper[1].reg.number shr 8;
if get_alias(y)=get_alias(u) then
v:=get_alias(x)
else
v:=get_alias(y);
{Move m from active_moves/worklist_moves to frozen_moves.}
if Tmoveins(m).moveset=ms_active_moves then
active_moves.remove(m)
else
worklist_moves.remove(m);
Tmoveins(m).moveset:=ms_frozen_moves;
frozen_moves.insert(m);
if not(move_related(v)) and (degree[v]<cpu_registers) then
begin
delete(freezeworklist,pos(char(v),freezeworklist),1);
simplifyworklist:=simplifyworklist+char(v);
end;
end;
end;
end;
procedure Trgobj.freeze;
var n:Tsuperregister;
begin
{We need to take a random element out of the freezeworklist. We take
the last element. Dirty code!}
n:=Tsuperregister(freezeworklist[byte(freezeworklist[0])]);
dec(freezeworklist[0]);
{Add it to the simplifyworklist.}
simplifyworklist:=simplifyworklist+char(n);
freeze_moves(n);
end;
procedure Trgobj.select_spill;
var n:char;
begin
{This code is WAY too naive. We need not to select just a register, but
the register that is used the least...}
n:=spillworklist[byte(spillworklist[0])];
dec(spillworklist[0]);
simplifyworklist:=simplifyworklist+n;
freeze_moves(Tsuperregister(n));
end;
procedure Trgobj.assign_colours;
{Assign_colours assigns the actual colours to the registers.}
var adj:Pstring;
i,j,k:byte;
n,a:Tsuperregister;
adj_colours,colourednodes:set of Tsuperregister;
w:char;
begin
spillednodes:='';
{Colour the cpu registers...}
colourednodes:=[first_supreg..last_supreg];
for i:=first_supreg to last_supreg do
colour[i]:=i;
{Now colour the imaginary registers on the select-stack.}
for i:=length(selectstack) downto 1 do
begin
n:=Tsuperregister(selectstack[i]);
{Create a list of colours that we cannot assign to n.}
adj_colours:=[];
adj:=igraph.adjlist[n];
if adj<>nil then
for j:=1 to length(adj^) do
begin
w:=adj^[j];
a:=get_alias(Tsuperregister(w));
if a in colourednodes then
include(adj_colours,colour[a]);
end;
{Assume a spill by default...}
spillednodes:=spillednodes+char(n);
{Search for a colour not in this list.}
for k:=1 to cpu_registers do
if not(k in adj_colours) then
begin
colour[n]:=k;
dec(spillednodes[0]); {Colour found: no spill.}
include(colourednodes,n);
break;
end;
end;
{Finally colour the nodes that were coalesced.}
for i:=1 to length(coalescednodes) do
begin
n:=Tsuperregister(coalescednodes[i]);
colour[n]:=colour[get_alias(n)];
end;
for i:=first_imreg to maxintreg do
writeln(i:4,' ',colour[i]:4)
end;
procedure Trgobj.colour_registers;
begin
repeat
if length(simplifyworklist)<>0 then
simplify
else if not(worklist_moves.empty) then
coalesce
else if length(freezeworklist)<>0 then
freeze
else if length(spillworklist)<>0 then
select_spill;
until (length(simplifyworklist) or
byte(not(worklist_moves.empty)) or
length(freezeworklist) or
length(spillworklist)
)=0;
assign_colours;
end;
procedure Trgobj.epilogue_colouring;
begin
active_moves.destroy;
active_moves:=nil;
frozen_moves.destroy;
frozen_moves:=nil;
coalesced_moves.destroy;
coalesced_moves:=nil;
constrained_moves.destroy;
constrained_moves:=nil;
end;
{$endif newra}
{****************************************************************************
TReference
@ -1403,7 +1969,12 @@ end.
{
$Log$
Revision 1.35 2003-04-21 19:16:49 peter
Revision 1.36 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.35 2003/04/21 19:16:49 peter
* count address regs separate
Revision 1.34 2003/04/17 16:48:21 daniel

9
compiler/sparc/rgcpu.pas
View File

@ -66,11 +66,16 @@ procedure trgcpu.UngetRegisterInt(list:taasmoutput;reg:tregister);
inherited ungetregisterint(list,reg);
end;
begin
rg := trgcpu.create;
rg := trgcpu.create(24); {24 registers.}
end.
{
$Log$
Revision 1.8 2003-03-15 22:51:58 mazen
Revision 1.9 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.8 2003/03/15 22:51:58 mazen
* remaking sparc rtl compile
Revision 1.7 2003/03/10 21:59:54 mazen

42
compiler/x86/cgx86.pas
View File

@ -363,13 +363,24 @@ unit cgx86;
OS_8,OS_S8,
OS_16,OS_S16:
begin
{$ifdef newra}
if target_info.alignment.paraalign = 2 then
tmpreg:=rg.getregisterint(list,OS_16)
else
tmpreg:=rg.getregisterint(list,OS_32);
{$else}
if target_info.alignment.paraalign = 2 then
tmpreg:=get_scratch_reg_int(list,OS_16)
else
tmpreg:=get_scratch_reg_int(list,OS_32);
{$endif}
a_load_ref_reg(list,size,r,tmpreg);
list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
free_scratch_reg(list,tmpreg);
{$endif}
end;
OS_32,OS_S32:
list.concat(taicpu.op_ref(A_PUSH,S_L,r));
@ -405,10 +416,18 @@ unit cgx86;
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.base))
else
begin
{$ifdef newra}
tmpreg:=rg.getaddressregister(list);
{$else}
tmpreg := get_scratch_reg_address(list);
{$endif}
a_loadaddr_ref_reg(list,r,tmpreg);
list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
{$ifdef newra}
rg.ungetregisterint(list,tmpreg);
{$else}
free_scratch_reg(list,tmpreg);
{$endif}
end;
end;
@ -780,7 +799,9 @@ unit cgx86;
regloadsize: tcgsize;
dstsize: topsize;
tmpreg : tregister;
{$ifndef newra}
popecx : boolean;
{$endif}
r:Tregister;
instr:Taicpu;
@ -805,6 +826,13 @@ unit cgx86;
internalerror(200109233);
OP_SHR,OP_SHL,OP_SAR:
begin
{$ifdef newra}
tmpreg:=rg.getexplicitregisterint(list,NR_CL);
a_load_reg_reg(list,size,OS_8,dst,tmpreg);
list.concat(taicpu.op_reg_reg(Topcg2asmop[op],S_B,src,
tmpreg));
rg.ungetregisterint(list,tmpreg);
{$else newra}
tmpreg.enum:=R_INTREGISTER;
tmpreg.number:=NR_NO;
popecx := false;
@ -821,8 +849,6 @@ unit cgx86;
regloadsize:=OS_32;
end;
tmpreg := get_scratch_reg_int(list,OS_INT);
tmpreg.enum:=R_INTREGISTER;
tmpreg.number:=NR_EDI;
a_load_reg_reg(list,regloadsize,regloadsize,src,tmpreg);
end;
if src.number shr 8<>RS_ECX then
@ -862,16 +888,13 @@ unit cgx86;
list.concat(taicpu.op_reg(A_POP,S_L,r))
else if not (dst.number shr 8=RS_ECX) then
rg.ungetregisterint(list,r);
{$endif newra}
end;
else
begin
if reg2opsize(src) <> dstsize then
internalerror(200109226);
instr:=taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,src,dst);
{$ifdef newra}
if op in [_MOV,_XCHG] then
rg.add_move_instruction(instr);
{$endif newra}
list.concat(instr);
end;
end;
@ -1839,7 +1862,12 @@ unit cgx86;
end.
{
$Log$
Revision 1.38 2003-04-17 16:48:21 daniel
Revision 1.39 2003-04-22 10:09:35 daniel
+ Implemented the actual register allocator
+ Scratch registers unavailable when new register allocator used
+ maybe_save/maybe_restore unavailable when new register allocator used
Revision 1.38 2003/04/17 16:48:21 daniel
* Added some code to keep track of move instructions in register
allocator