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

* start of sparc support for newra

Browse Source
This commit is contained in:
peter 2003-08-11 21:18:20 +00:00
parent f8be2992fd
commit 52c73e80d1
18 changed files with 753 additions and 532 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
compiler/aasmtai.pas
View File

@ -444,12 +444,17 @@ interface
procedure loadoper(opidx:longint;o:toper);
function is_nop:boolean;virtual;abstract;
function is_move:boolean;virtual;abstract;
{$ifdef NEWRA}
{ register allocator }
function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsupregset):Tai;
procedure forward_allocation(p:Tai;var unusedregsint:Tsupregset);
function spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsupregset;
var unusedregsint:Tsupregset;
const spilltemplist:Tspill_temp_list):boolean;virtual;abstract;
{$endif NEWRA}
end;
{ alignment for operator }
@ -494,13 +499,13 @@ interface
implementation
uses
uses
{$ifdef delphi}
sysutils,
sysutils,
{$else}
strings,
strings,
{$endif}
verbose;
verbose;
const
pputaimarker = 254;
@ -1586,6 +1591,62 @@ uses
end;
end;
{$ifdef NEWRA}
{ ---------------------------------------------------------------------
Register allocator methods.
---------------------------------------------------------------------}
function taicpu_abstract.get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister;var unusedregsint:Tsupregset):Tai;
var
back:Tsupregset;
begin
back:=unusedregsint;
get_insert_pos:=p;
while (p<>nil) and (p.typ=ait_regalloc) do
begin
{Rewind the register allocation.}
if Tai_regalloc(p).allocation then
include(unusedregsint,Tai_regalloc(p).reg.number shr 8)
else
begin
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8);
if Tai_regalloc(p).reg.number shr 8=huntfor1 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
if Tai_regalloc(p).reg.number shr 8=huntfor2 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
if Tai_regalloc(p).reg.number shr 8=huntfor3 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
end;
p:=Tai(p.previous);
end;
unusedregsint:=back;
end;
procedure taicpu_abstract.forward_allocation(p:Tai;var unusedregsint:Tsupregset);
begin
{Forward the register allocation again.}
while (p<>self) do
begin
if p.typ<>ait_regalloc then
internalerror(200305311);
if Tai_regalloc(p).allocation then
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8)
else
include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
p:=Tai(p.next);
end;
end;
{$endif NEWRA}
{ ---------------------------------------------------------------------
Miscellaneous methods.
@ -1838,7 +1899,10 @@ uses
end.
{
$Log$
Revision 1.30 2003-07-02 16:43:48 jonas
Revision 1.31 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.30 2003/07/02 16:43:48 jonas
* always add dummy marker object at the start of an assembler list, so
the optimizer can't remove the first object

61
compiler/cgbase.pas
View File

@ -370,43 +370,39 @@ implementation
var
paramloc : tparalocation;
begin
{ generate callee paraloc register info }
paramanager.create_paraloc_info(current_procinfo.procdef,calleeside);
{ temporary space is set, while the BEGIN of the procedure }
if (symtablestack.symtabletype=localsymtable) then
current_procinfo.firsttemp_offset := tg.direction*symtablestack.datasize
else
current_procinfo.firsttemp_offset := 0;
{ space for the return value }
{ !!!!! this means that we can not set the return value
in a subfunction !!!!! }
{ because we don't know yet where the address is }
{ include return value registers }
if not is_void(procdef.rettype.def) then
begin
if not paramanager.ret_in_param(procdef.rettype.def,procdef.proccalloption) then
begin
paramloc:=paramanager.getfuncresultloc(procdef,procdef.proccalloption);
case paramloc.loc of
LOC_FPUREGISTER,
LOC_CFPUREGISTER,
LOC_MMREGISTER,
LOC_CMMREGISTER :
begin
include(rg.used_in_proc_other,paramloc.register.enum);
end;
LOC_REGISTER,LOC_CREGISTER :
begin
if ((paramloc.size in [OS_S64,OS_64]) and
(sizeof(aword) < 8)) then
begin
include(rg.used_in_proc_int,paramloc.registerhigh.number shr 8);
include(rg.used_in_proc_int,paramloc.registerlow.number shr 8);
end
else
include(rg.used_in_proc_int,paramloc.register.number shr 8);
end;
else
internalerror(20020816);
end;
end;
paramloc:=procdef.funcret_paraloc[calleeside];
case paramloc.loc of
LOC_FPUREGISTER,
LOC_CFPUREGISTER,
LOC_MMREGISTER,
LOC_CMMREGISTER :
begin
include(rg.used_in_proc_other,paramloc.register.enum);
end;
LOC_REGISTER,LOC_CREGISTER :
begin
if ((paramloc.size in [OS_S64,OS_64]) and
(sizeof(aword) < 8)) then
begin
include(rg.used_in_proc_int,paramloc.registerhigh.number shr 8);
include(rg.used_in_proc_int,paramloc.registerlow.number shr 8);
end
else
include(rg.used_in_proc_int,paramloc.register.number shr 8);
end;
end;
end;
end;
@ -571,7 +567,10 @@ implementation
end.
{
$Log$
Revision 1.57 2003-07-06 17:58:22 peter
Revision 1.58 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.57 2003/07/06 17:58:22 peter
* framepointer fixes for sparc
* parent framepointer code more generic

8
compiler/fpcdefs.inc
View File

@ -60,7 +60,8 @@
{$endif alpha}
{$ifdef sparc}
{$define callparatemp}
{$define usetempparaloc}
{ define callparatemp}
{$endif sparc}
{$ifdef powerpc}
@ -83,7 +84,10 @@
{
$Log$
Revision 1.21 2003-07-21 11:52:57 florian
Revision 1.22 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.21 2003/07/21 11:52:57 florian
* very basic stuff for the arm
Revision 1.20 2003/05/24 21:12:57 florian

49
compiler/i386/cpupara.pas
View File

@ -33,7 +33,7 @@ unit cpupara;
cpubase,
globtype,
cginfo,
symtype,symdef,paramgr;
symconst,symtype,symdef,paramgr;
type
{ Returns the location for the nr-st 32 Bit int parameter
@ -55,7 +55,7 @@ unit cpupara;
uses
systems,verbose,
symconst,symsym,
symsym,
cpuinfo,
cgbase;
@ -153,13 +153,45 @@ unit cpupara;
paraloc.reference.index.number:=NR_FRAME_POINTER_REG;
end;
paraloc.reference.offset:=tvarsym(hp.parasym).adjusted_address;
if side = callerside then
hp.callerparaloc:=paraloc
hp.paraloc[side]:=paraloc;
{$warning callerparaloc shall not be the same as calleeparaloc}
else
hp.calleeparaloc:=paraloc;
hp:=tparaitem(hp.next);
end;
{ Function return }
fillchar(paraloc,sizeof(tparalocation),0);
paraloc.size:=def_cgsize(p.rettype.def);
{ Return in FPU register? }
if p.rettype.def.deftype=floatdef then
begin
paraloc.loc:=LOC_FPUREGISTER;
paraloc.register.enum:=FPU_RESULT_REG;
end
else
{ Return in register? }
if not ret_in_param(p.rettype.def,p.proccalloption) then
begin
paraloc.loc:=LOC_REGISTER;
{$ifndef cpu64bit}
if paraloc.size in [OS_64,OS_S64] then
begin
paraloc.register64.reglo.enum:=R_INTREGISTER;
paraloc.register64.reglo.number:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc.register64.reghi.enum:=R_INTREGISTER;
paraloc.register64.reghi.number:=NR_FUNCTION_RETURN64_HIGH_REG;
end
else
{$endif cpu64bit}
begin
paraloc.register.enum:=R_INTREGISTER;
paraloc.register.number:=NR_FUNCTION_RETURN_REG;
end;
end
else
begin
paraloc.loc:=LOC_REFERENCE;
end;
p.funcret_paraloc[side]:=paraloc;
end;
@ -182,7 +214,10 @@ begin
end.
{
$Log$
Revision 1.21 2003-07-05 20:11:41 jonas
Revision 1.22 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.21 2003/07/05 20:11:41 jonas
* create_paraloc_info() is now called separately for the caller and
callee info
* fixed ppc cycle

237
compiler/ncgcal.pas
View File

@ -35,6 +35,9 @@ interface
type
tcgcallparanode = class(tcallparanode)
private
tempparaloc : tparalocation;
public
procedure secondcallparan(push_from_left_to_right:boolean;calloption:tproccalloption;
para_alignment,para_offset : longint);override;
end;
@ -125,19 +128,31 @@ implementation
objectlibrary.getlabel(truelabel);
objectlibrary.getlabel(falselabel);
secondpass(left);
{ allocate paraloc }
paramanager.allocparaloc(exprasmlist,paraitem.callerparaloc);
{ Allocate (temporary) paralocation }
{$ifdef usetempparaloc}
tempparaloc:=paraitem.paraloc[callerside];
if tempparaloc.loc=LOC_REGISTER then
paramanager.alloctempregs(exprasmlist,tempparaloc)
else
paramanager.allocparaloc(exprasmlist,tempparaloc);
{$else}
tempparaloc:=paraitem.paraloc[callerside];
paramanager.allocparaloc(exprasmlist,tempparaloc);
{$endif usetempparaloc}
{ handle varargs first, because defcoll is not valid }
if (nf_varargs_para in flags) then
begin
if paramanager.push_addr_param(left.resulttype.def,calloption) then
begin
inc(pushedparasize,POINTER_SIZE);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.callerparaloc);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
location_release(exprasmlist,left.location);
end
else
push_value_para(exprasmlist,left,calloption,para_offset,para_alignment,paraitem.callerparaloc);
push_value_para(exprasmlist,left,calloption,para_offset,para_alignment,tempparaloc);
end
{ hidden parameters }
else if paraitem.is_hidden then
@ -169,13 +184,13 @@ implementation
{$endif}
end
else
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.callerparaloc);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
location_release(exprasmlist,left.location);
end
else
begin
push_value_para(exprasmlist,left,calloption,
para_offset,para_alignment,paraitem.callerparaloc);
para_offset,para_alignment,tempparaloc);
end;
end
{ filter array of const c styled args }
@ -203,7 +218,7 @@ implementation
cg.a_load_loc_ref(exprasmlist,OS_ADDR,left.location,href);
end
else
cg.a_param_loc(exprasmlist,left.location,paraitem.callerparaloc);
cg.a_param_loc(exprasmlist,left.location,tempparaloc);
location_release(exprasmlist,left.location);
end
else
@ -228,7 +243,7 @@ implementation
{$endif}
end
else
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.callerparaloc);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
location_release(exprasmlist,left.location);
end;
end
@ -266,7 +281,7 @@ implementation
{$endif}
end
else
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.callerparaloc);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
location_release(exprasmlist,left.location);
end
else
@ -316,13 +331,13 @@ implementation
{$endif}
end
else
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraitem.callerparaloc);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
location_release(exprasmlist,left.location);
end
else
begin
push_value_para(exprasmlist,left,calloption,
para_offset,para_alignment,paraitem.callerparaloc);
para_offset,para_alignment,tempparaloc);
end;
end;
truelabel:=otlabel;
@ -401,7 +416,9 @@ implementation
var
cgsize : tcgsize;
r,hregister : tregister;
{$ifndef NEWRA}
href: treference;
{$endif}
tempnode: tnode;
begin
{ structured results are easy to handle.... }
@ -418,7 +435,7 @@ implementation
is_widestring(resulttype.def) then
begin
r.enum:=R_INTREGISTER;
r.number:=NR_FUNCTION_RETURN_REG;
r.number:=NR_FUNCTION_RESULT_REG;
{$ifdef newra}
{ the FUNCTION_RESULT_REG is already allocated }
rg.ungetregisterint(exprasmlist,r);
@ -648,9 +665,7 @@ implementation
regs_to_push_other : tregisterset;
unusedstate: pointer;
{$ifdef newra}
i:Tsuperregister;
regs_to_alloc,regs_to_free:Tsupregset;
funcretloc: tparalocation;
{$else}
regs_to_push_int : Tsupregset;
pushedint : tpushedsavedint;
@ -664,23 +679,62 @@ implementation
href,helpref : treference;
para_alignment,
pop_size : longint;
r,
{$ifdef x86}
accreg,
{$endif x86}
vmtreg,vmtreg2 : tregister;
oldaktcallnode : tcallnode;
procedure pushparas;
var
ppn : tcgcallparanode;
begin
{ copy all resources to the allocated registers }
ppn:=tcgcallparanode(left);
while assigned(ppn) do
begin
if ppn.tempparaloc.loc=LOC_REGISTER then
begin
paramanager.allocparaloc(exprasmlist,ppn.paraitem.paraloc[callerside]);
{$ifdef sparc}
case ppn.tempparaloc.size of
OS_F32 :
ppn.tempparaloc.size:=OS_32;
OS_F64 :
ppn.tempparaloc.size:=OS_64;
end;
{$endif sparc}
{$ifndef cpu64bit}
if ppn.tempparaloc.size in [OS_64,OS_S64] then
begin
cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,ppn.tempparaloc.registerlow,
ppn.paraitem.paraloc[callerside].registerlow);
cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,ppn.tempparaloc.registerhigh,
ppn.paraitem.paraloc[callerside].registerhigh);
end
else
{$endif cpu64bit}
cg.a_load_reg_reg(exprasmlist,ppn.tempparaloc.size,ppn.paraitem.paraloc[callerside].size,
ppn.tempparaloc.register,ppn.paraitem.paraloc[callerside].register);
end;
ppn:=tcgcallparanode(ppn.right);
end;
end;
procedure freeparas;
var
paraitem : tparaitem;
ppn : tcgcallparanode;
begin
{ free the resources allocated for the parameters }
paraitem:=tparaitem(procdefinition.para.first);
while assigned(paraitem) do
ppn:=tcgcallparanode(left);
while assigned(ppn) do
begin
paramanager.freeparaloc(exprasmlist,paraitem.callerparaloc);
paraitem:=tparaitem(paraitem.next);
{$ifdef usetempparaloc}
if ppn.tempparaloc.loc=LOC_REGISTER then
paramanager.freeparaloc(exprasmlist,ppn.tempparaloc);
{$endif usetempparaloc}
paramanager.freeparaloc(exprasmlist,ppn.paraitem.paraloc[callerside]);
ppn:=tcgcallparanode(ppn.right);
end;
{ free pushed base pointer }
if (right=nil) and
@ -743,44 +797,10 @@ implementation
{$ifdef newra}
regs_to_alloc:=Tprocdef(procdefinition).usedintregisters;
if (not is_void(resulttype.def)) and
not(paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
begin
funcretloc := paramanager.getfuncretparaloc(procdefinition);
case funcretloc.loc of
LOC_REGISTER,LOC_CREGISTER:
begin
{$ifndef cpu64bit}
if funcretloc.size in [OS_S64,OS_64] then
begin
include(regs_to_alloc,funcretloc.registerlow.number shr 8);
include(regs_to_alloc,funcretloc.registerhigh.number shr 8);
end
else
{$endif cpu64bit}
include(regs_to_alloc,funcretloc.register.number shr 8);
end;
end;
end;
{$else}
{ save all used registers and possible registers
used for the return value }
regs_to_push_int := tprocdef(procdefinition).usedintregisters;
if (not is_void(resulttype.def)) and
(not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
begin
{$ifndef cpu64bit}
if resulttype.def.deftype<>floatdef then
if resulttype.def.size>sizeof(aword) then
begin
include(regs_to_push_int,RS_FUNCTION_RESULT64_LOW_REG);
include(regs_to_push_int,RS_FUNCTION_RESULT64_HIGH_REG);
end
else
{$endif cpu64bit}
include(regs_to_push_int,RS_FUNCTION_RESULT_REG);
end;
rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
{$endif}
{$ifdef i386}
@ -788,8 +808,6 @@ implementation
{$else i386}
regs_to_push_other := [];
{$endif i386}
rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
{ on the ppc, ever procedure saves the non-volatile registers it uses itself }
{ and must make sure it saves its volatile registers before doing a call }
{$ifdef i386}
@ -800,39 +818,18 @@ implementation
end
else
begin
{No procedure is allowed to destroy ebp.}
{$ifdef newra}
regs_to_alloc:=VOLATILE_INTREGISTERS;
if (not is_void(resulttype.def)) and
not(paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
begin
funcretloc := paramanager.getfuncretparaloc(procdefinition);
case funcretloc.loc of
LOC_REGISTER,LOC_CREGISTER:
begin
{$ifndef cpu64bit}
if funcretloc.size in [OS_S64,OS_64] then
begin
include(regs_to_alloc,funcretloc.registerlow.number shr 8);
include(regs_to_alloc,funcretloc.registerhigh.number shr 8);
end
else
{$endif cpu64bit}
include(regs_to_alloc,funcretloc.register.number shr 8);
end;
end;
end;
{$else}
regs_to_push_int := VOLATILE_INTREGISTERS;
rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
{$endif}
{$ifdef i386}
regs_to_push_other := all_registers;
{$else i386}
regs_to_push_other := [];
{$endif i386}
rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
{$ifdef i386}
rg.used_in_proc_int:=VOLATILE_INTREGISTERS;
rg.used_in_proc_other:=all_registers;
{$endif i386}
@ -840,6 +837,48 @@ implementation
iolabel:=nil;
end;
{ Include Function result registers }
if (not is_void(resulttype.def)) then
begin
{$ifdef NEWRA}
case procdefinition.funcret_paraloc[callerside].loc of
LOC_REGISTER,LOC_CREGISTER:
begin
{$ifndef cpu64bit}
if procdefinition.funcret_paraloc[callerside].size in [OS_S64,OS_64] then
begin
include(regs_to_alloc,procdefinition.funcret_paraloc[callerside].registerlow.number shr 8);
include(regs_to_alloc,procdefinition.funcret_paraloc[callerside].registerhigh.number shr 8);
end
else
{$endif cpu64bit}
include(regs_to_alloc,procdefinition.funcret_paraloc[callerside].register.number shr 8);
end;
end;
{$else NEWRA}
case procdefinition.funcret_paraloc[callerside].loc of
LOC_REGISTER,LOC_CREGISTER:
begin
{$ifndef cpu64bit}
if procdefinition.funcret_paraloc[callerside].size in [OS_S64,OS_64] then
begin
include(regs_to_push_int,procdefinition.funcret_paraloc[callerside].registerlow.number shr 8);
include(regs_to_push_int,procdefinition.funcret_paraloc[callerside].registerhigh.number shr 8);
end
else
{$endif cpu64bit}
include(regs_to_push_int,procdefinition.funcret_paraloc[callerside].register.number shr 8);
end;
end;
{$endif NEWRA}
end;
{ Save registers destroyed by the call }
{$ifndef NEWRA}
rg.saveusedintregisters(exprasmlist,pushedint,regs_to_push_int);
{$endif}
rg.saveusedotherregisters(exprasmlist,pushedother,regs_to_push_other);
{ Initialize for pushing the parameters }
oldpushedparasize:=pushedparasize;
pushedparasize:=0;
@ -879,6 +918,7 @@ implementation
end;
{$endif not i386}
{ Process parameters }
if assigned(left) then
begin
{$ifndef newra}
@ -899,6 +939,10 @@ implementation
if assigned(methodpointer) then
maybe_restore(exprasmlist,methodpointer.location,pushedregs);
{$endif newra}
{$ifdef usetempparaloc}
pushparas;
{$endif}
end;
aktcallnode:=oldaktcallnode;
@ -1058,22 +1102,23 @@ implementation
{$endif TEMPREGDEBUG}
{$ifdef newra}
{ Release registers, but not the registers that contain the
function result }
regs_to_free:=regs_to_alloc;
if (not is_void(resulttype.def)) and
not(paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
if (not is_void(resulttype.def)) then
begin
case funcretloc.loc of
case procdefinition.funcret_paraloc[callerside].loc of
LOC_REGISTER,LOC_CREGISTER:
begin
{$ifndef cpu64bit}
if funcretloc.size in [OS_S64,OS_64] then
if procdefinition.funcret_paraloc[callerside].size in [OS_S64,OS_64] then
begin
exclude(regs_to_free,funcretloc.registerlow.number shr 8);
exclude(regs_to_free,funcretloc.registerhigh.number shr 8);
exclude(regs_to_free,procdefinition.funcret_paraloc[callerside].registerlow.number shr 8);
exclude(regs_to_free,procdefinition.funcret_paraloc[callerside].registerhigh.number shr 8);
end
else
{$endif cpu64bit}
exclude(regs_to_free,funcretloc.register.number shr 8);
exclude(regs_to_free,procdefinition.funcret_paraloc[callerside].register.number shr 8);
end;
end;
end;
@ -1147,7 +1192,6 @@ implementation
pushedint : tpushedsavedint;
pushedregs : tmaybesave;
{$endif}
funcretloc: tparalocation;
oldpushedparasize : longint;
{ adress returned from an I/O-error }
iolabel : tasmlabel;
@ -1314,22 +1358,20 @@ implementation
used for the return value }
regs_to_push_int := tprocdef(procdefinition).usedintregisters;
regs_to_push_other := tprocdef(procdefinition).usedotherregisters;
if (not is_void(resulttype.def)) and
not(paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption)) then
if (not is_void(resulttype.def)) then
begin
funcretloc := paramanager.getfuncretparaloc(procdefinition);
case funcretloc.loc of
case procdefinition.funcret_paraloc[callerside].loc of
LOC_REGISTER,LOC_CREGISTER:
begin
{$ifndef cpu64bit}
if funcretloc.size in [OS_S64,OS_64] then
if procdefinition.funcret_paraloc[callerside].size in [OS_S64,OS_64] then
begin
include(regs_to_push_int,funcretloc.registerlow.number shr 8);
include(regs_to_push_int,funcretloc.registerhigh.number shr 8);
include(regs_to_push_int,procdefinition.funcret_paraloc[callerside].registerlow.number shr 8);
include(regs_to_push_int,procdefinition.funcret_paraloc[callerside].registerhigh.number shr 8);
end
else
{$endif cpu64bit}
include(regs_to_push_int,funcretloc.register.number shr 8);
include(regs_to_push_int,procdefinition.funcret_paraloc[callerside].register.number shr 8);
end;
end;
end;
@ -1541,7 +1583,10 @@ begin
end.
{
$Log$
Revision 1.104 2003-08-11 14:22:06 mazen
Revision 1.105 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.104 2003/08/11 14:22:06 mazen
- dupplicated code removed
Revision 1.103 2003/07/23 11:01:14 jonas
@ -1573,7 +1618,7 @@ end.
* fixed ppc cycle
Revision 1.96 2003/07/02 22:18:04 peter
* paraloc splitted in callerparaloc,calleeparaloc
* paraloc splitted in paraloc[callerside],calleeparaloc
* sparc calling convention updates
Revision 1.95 2003/06/17 16:34:44 jonas

11
compiler/ncgutil.pas
View File

@ -1636,14 +1636,14 @@ implementation
internalerror(200301081);
if (tvarsym(hp.parasym).reg.enum<>R_NO) then
begin
cg.a_load_param_reg(list,hp.calleeparaloc,tvarsym(hp.parasym).reg);
cg.a_load_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).reg);
end
else if (hp.calleeparaloc.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER,
else if (hp.paraloc[calleeside].loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER,
LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER]) and
(tvarsym(hp.parasym).reg.enum=R_NO) then
begin
reference_reset_base(href,current_procinfo.framepointer,tvarsym(hp.parasym).adjusted_address);
cg.a_load_param_ref(list,hp.calleeparaloc,href);
cg.a_load_param_ref(list,hp.paraloc[calleeside],href);
end;
hp:=tparaitem(hp.next);
end;
@ -2030,7 +2030,10 @@ implementation
end.
{
$Log$
Revision 1.133 2003-08-09 18:56:54 daniel
Revision 1.134 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.133 2003/08/09 18:56:54 daniel
* cs_regalloc renamed to cs_regvars to avoid confusion with register
allocator
* Some preventive changes to i386 spillinh code

138
compiler/paramgr.pas
View File

@ -35,7 +35,6 @@ unit paramgr;
symconst,symtype,symdef;
type
tcallercallee = (callerside,calleeside);
{# This class defines some methods to take care of routine
parameters. It should be overriden for each new processor
}
@ -100,33 +99,18 @@ unit paramgr;
}
procedure create_paraloc_info(p : tabstractprocdef; side: tcallercallee);virtual;abstract;
{
Returns the location where the invisible parameter for structured
function results will be passed.
}
function getfuncretparaloc(p : tabstractprocdef) : tparalocation;virtual;
{
Returns the location where the invisible parameter for nested
subroutines is passed.
}
function getframepointerloc(p : tabstractprocdef) : tparalocation;virtual;
{ Returns the self pointer location for the given tabstractprocdef,
when the stack frame is already created. This is used by the code
generating the wrappers for implemented interfaces.
}
function getselflocation(p : tabstractprocdef) : tparalocation;virtual;abstract;
{
Returns the location of the result if the result is in
a register, the register(s) return depend on the type of
the result.
@param(def The definition of the result type of the function)
}
function getfuncresultloc(def : tdef;calloption:tproccalloption): tparalocation;virtual;
{ Return the location of the low and high part of a 64bit parameter }
procedure splitparaloc64(const locpara:tparalocation;var loclopara,lochipara:tparalocation);virtual;
{$ifdef usetempparaloc}
procedure alloctempregs(list: taasmoutput;var locpara:tparalocation);virtual;
{$endif usetempparaloc}
end;
@ -312,97 +296,6 @@ implementation
end;
function tparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
begin
result.loc:=LOC_REFERENCE;
result.size:=OS_ADDR;
result.sp_fixup:=pointer_size;
result.reference.index.enum:=R_INTREGISTER;
result.reference.index.number:=NR_STACK_POINTER_REG;
result.reference.offset:=0;
end;
function tparamanager.getframepointerloc(p : tabstractprocdef) : tparalocation;
begin
result.loc:=LOC_REFERENCE;
result.size:=OS_ADDR;
result.sp_fixup:=pointer_size;
result.reference.index.enum:=R_INTREGISTER;
result.reference.index.number:=NR_STACK_POINTER_REG;
result.reference.offset:=0;
end;
function tparamanager.getfuncresultloc(def : tdef;calloption:tproccalloption): tparalocation;
begin
fillchar(result,sizeof(tparalocation),0);
if is_void(def) then exit;
result.size := def_cgsize(def);
case def.deftype of
orddef,
enumdef :
begin
result.loc := LOC_REGISTER;
{$ifndef cpu64bit}
if result.size in [OS_64,OS_S64] then
begin
result.register64.reglo.enum:=R_INTREGISTER;
result.register64.reglo.number:=NR_FUNCTION_RETURN64_LOW_REG;
result.register64.reghi.enum:=R_INTREGISTER;
result.register64.reghi.number:=NR_FUNCTION_RETURN64_HIGH_REG;
end
else
{$endif cpu64bit}
begin
result.register.enum:=R_INTREGISTER;
result.register.number:=NR_FUNCTION_RETURN_REG;
end;
end;
floatdef :
begin
result.loc := LOC_FPUREGISTER;
{$ifdef cpufpemu}
if cs_fp_emulation in aktmoduleswitches then
begin
result.register.enum:=R_INTREGISTER;
result.register.number:=FUNCTION_RETURN_REG;
end
else
{$endif cpufpemu}
result.register.enum := FPU_RESULT_REG;
end;
else
begin
if not ret_in_param(def,calloption) then
begin
result.loc := LOC_REGISTER;
result.register.enum:=R_INTREGISTER;
result.register.number:=NR_FUNCTION_RETURN_REG;
end
else
begin
result.loc := LOC_REFERENCE;
internalerror(2002081602);
(*
{$ifdef EXTDEBUG}
{ it is impossible to have the
return value with an index register
and a symbol!
}
if (ref.index <> R_NO) or (assigned(ref.symbol)) then
internalerror(2002081602);
{$endif}
result.reference.index := ref.base;
result.reference.offset := ref.offset;
*)
end;
end;
end;
end;
procedure tparamanager.splitparaloc64(const locpara:tparalocation;var loclopara,lochipara:tparalocation);
begin
if not(locpara.size in [OS_64,OS_S64]) then
@ -433,6 +326,22 @@ implementation
end;
{$ifdef usetempparaloc}
procedure tparamanager.alloctempregs(list: taasmoutput;var locpara:tparalocation);
begin
if locpara.loc<>LOC_REGISTER then
internalerror(200308123);
{$ifndef cpu64bit}
if locpara.size in [OS_64,OS_S64] then
begin
locpara.registerlow:=rg.getregisterint(list,OS_32);
locpara.registerhigh:=rg.getregisterint(list,OS_32);
end
else
{$endif cpu64bit}
locpara.register:=rg.getregisterint(list,locpara.size);
end;
{$endif usetempparaloc}
initialization
@ -443,7 +352,10 @@ end.
{
$Log$
Revision 1.49 2003-07-08 21:24:59 peter
Revision 1.50 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.49 2003/07/08 21:24:59 peter
* sparc fixes
Revision 1.48 2003/07/05 20:11:41 jonas

11
compiler/pass_2.pas
View File

@ -164,7 +164,9 @@ implementation
prevp : pptree;
{$endif TEMPREGDEBUG}
{$ifdef EXTDEBUG}
{$ifndef newra}
i : longint;
{$endif newra}
{$endif EXTDEBUG}
begin
if not assigned(p) then
@ -205,9 +207,11 @@ implementation
end;
{$ifdef newra}
{$ifdef i386}
if rg.unusedregsint*([first_supreg..last_supreg] - [RS_FRAME_POINTER_REG,RS_STACK_POINTER_REG])<>
([first_supreg..last_supreg] - [RS_FRAME_POINTER_REG,RS_STACK_POINTER_REG]) then
internalerror(200306171);
{$endif}
{$else}
{ check if all scratch registers are freed }
for i:=1 to max_scratch_regs do
@ -280,8 +284,6 @@ implementation
{ assign parameter locations }
current_procinfo.after_pass1;
{ callee paraloc register info is necessary for regvars }
paramanager.create_paraloc_info(current_procinfo.procdef,calleeside);
{ caller paraloc info is also necessary in the stackframe_entry }
{ code of the ppc (and possibly other processors) }
if not current_procinfo.procdef.has_paraloc_info then
@ -315,7 +317,10 @@ implementation
end.
{
$Log$
Revision 1.62 2003-08-10 17:25:23 peter
Revision 1.63 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.62 2003/08/10 17:25:23 peter
* fixed some reported bugs
Revision 1.61 2003/07/06 17:58:22 peter

86
compiler/powerpc/aasmcpu.pas
View File

@ -82,12 +82,14 @@ uses
function is_nop: boolean; override;
function is_move:boolean; override;
{$ifdef newra}
function spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsupregset;
var unusedregsint:Tsupregset;
const spilltemplist:Tspill_temp_list):boolean; override;
{$endif}
end;
@ -416,7 +418,8 @@ uses cutils,rgobj;
function taicpu.is_nop: boolean;
begin
{ we don't insert any more nops than necessary }
is_nop := false;
is_nop :=
((opcode=A_MR) and (oper[0].typ=top_reg) and (oper[1].typ=top_reg) and (oper[0].reg.number=oper[1].reg.number));
end;
@ -426,68 +429,16 @@ uses cutils,rgobj;
end;
function taicpu.spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsupregset;
var unusedregsint:Tsupregset;
{$ifdef newra}
function taicpu.spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsupregset;
var unusedregsint:Tsupregset;
const spilltemplist:Tspill_temp_list): boolean;
function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister):Tai;
function decode_loadstore(op: tasmop; var counterpart: tasmop; var wasload: boolean): boolean;
var back:Tsupregset;
begin
back:=unusedregsint;
get_insert_pos:=p;
while (p<>nil) and (p.typ=ait_regalloc) do
begin
{Rewind the register allocation.}
if Tai_regalloc(p).allocation then
include(unusedregsint,Tai_regalloc(p).reg.number shr 8)
else
begin
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8);
if Tai_regalloc(p).reg.number shr 8=huntfor1 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
if Tai_regalloc(p).reg.number shr 8=huntfor2 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
if Tai_regalloc(p).reg.number shr 8=huntfor3 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
end;
p:=Tai(p.previous);
end;
unusedregsint:=back;
end;
procedure forward_allocation(p:Tai);
begin
{Forward the register allocation again.}
while (p<>self) do
begin
if p.typ<>ait_regalloc then
internalerror(200305311);
if Tai_regalloc(p).allocation then
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8)
else
include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
p:=Tai(p.next);
end;
end;
function decode_loadstore(op: tasmop; var counterpart: tasmop; wasload: boolean): boolean;
begin
result := true;
wasload := true;
@ -591,7 +542,7 @@ uses cutils,rgobj;
//
// l?? r21d, -60(r1)
// st? r21d, 8(r1)
pos := get_insert_pos(Tai(previous),oper[0].reg.number shr 8,
oper[1].ref^.base.number shr 8,oper[1].ref^.index.number shr 8);
rgget(list,pos,0,helpreg);
@ -720,7 +671,7 @@ uses cutils,rgobj;
for i := 1 to 2 do
if (oper[i].typ = top_reg) then
begin
supreg:=oper[i].reg.number;
supreg:=oper[i].reg.number shr 8;
if supreg in r then
begin
// Example:
@ -731,7 +682,7 @@ uses cutils,rgobj;
// lwz r23d, -60(r1)
// add r23d, r21d, r22d
// stw r23d, -60(r1)
pos := get_insert_pos(Tai(previous),reg1,reg2,reg3);
rgget(list,pos,0,helpreg);
spill_registers := true;
@ -750,6 +701,7 @@ uses cutils,rgobj;
end;
end;
end;
{$endif newra}
@ -765,7 +717,13 @@ uses cutils,rgobj;
end.
{
$Log$
Revision 1.11 2003-07-23 10:58:06 jonas
Revision 1.13 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.12 2002/09/30 23:16:49 jonas
* is_nop() now identifies "mr rA,rA" instructions for removal
Revision 1.11 2003/07/23 10:58:06 jonas
- disabled some debugging code
Revision 1.10 2003/07/06 21:26:06 jonas

11
compiler/powerpc/cgcpu.pas
View File

@ -1212,11 +1212,11 @@ const
hp:=tparaitem(current_procinfo.procdef.para.first);
while assigned(hp) do
begin
if (hp.calleeparaloc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
if (hp.paraloc[calleeside].loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
begin
reference_reset_base(href,current_procinfo.framepointer,tvarsym(hp.parasym).adjusted_address);
reference_reset_base(href2,r,hp.callerparaloc.reference.offset);
cg.a_load_ref_ref(list,hp.calleeparaloc.size,hp.calleeparaloc.size,href2,href);
reference_reset_base(href2,r,hp.paraloc[callerside].reference.offset);
cg.a_load_ref_ref(list,hp.paraloc[calleeside].size,hp.paraloc[calleeside].size,href2,href);
end;
hp := tparaitem(hp.next);
end;
@ -2672,7 +2672,10 @@ begin
end.
{
$Log$
Revision 1.118 2003-08-08 15:50:45 olle
Revision 1.119 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.118 2003/08/08 15:50:45 olle
* merged macos entry/exit code generation into the general one.
Revision 1.117 2002/10/01 05:24:28 olle

104
compiler/powerpc/cpupara.pas
View File

@ -39,7 +39,6 @@ unit cpupara;
function getintparaloc(list: taasmoutput; nr : longint) : tparalocation;override;
procedure freeintparaloc(list: taasmoutput; nr : longint); override;
procedure create_paraloc_info(p : tabstractprocdef; side: tcallercallee);override;
function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
end;
implementation
@ -247,9 +246,9 @@ unit cpupara;
if nextintreg.number<=(NR_R10-ord(is_64bit)*(NR_R1-NR_R0)) then
begin
paraloc.loc:=LOC_REGISTER;
if is_64bit then
if is_64bit then
begin
if odd((nextintreg.number-NR_R3) shr 8) and (target_info.abi=abi_powerpc_sysv) Then
if odd((nextintreg.number-NR_R3) shr 8) and (target_info.abi=abi_powerpc_sysv) Then
inc(nextintreg.number,NR_R1-NR_R0);
paraloc.registerhigh:=nextintreg;
inc(nextintreg.number,NR_R1-NR_R0);
@ -312,81 +311,60 @@ unit cpupara;
else
internalerror(2002071002);
end;
if side = callerside then
hp.callerparaloc:=paraloc
else
if side = calleeside then
begin
if (paraloc.loc = LOC_REFERENCE) then
paraloc.reference.offset := tvarsym(hp.parasym).adjusted_address;
hp.calleeparaloc:=paraloc;
end;
hp.paraloc[side]:=paraloc;
hp:=tparaitem(hp.next);
end;
end;
function tppcparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
begin
fillchar(result,sizeof(result),0);
case p.rettype.def.deftype of
orddef,
enumdef:
begin
getfuncretparaloc.loc:=LOC_REGISTER;
getfuncretparaloc.register.enum:=R_INTREGISTER;
getfuncretparaloc.register.number:=NR_R3;
getfuncretparaloc.size:=def_cgsize(p.rettype.def);
if getfuncretparaloc.size in [OS_S64,OS_64] then
begin
getfuncretparaloc.registerhigh.enum:=R_INTREGISTER;
getfuncretparaloc.registerhigh.number:=NR_R3;
getfuncretparaloc.register.number:=NR_R4;
end;
end;
floatdef:
begin
getfuncretparaloc.loc:=LOC_FPUREGISTER;
getfuncretparaloc.register.enum:=R_F1;
getfuncretparaloc.size:=def_cgsize(p.rettype.def);
end;
{ smallsets are OS_INT in R3, others are OS_ADDR in R3 -> the same }
{ ugly, I know :) (JM) }
setdef,
variantdef,
pointerdef,
formaldef,
classrefdef,
recorddef,
objectdef,
procvardef,
filedef,
arraydef,
stringdef:
begin
if (p.rettype.def.deftype <> stringdef) or
(is_ansistring(p.rettype.def) or
is_widestring(p.rettype.def)) then
begin
getfuncretparaloc.loc:=LOC_REGISTER;
getfuncretparaloc.register.enum:=R_INTREGISTER;
getfuncretparaloc.register.number:=NR_R3;
getfuncretparaloc.size:=OS_ADDR;
end
else
internalerror(2003061601);
end;
{ Function return }
fillchar(paraloc,sizeof(tparalocation),0);
paraloc.size:=def_cgsize(p.rettype.def);
{ Return in FPU register? }
if p.rettype.def.deftype=floatdef then
begin
paraloc.loc:=LOC_FPUREGISTER;
paraloc.register.enum:=FPU_RESULT_REG;
end
else
{ Return in register? }
if not ret_in_param(p.rettype.def,p.proccalloption) then
begin
paraloc.loc:=LOC_REGISTER;
{$ifndef cpu64bit}
if paraloc.size in [OS_64,OS_S64] then
begin
paraloc.register64.reglo.enum:=R_INTREGISTER;
paraloc.register64.reglo.number:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc.register64.reghi.enum:=R_INTREGISTER;
paraloc.register64.reghi.number:=NR_FUNCTION_RETURN64_HIGH_REG;
end
else
internalerror(2002090903);
end;
{$endif cpu64bit}
begin
paraloc.register.enum:=R_INTREGISTER;
paraloc.register.number:=NR_FUNCTION_RETURN_REG;
end;
end
else
begin
paraloc.loc:=LOC_REFERENCE;
end;
p.funcret_paraloc[side]:=paraloc;
end;
begin
paramanager:=tppcparamanager.create;
end.
{
$Log$
Revision 1.41 2003-07-05 20:11:41 jonas
Revision 1.42 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.41 2003/07/05 20:11:41 jonas
* create_paraloc_info() is now called separately for the caller and
callee info
* fixed ppc cycle

17
compiler/regvars.pas
View File

@ -183,15 +183,15 @@ implementation
hp:=tparaitem(current_procinfo.procdef.para.first);
while assigned(hp) do
begin
if (hp.calleeparaloc.loc in [LOC_REGISTER,LOC_FPUREGISTER,
if (hp.paraloc[calleeside].loc in [LOC_REGISTER,LOC_FPUREGISTER,
LOC_CREGISTER,LOC_CFPUREGISTER]) and
(TCGSize2Size[hp.calleeparaloc.size] <= sizeof(aword)) then
(TCGSize2Size[hp.paraloc[calleeside].size] <= sizeof(aword)) then
begin
tvarsym(hp.parasym).reg := hp.calleeparaloc.register;
if (hp.calleeparaloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
rg.makeregvarint(hp.calleeparaloc.register.number shr 8)
tvarsym(hp.parasym).reg := hp.paraloc[calleeside].register;
if (hp.paraloc[calleeside].loc in [LOC_REGISTER,LOC_CREGISTER]) then
rg.makeregvarint(hp.paraloc[calleeside].register.number shr 8)
else
rg.makeregvarother(hp.calleeparaloc.register);
rg.makeregvarother(hp.paraloc[calleeside].register);
end
else
begin
@ -616,7 +616,10 @@ end.
{
$Log$
Revision 1.59 2003-08-09 18:56:54 daniel
Revision 1.60 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.59 2003/08/09 18:56:54 daniel
* cs_regalloc renamed to cs_regvars to avoid confusion with register
allocator
* Some preventive changes to i386 spillinh code

249
compiler/sparc/aasmcpu.pas
View File

@ -59,8 +59,16 @@ uses
constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
constructor op_sym(op : tasmop;_op1 : tasmsymbol);
constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
{ register allocation }
function is_nop:boolean;override;
function is_move:boolean;override;
function spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsupregset;
var unusedregsint:Tsupregset;
const spilltemplist:Tspill_temp_list):boolean; override;
end;
tai_align = class(tai_align_abstract)
@ -250,6 +258,242 @@ implementation
end;
function taicpu.spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsupregset;
var unusedregsint:Tsupregset;
const spilltemplist:Tspill_temp_list): boolean;
function decode_loadstore(op: tasmop; var counterpart: tasmop; var wasload: boolean): boolean;
begin
result := true;
wasload := true;
case op of
A_LDSB,
A_LDUB :
begin
counterpart := A_STB;
end;
A_LDSH,
A_LDUH:
begin
counterpart := A_STH;
end;
A_LD :
begin
counterpart := A_ST;
wasload := false;
end;
A_LDD:
begin
counterpart := A_STD;
wasload := false;
end;
else
result := false;
end;
end;
var i:byte;
supreg, reg1, reg2, reg3: Tsuperregister;
helpreg:Tregister;
helpins:Taicpu;
op:Tasmop;
pos:Tai;
wasload: boolean;
begin
spill_registers:=false;
if (ops = 2) and
(oper[1].typ=top_ref) and
{ oper[1] can also be ref in case of "lis r3,symbol@ha" or so }
decode_loadstore(opcode,op,wasload) then
begin
{ the register that's being stored/loaded }
supreg:=oper[0].reg.number shr 8;
if supreg in r then
begin
// Example:
// l?? r20d, 8(r1) ; r20d must be spilled into -60(r1)
//
// Change into:
//
// l?? r21d, 8(r1)
// st? r21d, -60(r1)
//
// And:
//
// st? r20d, 8(r1) ; r20d must be spilled into -60(r1)
//
// Change into:
//
// l?? r21d, -60(r1)
// st? r21d, 8(r1)
pos := get_insert_pos(Tai(previous),oper[0].reg.number shr 8,
oper[1].ref^.base.number shr 8,
oper[1].ref^.index.number shr 8,
unusedregsint);
rgget(list,pos,0,helpreg);
spill_registers := true;
if wasload then
begin
helpins := taicpu.op_reg_ref(opcode,helpreg,oper[1].ref^);
loadref(1,spilltemplist[supreg]);
opcode := op;
end
else
helpins := taicpu.op_reg_ref(op,helpreg,spilltemplist[supreg]);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
loadreg(0,helpreg);
rgunget(list,helpins,helpreg);
forward_allocation(tai(helpins.next),unusedregsint);
{
writeln('spilling!');
list.insertafter(tai_comment.Create(strpnew('Spilling!')),helpins);
}
end;
{ now the registers used in the reference }
{ a) base }
supreg := oper[1].ref^.base.number shr 8;
if supreg in r then
begin
if wasload then
pos:=get_insert_pos(Tai(previous),oper[1].ref^.index.number shr 8,oper[0].reg.number shr 8,0,unusedregsint)
else
pos:=get_insert_pos(Tai(previous),oper[1].ref^.index.number shr 8,0,0,unusedregsint);
rgget(list,pos,0,helpreg);
spill_registers:=true;
helpins:=Taicpu.op_reg_ref(A_LD,helpreg,spilltemplist[supreg]);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
oper[1].ref^.base:=helpreg;
rgunget(list,helpins,helpreg);
forward_allocation(Tai(helpins.next),unusedregsint);
{
writeln('spilling!');
list.insertafter(tai_comment.Create(strpnew('Spilling!')),helpins);
}
end;
{ b) index }
supreg := oper[1].ref^.index.number shr 8;
if supreg in r then
begin
if wasload then
pos:=get_insert_pos(Tai(previous),oper[1].ref^.base.number shr 8,oper[0].reg.number shr 8,0,unusedregsint)
else
pos:=get_insert_pos(Tai(previous),oper[1].ref^.base.number shr 8,0,0,unusedregsint);
rgget(list,pos,0,helpreg);
spill_registers:=true;
helpins:=Taicpu.op_reg_ref(A_LD,helpreg,spilltemplist[supreg]);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
oper[1].ref^.index:=helpreg;
rgunget(list,helpins,helpreg);
forward_allocation(Tai(helpins.next),unusedregsint);
{
writeln('spilling!');
list.insertafter(tai_comment.Create(strpnew('Spilling!')),helpins);
}
end;
{ load/store is done }
exit;
end;
{ all other instructions the compiler generates are the same (I hope): }
{ operand 0 is a register and is the destination, the others are sources }
{ and can be either registers or constants }
{ exception: branches (is_jmp isn't always set for them) }
if oper[0].typ <> top_reg then
exit;
reg1 := oper[0].reg.number shr 8;
if oper[1].typ = top_reg then
reg2 := oper[1].reg.number shr 8
else
reg2 := 0;
if (ops >= 3) and
(oper[2].typ = top_reg) then
reg3 := oper[2].reg.number shr 8
else
reg3 := 0;
supreg:=reg1;
if supreg in r then
begin
// Example:
// add r20d, r21d, r22d ; r20d must be spilled into -60(r1)
//
// Change into:
//
// lwz r23d, -60(r1)
// add r23d, r21d, r22d
// stw r23d, -60(r1)
pos := get_insert_pos(Tai(previous),reg1,reg2,reg3,unusedregsint);
rgget(list,pos,0,helpreg);
spill_registers := true;
helpins := taicpu.op_reg_ref(A_ST,helpreg,spilltemplist[supreg]);
list.insertafter(helpins,self);
helpins := taicpu.op_reg_ref(A_LD,helpreg,spilltemplist[supreg]);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
loadreg(0,helpreg);
rgunget(list,helpins,helpreg);
forward_allocation(tai(helpins.next),unusedregsint);
{
writeln('spilling!');
list.insertafter(tai_comment.Create(strpnew('Spilling!')),helpins);
}
end;
for i := 1 to 2 do
if (oper[i].typ = top_reg) then
begin
supreg:=oper[i].reg.number shr 8;
if supreg in r then
begin
// Example:
// add r20d, r21d, r22d ; r20d must be spilled into -60(r1)
//
// Change into:
//
// lwz r23d, -60(r1)
// add r23d, r21d, r22d
// stw r23d, -60(r1)
pos := get_insert_pos(Tai(previous),reg1,reg2,reg3,unusedregsint);
rgget(list,pos,0,helpreg);
spill_registers := true;
helpins := taicpu.op_reg_ref(A_LD,helpreg,spilltemplist[supreg]);
if pos=nil then
list.insertafter(helpins,list.first)
else
list.insertafter(helpins,pos.next);
loadreg(i,helpreg);
rgunget(list,helpins,helpreg);
forward_allocation(tai(helpins.next),unusedregsint);
{
writeln('spilling!');
list.insertafter(tai_comment.Create(strpnew('Spilling!')),helpins);
}
end;
end;
end;
procedure InitAsm;
begin
end;
@ -262,7 +506,10 @@ implementation
end.
{
$Log$
Revision 1.30 2003-06-14 14:53:50 jonas
Revision 1.31 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.30 2003/06/14 14:53:50 jonas
* fixed newra cycle for x86
* added constants for indicating source and destination operands of the
"move reg,reg" instruction to aasmcpu (and use those in rgobj)

114
compiler/sparc/cpupara.pas
View File

@ -42,9 +42,6 @@ interface
procedure allocparaloc(list: taasmoutput; const loc: tparalocation);override;
procedure freeparaloc(list: taasmoutput; const loc: tparalocation);override;
procedure create_paraloc_info(p:TAbstractProcDef; side: tcallercallee);override;
{Returns the location where the invisible parameter for structured function
results will be passed.}
function GetFuncRetParaLoc(p:TAbstractProcDef):TParaLocation;override;
procedure splitparaloc64(const locpara:tparalocation;var loclopara,lochipara:tparalocation);override;
end;
@ -209,75 +206,71 @@ implementation
else
inc(stack_offset,4);
end;
if side = callerside then
hp.callerparaloc:=paraloc
else
hp.paraloc[side]:=paraloc;
if side = calleeside then
begin
{ update callee paraloc and use Ix registers instead
of Ox registers }
hp.calleeparaloc:=paraloc;
if hp.calleeparaloc.loc=LOC_REGISTER then
if hp.paraloc[calleeside].loc=LOC_REGISTER then
begin
{ big endian }
if is_64bit then
inc(hp.calleeparaloc.registerhigh.number,(RS_I0-RS_O0) shl 8);
inc(hp.calleeparaloc.registerlow.number,(RS_I0-RS_O0) shl 8);
inc(hp.paraloc[calleeside].registerhigh.number,(RS_I0-RS_O0) shl 8);
inc(hp.paraloc[calleeside].registerlow.number,(RS_I0-RS_O0) shl 8);
end
else
begin
if hp.calleeparaloc.low_in_reg then
inc(hp.calleeparaloc.lowreg.number,(RS_I0-RS_O0) shl 8);
inc(hp.calleeparaloc.reference.index.number,(RS_I0-RS_O0) shl 8);
if hp.paraloc[calleeside].low_in_reg then
inc(hp.paraloc[calleeside].lowreg.number,(RS_I0-RS_O0) shl 8);
inc(hp.paraloc[calleeside].reference.index.number,(RS_I0-RS_O0) shl 8);
end;
end;
hp:=TParaItem(hp.Next);
end;
end;
function tSparcParaManager.GetFuncRetParaLoc(p:TAbstractProcDef):TParaLocation;
begin
with GetFuncRetParaLoc do
begin
case p.rettype.def.deftype of
orddef,enumdef:
begin
loc:=LOC_REGISTER;
register.enum:=R_INTREGISTER;
register.number:=NR_FUNCTION_RETURN_REG;
size:=def_cgsize(p.rettype.def);
if size in [OS_S64,OS_64] then
internalerror(200305309);
end;
floatdef:
begin
loc:=LOC_FPUREGISTER;
register.enum:=R_F1;
size:=def_cgsize(p.rettype.def);
end;
setdef,
variantdef,
pointerdef,
formaldef,
classrefdef,
recorddef,
objectdef,
stringdef,
procvardef,
filedef,
arraydef,
errordef:
begin
loc:=LOC_REFERENCE;
reference.index.enum:=R_INTREGISTER;
reference.index.number:=NR_FRAME_POINTER_REG;
reference.offset:=64;
size:=OS_ADDR;
end;
else
internalerror(2002090903);
end;
end;
{ Function return }
fillchar(paraloc,sizeof(tparalocation),0);
paraloc.size:=def_cgsize(p.rettype.def);
{ Return in FPU register? }
if p.rettype.def.deftype=floatdef then
begin
paraloc.loc:=LOC_FPUREGISTER;
paraloc.register.enum:=FPU_RESULT_REG;
end
else
{ Return in register? }
if not ret_in_param(p.rettype.def,p.proccalloption) then
begin
paraloc.loc:=LOC_REGISTER;
{$ifndef cpu64bit}
if paraloc.size in [OS_64,OS_S64] then
begin
paraloc.register64.reglo.enum:=R_INTREGISTER;
if side=callerside then
paraloc.register64.reglo.number:=NR_FUNCTION_RESULT64_LOW_REG
else
paraloc.register64.reglo.number:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc.register64.reghi.enum:=R_INTREGISTER;
if side=callerside then
paraloc.register64.reghi.number:=NR_FUNCTION_RESULT64_HIGH_REG
else
paraloc.register64.reghi.number:=NR_FUNCTION_RETURN64_HIGH_REG;
end
else
{$endif cpu64bit}
begin
paraloc.register.enum:=R_INTREGISTER;
if side=callerside then
paraloc.register.number:=NR_FUNCTION_RESULT_REG
else
paraloc.register.number:=NR_FUNCTION_RETURN_REG;
end;
end
else
begin
paraloc.loc:=LOC_REFERENCE;
end;
p.funcret_paraloc[side]:=paraloc;
end;
@ -308,7 +301,10 @@ begin
end.
{
$Log$
Revision 1.26 2003-07-08 21:25:00 peter
Revision 1.27 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.26 2003/07/08 21:25:00 peter
* sparc fixes
Revision 1.25 2003/07/06 22:10:56 peter

22
compiler/sparc/rgcpu.pas
View File

@ -36,13 +36,16 @@ interface
type
trgcpu=class(trgobj)
function GetRegisterFpu(list:TAasmOutput;size:Tcgsize):TRegister;override;
function GetExplicitRegisterInt(list:taasmoutput;Reg:Tnewregister):tregister;override;
procedure UngetregisterInt(list:taasmoutput;Reg:tregister);override;
procedure UngetRegisterFpu(list:taasmoutput;reg:tregister;size:TCGsize);override;
procedure ClearTempGen;override;
{$ifndef NEWRA}
private
UsedParaRegs: TSupRegSet;
public
function GetExplicitRegisterInt(list:taasmoutput;Reg:Tnewregister):tregister;override;
procedure UngetregisterInt(list:taasmoutput;Reg:tregister);override;
{$endif NEWRA}
function GetRegisterFpu(list:TAasmOutput;size:Tcgsize):TRegister;override;
procedure UngetRegisterFpu(list:taasmoutput;reg:tregister;size:TCGsize);override;
procedure ClearTempGen;override;
end;
@ -52,6 +55,7 @@ implementation
cgobj,verbose;
{$ifndef NEWRA}
function TRgCpu.GetExplicitRegisterInt(list:TAasmOutput;reg:TNewRegister):TRegister;
begin
if ((reg shr 8) in [RS_O0..RS_O7,RS_I0..RS_I7]) then
@ -84,6 +88,7 @@ implementation
else
inherited ungetregisterint(list,reg);
end;
{$endif NEWRA}
function TRgCpu.GetRegisterFpu(list:TAasmOutput;size:Tcgsize):TRegister;
@ -144,7 +149,9 @@ implementation
procedure trgcpu.cleartempgen;
begin
inherited cleartempgen;
{$ifndef NEWRA}
usedpararegs:=[];
{$endif NEWRA}
end;
begin
@ -152,7 +159,10 @@ begin
end.
{
$Log$
Revision 1.15 2003-07-02 22:18:04 peter
Revision 1.16 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.15 2003/07/02 22:18:04 peter
* paraloc splitted in callerparaloc,calleeparaloc
* sparc calling convention updates

7
compiler/symconst.pas
View File

@ -165,6 +165,8 @@ type
normset,smallset,varset
);
tcallercallee = (callerside,calleeside);
{ basic type for tprocdef and tprocvardef }
tproctypeoption=(potype_none,
potype_proginit, { Program initialization }
@ -355,7 +357,10 @@ implementation
end.
{
$Log$
Revision 1.59 2003-08-10 17:25:23 peter
Revision 1.60 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.59 2003/08/10 17:25:23 peter
* fixed some reported bugs
Revision 1.58 2003/06/25 18:31:23 peter

9
compiler/symdef.pas
View File

@ -107,8 +107,7 @@ interface
defaultvalue : tsym; { tconstsym }
defaultvaluederef : tderef;
paratyp : tvarspez; { required for procvar }
calleeparaloc,
callerparaloc : tparalocation;
paraloc : array[tcallercallee] of tparalocation;
is_hidden : boolean; { is this a hidden (implicit) parameter }
{$ifdef EXTDEBUG}
eqval : tequaltype;
@ -429,6 +428,7 @@ interface
maxparacount,
minparacount : byte;
fpu_used : byte; { how many stack fpu must be empty }
funcret_paraloc : array[tcallercallee] of tparalocation;
has_paraloc_info : boolean; { paraloc info is available }
constructor create(level:byte);
constructor ppuload(ppufile:tcompilerppufile);
@ -5838,7 +5838,10 @@ implementation
end.
{
$Log$
Revision 1.157 2003-07-08 15:20:56 peter
Revision 1.158 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.157 2003/07/08 15:20:56 peter
* don't allow add/assignments for formaldef
* formaldef size changed to 0

77
compiler/x86/aasmcpu.pas
View File

@ -201,12 +201,14 @@ interface
procedure SetOperandOrder(order:TOperandOrder);
function is_nop:boolean;override;
function is_move:boolean;override;
{$ifdef NEWRA}
function spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
r:Tsupregset;
var unusedregsint:Tsupregset;
const spilltemplist:Tspill_temp_list):boolean;override;
{$endif}
protected
procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);override;
procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);override;
@ -1997,6 +1999,8 @@ implementation
((oper[0].typ=top_reg) and (oper[1].typ=top_reg));
end;
{$ifdef NEWRA}
function Taicpu.spill_registers(list:Taasmoutput;
rgget:Trggetproc;
rgunget:Trgungetproc;
@ -2009,64 +2013,6 @@ implementation
of the huge amount of situations you can have. The irregularity of the i386
instruction set doesn't help either. (DM)}
function get_insert_pos(p:Tai;huntfor1,huntfor2,huntfor3:Tsuperregister):Tai;
var back:Tsupregset;
begin
back:=unusedregsint;
get_insert_pos:=p;
while (p<>nil) and not (p.typ in [ait_instruction,ait_label]) do
begin
if p.typ=ait_regalloc then
begin
{Rewind the register allocation.}
if Tai_regalloc(p).allocation then
include(unusedregsint,Tai_regalloc(p).reg.number shr 8)
else
begin
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8);
if Tai_regalloc(p).reg.number shr 8=huntfor1 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
if Tai_regalloc(p).reg.number shr 8=huntfor2 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
if Tai_regalloc(p).reg.number shr 8=huntfor3 then
begin
get_insert_pos:=Tai(p.previous);
back:=unusedregsint;
end;
end;
end {else writeln('!!!!'^g,byte(p.typ))};
p:=Tai(p.previous);
end;
unusedregsint:=back;
end;
procedure forward_allocation(p:Tai);
begin
{Forward the register allocation again.}
while (p<>self) do
begin
if p.typ in [ait_instruction,ait_label] then
internalerror(200305311);
if p.typ=ait_regalloc then
begin
if Tai_regalloc(p).allocation then
exclude(unusedregsint,Tai_regalloc(p).reg.number shr 8)
else
include(unusedregsint,Tai_regalloc(p).reg.number shr 8);
end;
p:=Tai(p.next);
end;
end;
var i:byte;
supreg:Tsuperregister;
@ -2212,9 +2158,9 @@ implementation
begin
{Situation example:
add r20d,[r21d] ; r20d must be spilled into [ebp-12]
Change into:
mov r22d,[r21d] ; Use a help register
add [ebp-12],r22d ; Replace register by helpregister }
pos:=get_insert_pos(Tai(previous),oper[0].ref^.base.number shr 8,
@ -2248,9 +2194,9 @@ implementation
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
@ -2369,6 +2315,8 @@ implementation
end;
end;
end;
{$endif NEWRA}
{*****************************************************************************
Instruction table
@ -2419,7 +2367,10 @@ implementation
end.
{
$Log$
Revision 1.8 2003-08-09 18:56:54 daniel
Revision 1.9 2003-08-11 21:18:20 peter
* start of sparc support for newra
Revision 1.8 2003/08/09 18:56:54 daniel
* cs_regalloc renamed to cs_regvars to avoid confusion with register
allocator
* Some preventive changes to i386 spillinh code