paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-30 17:51:32 +01:00
Code Issues Packages Projects Releases Wiki Activity

* basics for x86 register calling

Browse Source
This commit is contained in:
peter 2003-09-09 21:03:17 +00:00
parent 49e539ac8d
commit 3a3d710c47
6 changed files with 282 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/defcmp.pas
View File

@ -813,7 +813,8 @@ implementation
begin
{ object pascal objects }
if (def_from.deftype=objectdef) and
tobjectdef(def_from).is_related(tobjectdef(def_to)) then
(tobjectdef(def_from).is_related(tobjectdef(def_to)) or
tobjectdef(def_to).is_related(tobjectdef(def_from))) then
begin
doconv:=tc_equal;
eq:=te_convert_l1;
@ -1209,7 +1210,10 @@ implementation
end.
{
$Log$
Revision 1.27 2003-06-03 21:02:08 peter
Revision 1.28 2003-09-09 21:03:17 peter
* basics for x86 register calling
Revision 1.27 2003/06/03 21:02:08 peter
* allow pointer(int64) in all modes
Revision 1.26 2003/05/26 21:17:17 peter

113
compiler/i386/cpupara.pas
View File

@ -51,6 +51,10 @@ unit cpupara;
function getparaloc(p : tdef) : tcgloc;
procedure create_paraloc_info(p : tabstractprocdef; side: tcallercallee);override;
function getselflocation(p : tabstractprocdef) : tparalocation;override;
private
procedure create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee);
procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee);
end;
implementation
@ -174,29 +178,10 @@ unit cpupara;
end;
procedure ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee);
procedure ti386paramanager.create_funcret_paraloc_info(p : tabstractprocdef; side: tcallercallee);
var
hp : tparaitem;
paraloc : tparalocation;
begin
hp:=tparaitem(p.para.first);
while assigned(hp) do
begin
if hp.paratyp in [vs_var,vs_out] then
paraloc.size:=OS_ADDR
else
paraloc.size:=def_cgsize(hp.paratype.def);
paraloc.loc:=LOC_REFERENCE;
if assigned(current_procinfo) then
paraloc.reference.index:=current_procinfo.framepointer
else
paraloc.reference.index:=NR_FRAME_POINTER_REG;
paraloc.reference.offset:=tvarsym(hp.parasym).adjusted_address;
hp.paraloc[side]:=paraloc;
{$warning callerparaloc shall not be the same as calleeparaloc}
hp:=tparaitem(hp.next);
end;
{ Function return }
fillchar(paraloc,sizeof(tparalocation),0);
paraloc.size:=def_cgsize(p.rettype.def);
@ -231,6 +216,89 @@ unit cpupara;
end;
procedure ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee);
var
hp : tparaitem;
paraloc : tparalocation;
begin
hp:=tparaitem(p.para.first);
while assigned(hp) do
begin
if hp.paratyp in [vs_var,vs_out] then
paraloc.size:=OS_ADDR
else
paraloc.size:=def_cgsize(hp.paratype.def);
paraloc.loc:=LOC_REFERENCE;
if assigned(current_procinfo) then
paraloc.reference.index:=current_procinfo.framepointer
else
paraloc.reference.index:=NR_FRAME_POINTER_REG;
paraloc.reference.offset:=tvarsym(hp.parasym).adjusted_address;
hp.paraloc[side]:=paraloc;
{$warning callerparaloc shall not be the same as calleeparaloc}
hp:=tparaitem(hp.next);
end;
end;
procedure ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee);
var
hp : tparaitem;
paraloc : tparalocation;
sr : tsuperregister;
subreg : tsubregister;
begin
sr:=RS_EAX;
hp:=tparaitem(p.para.first);
while assigned(hp) do
begin
if hp.paratyp in [vs_var,vs_out] then
paraloc.size:=OS_ADDR
else
paraloc.size:=def_cgsize(hp.paratype.def);
{
EAX
EDX
ECX
Stack
Stack
}
if sr<=NR_ECX then
begin
paraloc.loc:=LOC_REGISTER;
if paraloc.size=OS_NO then
subreg:=R_SUBWHOLE
else
subreg:=cgsize2subreg(paraloc.size);
paraloc.register:=newreg(R_INTREGISTER,sr,subreg);
inc(sr);
end
else
begin
paraloc.loc:=LOC_REFERENCE;
if assigned(current_procinfo) then
paraloc.reference.index:=current_procinfo.framepointer
else
paraloc.reference.index:=NR_FRAME_POINTER_REG;
paraloc.reference.offset:=tvarsym(hp.parasym).adjusted_address;
end;
hp.paraloc[side]:=paraloc;
{$warning callerparaloc shall not be the same as calleeparaloc}
hp:=tparaitem(hp.next);
end;
end;
procedure ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee);
begin
if p.proccalloption=pocall_register then
create_register_paraloc_info(p,side)
else
create_stdcall_paraloc_info(p,side);
create_funcret_paraloc_info(p,side);
end;
function ti386paramanager.getselflocation(p : tabstractprocdef) : tparalocation;
var
hsym : tvarsym;
@ -250,7 +318,10 @@ begin
end.
{
$Log$
Revision 1.26 2003-09-09 15:55:05 peter
Revision 1.27 2003-09-09 21:03:17 peter
* basics for x86 register calling
Revision 1.26 2003/09/09 15:55:05 peter
* winapi doesn't like pushing 8 byte record
Revision 1.25 2003/09/08 18:28:51 peter

12
compiler/i386/cpupi.pas
View File

@ -35,6 +35,7 @@ unit cpupi;
ti386procinfo = class(tcgprocinfo)
procedure allocate_interrupt_parameter;override;
procedure allocate_framepointer_reg;override;
procedure handle_body_start;override;
end;
@ -64,12 +65,21 @@ unit cpupi;
end;
procedure ti386procinfo.handle_body_start;
begin
inherited handle_body_start;
end;
begin
cprocinfo:=ti386procinfo;
end.
{
$Log$
Revision 1.10 2003-09-03 15:55:01 peter
Revision 1.11 2003-09-09 21:03:17 peter
* basics for x86 register calling
Revision 1.10 2003/09/03 15:55:01 peter
* NEWRA branch merged
Revision 1.9.2.1 2003/08/31 15:46:26 peter

49
compiler/pdecsub.pas
View File

@ -1699,7 +1699,8 @@ const
end;
pocall_register :
begin
Message1(parser_w_proc_directive_ignored,'REGISTER');
{ Adjust alignment to match cdecl or stdcall }
pd.parast.dataalignment:=std_param_align;
end;
pocall_far16 :
begin
@ -1758,6 +1759,11 @@ const
var
currpara : tparaitem;
st : tsymtable;
{$ifdef i386}
orgs : stringid;
vs : tvarsym;
n : integer;
{$endif i386}
begin
{ insert hidden high parameters }
insert_hidden_para(pd);
@ -1766,6 +1772,41 @@ const
{ insert funcret parameter if required }
insert_funcret_para(pd);
{$ifdef i386}
{ Move first 3 register parameters in localst }
if (pd.deftype=procdef) and
(pd.proccalloption=pocall_register) and
not(po_assembler in pd.procoptions) and
assigned(pd.para.first) then
begin
{ insert copy in localst }
if not assigned(tprocdef(pd).localst) then
tprocdef(pd).insert_localst;
n:=0;
currpara:=tparaitem(pd.para.first);
while assigned(currpara) and (n<3) do
begin
orgs:=currpara.parasym.realname;
if not(assigned(currpara.parasym) and (currpara.parasym.typ=varsym)) then
internalerror(200304232);
{ rename parameter in parast }
pd.parast.rename(currpara.parasym.name,'reg'+currpara.parasym.name);
include(tvarsym(currpara.parasym).varoptions,vo_is_reg_para);
vs:=tvarsym.create(orgs,currpara.paratyp,currpara.paratype);
vs.varoptions:=tvarsym(currpara.parasym).varoptions;
include(vs.varoptions,vo_is_reg_para);
tprocdef(pd).localst.insert(vs);
tprocdef(pd).localst.insertvardata(vs);
{ update currpara }
currpara.parasym:=vs;
{ next }
currpara:=tparaitem(currpara.next);
inc(n);
end;
end;
{$endif i386}
if (pd.deftype=procdef) then
begin
{ rename value parameters that need a local copy to valXXX,
@ -1796,6 +1837,7 @@ const
begin
if not(assigned(currpara.parasym) and (currpara.parasym.typ=varsym)) then
internalerror(200304232);
if not(vo_is_reg_para in tvarsym(currpara.parasym).varoptions) then
st.insertvardata(currpara.parasym);
currpara:=tparaitem(currpara.next);
end;
@ -2148,7 +2190,10 @@ const
end.
{
$Log$
Revision 1.132 2003-09-09 15:54:10 peter
Revision 1.133 2003-09-09 21:03:17 peter
* basics for x86 register calling
Revision 1.132 2003/09/09 15:54:10 peter
* calling convention fix
Revision 1.131 2003/09/07 22:09:35 peter

8
compiler/symconst.pas
View File

@ -256,7 +256,8 @@ type
vo_is_funcret,
vo_is_self,
vo_is_vmt,
vo_is_result { special result variable }
vo_is_result, { special result variable }
vo_is_reg_para { register parameter, no space allocation in parast, but in localst }
);
tvaroptions=set of tvaroption;
@ -373,7 +374,10 @@ implementation
end.
{
$Log$
Revision 1.62 2003-09-09 15:54:10 peter
Revision 1.63 2003-09-09 21:03:17 peter
* basics for x86 register calling
Revision 1.62 2003/09/09 15:54:10 peter
* calling convention fix
Revision 1.61 2003/09/07 22:09:35 peter

68
compiler/x86/cgx86.pas
View File

@ -356,6 +356,11 @@ unit cgx86;
procedure tcgx86.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);
begin
check_register_size(size,r);
case locpara.loc of
LOC_REGISTER :
cg.a_load_reg_reg(list,size,locpara.size,r,locpara.register);
LOC_REFERENCE :
begin
case size of
OS_8,OS_S8,
OS_16,OS_S16:
@ -376,10 +381,19 @@ unit cgx86;
internalerror(2002032212);
end;
end;
else
internalerror(200309082);
end;
end;
procedure tcgx86.a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);
begin
case locpara.loc of
LOC_REGISTER :
cg.a_load_const_reg(list,locpara.size,a,locpara.register);
LOC_REFERENCE :
begin
case size of
OS_8,OS_S8,OS_16,OS_S16:
@ -395,6 +409,10 @@ unit cgx86;
internalerror(2002032213);
end;
end;
else
internalerror(200309082);
end;
end;
procedure tcgx86.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
@ -403,6 +421,11 @@ unit cgx86;
pushsize : tcgsize;
tmpreg : tregister;
begin
case locpara.loc of
LOC_REGISTER :
cg.a_load_ref_reg(list,size,locpara.size,r,locpara.register);
LOC_REFERENCE :
begin
case size of
OS_8,OS_S8,
@ -419,34 +442,58 @@ unit cgx86;
end;
OS_32,OS_S32:
list.concat(taicpu.op_ref(A_PUSH,S_L,r));
{$ifdef cpu64bit}
OS_64,OS_S64:
list.concat(taicpu.op_ref(A_PUSH,S_Q,r));
{$endif cpu64bit}
else
internalerror(2002032214);
end;
end;
else
internalerror(200309083);
end;
end;
procedure tcgx86.a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
var
tmpreg : tregister;
baseno,indexno:boolean;
begin
if (r.segment<>NR_NO) then
CGMessage(cg_e_cant_use_far_pointer_there);
baseno:=(r.base=NR_NO);
indexno:=(r.index=NR_NO);
if baseno and indexno then
case locpara.loc of
LOC_REGISTER :
begin
if (r.base=NR_NO) and (r.index=NR_NO) then
begin
if assigned(r.symbol) then
list.concat(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,r.symbol,r.offset,locpara.register))
else
a_load_const_reg(list,OS_INT,r.offset,locpara.register);
end
else if (r.base=NR_NO) and (r.index<>NR_NO) and
(r.offset=0) and (r.scalefactor=0) and (r.symbol=nil) then
a_load_reg_reg(list,OS_INT,OS_INT,r.index,locpara.register)
else if (r.base<>NR_NO) and (r.index=NR_NO) and
(r.offset=0) and (r.symbol=nil) then
a_load_reg_reg(list,OS_INT,OS_INT,r.base,locpara.register)
else
a_loadaddr_ref_reg(list,r,locpara.register);
end;
LOC_REFERENCE :
begin
if (r.base=NR_NO) and (r.index=NR_NO) then
begin
if assigned(r.symbol) then
list.concat(Taicpu.Op_sym_ofs(A_PUSH,S_L,r.symbol,r.offset))
else
list.concat(Taicpu.Op_const(A_PUSH,S_L,r.offset));
end
else if baseno and not indexno and
else if (r.base=NR_NO) and (r.index<>NR_NO) and
(r.offset=0) and (r.scalefactor=0) and (r.symbol=nil) then
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.index))
else if not baseno and indexno and
else if (r.base<>NR_NO) and (r.index=NR_NO) and
(r.offset=0) and (r.symbol=nil) then
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r.base))
else
@ -457,6 +504,10 @@ unit cgx86;
rg.ungetregisterint(list,tmpreg);
end;
end;
else
internalerror(200309084);
end;
end;
procedure tcgx86.a_call_name(list : taasmoutput;const s : string);
@ -1572,7 +1623,10 @@ unit cgx86;
end.
{
$Log$
Revision 1.62 2003-09-09 20:59:27 daniel
Revision 1.63 2003-09-09 21:03:17 peter
* basics for x86 register calling
Revision 1.62 2003/09/09 20:59:27 daniel
* Adding register allocation order
Revision 1.61 2003/09/07 22:09:35 peter