paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-14 11:18:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

Try to do something for m68k integer/address registers; not working yet :!(

Browse Source 
git-svn-id: trunk@22771 -
This commit is contained in:
pierre 2012-10-19 15:52:57 +00:00
parent 6bc6036fd5
commit 322b793506
1 changed files with 44 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
compiler/rgobj.pas
View File

@ -607,6 +607,10 @@ unit rgobj;
procedure addadj(u,v:Tsuperregister); procedure addadj(u,v:Tsuperregister);
begin begin
{$ifdef EXTDEBUG}
if (u>=maxreginfo) then
internalerror(2012101901);
{$endif}
with reginfo[u] do with reginfo[u] do
begin begin
if adjlist=nil then if adjlist=nil then
@ -680,6 +684,10 @@ unit rgobj;
procedure trgobj.add_to_movelist(u:Tsuperregister;data:Tlinkedlistitem); procedure trgobj.add_to_movelist(u:Tsuperregister;data:Tlinkedlistitem);
begin begin
{$ifdef EXTDEBUG}
if (u>=maxreginfo) then
internalerror(2012101902);
{$endif}
with reginfo[u] do with reginfo[u] do
begin begin
if movelist=nil then if movelist=nil then
@ -801,6 +809,7 @@ unit rgobj;
register allocator can try to eliminate it.} register allocator can try to eliminate it.}
var i:Tmoveins; var i:Tmoveins;
sreg, dreg : Tregister;
ssupreg,dsupreg:Tsuperregister; ssupreg,dsupreg:Tsuperregister;
begin begin
@ -809,13 +818,20 @@ unit rgobj;
(instr.oper[O_MOV_DEST]^.typ<>top_reg) then (instr.oper[O_MOV_DEST]^.typ<>top_reg) then
internalerror(200311291); internalerror(200311291);
{$endif} {$endif}
sreg:=instr.oper[O_MOV_SOURCE]^.reg;
dreg:=instr.oper[O_MOV_DEST]^.reg;
{ How should we handle m68k move %d0,%a0? }
if (getregtype(sreg)<>getregtype(dreg)) then
exit;
i:=Tmoveins.create; i:=Tmoveins.create;
i.moveset:=ms_worklist_moves; i.moveset:=ms_worklist_moves;
worklist_moves.insert(i); worklist_moves.insert(i);
ssupreg:=getsupreg(instr.oper[O_MOV_SOURCE]^.reg); ssupreg:=getsupreg(sreg);
add_to_movelist(ssupreg,i); add_to_movelist(ssupreg,i);
dsupreg:=getsupreg(instr.oper[O_MOV_DEST]^.reg); dsupreg:=getsupreg(dreg);
if ssupreg<>dsupreg then { On m68k move can mix address and integer registers,
this leads to problems ... PM }
if (ssupreg<>dsupreg) {and (getregtype(sreg)=getregtype(dreg))} then
{Avoid adding the same move instruction twice to a single register.} {Avoid adding the same move instruction twice to a single register.}
add_to_movelist(dsupreg,i); add_to_movelist(dsupreg,i);
i.x:=ssupreg; i.x:=ssupreg;
@ -1685,6 +1701,7 @@ unit rgobj;
var var
hp,p,q:Tai; hp,p,q:Tai;
i:shortint; i:shortint;
u:longint;
{$ifdef arm} {$ifdef arm}
so:pshifterop; so:pshifterop;
{$endif arm} {$endif arm}
@ -1782,7 +1799,14 @@ unit rgobj;
case typ of case typ of
Top_reg: Top_reg:
if (getregtype(reg)=regtype) then if (getregtype(reg)=regtype) then
setsupreg(reg,reginfo[getsupreg(reg)].colour); begin
u:=getsupreg(reg);
{$ifdef EXTDEBUG}
if (u>=maxreginfo) then
internalerror(2012101903);
{$endif}
setsupreg(reg,reginfo[u].colour);
end;
Top_ref: Top_ref:
begin begin
if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then
@ -1790,10 +1814,24 @@ unit rgobj;
begin begin
if (base<>NR_NO) and if (base<>NR_NO) and
(getregtype(base)=regtype) then (getregtype(base)=regtype) then
setsupreg(base,reginfo[getsupreg(base)].colour); begin
u:=getsupreg(base);
{$ifdef EXTDEBUG}
if (u>=maxreginfo) then
internalerror(2012101904);
{$endif}
setsupreg(base,reginfo[u].colour);
end;
if (index<>NR_NO) and if (index<>NR_NO) and
(getregtype(index)=regtype) then (getregtype(index)=regtype) then
setsupreg(index,reginfo[getsupreg(index)].colour); begin
u:=getsupreg(index);
{$ifdef EXTDEBUG}
if (u>=maxreginfo) then
internalerror(2012101905);
{$endif}
setsupreg(index,reginfo[u].colour);
end;
end; end;
end; end;
{$ifdef arm} {$ifdef arm}