paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 12:59:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved spilling code from taicpu to rg

Browse Source
This commit is contained in:
peter 2004-01-12 16:37:59 +00:00
parent 32173c41fa
commit c34c9af5ce
5 changed files with 844 additions and 875 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

267
compiler/aasmtai.pas
View File

@ -488,15 +488,6 @@ interface
function is_reg_move:boolean;virtual;abstract;
function is_same_reg_move:boolean;virtual;abstract;
{ register allocator }
function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var live_registers_int:Tsuperregisterworklist):Tai;
procedure forward_allocation(p:Tai;var live_registers_int:Tsuperregisterworklist);
function spill_registers(list:Taasmoutput;
rt:Tregistertype;
rgget:Trggetproc;
rgunget:Trgungetproc;
const r:tsuperregisterset;
var live_registers_int:Tsuperregisterworklist;
const spilltemplist:Tspill_temp_list):boolean;virtual;
function spilling_create_load(const ref:treference;r:tregister): tai;virtual;abstract;
function spilling_create_store(r:tregister; const ref:treference): tai;virtual;abstract;
function spilling_get_operation_type(opnr: longint): topertype;virtual;abstract;
@ -1763,259 +1754,6 @@ implementation
end;
{ ---------------------------------------------------------------------
Register allocator methods.
---------------------------------------------------------------------}
function taicpu_abstract.get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;
var live_registers_int:Tsuperregisterworklist):Tai;
var
back : Tsuperregisterworklist;
supreg : tsuperregister;
begin
back.copyfrom(live_registers_int);
get_insert_pos:=p;
while (p<>nil) and (p.typ=ait_regalloc) do
begin
supreg:=getsupreg(Tai_regalloc(p).reg);
{Rewind the register allocation.}
if Tai_regalloc(p).allocation then
live_registers_int.delete(supreg)
else
begin
live_registers_int.add(supreg);
if supreg=huntfor1 then
begin
get_insert_pos:=Tai(p.previous);
back.done;
back.copyfrom(live_registers_int);
end;
if supreg=huntfor2 then
begin
get_insert_pos:=Tai(p.previous);
back.done;
back.copyfrom(live_registers_int);
end;
if supreg=huntfor3 then
begin
get_insert_pos:=Tai(p.previous);
back.done;
back.copyfrom(live_registers_int);
end;
end;
p:=Tai(p.previous);
end;
live_registers_int.done;
live_registers_int.copyfrom(back);
end;
procedure taicpu_abstract.forward_allocation(p:Tai;var live_registers_int:Tsuperregisterworklist);
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
live_registers_int.add(getsupreg(Tai_regalloc(p).reg))
else
live_registers_int.delete(getsupreg(Tai_regalloc(p).reg));
p:=Tai(p.next);
end;
end;
function taicpu_abstract.spill_registers(list:Taasmoutput;
rt:Tregistertype;
rgget:Trggetproc;
rgunget:Trgungetproc;
const r:Tsuperregisterset;
var live_registers_int:Tsuperregisterworklist;
const spilltemplist:Tspill_temp_list): boolean;
type
tspillreginfo = record
orgreg: tsuperregister;
newreg: tregister;
regread,regwritten, mustbespilled: boolean;
end;
var
counter, regindex: longint;
pos: tai;
regs: array[0..2] of tspillreginfo;
supreg: tsuperregister;
spilled: boolean;
procedure DoSpillRead(pos: tai; regidx: longint);
var
helpins: tai;
begin
helpins:=spilling_create_load(spilltemplist[regs[regidx].orgreg],regs[regidx].newreg);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
rgunget(list,self,regs[regidx].newreg);
forward_allocation(tai(helpins.next),live_registers_int);
end;
procedure DoSpillWritten(pos: tai; regidx: longint);
var
helpins: tai;
begin
helpins:=spilling_create_store(regs[regidx].newreg,spilltemplist[regs[regidx].orgreg]);
list.insertafter(helpins,self);
rgunget(list,helpins,regs[regidx].newreg);
end;
procedure DoSpillReadWritten(pos: tai; regidx: longint);
var
helpins1, helpins2: tai;
begin
helpins1:=spilling_create_load(spilltemplist[regs[regidx].orgreg],regs[regidx].newreg);
if pos=nil then
list.insertafter(helpins1,list.first)
else
list.insertafter(helpins1,pos.next);
helpins2:=spilling_create_store(regs[regidx].newreg,spilltemplist[regs[regidx].orgreg]);
list.insertafter(helpins2,self);
rgunget(list,helpins2,regs[regidx].newreg);
forward_allocation(tai(helpins1.next),live_registers_int);
end;
procedure addreginfo(reg: tsuperregister; operation: topertype);
var
i, tmpindex: longint;
begin
tmpindex := regindex;
// did we already encounter this register?
for i := 0 to pred(regindex) do
if (regs[i].orgreg = reg) then
begin
tmpindex := i;
break;
end;
if tmpindex > high(regs) then
internalerror(2003120301);
regs[tmpindex].orgreg := reg;
if supregset_in(r,reg) then
begin
// add/update info on this register
regs[tmpindex].mustbespilled := true;
case operation of
operand_read:
regs[tmpindex].regread := true;
operand_write:
regs[tmpindex].regwritten := true;
operand_readwrite:
begin
regs[tmpindex].regread := true;
regs[tmpindex].regwritten := true;
end;
end;
spilled := true;
end;
inc(regindex,ord(regindex=tmpindex));
end;
procedure tryreplacereg(var reg: tregister);
var
i: longint;
supreg: tsuperregister;
begin
if (getregtype(reg) = R_INTREGISTER) then
begin
supreg := getsupreg(reg);
for i := 0 to pred(regindex) do
if (regs[i].mustbespilled) and
(regs[i].orgreg = supreg) then
begin
reg := regs[i].newreg;
break;
end;
end;
end;
begin
result := false;
fillchar(regs,sizeof(regs),0);
for counter := low(regs) to high(regs) do
regs[counter].orgreg := RS_INVALID;
spilled := false;
regindex := 0;
// check whether and if so which and how (read/written) this instructions contains
// registers that must be spilled
for counter := 0 to ops-1 do
begin
case oper[counter]^.typ of
top_reg:
if (getregtype(oper[counter]^.reg) = R_INTREGISTER) then
begin
addreginfo(getsupreg(oper[counter]^.reg),spilling_get_operation_type(counter));
end;
top_ref:
begin
if (oper[counter]^.ref^.base <> NR_NO) then
begin
addreginfo(getsupreg(oper[counter]^.ref^.base),operand_read);
end;
if (oper[counter]^.ref^.index <> NR_NO) then
begin
addreginfo(getsupreg(oper[counter]^.ref^.index),operand_read);
end;
end;
end;
end;
// generate the spilling code
if spilled then
begin
result := true;
for counter := 0 to pred(regindex) do
begin
if regs[counter].mustbespilled then
begin
supreg := regs[counter].orgreg;
pos := get_insert_pos(Tai(previous),regs[0].orgreg,regs[1].orgreg,regs[2].orgreg,live_registers_int);
rgget(list,pos,R_SUBWHOLE,regs[counter].newreg);
if regs[counter].regread then
if regs[counter].regwritten then
DoSpillReadWritten(pos,counter)
else
DoSpillRead(pos,counter)
else
DoSpillWritten(pos,counter)
end;
end;
end
else
exit;
// substitute registers
for counter := 0 to ops-1 do
begin
case oper[counter]^.typ of
top_reg:
begin
tryreplacereg(oper[counter]^.reg);
end;
top_ref:
begin
tryreplacereg(oper[counter]^.ref^.base);
tryreplacereg(oper[counter]^.ref^.index);
end;
end;
end;
end;
{ ---------------------------------------------------------------------
Miscellaneous methods.
---------------------------------------------------------------------}
@ -2208,7 +1946,10 @@ implementation
end.
{
$Log$
Revision 1.63 2003-12-28 16:20:09 jonas
Revision 1.64 2004-01-12 16:37:59 peter
* moved spilling code from taicpu to rg
Revision 1.63 2003/12/28 16:20:09 jonas
- removed unused methods from old generic spilling code
Revision 1.62 2003/12/26 14:02:30 peter

658
compiler/rgobj.pas
View File

@ -205,7 +205,16 @@ unit rgobj;
regtype : Tregistertype;
{ default subregister used }
defaultsub : tsubregister;
live_registers:Tsuperregisterworklist;
function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister):Tai;
procedure forward_allocation(pfrom,pto:Tai);
procedure getregisterinline(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister);
procedure ungetregisterinline(list:Taasmoutput;position:Tai;r:Tregister);
procedure add_constraints(reg:Tregister);virtual;
function instr_spill_register(list:Taasmoutput;
instr:taicpu_abstract;
const r:Tsuperregisterset;
const spilltemplist:Tspill_temp_list): boolean;virtual;
private
{# First imaginary register.}
first_imaginary : Tsuperregister;
@ -228,7 +237,6 @@ unit rgobj;
frozen_moves,
coalesced_moves,
constrained_moves : Tlinkedlist;
live_registers:Tsuperregisterworklist;
{$ifdef EXTDEBUG}
procedure writegraph(loopidx:longint);
{$endif EXTDEBUG}
@ -242,10 +250,8 @@ unit rgobj;
procedure insert_regalloc_info(list:Taasmoutput;headertai:tai);
procedure generate_interference_graph(list:Taasmoutput;headertai:tai);
procedure translate_registers(list:Taasmoutput);
function spill_registers(list:Taasmoutput;headertai:tai):boolean;
function spill_registers(list:Taasmoutput;headertai:tai):boolean;virtual;
function getnewreg(subreg:tsubregister):tsuperregister;
procedure getregisterinline(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister);
procedure ungetregisterinline(list:Taasmoutput;position:Tai;r:Tregister);
procedure add_edges_used(u:Tsuperregister);
procedure add_to_movelist(u:Tsuperregister;data:Tlinkedlistitem);
function move_related(n:Tsuperregister):boolean;
@ -731,20 +737,21 @@ implementation
assign it to any of the registers, thus it is significant.}
for n:=first_imaginary to maxreg-1 do
begin
if reginfo[n].adjlist=nil then
reginfo[n].degree:=0
else
reginfo[n].degree:=reginfo[n].adjlist^.length;
if reginfo[n].degree>=usable_registers_cnt then
spillworklist.add(n)
else if move_related(n) then
freezeworklist.add(n)
else
simplifyworklist.add(n);
end;
if reginfo[n].adjlist=nil then
reginfo[n].degree:=0
else
reginfo[n].degree:=reginfo[n].adjlist^.length;
if reginfo[n].degree>=usable_registers_cnt then
spillworklist.add(n)
else if move_related(n) then
freezeworklist.add(n)
else
simplifyworklist.add(n);
end;
sort_simplify_worklist;
end;
procedure trgobj.prepare_colouring;
var i:word;
@ -1189,7 +1196,7 @@ implementation
include(used_in_proc,reginfo[k].colour);
end;
{$ifdef ra_debug}
if aktfilepos.line=51 then
if aktfilepos.line=179 then
begin
writeln('colourlist');
for i:=0 to maxreg-1 do
@ -1218,9 +1225,8 @@ implementation
end;
procedure trgobj.epilogue_colouring;
var i:Tsuperregister;
var
i : Tsuperregister;
begin
worklist_moves.clear;
active_moves.destroy;
@ -1360,43 +1366,19 @@ implementation
p:=headertai;
while assigned(p) do
begin
case p.typ of
ait_regalloc:
begin
if (getregtype(Tai_regalloc(p).reg)=regtype) then
begin
supreg:=getsupreg(Tai_regalloc(p).reg);
if Tai_regalloc(p).allocation then
live_registers.add(supreg)
else
live_registers.delete(supreg);
add_edges_used(supreg);
add_constraints(Tai_regalloc(p).reg);
end;
end;
{ ait_instruction:
begin
aktfilepos:=Taicpu_abstract(p).fileinfo;
for i:=0 to Taicpu_abstract(p).ops-1 do
with Taicpu_abstract(p).oper[i]^ do
begin
case typ of
top_reg :
begin
add_edges_used(getsupreg(reg));
add_constraints(reg);
end;
top_ref :
begin
add_edges_used(getsupreg(ref^.base));
add_constraints(ref^.base);
add_edges_used(getsupreg(ref^.index));
add_constraints(ref^.index);
end;
end;
end;
end; }
end;
if p.typ=ait_regalloc then
begin
if (getregtype(Tai_regalloc(p).reg)=regtype) then
begin
supreg:=getsupreg(Tai_regalloc(p).reg);
if Tai_regalloc(p).allocation then
live_registers.add(supreg)
else
live_registers.delete(supreg);
add_edges_used(supreg);
add_constraints(Tai_regalloc(p).reg);
end;
end;
p:=Tai(p.next);
end;
@ -1414,95 +1396,9 @@ implementation
end;
function trgobj.spill_registers(list:Taasmoutput;headertai:tai):boolean;
{Returns true if any help registers have been used.}
var i : word;
t : tsuperregister;
p,q : Tai;
regs_to_spill_set:Tsuperregisterset;
spill_temps : ^Tspill_temp_list;
supreg : tsuperregister;
templist : taasmoutput;
begin
spill_registers:=false;
live_registers.clear;
for i:=first_imaginary to maxreg-1 do
exclude(reginfo[i].flags,ri_selected);
spill_temps:=allocmem(sizeof(treference)*maxreg);
supregset_reset(regs_to_spill_set,false);
{ Allocate temps and insert in front of the list }
templist:=taasmoutput.create;
{Safe: this procedure is only called if there are spilled nodes.}
for i:=0 to spillednodes.length-1 do
begin
t:=spillednodes.buf^[i];
{Alternative representation.}
supregset_include(regs_to_spill_set,t);
{Clear all interferences of the spilled register.}
clear_interferences(t);
{Get a temp for the spilled register}
tg.gettemp(templist,4,tt_noreuse,spill_temps^[t]);
end;
list.insertlistafter(headertai,templist);
templist.free;
{ Walk through all instructions, we can start with the headertai,
because before the header tai is only symbols }
p:=headertai;
while assigned(p) do
begin
case p.typ of
ait_regalloc:
begin
if (getregtype(Tai_regalloc(p).reg)=regtype) then
begin
{A register allocation of a spilled register can be removed.}
supreg:=getsupreg(Tai_regalloc(p).reg);
if supregset_in(regs_to_spill_set,supreg) then
begin
q:=Tai(p.next);
list.remove(p);
p.free;
p:=q;
continue;
end
else
if Tai_regalloc(p).allocation then
live_registers.add(supreg)
else
live_registers.delete(supreg);
end;
end;
ait_instruction:
begin
aktfilepos:=Taicpu_abstract(p).fileinfo;
if Taicpu_abstract(p).spill_registers(list,
regtype,
@getregisterinline,
@ungetregisterinline,
regs_to_spill_set,
live_registers,
spill_temps^) then
spill_registers:=true;
if Taicpu_abstract(p).is_reg_move then
add_move_instruction(Taicpu(p));
end;
end;
p:=Tai(p.next);
end;
aktfilepos:=current_procinfo.exitpos;
{Safe: this procedure is only called if there are spilled nodes.}
for i:=0 to spillednodes.length-1 do
tg.ungettemp(list,spill_temps^[spillednodes.buf^[i]]);
freemem(spill_temps);
end;
procedure Trgobj.translate_registers(list:taasmoutput);
var hp,p,q:Tai;
var
hp,p,q:Tai;
i:shortint;
r:Preference;
{$ifdef arm}
@ -1510,96 +1406,418 @@ implementation
{$endif arm}
begin
{ Leave when no imaginary registers are used }
if maxreg<=first_imaginary then
exit;
p:=Tai(list.first);
while assigned(p) do
begin
case p.typ of
ait_regalloc:
begin
{ Leave when no imaginary registers are used }
if maxreg<=first_imaginary then
exit;
p:=Tai(list.first);
while assigned(p) do
begin
case p.typ of
ait_regalloc:
begin
if (getregtype(Tai_regalloc(p).reg)=regtype) then
setsupreg(Tai_regalloc(p).reg,reginfo[getsupreg(Tai_regalloc(p).reg)].colour);
{
Remove sequences of release and
allocation of the same register like:
# Register X released
# Register X allocated
}
if assigned(p.previous) and
(Tai(p.previous).typ=ait_regalloc) and
(Tai_regalloc(p.previous).reg=Tai_regalloc(p).reg) and
{ allocation,deallocation or deallocation,allocation }
(Tai_regalloc(p.previous).allocation xor Tai_regalloc(p).allocation) then
begin
q:=Tai(p.next);
hp:=tai(p.previous);
list.remove(hp);
hp.free;
list.remove(p);
p.free;
p:=q;
continue;
end;
end;
ait_instruction:
begin
for i:=0 to Taicpu_abstract(p).ops-1 do
case Taicpu_abstract(p).oper[i]^.typ of
Top_reg:
if (getregtype(Taicpu_abstract(p).oper[i]^.reg)=regtype) then
setsupreg(Taicpu_abstract(p).oper[i]^.reg,reginfo[getsupreg(Taicpu_abstract(p).oper[i]^.reg)].colour);
Top_ref:
begin
if regtype=R_INTREGISTER then
begin
r:=Taicpu_abstract(p).oper[i]^.ref;
if r^.base<>NR_NO then
setsupreg(r^.base,reginfo[getsupreg(r^.base)].colour);
if r^.index<>NR_NO then
setsupreg(r^.index,reginfo[getsupreg(r^.index)].colour);
end;
end;
{$ifdef arm}
Top_shifterop:
begin
so:=Taicpu_abstract(p).oper[i]^.shifterop;
if so^.rs<>NR_NO then
setsupreg(so^.rs,reginfo[getsupreg(so^.rs)].colour);
end;
{$endif arm}
end;
{ Maybe the operation can be removed when
it is a move and both arguments are the same }
if Taicpu_abstract(p).is_same_reg_move then
begin
q:=Tai(p.next);
list.remove(p);
p.free;
p:=q;
continue;
end;
end;
end;
p:=Tai(p.next);
end;
end;
function trgobj.get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister):Tai;
var
back : Tsuperregisterworklist;
supreg : tsuperregister;
begin
back.copyfrom(live_registers);
result:=p;
while (p<>nil) and (p.typ=ait_regalloc) do
begin
supreg:=getsupreg(Tai_regalloc(p).reg);
{Rewind the register allocation.}
if Tai_regalloc(p).allocation then
live_registers.delete(supreg)
else
begin
if (getregtype(Tai_regalloc(p).reg)=regtype) then
setsupreg(Tai_regalloc(p).reg,reginfo[getsupreg(Tai_regalloc(p).reg)].colour);
{
Remove sequences of release and
allocation of the same register like:
# Register X released
# Register X allocated
}
if assigned(p.previous) and
(Tai(p.previous).typ=ait_regalloc) and
(Tai_regalloc(p.previous).reg=Tai_regalloc(p).reg) and
{ allocation,deallocation or deallocation,allocation }
(Tai_regalloc(p.previous).allocation xor Tai_regalloc(p).allocation) then
live_registers.add(supreg);
if supreg=huntfor1 then
begin
q:=Tai(p.next);
hp:=tai(p.previous);
list.remove(hp);
hp.free;
list.remove(p);
p.free;
p:=q;
continue;
get_insert_pos:=Tai(p.previous);
back.done;
back.copyfrom(live_registers);
end;
if supreg=huntfor2 then
begin
get_insert_pos:=Tai(p.previous);
back.done;
back.copyfrom(live_registers);
end;
if supreg=huntfor3 then
begin
get_insert_pos:=Tai(p.previous);
back.done;
back.copyfrom(live_registers);
end;
end;
ait_instruction:
begin
for i:=0 to Taicpu_abstract(p).ops-1 do
case Taicpu_abstract(p).oper[i]^.typ of
Top_reg:
if (getregtype(Taicpu_abstract(p).oper[i]^.reg)=regtype) then
setsupreg(Taicpu_abstract(p).oper[i]^.reg,reginfo[getsupreg(Taicpu_abstract(p).oper[i]^.reg)].colour);
Top_ref:
begin
if regtype=R_INTREGISTER then
begin
r:=Taicpu_abstract(p).oper[i]^.ref;
if r^.base<>NR_NO then
setsupreg(r^.base,reginfo[getsupreg(r^.base)].colour);
if r^.index<>NR_NO then
setsupreg(r^.index,reginfo[getsupreg(r^.index)].colour);
end;
end;
{$ifdef arm}
Top_shifterop:
begin
so:=Taicpu_abstract(p).oper[i]^.shifterop;
if so^.rs<>NR_NO then
setsupreg(so^.rs,reginfo[getsupreg(so^.rs)].colour);
end;
{$endif arm}
end;
p:=Tai(p.previous);
end;
live_registers.done;
live_registers.copyfrom(back);
end;
{ Maybe the operation can be removed when
it is a move and both arguments are the same }
if Taicpu_abstract(p).is_same_reg_move then
procedure trgobj.forward_allocation(pfrom,pto:Tai);
var
p : tai;
begin
{Forward the register allocation again.}
p:=pfrom;
while (p<>pto) do
begin
if p.typ<>ait_regalloc then
internalerror(200305311);
if Tai_regalloc(p).allocation then
live_registers.add(getsupreg(Tai_regalloc(p).reg))
else
live_registers.delete(getsupreg(Tai_regalloc(p).reg));
p:=Tai(p.next);
end;
end;
function trgobj.spill_registers(list:Taasmoutput;headertai:tai):boolean;
{ Returns true if any help registers have been used }
var
i : word;
t : tsuperregister;
p,q : Tai;
regs_to_spill_set:Tsuperregisterset;
spill_temps : ^Tspill_temp_list;
supreg : tsuperregister;
templist : taasmoutput;
begin
spill_registers:=false;
live_registers.clear;
for i:=first_imaginary to maxreg-1 do
exclude(reginfo[i].flags,ri_selected);
spill_temps:=allocmem(sizeof(treference)*maxreg);
supregset_reset(regs_to_spill_set,false);
{ Allocate temps and insert in front of the list }
templist:=taasmoutput.create;
{Safe: this procedure is only called if there are spilled nodes.}
for i:=0 to spillednodes.length-1 do
begin
t:=spillednodes.buf^[i];
{Alternative representation.}
supregset_include(regs_to_spill_set,t);
{Clear all interferences of the spilled register.}
clear_interferences(t);
{Get a temp for the spilled register}
tg.gettemp(templist,4,tt_noreuse,spill_temps^[t]);
end;
list.insertlistafter(headertai,templist);
templist.free;
{ Walk through all instructions, we can start with the headertai,
because before the header tai is only symbols }
p:=headertai;
while assigned(p) do
begin
case p.typ of
ait_regalloc:
begin
if (getregtype(Tai_regalloc(p).reg)=regtype) then
begin
{A register allocation of a spilled register can be removed.}
supreg:=getsupreg(Tai_regalloc(p).reg);
if supregset_in(regs_to_spill_set,supreg) then
begin
q:=Tai(p.next);
list.remove(p);
p.free;
p:=q;
continue;
end
else
if Tai_regalloc(p).allocation then
live_registers.add(supreg)
else
live_registers.delete(supreg);
end;
end;
ait_instruction:
begin
aktfilepos:=Taicpu_abstract(p).fileinfo;
if instr_spill_register(list,Taicpu_abstract(p),regs_to_spill_set,spill_temps^) then
spill_registers:=true;
if Taicpu_abstract(p).is_reg_move then
add_move_instruction(Taicpu(p));
end;
end;
p:=Tai(p.next);
end;
aktfilepos:=current_procinfo.exitpos;
{Safe: this procedure is only called if there are spilled nodes.}
for i:=0 to spillednodes.length-1 do
tg.ungettemp(list,spill_temps^[spillednodes.buf^[i]]);
freemem(spill_temps);
end;
function trgobj.instr_spill_register(list:Taasmoutput;
instr:taicpu_abstract;
const r:Tsuperregisterset;
const spilltemplist:Tspill_temp_list): boolean;
type
tspillreginfo = record
orgreg : tsuperregister;
tempreg : tregister;
regread,regwritten, mustbespilled: boolean;
end;
var
counter, regindex: longint;
pos: tai;
regs: array[0..2] of tspillreginfo;
spilled: boolean;
procedure DoSpillRead(pos: tai; regidx: longint);
var
helpins: tai;
begin
helpins:=instr.spilling_create_load(spilltemplist[regs[regidx].orgreg],regs[regidx].tempreg);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
ungetregisterinline(list,instr,regs[regidx].tempreg);
forward_allocation(tai(helpins.next),instr);
end;
procedure DoSpillWritten(pos: tai; regidx: longint);
var
helpins: tai;
begin
helpins:=instr.spilling_create_store(regs[regidx].tempreg,spilltemplist[regs[regidx].orgreg]);
list.insertafter(helpins,instr);
ungetregisterinline(list,helpins,regs[regidx].tempreg);
end;
procedure DoSpillReadWritten(pos: tai; regidx: longint);
var
helpins1, helpins2: tai;
begin
helpins1:=instr.spilling_create_load(spilltemplist[regs[regidx].orgreg],regs[regidx].tempreg);
if pos=nil then
list.insertafter(helpins1,list.first)
else
list.insertafter(helpins1,pos.next);
helpins2:=instr.spilling_create_store(regs[regidx].tempreg,spilltemplist[regs[regidx].orgreg]);
list.insertafter(helpins2,instr);
ungetregisterinline(list,helpins2,regs[regidx].tempreg);
forward_allocation(tai(helpins1.next),instr);
end;
procedure addreginfo(reg: tsuperregister; operation: topertype);
var
i, tmpindex: longint;
begin
tmpindex := regindex;
// did we already encounter this register?
for i := 0 to pred(regindex) do
if (regs[i].orgreg = reg) then
begin
tmpindex := i;
break;
end;
if tmpindex > high(regs) then
internalerror(2003120301);
regs[tmpindex].orgreg := reg;
if supregset_in(r,reg) then
begin
// add/update info on this register
regs[tmpindex].mustbespilled := true;
case operation of
operand_read:
regs[tmpindex].regread := true;
operand_write:
regs[tmpindex].regwritten := true;
operand_readwrite:
begin
q:=Tai(p.next);
list.remove(p);
p.free;
p:=q;
continue;
regs[tmpindex].regread := true;
regs[tmpindex].regwritten := true;
end;
end;
spilled := true;
end;
inc(regindex,ord(regindex=tmpindex));
end;
procedure tryreplacereg(var reg: tregister);
var
i: longint;
supreg: tsuperregister;
begin
if (getregtype(reg) = R_INTREGISTER) then
begin
supreg := getsupreg(reg);
for i := 0 to pred(regindex) do
if (regs[i].mustbespilled) and
(regs[i].orgreg = supreg) then
begin
reg := regs[i].tempreg;
break;
end;
end;
end;
begin
result := false;
fillchar(regs,sizeof(regs),0);
for counter := low(regs) to high(regs) do
regs[counter].orgreg := RS_INVALID;
spilled := false;
regindex := 0;
{ check whether and if so which and how (read/written) this instructions contains
registers that must be spilled }
for counter := 0 to instr.ops-1 do
with instr.oper[counter]^ do
begin
case typ of
top_reg:
begin
if (getregtype(reg) = regtype) then
addreginfo(getsupreg(reg),instr.spilling_get_operation_type(counter));
end;
top_ref:
begin
if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then
begin
if (ref^.base <> NR_NO) then
addreginfo(getsupreg(ref^.base),operand_read);
if (ref^.index <> NR_NO) then
addreginfo(getsupreg(ref^.index),operand_read);
end;
end;
end;
end;
{ if no spilling for this instruction we can leave }
if not spilled then
exit;
{ generate the spilling code }
result := true;
for counter := 0 to pred(regindex) do
begin
if regs[counter].mustbespilled then
begin
pos := get_insert_pos(Tai(instr.previous),regs[0].orgreg,regs[1].orgreg,regs[2].orgreg);
getregisterinline(list,pos,defaultsub,regs[counter].tempreg);
if regs[counter].regread then
if regs[counter].regwritten then
DoSpillReadWritten(pos,counter)
else
DoSpillRead(pos,counter)
else
DoSpillWritten(pos,counter)
end;
end;
p:=Tai(p.next);
end;
end;
{ substitute registers }
for counter := 0 to instr.ops-1 do
with instr.oper[counter]^ do
begin
case typ of
top_reg:
begin
tryreplacereg(reg);
end;
top_ref:
begin
tryreplacereg(ref^.base);
tryreplacereg(ref^.index);
end;
end;
end;
end;
end.
{
$Log$
Revision 1.111 2004-01-11 13:21:35 daniel
* Register allocation bug fixed
Revision 1.110 2004/01/09 22:02:29 daniel
* Degree=0 problem fixed
* Degree to high problem fixed
Revision 1.112 2004-01-12 16:37:59 peter
* moved spilling code from taicpu to rg
Revision 1.109 2003/12/26 14:02:30 peter
* sparc updates

391
compiler/x86/aasmcpu.pas
View File

@ -202,14 +202,6 @@ interface
procedure SetOperandOrder(order:TOperandOrder);
function is_same_reg_move:boolean;override;
function is_reg_move:boolean;override;
function spill_registers(list:Taasmoutput;
rt:Tregistertype;
rgget:Trggetproc;
rgunget:Trgungetproc;
const r:Tsuperregisterset;
{ var unusedregsint:Tsuperregisterset;}
var live_registers_int:Tsuperregisterworklist;
const spilltemplist:Tspill_temp_list):boolean;override;
protected
procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);override;
procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);override;
@ -1930,384 +1922,6 @@ implementation
end;
function Taicpu.spill_registers(list:Taasmoutput;
rt:Tregistertype;
rgget:Trggetproc;
rgunget:Trgungetproc;
const r:Tsuperregisterset;
var live_registers_int:Tsuperregisterworklist;
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)}
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) and
(getregtype(oper[0]^.reg)=rt) then
begin
supreg:=getsupreg(oper[0]^.reg);
if supregset_in(r,supreg) 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:=getsupreg(oper[0]^.ref^.base);
if supregset_in(r,supreg) 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:=getsubreg(oper[0]^.ref^.base);
if oper[0]^.ref^.index=NR_NO then
pos:=Tai(previous)
else
pos:=get_insert_pos(Tai(previous),getsupreg(oper[0]^.ref^.index),RS_INVALID,RS_INVALID,{unusedregsint}live_registers_int);
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),{unusedregsint}live_registers_int);
oper[0]^.ref^.base:=helpreg;
end;
supreg:=getsupreg(oper[0]^.ref^.index);
if supregset_in(r,supreg) 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:=getsubreg(oper[0]^.ref^.index);
if oper[0]^.ref^.base=NR_NO then
pos:=Tai(previous)
else
pos:=get_insert_pos(Tai(previous),getsupreg(oper[0]^.ref^.base),RS_INVALID,RS_INVALID,{unusedregsint}live_registers_int);
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),{unusedregsint}live_registers_int);
oper[0]^.ref^.index:=helpreg;
end;
end;
end;
2:
begin
{ First spill the registers from the references. This is
required because the reference can be moved from this instruction
to a MOV instruction when spilling of the register operand is done }
for i:=0 to 1 do
if oper[i]^.typ=top_ref then
begin
supreg:=getsupreg(oper[i]^.ref^.base);
if supregset_in(r,supreg) 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:=getsubreg(oper[i]^.ref^.base);
if i=1 then
pos:=get_insert_pos(Tai(previous),getsupreg(oper[i]^.ref^.index),getsupreg(oper[0]^.reg),
RS_INVALID,{unusedregsint}live_registers_int)
else
pos:=get_insert_pos(Tai(previous),getsupreg(oper[i]^.ref^.index),RS_INVALID,RS_INVALID,{unusedregsint}live_registers_int);
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),{unusedregsint}live_registers_int);
end;
supreg:=getsupreg(oper[i]^.ref^.index);
if supregset_in(r,supreg) 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:=getsubreg(oper[i]^.ref^.index);
if i=1 then
pos:=get_insert_pos(Tai(previous),getsupreg(oper[i]^.ref^.base),getsupreg(oper[0]^.reg),
RS_INVALID,{unusedregsint}live_registers_int)
else
pos:=get_insert_pos(Tai(previous),getsupreg(oper[i]^.ref^.base),RS_INVALID,RS_INVALID,{unusedregsint}live_registers_int);
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),{unusedregsint}live_registers_int);
end;
end;
if (oper[0]^.typ=top_reg) and
(getregtype(oper[0]^.reg)=rt) then
begin
supreg:=getsupreg(oper[0]^.reg);
subreg:=getsubreg(oper[0]^.reg);
if supregset_in(r,supreg) 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),getsupreg(oper[0]^.reg),
getsupreg(oper[1]^.ref^.base),getsupreg(oper[1]^.ref^.index),
{unusedregsint}live_registers_int);
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),{unusedregsint}live_registers_int);
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) and
(getregtype(oper[1]^.reg)=rt) then
begin
supreg:=getsupreg(oper[1]^.reg);
subreg:=getsubreg(oper[1]^.reg);
if supregset_in(r,supreg) 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),getsupreg(oper[0]^.ref^.base),
getsupreg(oper[0]^.ref^.index),RS_INVALID,{unusedregsint}live_registers_int);
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),{unusedregsint}live_registers_int);
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 }
if (opcode=A_MOVZX) or (opcode=A_MOVSX) then
begin
{Because 'movzx memory,register' does not exist...}
spill_registers:=true;
op:=opcode;
hopsize:=opsize;
opcode:=A_MOV;
opsize:=reg2opsize(oper[1]^.reg);
pos:=get_insert_pos(Tai(previous),getsupreg(oper[0]^.reg),RS_INVALID,RS_INVALID,{unusedregsint}live_registers_int);
rgget(list,pos,subreg,helpreg);
helpins:=Taicpu.op_reg_reg(op,hopsize,oper[0]^.reg,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),{unusedregsint}live_registers_int);
end;
oper[1]^.typ:=top_ref;
new(oper[1]^.ref);
oper[1]^.ref^:=spilltemplist[supreg];
end;
end;
end;
{ The i386 instruction set never gets boring...
some opcodes do not support a memory location as destination }
if (oper[1]^.typ=top_ref) and
(
(oper[0]^.typ=top_const) or
((oper[0]^.typ=top_reg) and
(getregtype(oper[0]^.reg)=rt))
) then
begin
case opcode of
A_IMUL :
begin
{Yikes! We just changed the destination register into
a memory location above here.
Situation examples:
imul [ebp-12],r21d ; We need a help register
imul [ebp-12],<const> ; 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);
spill_registers:=true;
{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);
rgunget(list,self,helpreg);
end;
end;
end;
{ The i386 instruction set never gets boring...
some opcodes do not support a memory location as source }
if (oper[0]^.typ=top_ref) and
(oper[1]^.typ=top_reg) and
(getregtype(oper[1]^.reg)=rt) then
begin
case opcode of
A_BT,A_BTS,
A_BTC,A_BTR :
begin
{Yikes! We just changed the source register into
a memory location above here.
Situation example:
bt r21d,[ebp-12] ; We need a help register
Change into:
mov r22d,[ebp-12] ; Use a help instruction (only for IMUL)
bt r21d,r22d ; Replace reference by helpregister}
rgget(list,Tai(previous),subreg,helpreg);
spill_registers:=true;
{First help instruction.}
helpins:=Taicpu.op_ref_reg(A_MOV,opsize,oper[0]^.ref^,helpreg);
if previous=nil then
list.insert(helpins)
else
list.insertafter(helpins,previous);
dispose(oper[0]^.ref);
oper[0]^.typ:=top_reg;
oper[0]^.reg:=helpreg;
rgunget(list,helpins,helpreg);
end;
end;
end;
end;
3:
begin
{$warning todo!!}
end;
end;
end;
{*****************************************************************************
Instruction table
*****************************************************************************}
@ -2357,7 +1971,10 @@ implementation
end.
{
$Log$
Revision 1.43 2003-12-26 14:02:30 peter
Revision 1.44 2004-01-12 16:37:59 peter
* moved spilling code from taicpu to rg
Revision 1.43 2003/12/26 14:02:30 peter
* sparc updates
* use registertype in spill_register

7
compiler/x86/cpubase.pas
View File

@ -433,7 +433,7 @@ implementation
function reg2opsize(r:Tregister):topsize;
const
subreg2opsize : array[tsubregister] of topsize =
(S_NO,S_B,S_B,S_W,S_L,S_D,S_NO);
(S_NO,S_B,S_B,S_W,S_L,S_D,S_NO,S_NO);
begin
reg2opsize:=S_L;
case getregtype(r) of
@ -535,7 +535,10 @@ implementation
end.
{
$Log$
Revision 1.34 2003-12-26 13:19:16 florian
Revision 1.35 2004-01-12 16:37:59 peter
* moved spilling code from taicpu to rg
Revision 1.34 2003/12/26 13:19:16 florian
* rtl and compiler compile with -Cfsse2
Revision 1.33 2003/12/25 01:07:09 florian

396
compiler/x86/rgx86.pas
View File

@ -35,6 +35,13 @@ unit rgx86;
cclasses,globtype,cgbase,rgobj;
type
trgx86 = class(trgobj)
function instr_spill_register(list:Taasmoutput;
instr:taicpu_abstract;
const r:Tsuperregisterset;
const spilltemplist:Tspill_temp_list): boolean;override;
end;
tpushedsavedloc = record
case byte of
0: (pushed: boolean);
@ -88,7 +95,8 @@ implementation
uses
systems,
verbose;
verbose,
aasmcpu;
const
{ This value is used in tsaved. If the array value is equal
@ -97,7 +105,386 @@ implementation
{******************************************************************************
Trgobj
Trgcpu
******************************************************************************}
function trgx86.instr_spill_register(list:Taasmoutput;
instr:taicpu_abstract;
const r:Tsuperregisterset;
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)
}
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)}
result:=false;
with taicpu(instr) do
begin
case ops of
1:
begin
if (oper[0]^.typ=top_reg) and
(getregtype(oper[0]^.reg)=regtype) then
begin
supreg:=getsupreg(oper[0]^.reg);
if supregset_in(r,supreg) 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:=getsupreg(oper[0]^.ref^.base);
if supregset_in(r,supreg) 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:=getsubreg(oper[0]^.ref^.base);
if oper[0]^.ref^.index=NR_NO then
pos:=Tai(previous)
else
pos:=get_insert_pos(Tai(previous),getsupreg(oper[0]^.ref^.index),RS_INVALID,RS_INVALID);
getregisterinline(list,pos,subreg,helpreg);
result:=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);
ungetregisterinline(list,helpins,helpreg);
forward_allocation(Tai(helpins.next),instr);
oper[0]^.ref^.base:=helpreg;
end;
supreg:=getsupreg(oper[0]^.ref^.index);
if supregset_in(r,supreg) 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:=getsubreg(oper[0]^.ref^.index);
if oper[0]^.ref^.base=NR_NO then
pos:=Tai(instr.previous)
else
pos:=get_insert_pos(Tai(instr.previous),getsupreg(oper[0]^.ref^.base),RS_INVALID,RS_INVALID);
getregisterinline(list,pos,subreg,helpreg);
result:=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);
ungetregisterinline(list,helpins,helpreg);
forward_allocation(Tai(helpins.next),instr);
oper[0]^.ref^.index:=helpreg;
end;
end;
end;
2:
begin
{ First spill the registers from the references. This is
required because the reference can be moved from this instruction
to a MOV instruction when spilling of the register operand is done }
for i:=0 to 1 do
if oper[i]^.typ=top_ref then
begin
supreg:=getsupreg(oper[i]^.ref^.base);
if supregset_in(r,supreg) 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:=getsubreg(oper[i]^.ref^.base);
if i=1 then
pos:=get_insert_pos(Tai(instr.previous),getsupreg(oper[i]^.ref^.index),getsupreg(oper[0]^.reg),RS_INVALID)
else
pos:=get_insert_pos(Tai(instr.previous),getsupreg(oper[i]^.ref^.index),RS_INVALID,RS_INVALID);
getregisterinline(list,pos,subreg,helpreg);
result:=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;
ungetregisterinline(list,helpins,helpreg);
forward_allocation(Tai(helpins.next),instr);
end;
supreg:=getsupreg(oper[i]^.ref^.index);
if supregset_in(r,supreg) 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:=getsubreg(oper[i]^.ref^.index);
if i=1 then
pos:=get_insert_pos(Tai(instr.previous),getsupreg(oper[i]^.ref^.base),
getsupreg(oper[0]^.reg),RS_INVALID)
else
pos:=get_insert_pos(Tai(instr.previous),getsupreg(oper[i]^.ref^.base),RS_INVALID,RS_INVALID);
getregisterinline(list,pos,subreg,helpreg);
result:=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;
ungetregisterinline(list,helpins,helpreg);
forward_allocation(Tai(helpins.next),instr);
end;
end;
if (oper[0]^.typ=top_reg) and
(getregtype(oper[0]^.reg)=regtype) then
begin
supreg:=getsupreg(oper[0]^.reg);
subreg:=getsubreg(oper[0]^.reg);
if supregset_in(r,supreg) 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(instr.previous),getsupreg(oper[0]^.reg),
getsupreg(oper[1]^.ref^.base),getsupreg(oper[1]^.ref^.index));
getregisterinline(list,pos,subreg,helpreg);
result:=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;
ungetregisterinline(list,helpins,helpreg);
forward_allocation(Tai(helpins.next),instr);
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) and
(getregtype(oper[1]^.reg)=regtype) then
begin
supreg:=getsupreg(oper[1]^.reg);
subreg:=getsubreg(oper[1]^.reg);
if supregset_in(r,supreg) 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(instr.previous),getsupreg(oper[0]^.ref^.base),
getsupreg(oper[0]^.ref^.index),RS_INVALID);
getregisterinline(list,pos,subreg,helpreg);
result:=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];
ungetregisterinline(list,helpins,helpreg);
forward_allocation(Tai(helpins.next),instr);
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 }
if (opcode=A_MOVZX) or (opcode=A_MOVSX) then
begin
{Because 'movzx memory,register' does not exist...}
result:=true;
op:=opcode;
hopsize:=opsize;
opcode:=A_MOV;
opsize:=reg2opsize(oper[1]^.reg);
pos:=get_insert_pos(Tai(instr.previous),getsupreg(oper[0]^.reg),RS_INVALID,RS_INVALID);
getregisterinline(list,pos,subreg,helpreg);
helpins:=Taicpu.op_reg_reg(op,hopsize,oper[0]^.reg,helpreg);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
oper[0]^.reg:=helpreg;
ungetregisterinline(list,helpins,helpreg);
forward_allocation(Tai(helpins.next),instr);
end;
oper[1]^.typ:=top_ref;
new(oper[1]^.ref);
oper[1]^.ref^:=spilltemplist[supreg];
end;
end;
end;
{ The i386 instruction set never gets boring...
some opcodes do not support a memory location as destination }
if (oper[1]^.typ=top_ref) and
(
(oper[0]^.typ=top_const) or
((oper[0]^.typ=top_reg) and
(getregtype(oper[0]^.reg)=regtype))
) then
begin
case opcode of
A_IMUL :
begin
{Yikes! We just changed the destination register into
a memory location above here.
Situation examples:
imul [ebp-12],r21d ; We need a help register
imul [ebp-12],<const> ; 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}
getregisterinline(list,Tai(previous),subreg,helpreg);
result:=true;
{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,instr);
ungetregisterinline(list,instr,helpreg);
end;
end;
end;
{ The i386 instruction set never gets boring...
some opcodes do not support a memory location as source }
if (oper[0]^.typ=top_ref) and
(oper[1]^.typ=top_reg) and
(getregtype(oper[1]^.reg)=regtype) then
begin
case opcode of
A_BT,A_BTS,
A_BTC,A_BTR :
begin
{Yikes! We just changed the source register into
a memory location above here.
Situation example:
bt r21d,[ebp-12] ; We need a help register
Change into:
mov r22d,[ebp-12] ; Use a help instruction (only for IMUL)
bt r21d,r22d ; Replace reference by helpregister}
getregisterinline(list,Tai(previous),subreg,helpreg);
result:=true;
{First help instruction.}
helpins:=Taicpu.op_ref_reg(A_MOV,opsize,oper[0]^.ref^,helpreg);
if previous=nil then
list.insert(helpins)
else
list.insertafter(helpins,previous);
dispose(oper[0]^.ref);
oper[0]^.typ:=top_reg;
oper[0]^.reg:=helpreg;
ungetregisterinline(list,helpins,helpreg);
end;
end;
end;
end;
3:
begin
{$warning todo!!}
end;
end;
end;
end;
{******************************************************************************
Trgx86fpu
******************************************************************************}
constructor Trgx86fpu.create;
@ -228,7 +615,10 @@ implementation
end.
{
$Log$
Revision 1.1 2003-12-24 00:12:57 florian
Revision 1.2 2004-01-12 16:37:59 peter
* moved spilling code from taicpu to rg
Revision 1.1 2003/12/24 00:12:57 florian
* rg unified for i386/x86-64
Revision 1.40 2003/10/17 15:08:34 peter