paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 21:09:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

* register allocation for parameters now done in cpupara, but InternalError(200109223) in cgcpu.pas:1053 is still not fixed du to location_force problem in ncgutils.pas:419

Browse Source
This commit is contained in:
mazen 2002-10-04 21:57:42 +00:00
parent 536f3971b8
commit 3d9be081b9
3 changed files with 302 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

142
compiler/sparc/cgcpu.pas
View File

@ -38,7 +38,6 @@ USES
TYPE
tcgSPARC=CLASS(tcg)
FreeParamRegSet:TRegisterSet;
constructor Create;
{This method is used to pass a parameter, which is located in a register, to a
routine. It should give the parameter to the routine, as required by the
specific processor ABI. It is overriden for each CPU target.
@ -48,7 +47,7 @@ specific processor ABI. It is overriden for each CPU target.
from one from left to right}
procedure a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;const LocPara:TParaLocation);override;
PROCEDURE a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST LocPara:TParaLocation);override;
PROCEDURE a_param_ref(list:TAasmOutput;size:tcgsize;CONST r:TReference;CONST LocPara:TParaLocation);override;
procedure a_param_ref(list:TAasmOutput;size:tcgsize;CONST r:TReference;CONST LocPara:TParaLocation);override;
PROCEDURE a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);override;
PROCEDURE a_call_name(list:TAasmOutput;CONST s:string);override;
PROCEDURE a_call_ref(list:TAasmOutput;CONST ref:TReference);override;
@ -111,7 +110,7 @@ USES
globtype,globals,verbose,systems,cutils,
symdef,symsym,defbase,paramgr,
rgobj,tgobj,rgcpu;
function GetFreeParamReg(var FreeParamRegSet:TRegisterSet):TRegister;
{function GetFreeParamReg(var FreeParamRegSet:TRegisterSet):TRegister;
begin
if FreeParamRegSet=[]
then
@ -126,7 +125,7 @@ constructor tcgSPARC.Create;
begin
inherited Create;
FreeParamRegSet:=[R_O0..R_O5];
end;
end;}
{ we implement the following routines because otherwise we can't }
{ instantiate the class since it's abstract }
PROCEDURE tcgSPARC.a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;CONST LocPara:TParaLocation);
@ -145,16 +144,40 @@ PROCEDURE tcgSPARC.a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST Loc
END;
procedure tcgSPARC.a_param_ref(list:TAasmOutput;size:tcgsize;const r:TReference;const LocPara:TParaLocation);
var
ref: treference;
tmpreg:TRegister;
begin
if((Size=OS_32)and(Size=OS_S32))
if Size<>OS_32
then
InternalError(2002032214);
tmpReg:=GetFreeParamReg(FreeParamRegSet);
if tmpReg=R_NONE
InternalError(2002100400);
case locpara.loc of
LOC_REGISTER,LOC_CREGISTER:
a_load_ref_reg(list,size,r,locpara.register);
LOC_REFERENCE:
begin
reference_reset(ref);
ref.base:=locpara.reference.index;
ref.offset:=locpara.reference.offset;
tmpreg := get_scratch_reg_int(list);
a_load_ref_reg(list,size,r,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
free_scratch_reg(list,tmpreg);
end;
LOC_FPUREGISTER,LOC_CFPUREGISTER:
case size of
OS_32:
a_loadfpu_ref_reg(list,OS_F32,r,locpara.register);
OS_64:
a_loadfpu_ref_reg(list,OS_F64,r,locpara.register);
else
internalerror(2002072801);
end;
else
internalerror(2002081103);
end;
if locpara.sp_fixup<>0
then
InternalError(200210030020);
list.concat(taicpu.op_ref_reg(A_LD,S_L,r,tmpReg));
internalerror(2002081104);
end;
PROCEDURE tcgSPARC.a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);
VAR
@ -221,15 +244,14 @@ PROCEDURE tcgSPARC.a_load_reg_ref(list:TAasmOutput;size:TCGSize;reg:tregister;CO
BEGIN
list.concat(taicpu.op_reg_ref(A_LD,TCGSize2OpSize[size],reg,ref));
END;
PROCEDURE tcgSPARC.a_load_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister);
VAR
op:tasmop;
s:topsize;
begin
sizes2load(size,S_L,op,s);
list.concat(taicpu.op_ref_reg(op,s,ref,reg));
end;
procedure tcgSPARC.a_load_ref_reg(list:TAasmOutput;size:tcgsize;const ref:TReference;reg:tregister);
var
op:tasmop;
s:topsize;
begin
sizes2load(size,S_L,op,s);
list.concat(taicpu.op_ref_reg(op,s,ref,reg));
end;
PROCEDURE tcgSPARC.a_load_reg_reg(list:TAasmOutput;fromsize,size:tcgsize;reg1,reg2:tregister);
@ -1001,40 +1023,49 @@ PROCEDURE tcgSPARC.a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tr
{***************** This is private property, keep out! :) *****************}
PROCEDURE tcgSPARC.sizes2load(s1:tcgsize;s2:topsize;VAR op:tasmop;VAR s3:topsize);
BEGIN
{ case s2 of
S_B:
if S1 in [OS_8,OS_S8] then
s3 := S_B
else internalerror(200109221);
S_W:
case s1 of
OS_8,OS_S8:
s3 := S_BW;
OS_16,OS_S16:
s3 := S_W;
else internalerror(200109222);
end;
S_L:
case s1 of
OS_8,OS_S8:
s3 := S_BL;
OS_16,OS_S16:
s3 := S_WL;
OS_32,OS_S32:
s3 := S_L;
else internalerror(200109223);
end;
else internalerror(200109227);
end;
if s3 in [S_B,S_W,S_L] then
op := A_NONE
else if s1 in [OS_8,OS_16,OS_32] then
op := A_NONEZX
else
op := A_NONESX;}
END;
procedure tcgSPARC.sizes2load(s1:tcgsize;s2:topsize;var op:tasmop;var s3:topsize);
begin
case s2 of
S_B:
if S1 in [OS_8,OS_S8]
then
s3 := S_B
else
internalerror(200109221);
S_W:
case s1 of
OS_8,OS_S8:
s3 := S_BW;
OS_16,OS_S16:
s3 := S_W;
else
internalerror(200109222);
end;
S_L:
case s1 of
OS_8,OS_S8:
s3 := S_BL;
OS_16,OS_S16:
s3 := S_WL;
OS_32,OS_S32:
s3 := S_L;
else
internalerror(200109223);
end;
else internalerror(200109227);
end;
if s3 in [S_B,S_W,S_L]
then
op := A_LD
{ else if s3=S_DW
then
op:=A_LDD
else if s3 in [OS_8,OS_16,OS_32]
then
op := A_NONE}
else
op := A_NONE;
end;
PROCEDURE tcgSPARC.floatloadops(t:tcgsize;VAR op:tasmop;VAR s:topsize);
BEGIN
(* case t of
@ -1104,7 +1135,10 @@ BEGIN
END.
{
$Log$
Revision 1.9 2002-10-02 22:20:28 mazen
Revision 1.10 2002-10-04 21:57:42 mazen
* register allocation for parameters now done in cpupara, but InternalError(200109223) in cgcpu.pas:1053 is still not fixed du to location_force problem in ncgutils.pas:419
Revision 1.9 2002/10/02 22:20:28 mazen
+ out registers allocator for the first 6 scalar parameters which must be passed into %o0..%o5
Revision 1.8 2002/10/01 21:35:58 mazen

260
compiler/sparc/cpupara.pas
View File

@ -27,47 +27,51 @@
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************}
UNIT cpupara;
unit cpupara;
{SPARC specific calling conventions are handled by this unit}
{$INCLUDE fpcdefs.inc}
INTERFACE
USES
cpubase,
symconst,symbase,symdef,paramgr;
TYPE
TSparcParaManager=CLASS(TParaManager)
FUNCTION getintparaloc(nr:longint):tparalocation;OVERRIDE;
PROCEDURE create_param_loc_info(p:tabstractprocdef);OVERRIDE;
FUNCTION GetSelfLocation(p:tabstractprocdef):tparalocation;OVERRIDE;
end;
IMPLEMENTATION
USES
verbose,
cpuinfo,
symtype;
FUNCTION TSparcParaManager.getintparaloc(nr : longint) : tparalocation;
BEGIN
fillchar(result,sizeof(tparalocation),0);
if nr<1
then
internalerror(2002070801)
else if nr<=8
then
BEGIN
result.loc:=LOC_REGISTER;
result.register:=tregister(longint(R_O0)+nr);
end
else
BEGIN
interface
uses
cpubase,
symconst,symbase,symtype,symdef,paramgr;
type
tSparcparamanager = class(tparamanager)
function getintparaloc(nr : longint) : tparalocation;override;
procedure create_param_loc_info(p : tabstractprocdef);override;
function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
end;
implementation
uses
verbose,
globtype,
cpuinfo,cginfo,cgbase,
defbase;
function tSparcparamanager.getintparaloc(nr : longint) : tparalocation;
begin
fillchar(result,sizeof(tparalocation),0);
if nr<1 then
internalerror(2002070801)
else if nr<=8 then
begin
result.loc:=LOC_REGISTER;
result.register:=tregister(longint(R_O0)+nr);
end
else
begin
result.loc:=LOC_REFERENCE;
result.reference.index:=stack_pointer_reg;
result.reference.offset:=(nr-8)*4;
end;
end;
FUNCTION getparaloc(p : tdef) : tloc;
function getparaloc(p : tdef) : tloc;
BEGIN
begin
{ Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
if push_addr_param for the def is true
}
case p.deftype of
orddef:
getparaloc:=LOC_REGISTER;
@ -77,26 +81,66 @@ FUNCTION TSparcParaManager.getintparaloc(nr : longint) : tparalocation;
getparaloc:=LOC_REGISTER;
pointerdef:
getparaloc:=LOC_REGISTER;
formaldef:
getparaloc:=LOC_REGISTER;
classrefdef:
getparaloc:=LOC_REGISTER;
recorddef:
getparaloc:=LOC_REFERENCE;
objectdef:
if is_object(p) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
stringdef:
if is_shortstring(p) or is_longstring(p) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
procvardef:
if (po_methodpointer in tprocvardef(p).procoptions) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
filedef:
getparaloc:=LOC_REGISTER;
arraydef:
getparaloc:=LOC_REFERENCE;
setdef:
if is_smallset(p) then
getparaloc:=LOC_REGISTER
else
getparaloc:=LOC_REFERENCE;
variantdef:
getparaloc:=LOC_REFERENCE;
{ avoid problems with errornous definitions }
errordef:
getparaloc:=LOC_REGISTER;
else
internalerror(2002071001);
end;
end;
PROCEDURE TSparcParaManager.create_param_loc_info(p : tabstractprocdef);
procedure tSparcparamanager.create_param_loc_info(p : tabstractprocdef);
var
nextintreg,nextfloatreg,nextmmreg : tregister;
stack_offset : aword;
hp : tparaitem;
loc : tloc;
is_64bit: boolean;
BEGIN
nextintreg:=R_G3;
begin
nextintreg:=R_O3;
nextfloatreg:=R_F1;
nextmmreg:=R_L1;
nextmmreg:=R_NONE;
stack_offset:=0;
{ pointer for structured results ? }
{ !!!nextintreg:=R_4; }
if not is_void(p.rettype.def) then
begin
if not(ret_in_reg(p.rettype.def)) then
inc(nextintreg);
end;
{ frame pointer for nested procedures? }
{ inc(nextintreg); }
@ -104,21 +148,97 @@ FUNCTION TSparcParaManager.getintparaloc(nr : longint) : tparalocation;
{ destructor? }
hp:=tparaitem(p.para.last);
while assigned(hp) do
BEGIN
begin
loc:=getparaloc(hp.paratype.def);
hp.paraloc.sp_fixup:=0;
case loc of
LOC_REGISTER:
BEGIN
if nextintreg<=R_I7 then
BEGIN
begin
hp.paraloc.size := def_cgsize(hp.paratype.def);
{ for things like formaldef }
if hp.paraloc.size = OS_NO then
hp.paraloc.size := OS_ADDR;
is_64bit := hp.paraloc.size in [OS_64,OS_S64];
if nextintreg<=tregister(ord(R_O4)-ord(is_64bit)) then
begin
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.register:=nextintreg;
hp.paraloc.registerlow:=nextintreg;
inc(nextintreg);
if is_64bit then
begin
hp.paraloc.registerhigh:=nextintreg;
inc(nextintreg);
end;
end
else
BEGIN
begin
nextintreg := R_O5;
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
if not is_64bit then
inc(stack_offset,4)
else
inc(stack_offset,8);
end;
end;
LOC_FPUREGISTER:
begin
if hp.paratyp in [vs_var,vs_out] then
begin
if nextintreg<=R_O5 then
begin
hp.paraloc.size:=OS_ADDR;
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.register:=nextintreg;
inc(nextintreg);
end
else
begin
{!!!!!!!}
hp.paraloc.size:=def_cgsize(hp.paratype.def);
internalerror(2002071006);
end;
end
else if nextfloatreg<=R_F10 then
begin
hp.paraloc.size:=def_cgsize(hp.paratype.def);
hp.paraloc.loc:=LOC_FPUREGISTER;
hp.paraloc.register:=nextfloatreg;
inc(nextfloatreg);
end
else
begin
{!!!!!!!}
internalerror(2002071003);
hp.paraloc.size:=def_cgsize(hp.paratype.def);
internalerror(2002071004);
end;
end;
LOC_REFERENCE:
begin
hp.paraloc.size:=OS_ADDR;
if push_addr_param(hp.paratype.def,p.proccalloption in [pocall_cdecl,pocall_cppdecl]) or (hp.paratyp in [vs_var,vs_out]) then
begin
if nextintreg<=R_O5 then
begin
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.register:=nextintreg;
inc(nextintreg);
end
else
begin
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
inc(stack_offset,4);
end;
end
else
begin
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
inc(stack_offset,hp.paratype.def.size);
end;
end;
else
@ -128,19 +248,57 @@ FUNCTION TSparcParaManager.getintparaloc(nr : longint) : tparalocation;
end;
end;
FUNCTION TSparcParaManager.GetSelfLocation(p:tabstractprocdef):tparalocation;
BEGIN
getselflocation.loc:=LOC_REFERENCE;
getselflocation.reference.index:=R_G3{R_ESP};
getselflocation.reference.offset:=4;
END;
function tSparcparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
begin
case p.rettype.def.deftype of
orddef,
enumdef:
begin
getfuncretparaloc.loc:=LOC_REGISTER;
getfuncretparaloc.register:=R_O0;
getfuncretparaloc.size:=def_cgsize(p.rettype.def);
if getfuncretparaloc.size in [OS_S64,OS_64] then
getfuncretparaloc.registerhigh:=R_O1;
end;
floatdef:
begin
getfuncretparaloc.loc:=LOC_FPUREGISTER;
getfuncretparaloc.register:=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,
stringdef,
procvardef,
filedef,
arraydef,
errordef:
begin
getfuncretparaloc.loc:=LOC_REGISTER;
getfuncretparaloc.register:=R_O0;
getfuncretparaloc.size:=OS_ADDR;
end;
else
internalerror(2002090903);
end;
end;
BEGIN
paramanager:=TSparcParaManager.create;
end.
{
$Log$
Revision 1.1 2002-08-21 13:30:07 mazen
Revision 1.2 2002-10-04 21:57:42 mazen
* register allocation for parameters now done in cpupara, but InternalError(200109223) in cgcpu.pas:1053 is still not fixed du to location_force problem in ncgutils.pas:419
Revision 1.1 2002/08/21 13:30:07 mazen
*** empty log message ***
Revision 1.2 2002/07/11 14:41:34 florian

7
compiler/systems/i_linux.pas
View File

@ -388,7 +388,7 @@ unit i_linux;
ar : ar_gnu_ar;
res : res_none;
script : script_unix;
endian : endian_little;
endian : endian_big;
alignment :
(
procalign : 4;
@ -446,7 +446,10 @@ initialization
end.
{
$Log$
Revision 1.1 2002-09-06 15:03:51 carl
Revision 1.2 2002-10-04 21:57:42 mazen
* register allocation for parameters now done in cpupara, but InternalError(200109223) in cgcpu.pas:1053 is still not fixed du to location_force problem in ncgutils.pas:419
Revision 1.1 2002/09/06 15:03:51 carl
* moved files to systems directory
Revision 1.3 2002/08/13 18:01:51 carl