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

* Patch from Peter for paraloc

Browse Source
This commit is contained in:
marco 2003-09-10 08:31:47 +00:00
parent 3a3d710c47
commit cd5ae5fcc3
11 changed files with 360 additions and 198 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

140
compiler/cgobj.pas
View File

@ -1134,21 +1134,29 @@ unit cgobj;
procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
var
paraloc1,paraloc2,paraloc3 : tparalocation;
begin
{$ifdef FPC}
{$warning FIX ME!}
{$endif}
a_paramaddr_ref(list,dest,paramanager.getintparaloc(list,3));
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paraloc3:=paramanager.getintparaloc(pocall_default,3);
paramanager.allocparaloc(list,paraloc3);
a_paramaddr_ref(list,dest,paraloc3);
paramanager.allocparaloc(list,paraloc2);
if loadref then
a_param_ref(list,OS_ADDR,source,paramanager.getintparaloc(list,2))
a_param_ref(list,OS_ADDR,source,paraloc2)
else
a_paramaddr_ref(list,source,paramanager.getintparaloc(list,2));
a_paramaddr_ref(list,source,paraloc2);
if delsource then
reference_release(list,source);
a_param_const(list,OS_INT,len,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,3);
paramanager.freeintparaloc(list,2);
paramanager.freeintparaloc(list,1);
paramanager.allocparaloc(list,paraloc1);
a_param_const(list,OS_INT,len,paraloc1);
paramanager.freeparaloc(list,paraloc3);
paramanager.freeparaloc(list,paraloc2);
paramanager.freeparaloc(list,paraloc1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
a_call_name(list,'FPC_SHORTSTR_ASSIGN');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
@ -1159,7 +1167,10 @@ unit cgobj;
var
href : treference;
incrfunc : string;
paraloc1,paraloc2 : tparalocation;
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
{ These functions should not change the registers (they use
the saveregister proc directive }
if is_interfacecom(t) then
@ -1176,8 +1187,9 @@ unit cgobj;
if incrfunc<>'' then
begin
{ these functions get the pointer by value }
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,1);
paramanager.allocparaloc(list,paraloc1);
a_param_ref(list,OS_ADDR,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
a_call_name(list,incrfunc);
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
@ -1185,13 +1197,15 @@ unit cgobj;
else
begin
reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
paramanager.allocparaloc(list,paraloc2);
a_paramaddr_ref(list,href,paraloc2);
paramanager.allocparaloc(list,paraloc1);
if loadref then
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
a_param_ref(list,OS_ADDR,ref,paraloc1)
else
a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,1);
paramanager.freeintparaloc(list,2);
a_paramaddr_ref(list,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
paramanager.freeparaloc(list,paraloc2);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
a_call_name(list,'FPC_ADDREF');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
@ -1204,7 +1218,10 @@ unit cgobj;
href : treference;
decrfunc : string;
needrtti : boolean;
paraloc1,paraloc2 : tparalocation;
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
needrtti:=false;
if is_interfacecom(t) then
decrfunc:='FPC_INTF_DECR_REF'
@ -1225,29 +1242,33 @@ unit cgobj;
if needrtti then
begin
reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
paramanager.allocparaloc(list,paraloc2);
a_paramaddr_ref(list,href,paraloc2);
end;
paramanager.allocparaloc(list,paraloc1);
if loadref then
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
a_param_ref(list,OS_ADDR,ref,paraloc1)
else
a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,1);
a_paramaddr_ref(list,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
if needrtti then
paramanager.freeparaloc(list,paraloc2);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
a_call_name(list,decrfunc);
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
if needrtti then
paramanager.freeintparaloc(list,2);
end
else
begin
reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
paramanager.allocparaloc(list,paraloc2);
a_paramaddr_ref(list,href,paraloc2);
paramanager.allocparaloc(list,paraloc1);
if loadref then
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
a_param_ref(list,OS_ADDR,ref,paraloc1)
else
a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,1);
paramanager.freeintparaloc(list,2);
a_paramaddr_ref(list,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
paramanager.freeparaloc(list,paraloc2);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
a_call_name(list,'FPC_DECREF');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
@ -1258,7 +1279,10 @@ unit cgobj;
procedure tcg.g_initialize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
var
href : treference;
paraloc1,paraloc2 : tparalocation;
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
if is_ansistring(t) or
is_widestring(t) or
is_interfacecom(t) then
@ -1266,13 +1290,15 @@ unit cgobj;
else
begin
reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
paramanager.allocparaloc(list,paraloc2);
a_paramaddr_ref(list,href,paraloc2);
paramanager.allocparaloc(list,paraloc1);
if loadref then
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
a_param_ref(list,OS_ADDR,ref,paraloc1)
else
a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,1);
paramanager.freeintparaloc(list,2);
a_paramaddr_ref(list,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
paramanager.freeparaloc(list,paraloc2);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
a_call_name(list,'FPC_INITIALIZE');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
@ -1283,7 +1309,10 @@ unit cgobj;
procedure tcg.g_finalize(list : taasmoutput;t : tdef;const ref : treference;loadref : boolean);
var
href : treference;
paraloc1,paraloc2 : tparalocation;
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
if is_ansistring(t) or
is_widestring(t) or
is_interfacecom(t) then
@ -1291,13 +1320,15 @@ unit cgobj;
else
begin
reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
paramanager.allocparaloc(list,paraloc2);
a_paramaddr_ref(list,href,paraloc2);
paramanager.allocparaloc(list,paraloc1);
if loadref then
a_param_ref(list,OS_ADDR,ref,paramanager.getintparaloc(list,1))
a_param_ref(list,OS_ADDR,ref,paraloc1)
else
a_paramaddr_ref(list,ref,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,1);
paramanager.freeintparaloc(list,2);
a_paramaddr_ref(list,ref,paraloc1);
paramanager.freeparaloc(list,paraloc1);
paramanager.freeparaloc(list,paraloc2);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
a_call_name(list,'FPC_FINALIZE');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
@ -1416,11 +1447,14 @@ unit cgobj;
procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
var
paraloc1 : tparalocation;
begin
a_param_const(list,OS_32,stackframesize,paramanager.getintparaloc(list,1));
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(list,paraloc1);
a_param_const(list,OS_32,stackframesize,paraloc1);
paramanager.freeparaloc(list,paraloc1);
a_call_name(list,'FPC_STACKCHECK');
paramanager.freeintparaloc(list,1);
end;
@ -1439,15 +1473,18 @@ unit cgobj;
procedure tcg.g_maybe_testself(list : taasmoutput;reg:tregister);
var
OKLabel : tasmlabel;
paraloc1 : tparalocation;
begin
if (cs_check_object in aktlocalswitches) or
(cs_check_range in aktlocalswitches) then
begin
objectlibrary.getlabel(oklabel);
a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
a_param_const(list,OS_INT,210,paramanager.getintparaloc(list,1));
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(list,paraloc1);
a_param_const(list,OS_INT,210,paraloc1);
paramanager.freeparaloc(list,paraloc1);
a_call_name(list,'FPC_HANDLEERROR');
paramanager.freeintparaloc(list,1);
a_label(list,oklabel);
end;
end;
@ -1456,14 +1493,19 @@ unit cgobj;
procedure tcg.g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef);
var
hrefvmt : treference;
paraloc1,paraloc2 : tparalocation;
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
if (cs_check_object in aktlocalswitches) then
begin
reference_reset_symbol(hrefvmt,objectlibrary.newasmsymboldata(objdef.vmt_mangledname),0);
a_paramaddr_ref(list,hrefvmt,paramanager.getintparaloc(list,2));
a_param_reg(list,OS_ADDR,reg,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,2);
paramanager.freeintparaloc(list,1);
paramanager.allocparaloc(list,paraloc2);
a_paramaddr_ref(list,hrefvmt,paraloc2);
paramanager.allocparaloc(list,paraloc1);
a_param_reg(list,OS_ADDR,reg,paraloc1);
paramanager.freeparaloc(list,paraloc1);
paramanager.freeparaloc(list,paraloc2);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
a_call_name(list,'FPC_CHECK_OBJECT_EXT');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
@ -1471,8 +1513,9 @@ unit cgobj;
else
if (cs_check_range in aktlocalswitches) then
begin
a_param_reg(list,OS_ADDR,reg,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,1);
paramanager.allocparaloc(list,paraloc1);
a_param_reg(list,OS_ADDR,reg,paraloc1);
paramanager.freeparaloc(list,paraloc1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
a_call_name(list,'FPC_CHECK_OBJECT');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
@ -1539,7 +1582,10 @@ finalization
end.
{
$Log$
Revision 1.120 2003-09-09 20:59:27 daniel
Revision 1.121 2003-09-10 08:31:47 marco
* Patch from Peter for paraloc
Revision 1.120 2003/09/09 20:59:27 daniel
* Adding register allocation order
Revision 1.119 2003/09/07 22:09:34 peter

46
compiler/i386/cpupara.pas
View File

@ -46,9 +46,7 @@ unit cpupara;
function push_addr_param(def : tdef;calloption : tproccalloption) : boolean;override;
function get_volatile_registers_int(calloption : tproccalloption):tsuperregisterset;override;
function get_volatile_registers_fpu(calloption : tproccalloption):tsuperregisterset;override;
function getintparaloc(list: taasmoutput; nr : longint) : tparalocation;override;
procedure freeintparaloc(list: taasmoutput; nr : longint); override;
function getparaloc(p : tdef) : tcgloc;
function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
procedure create_paraloc_info(p : tabstractprocdef; side: tcallercallee);override;
function getselflocation(p : tabstractprocdef) : tparalocation;override;
private
@ -158,23 +156,28 @@ unit cpupara;
end;
function ti386paramanager.getintparaloc(list: taasmoutput; nr : longint) : tparalocation;
function ti386paramanager.getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;
begin
getintparaloc.loc:=LOC_REFERENCE;
getintparaloc.reference.index:=NR_EBP;
getintparaloc.reference.offset:=4*nr;
end;
procedure ti386paramanager.freeintparaloc(list: taasmoutput; nr : longint);
begin
{ nothing to release }
end;
function ti386paramanager.getparaloc(p : tdef) : tcgloc;
begin
result:=LOC_REFERENCE;
if calloption=pocall_register then
begin
if nr<=3 then
begin
getintparaloc.loc:=LOC_REGISTER;
getintparaloc.register:=nr-1;
end
else
begin
getintparaloc.loc:=LOC_REFERENCE;
getintparaloc.reference.index:=NR_EBP;
getintparaloc.reference.offset:=4*nr;
end;
end
else
begin
getintparaloc.loc:=LOC_REFERENCE;
getintparaloc.reference.index:=NR_EBP;
getintparaloc.reference.offset:=4*nr;
end;
end;
@ -318,7 +321,10 @@ begin
end.
{
$Log$
Revision 1.27 2003-09-09 21:03:17 peter
Revision 1.28 2003-09-10 08:31:47 marco
* Patch from Peter for paraloc
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

20
compiler/i386/n386add.pas
View File

@ -329,7 +329,8 @@ interface
procedure ti386addnode.second_addstring;
var
paraloc1,paraloc2 : tparalocation;
begin
{ string operations are not commutative }
if nf_swaped in flags then
@ -340,16 +341,20 @@ interface
case nodetype of
ltn,lten,gtn,gten,equaln,unequaln :
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
secondpass(left);
location_release(exprasmlist,left.location);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(exprasmlist,2));
paramanager.allocparaloc(exprasmlist,paraloc2);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paraloc2);
secondpass(right);
location_release(exprasmlist,right.location);
cg.a_paramaddr_ref(exprasmlist,right.location.reference,paramanager.getintparaloc(exprasmlist,1));
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_paramaddr_ref(exprasmlist,right.location.reference,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc2);
rg.allocexplicitregistersint(exprasmlist,[first_int_supreg..last_int_supreg]-[RS_FRAME_POINTER_REG,RS_STACK_POINTER_REG]);
cg.a_call_name(exprasmlist,'FPC_SHORTSTR_COMPARE');
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
rg.deallocexplicitregistersint(exprasmlist,[first_int_supreg..last_int_supreg]-[RS_FRAME_POINTER_REG,RS_STACK_POINTER_REG]);
location_freetemp(exprasmlist,left.location);
location_freetemp(exprasmlist,right.location);
@ -1446,7 +1451,10 @@ begin
end.
{
$Log$
Revision 1.76 2003-09-03 15:55:01 peter
Revision 1.77 2003-09-10 08:31:48 marco
* Patch from Peter for paraloc
Revision 1.76 2003/09/03 15:55:01 peter
* NEWRA branch merged
Revision 1.75.2.2 2003/08/31 13:50:16 daniel

16
compiler/ncgcal.pas
View File

@ -42,6 +42,7 @@ interface
tcgcallnode = class(tcallnode)
private
framepointer_paraloc : tparalocation;
procedure release_para_temps;
procedure normal_pass_2;
procedure inlined_pass_2;
@ -344,23 +345,25 @@ implementation
href : treference;
hregister : tregister;
begin
framepointer_paraloc:=paramanager.getintparaloc(procdefinition.proccalloption,1);
paramanager.allocparaloc(exprasmlist,framepointer_paraloc);
{ this routine is itself not nested }
if current_procinfo.procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel) then
begin
reference_reset_base(href,current_procinfo.framepointer,current_procinfo.parent_framepointer_offset);
cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getintparaloc(exprasmlist,1));
cg.a_param_ref(exprasmlist,OS_ADDR,href,framepointer_paraloc);
end
{ one nesting level }
else if (current_procinfo.procdef.parast.symtablelevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
begin
cg.a_param_reg(exprasmlist,OS_ADDR,current_procinfo.framepointer,paramanager.getintparaloc(exprasmlist,1));
cg.a_param_reg(exprasmlist,OS_ADDR,current_procinfo.framepointer,framepointer_paraloc);
end
{ very complex nesting level ... }
else if (current_procinfo.procdef.parast.symtablelevel>(tprocdef(procdefinition).parast.symtablelevel)) then
begin
hregister:=rg.getaddressregister(exprasmlist);
cg.g_load_parent_framepointer(exprasmlist,tprocdef(procdefinition).parast,hregister);
cg.a_param_reg(exprasmlist,OS_ADDR,hregister,paramanager.getintparaloc(exprasmlist,1));
cg.a_param_reg(exprasmlist,OS_ADDR,hregister,framepointer_paraloc);
rg.ungetaddressregister(exprasmlist,hregister);
end;
end;
@ -368,7 +371,7 @@ implementation
procedure tcgcallnode.free_pushed_framepointer;
begin
paramanager.freeintparaloc(exprasmlist,1);
paramanager.freeparaloc(exprasmlist,framepointer_paraloc);
end;
@ -1331,7 +1334,10 @@ begin
end.
{
$Log$
Revision 1.111 2003-09-07 22:09:35 peter
Revision 1.112 2003-09-10 08:31:47 marco
* Patch from Peter for paraloc
Revision 1.111 2003/09/07 22:09:35 peter
* preparations for different default calling conventions
* various RA fixes

71
compiler/ncgflw.pas
View File

@ -767,7 +767,11 @@ implementation
var
a : tasmlabel;
href2: treference;
paraloc1,paraloc2,paraloc3 : tparalocation;
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paraloc3:=paramanager.getintparaloc(pocall_default,3);
location_reset(location,LOC_VOID,OS_NO);
if assigned(left) then
@ -786,16 +790,18 @@ implementation
{ Push parameters }
if assigned(right) then
begin
paramanager.allocparaloc(exprasmlist,paraloc3);
if assigned(frametree) then
begin
location_release(exprasmlist,frametree.location);
cg.a_param_loc(exprasmlist,frametree.location,paramanager.getintparaloc(exprasmlist,3))
cg.a_param_loc(exprasmlist,frametree.location,paraloc3)
end
else
cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(exprasmlist,3));
cg.a_param_const(exprasmlist,OS_INT,0,paraloc3);
{ push address }
location_release(exprasmlist,right.location);
cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(exprasmlist,2));
paramanager.allocparaloc(exprasmlist,paraloc2);
cg.a_param_loc(exprasmlist,right.location,paraloc2);
end
else
begin
@ -804,18 +810,21 @@ implementation
cg.a_label(exprasmlist,a);
reference_reset_symbol(href2,a,0);
{ push current frame }
cg.a_param_reg(exprasmlist,OS_ADDR,NR_FRAME_POINTER_REG,paramanager.getintparaloc(exprasmlist,3));
paramanager.allocparaloc(exprasmlist,paraloc3);
cg.a_param_reg(exprasmlist,OS_ADDR,NR_FRAME_POINTER_REG,paraloc3);
{ push current address }
paramanager.allocparaloc(exprasmlist,paraloc2);
if target_info.system <> system_powerpc_macos then
cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(exprasmlist,2))
cg.a_paramaddr_ref(exprasmlist,href2,paraloc2)
else
cg.a_param_const(exprasmlist,OS_INT,0,paramanager.getintparaloc(exprasmlist,2));
cg.a_param_const(exprasmlist,OS_INT,0,paraloc2);
end;
location_release(exprasmlist,left.location);
cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(exprasmlist,1));
paramanager.freeintparaloc(exprasmlist,3);
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_loc(exprasmlist,left.location,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc2);
paramanager.freeparaloc(exprasmlist,paraloc3);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_RAISEEXCEPTION');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
@ -861,13 +870,16 @@ implementation
{ does the necessary things to clean up the object stack }
{ in the except block }
procedure cleanupobjectstack;
var
paraloc1 : tparalocation;
begin
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_POPOBJECTSTACK');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_param_reg(exprasmlist,OS_ADDR,NR_FUNCTION_RESULT_REG,paramanager.getintparaloc(exprasmlist,1));
paramanager.freeintparaloc(exprasmlist,1);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_reg(exprasmlist,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
@ -894,7 +906,7 @@ implementation
exceptflowcontrol : tflowcontrol;
tempbuf,tempaddr : treference;
href : treference;
paraloc1 : tparalocation;
label
errorexit;
begin
@ -973,8 +985,10 @@ implementation
{ FPC_CATCHES must be called with
'default handler' flag (=-1)
}
cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paramanager.getintparaloc(exprasmlist,1));
paramanager.freeintparaloc(exprasmlist,1);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_CATCHES');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
@ -999,8 +1013,10 @@ implementation
cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_param_reg(exprasmlist, OS_ADDR, NR_FUNCTION_RESULT_REG, paramanager.getintparaloc(exprasmlist,1));
paramanager.freeintparaloc(exprasmlist,1);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_reg(exprasmlist, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
@ -1124,7 +1140,7 @@ implementation
tempbuf,tempaddr : treference;
href : treference;
href2: treference;
paraloc1 : tparalocation;
begin
location_reset(location,LOC_VOID,OS_NO);
@ -1134,8 +1150,10 @@ implementation
{ send the vmt parameter }
reference_reset_symbol(href2,objectlibrary.newasmsymboldata(excepttype.vmt_mangledname),0);
cg.a_paramaddr_ref(exprasmlist,href2,paramanager.getintparaloc(exprasmlist,1));
paramanager.freeintparaloc(exprasmlist,1);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_paramaddr_ref(exprasmlist,href2,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_CATCHES');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
@ -1182,8 +1200,10 @@ implementation
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_param_reg(exprasmlist, OS_ADDR, NR_FUNCTION_RESULT_REG, paramanager.getintparaloc(exprasmlist,1));
paramanager.freeintparaloc(exprasmlist,1);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_reg(exprasmlist, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
@ -1409,7 +1429,10 @@ begin
end.
{
$Log$
Revision 1.79 2003-09-07 22:09:35 peter
Revision 1.80 2003-09-10 08:31:47 marco
* Patch from Peter for paraloc
Revision 1.79 2003/09/07 22:09:35 peter
* preparations for different default calling conventions
* various RA fixes

35
compiler/ncginl.pas
View File

@ -175,12 +175,18 @@ implementation
*****************************************************************************}
procedure tcginlinenode.second_Assert;
var
hp2 : tstringconstnode;
otlabel,oflabel{,l1} : tasmlabel;
hp2 : tstringconstnode;
otlabel,oflabel : tasmlabel;
paraloc1,paraloc2,
paraloc3,paraloc4 : tparalocation;
begin
{ the node should be removed in the firstpass }
if not (cs_do_assertion in aktlocalswitches) then
internalerror(7123458);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paraloc3:=paramanager.getintparaloc(pocall_default,3);
paraloc4:=paramanager.getintparaloc(pocall_default,4);
otlabel:=truelabel;
oflabel:=falselabel;
objectlibrary.getlabel(truelabel);
@ -189,25 +195,29 @@ implementation
maketojumpbool(exprasmlist,tcallparanode(left).left,lr_load_regvars);
cg.a_label(exprasmlist,falselabel);
{ erroraddr }
cg.a_param_reg(exprasmlist,OS_ADDR,NR_FRAME_POINTER_REG,paramanager.getintparaloc(exprasmlist,4));
paramanager.allocparaloc(exprasmlist,paraloc4);
cg.a_param_reg(exprasmlist,OS_ADDR,NR_FRAME_POINTER_REG,paraloc4);
{ lineno }
cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paramanager.getintparaloc(exprasmlist,3));
paramanager.allocparaloc(exprasmlist,paraloc3);
cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paraloc3);
{ filename string }
hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
firstpass(tnode(hp2));
secondpass(tnode(hp2));
if codegenerror then
exit;
cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(exprasmlist,2));
paramanager.allocparaloc(exprasmlist,paraloc2);
cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paraloc2);
hp2.free;
{ push msg }
secondpass(tcallparanode(tcallparanode(left).right).left);
cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paramanager.getintparaloc(exprasmlist,1));
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_paramaddr_ref(exprasmlist,tcallparanode(tcallparanode(left).right).left.location.reference,paraloc1);
{ call }
paramanager.freeintparaloc(exprasmlist,4);
paramanager.freeintparaloc(exprasmlist,3);
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
paramanager.freeparaloc(exprasmlist,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc2);
paramanager.freeparaloc(exprasmlist,paraloc3);
paramanager.freeparaloc(exprasmlist,paraloc4);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_ASSERT');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
@ -653,7 +663,10 @@ end.
{
$Log$
Revision 1.41 2003-09-07 22:09:35 peter
Revision 1.42 2003-09-10 08:31:47 marco
* Patch from Peter for paraloc
Revision 1.41 2003/09/07 22:09:35 peter
* preparations for different default calling conventions
* various RA fixes

50
compiler/ncgld.pas
View File

@ -69,7 +69,7 @@ implementation
newsize : tcgsize;
dorelocatelab,
norelocatelab : tasmlabel;
paraloc: tparalocation;
paraloc1 : tparalocation;
begin
{ we don't know the size of all arrays }
newsize:=def_cgsize(resulttype.def);
@ -130,7 +130,8 @@ implementation
objectlibrary.getlabel(dorelocatelab);
objectlibrary.getlabel(norelocatelab);
{ make sure hregister can't allocate the register necessary for the parameter }
paraloc := paramanager.getintparaloc(exprasmlist,1);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
{ we've to allocate the register before we save the used registers }
hregister:=rg.getaddressregister(exprasmlist);
reference_reset_symbol(href,objectlibrary.newasmsymboldata('FPC_THREADVAR_RELOCATE'),0);
@ -146,11 +147,11 @@ implementation
cg.a_label(exprasmlist,dorelocatelab);
{ don't save the allocated register else the result will be destroyed later }
reference_reset_symbol(href,objectlibrary.newasmsymboldata(tvarsym(symtableentry).mangledname),0);
cg.a_param_ref(exprasmlist,OS_ADDR,href,paraloc);
cg.a_param_ref(exprasmlist,OS_ADDR,href,paraloc1);
{ the called procedure isn't allowed to change }
{ any register except EAX }
cg.a_call_reg(exprasmlist,hregister);
paramanager.freeintparaloc(exprasmlist,1);
paramanager.freeparaloc(exprasmlist,paraloc1);
r:=rg.getexplicitregisterint(exprasmlist,NR_FUNCTION_RESULT_REG);
rg.ungetregisterint(exprasmlist,r);
cg.a_load_reg_reg(exprasmlist,OS_INT,OS_ADDR,r,hregister);
@ -666,6 +667,7 @@ implementation
dovariant : boolean;
elesize : longint;
tmpreg : tregister;
paraloc : tparalocation;
begin
dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
if dovariant then
@ -673,19 +675,24 @@ implementation
else
elesize:=tarraydef(resulttype.def).elesize;
if nf_cargs in flags then
location_reset(location,LOC_VOID,OS_NO)
begin
location_reset(location,LOC_VOID,OS_NO);
{ Retrieve parameter location for push }
paraloc:=paramanager.getintparaloc(pocall_cdecl,1);
end
else
location_reset(location,LOC_CREFERENCE,OS_NO);
if not(nf_cargs in flags) then
begin
{ Allocate always a temp, also if no elements are required, to
be sure that location is valid (PFV) }
if tarraydef(resulttype.def).highrange=-1 then
tg.GetTemp(exprasmlist,elesize,tt_normal,location.reference)
else
tg.GetTemp(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,tt_normal,location.reference);
href:=location.reference;
end;
begin
location_reset(location,LOC_CREFERENCE,OS_NO);
fillchar(paraloc,sizeof(paraloc),0);
{ Allocate always a temp, also if no elements are required, to
be sure that location is valid (PFV) }
if tarraydef(resulttype.def).highrange=-1 then
tg.GetTemp(exprasmlist,elesize,tt_normal,location.reference)
else
tg.GetTemp(exprasmlist,(tarraydef(resulttype.def).highrange+1)*elesize,tt_normal,location.reference);
href:=location.reference;
end;
{ Process nodes in array constructor }
hp:=self;
while assigned(hp) do
begin
@ -796,7 +803,7 @@ implementation
if vaddr then
begin
location_force_mem(exprasmlist,hp.left.location);
cg.a_paramaddr_ref(exprasmlist,hp.left.location.reference,paralocdummy);
cg.a_paramaddr_ref(exprasmlist,hp.left.location.reference,paraloc);
location_release(exprasmlist,hp.left.location);
if freetemp then
location_freetemp(exprasmlist,hp.left.location);
@ -804,10 +811,10 @@ implementation
end
else
if vtype in [vtInt64,vtQword,vtExtended] then
push_value_para(exprasmlist,hp.left,pocall_cdecl,0,4,paralocdummy)
push_value_para(exprasmlist,hp.left,pocall_cdecl,0,4,paraloc)
else
begin
cg.a_param_loc(exprasmlist,hp.left.location,paralocdummy);
cg.a_param_loc(exprasmlist,hp.left.location,paraloc);
inc(pushedparasize,pointer_size);
end;
end
@ -881,7 +888,10 @@ begin
end.
{
$Log$
Revision 1.79 2003-09-03 15:55:00 peter
Revision 1.80 2003-09-10 08:31:47 marco
* Patch from Peter for paraloc
Revision 1.79 2003/09/03 15:55:00 peter
* NEWRA branch merged
Revision 1.78 2003/09/03 11:18:37 florian

11
compiler/ncgmat.pas
View File

@ -266,6 +266,7 @@ implementation
hdenom : tregister;
power : longint;
hl : tasmlabel;
paraloc1 : tparalocation;
begin
secondpass(left);
if codegenerror then
@ -329,7 +330,10 @@ implementation
}
objectlibrary.getlabel(hl);
cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,hl);
cg.a_param_const(exprasmlist,OS_S32,200,paramanager.getintparaloc(exprasmlist,1));
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_const(exprasmlist,OS_S32,200,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
cg.a_call_name(exprasmlist,'FPC_HANDLERROR');
cg.a_label(exprasmlist,hl);
if nodetype = modn then
@ -498,7 +502,10 @@ begin
end.
{
$Log$
Revision 1.17 2003-09-03 15:55:00 peter
Revision 1.18 2003-09-10 08:31:47 marco
* Patch from Peter for paraloc
Revision 1.17 2003/09/03 15:55:00 peter
* NEWRA branch merged
Revision 1.16 2003/09/03 11:18:37 florian

73
compiler/ncgmem.pas
View File

@ -199,7 +199,8 @@ implementation
*****************************************************************************}
procedure tcgderefnode.pass_2;
var
paraloc1 : tparalocation;
begin
secondpass(left);
location_reset(location,LOC_REFERENCE,def_cgsize(resulttype.def));
@ -230,8 +231,10 @@ implementation
not(cs_compilesystem in aktmoduleswitches) and
(not tpointerdef(left.resulttype.def).is_far) then
begin
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
paramanager.freeintparaloc(exprasmlist,1);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
@ -244,7 +247,8 @@ implementation
*****************************************************************************}
procedure tcgsubscriptnode.pass_2;
var
paraloc1 : tparalocation;
begin
secondpass(left);
if codegenerror then
@ -280,8 +284,10 @@ implementation
(cs_checkpointer in aktglobalswitches) and
not(cs_compilesystem in aktmoduleswitches) then
begin
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
paramanager.freeintparaloc(exprasmlist,1);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
@ -296,8 +302,10 @@ implementation
(cs_checkpointer in aktglobalswitches) and
not(cs_compilesystem in aktmoduleswitches) then
begin
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
paramanager.freeintparaloc(exprasmlist,1);
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
@ -439,6 +447,7 @@ implementation
poslabel,
neglabel : tasmlabel;
hreg : tregister;
paraloc1,paraloc2 : tparalocation;
begin
if is_open_array(left.resulttype.def) or
is_array_of_const(left.resulttype.def) then
@ -480,12 +489,16 @@ implementation
else
if is_dynamic_array(left.resulttype.def) then
begin
cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(exprasmlist,2));
cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(exprasmlist,1));
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paramanager.allocparaloc(exprasmlist,paraloc2);
cg.a_param_loc(exprasmlist,right.location,paraloc2);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_loc(exprasmlist,left.location,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc2);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK');
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
end
else
@ -503,6 +516,7 @@ implementation
newsize : tcgsize;
mulsize: longint;
isjump : boolean;
paraloc1,paraloc2 : tparalocation;
begin
mulsize := get_mul_size;
@ -539,10 +553,12 @@ implementation
we can use the ansistring routine here }
if (cs_check_range in aktlocalswitches) then
begin
cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(exprasmlist,1));
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
paramanager.freeintparaloc(exprasmlist,1);
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
end;
@ -616,14 +632,18 @@ implementation
st_widestring,
st_ansistring:
begin
cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(exprasmlist,2));
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paramanager.allocparaloc(exprasmlist,paraloc2);
cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paraloc2);
href:=location.reference;
dec(href.offset,7);
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(exprasmlist,1));
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_ref(exprasmlist,OS_INT,href,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc2);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
end;
@ -746,14 +766,18 @@ implementation
st_widestring,
st_ansistring:
begin
cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(exprasmlist,2));
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paramanager.allocparaloc(exprasmlist,paraloc2);
cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paraloc2);
href:=location.reference;
dec(href.offset,7);
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(exprasmlist,1));
paramanager.allocparaloc(exprasmlist,paraloc1);
cg.a_param_ref(exprasmlist,OS_INT,href,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc1);
paramanager.freeparaloc(exprasmlist,paraloc2);
rg.allocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
paramanager.freeintparaloc(exprasmlist,2);
paramanager.freeintparaloc(exprasmlist,1);
rg.deallocexplicitregistersint(exprasmlist,paramanager.get_volatile_registers_int(pocall_default));
end;
st_shortstring:
@ -787,7 +811,10 @@ begin
end.
{
$Log$
Revision 1.71 2003-09-07 22:09:35 peter
Revision 1.72 2003-09-10 08:31:47 marco
* Patch from Peter for paraloc
Revision 1.71 2003/09/07 22:09:35 peter
* preparations for different default calling conventions
* various RA fixes

80
compiler/ncgutil.pas
View File

@ -257,26 +257,35 @@ implementation
procedure new_exception(list : taasmoutput;const jmpbuf,envbuf, href : treference;
a : aword; exceptlabel : tasmlabel);
begin
cg.a_paramaddr_ref(list,envbuf,paramanager.getintparaloc(list,3));
cg.a_paramaddr_ref(list,jmpbuf,paramanager.getintparaloc(list,2));
{ push type of exceptionframe }
cg.a_param_const(list,OS_S32,1,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,3);
paramanager.freeintparaloc(list,2);
paramanager.freeintparaloc(list,1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
var
paraloc1,paraloc2,paraloc3 : tparalocation;
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paraloc3:=paramanager.getintparaloc(pocall_default,3);
paramanager.allocparaloc(list,paraloc3);
cg.a_paramaddr_ref(list,envbuf,paraloc3);
paramanager.allocparaloc(list,paraloc2);
cg.a_paramaddr_ref(list,jmpbuf,paraloc2);
{ push type of exceptionframe }
paramanager.allocparaloc(list,paraloc1);
cg.a_param_const(list,OS_S32,1,paraloc1);
paramanager.freeparaloc(list,paraloc3);
paramanager.freeparaloc(list,paraloc2);
paramanager.freeparaloc(list,paraloc1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_SETJMP');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
paramanager.allocparaloc(list,paraloc1);
cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
paramanager.freeparaloc(list,paraloc1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_SETJMP');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
cg.g_exception_reason_save(list, href);
cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,NR_FUNCTION_RESULT_REG,exceptlabel);
cg.g_exception_reason_save(list, href);
cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,NR_FUNCTION_RESULT_REG,exceptlabel);
end;
@ -1029,7 +1038,9 @@ implementation
var
hp : ptemprecord;
href : treference;
paraloc1 : tparalocation;
begin
paraloc1:=paramanager.getintparaloc(pocall_default,1);
hp:=tg.templist;
while assigned(hp) do
begin
@ -1038,8 +1049,9 @@ implementation
tt_freeansistring :
begin
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,1);
paramanager.allocparaloc(list,paraloc1);
cg.a_paramaddr_ref(list,href,paraloc1);
paramanager.freeparaloc(list,paraloc1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_ANSISTR_DECR_REF');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
@ -1048,8 +1060,9 @@ implementation
tt_freewidestring :
begin
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,1);
paramanager.allocparaloc(list,paraloc1);
cg.a_paramaddr_ref(list,href,paraloc1);
paramanager.freeparaloc(list,paraloc1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_WIDESTR_DECR_REF');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
@ -1057,8 +1070,9 @@ implementation
tt_interfacecom :
begin
reference_reset_base(href,current_procinfo.framepointer,hp^.pos);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,1);
paramanager.allocparaloc(list,paraloc1);
cg.a_paramaddr_ref(list,href,paraloc1);
paramanager.freeparaloc(list,paraloc1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
cg.a_call_name(list,'FPC_INTF_DECR_REF');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_default));
@ -1218,6 +1232,7 @@ implementation
procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
var
href : treference;
paraloc1,paraloc2 : tparalocation;
begin
{ the actual profile code can clobber some registers,
therefore if the context must be saved, do it before
@ -1281,11 +1296,15 @@ implementation
(cs_profile in aktmoduleswitches) then
begin
reference_reset_symbol(href,objectlibrary.newasmsymboldata('etext'),0);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,2));
paraloc1:=paramanager.getintparaloc(pocall_default,1);
paraloc2:=paramanager.getintparaloc(pocall_default,2);
paramanager.allocparaloc(list,paraloc2);
cg.a_paramaddr_ref(list,href,paraloc2);
reference_reset_symbol(href,objectlibrary.newasmsymboldata('__image_base__'),0);
cg.a_paramaddr_ref(list,href,paramanager.getintparaloc(list,1));
paramanager.freeintparaloc(list,2);
paramanager.freeintparaloc(list,1);
paramanager.allocparaloc(list,paraloc1);
cg.a_paramaddr_ref(list,href,paraloc1);
paramanager.freeparaloc(list,paraloc2);
paramanager.freeparaloc(list,paraloc1);
rg.allocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_cdecl));
cg.a_call_name(list,'_monstartup');
rg.deallocexplicitregistersint(list,paramanager.get_volatile_registers_int(pocall_cdecl));
@ -1805,7 +1824,10 @@ implementation
end.
{
$Log$
Revision 1.140 2003-09-07 22:09:35 peter
Revision 1.141 2003-09-10 08:31:47 marco
* Patch from Peter for paraloc
Revision 1.140 2003/09/07 22:09:35 peter
* preparations for different default calling conventions
* various RA fixes

16
compiler/paramgr.pas
View File

@ -72,15 +72,7 @@ unit paramgr;
}
function get_volatile_registers_int(calloption : tproccalloption):tsuperregisterset;virtual;
function get_volatile_registers_fpu(calloption : tproccalloption):tsuperregisterset;virtual;
function getintparaloc(list: taasmoutput; nr : longint) : tparalocation;virtual;abstract;
{# frees a parameter location allocated with getintparaloc
@param(list Current assembler list)
@param(nr Parameter number of routine, starting from 1)
}
procedure freeintparaloc(list: taasmoutput; nr : longint); virtual; abstract;
function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;virtual;abstract;
{# allocate a parameter location created with create_paraloc_info
@ -115,7 +107,6 @@ unit paramgr;
var
paralocdummy : tparalocation;
paramanager : tparamanager;
@ -362,7 +353,10 @@ end.
{
$Log$
Revision 1.53 2003-09-07 22:09:35 peter
Revision 1.54 2003-09-10 08:31:47 marco
* Patch from Peter for paraloc
Revision 1.53 2003/09/07 22:09:35 peter
* preparations for different default calling conventions
* various RA fixes