paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 10:07:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ also specify the parameter def when allocating a parameter via

Browse Source 
getintparaloc + adapted all call sites of getintparaloc. This
    led to a number of additional, related changes:
   o corrected the type information for some getintparaloc parameters
   o don't allocate some intparalocs in cases they aren't used
   o changed "const tvardata" parameter into "constref tvardata" for
     fpc_variant_copy_overwrite to make pass-by-reference semantics
     explicit
   o moved a number of routines that now have to call find_system_type()
     from cgobj to hlcgobj so that cgobj doesn't have to start depending
     on the symtable unit
   o added versions of the cpureg alloc/dealloc methods to hlcgobj that
     call through to their cgobj counter parts, so we can call save/restore
     the cpu registers before/after calling system helpers from hlcgobj
     (not implemented in hlcgobj itself, because all basic register
      allocator functionality is still part of cgobj/cgcpu)

git-svn-id: trunk@21696 -
This commit is contained in:
Jonas Maebe 2012-06-24 15:02:12 +00:00
parent adf66eed8b
commit 7a0ae38700
30 changed files with 302 additions and 260 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/arm/cgcpu.pas
View File

@ -1963,10 +1963,10 @@ unit cgcpu;
paraloc1.init;
paraloc2.init;
paraloc3.init;
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,2,paraloc2);
paramanager.getintparaloc(pocall_default,3,paraloc3);
a_load_const_cgpara(list,OS_INT,len,paraloc3);
paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,paraloc2);
paramanager.getintparaloc(pocall_default,3,ptrsinttype,paraloc3);
a_load_const_cgpara(list,OS_SINT,len,paraloc3);
a_loadaddr_ref_cgpara(list,dest,paraloc2);
a_loadaddr_ref_cgpara(list,source,paraloc1);
paramanager.freecgpara(list,paraloc3);

9
compiler/arm/cpupara.pas
View File

@ -39,7 +39,7 @@ unit cpupara;
function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override;
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
@ -79,16 +79,17 @@ unit cpupara;
end;
procedure tarmparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);
procedure tarmparamanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
begin
if nr<1 then
internalerror(2002070801);
cgpara.reset;
cgpara.size:=OS_ADDR;
cgpara.intsize:=sizeof(pint);
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=std_param_align;
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
begin

14
compiler/avr/cgcpu.pas
View File

@ -470,9 +470,9 @@ unit cgcpu;
paraloc1.init;
paraloc2.init;
paraloc3.init;
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,2,paraloc2);
paramanager.getintparaloc(pocall_default,3,paraloc3);
paramanager.getintparaloc(pocall_default,1,u16inttype,paraloc1);
paramanager.getintparaloc(pocall_default,2,u16inttype,paraloc2);
paramanager.getintparaloc(pocall_default,3,pasbool8type,paraloc3);
a_load_const_cgpara(list,OS_8,0,paraloc3);
a_load_reg_cgpara(list,OS_16,src,paraloc2);
a_load_reg_cgpara(list,OS_16,dst,paraloc1);
@ -1451,10 +1451,10 @@ unit cgcpu;
paraloc1.init;
paraloc2.init;
paraloc3.init;
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,2,paraloc2);
paramanager.getintparaloc(pocall_default,3,paraloc3);
a_load_const_cgpara(list,OS_INT,len,paraloc3);
paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,paraloc2);
paramanager.getintparaloc(pocall_default,3,ptrsinttype,paraloc3);
a_load_const_cgpara(list,OS_SINT,len,paraloc3);
a_loadaddr_ref_cgpara(list,dest,paraloc2);
a_loadaddr_ref_cgpara(list,source,paraloc1);
paramanager.freecgpara(list,paraloc3);

9
compiler/avr/cpupara.pas
View File

@ -38,7 +38,7 @@ unit cpupara;
function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override;
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
@ -69,16 +69,17 @@ unit cpupara;
end;
procedure tavrparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);
procedure tavrparamanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
begin
if nr<1 then
internalerror(2002070801);
cgpara.reset;
cgpara.size:=OS_INT;
cgpara.intsize:=tcgsize2size[OS_INT];
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=std_param_align;
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
begin

158
compiler/cgobj.pas
View File

@ -398,13 +398,10 @@ unit cgobj;
}
procedure g_copyshortstring(list : TAsmList;const source,dest : treference;len:byte);
procedure g_copyvariant(list : TAsmList;const source,dest : treference);
procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);
procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation;
const name: string);
procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);
procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);
{# Generates overflow checking code for a node }
procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); virtual;abstract;
@ -2073,12 +2070,12 @@ implementation
cgpara1.init;
cgpara2.init;
cgpara3.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,2,cgpara2);
paramanager.getintparaloc(pocall_default,3,cgpara3);
paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
paramanager.getintparaloc(pocall_default,3,s32inttype,cgpara3);
a_loadaddr_ref_cgpara(list,dest,cgpara3);
a_loadaddr_ref_cgpara(list,source,cgpara2);
a_load_const_cgpara(list,OS_INT,len,cgpara1);
a_load_const_cgpara(list,OS_S32,len,cgpara1);
paramanager.freecgpara(list,cgpara3);
paramanager.freecgpara(list,cgpara2);
paramanager.freecgpara(list,cgpara1);
@ -2091,26 +2088,6 @@ implementation
end;
procedure tcg.g_copyvariant(list : TAsmList;const source,dest : treference);
var
cgpara1,cgpara2 : TCGPara;
begin
cgpara1.init;
cgpara2.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,2,cgpara2);
a_loadaddr_ref_cgpara(list,dest,cgpara2);
a_loadaddr_ref_cgpara(list,source,cgpara1);
paramanager.freecgpara(list,cgpara2);
paramanager.freecgpara(list,cgpara1);
allocallcpuregisters(list);
a_call_name(list,'FPC_VARIANT_COPY_OVERWRITE',false);
deallocallcpuregisters(list);
cgpara2.done;
cgpara1.done;
end;
procedure tcg.g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);
var
href : treference;
@ -2119,8 +2096,8 @@ implementation
begin
cgpara1.init;
cgpara2.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,2,cgpara2);
paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
if is_interfacecom_or_dispinterface(t) then
incrfunc:='FPC_INTF_INCR_REF'
else if is_ansistring(t) then
@ -2175,9 +2152,9 @@ implementation
cgpara1.init;
cgpara2.init;
cgpara3.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,2,cgpara2);
paramanager.getintparaloc(pocall_default,3,cgpara3);
paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
paramanager.getintparaloc(pocall_default,3,ptrsinttype,cgpara3);
reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
if highloc.loc=LOC_CONSTANT then
@ -2188,13 +2165,13 @@ implementation
hreg:=highloc.register
else
begin
hreg:=getintregister(list,OS_INT);
a_load_loc_reg(list,OS_INT,highloc,hreg);
hreg:=getintregister(list,OS_SINT);
a_load_loc_reg(list,OS_SINT,highloc,hreg);
end;
{ increment, converts high(x) to length(x) }
lenreg:=getintregister(list,OS_INT);
a_op_const_reg_reg(list,OP_ADD,OS_INT,1,hreg,lenreg);
a_load_reg_cgpara(list,OS_INT,lenreg,cgpara3);
lenreg:=getintregister(list,OS_SINT);
a_op_const_reg_reg(list,OP_ADD,OS_SINT,1,hreg,lenreg);
a_load_reg_cgpara(list,OS_SINT,lenreg,cgpara3);
end;
a_loadaddr_ref_cgpara(list,href,cgpara2);
@ -2211,93 +2188,6 @@ implementation
cgpara1.done;
end;
procedure tcg.g_initialize(list : TAsmList;t : tdef;const ref : treference);
var
href : treference;
cgpara1,cgpara2 : TCGPara;
begin
cgpara1.init;
cgpara2.init;
if is_ansistring(t) or
is_widestring(t) or
is_unicodestring(t) or
is_interfacecom_or_dispinterface(t) or
is_dynamic_array(t) then
a_load_const_ref(list,OS_ADDR,0,ref)
else if t.typ=variantdef then
begin
paramanager.getintparaloc(pocall_default,1,cgpara1);
a_loadaddr_ref_cgpara(list,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
allocallcpuregisters(list);
a_call_name(list,'FPC_VARIANT_INIT',false);
deallocallcpuregisters(list);
end
else
begin
if is_open_array(t) then
InternalError(201103052);
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,2,cgpara2);
reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
a_loadaddr_ref_cgpara(list,href,cgpara2);
a_loadaddr_ref_cgpara(list,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
paramanager.freecgpara(list,cgpara2);
allocallcpuregisters(list);
a_call_name(list,'FPC_INITIALIZE',false);
deallocallcpuregisters(list);
end;
cgpara1.done;
cgpara2.done;
end;
procedure tcg.g_finalize(list : TAsmList;t : tdef;const ref : treference);
var
href : treference;
cgpara1,cgpara2 : TCGPara;
decrfunc : string;
begin
if is_interfacecom_or_dispinterface(t) then
decrfunc:='FPC_INTF_DECR_REF'
else if is_ansistring(t) then
decrfunc:='FPC_ANSISTR_DECR_REF'
else if is_widestring(t) then
decrfunc:='FPC_WIDESTR_DECR_REF'
else if is_unicodestring(t) then
decrfunc:='FPC_UNICODESTR_DECR_REF'
else if t.typ=variantdef then
decrfunc:='FPC_VARIANT_CLEAR'
else
begin
cgpara1.init;
cgpara2.init;
if is_open_array(t) then
InternalError(201103051);
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,2,cgpara2);
reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
a_loadaddr_ref_cgpara(list,href,cgpara2);
a_loadaddr_ref_cgpara(list,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
paramanager.freecgpara(list,cgpara2);
if is_dynamic_array(t) then
g_call(list,'FPC_DYNARRAY_CLEAR')
else
g_call(list,'FPC_FINALIZE');
cgpara1.done;
cgpara2.done;
exit;
end;
cgpara1.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
a_loadaddr_ref_cgpara(list,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
g_call(list,decrfunc);
cgpara1.done;
end;
procedure tcg.g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);
begin
@ -2329,8 +2219,8 @@ implementation
current_asmdata.getjumplabel(oklabel);
a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
cgpara1.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
a_load_const_cgpara(list,OS_INT,tcgint(210),cgpara1);
paramanager.getintparaloc(pocall_default,1,s32inttype,cgpara1);
a_load_const_cgpara(list,OS_S32,tcgint(210),cgpara1);
paramanager.freecgpara(list,cgpara1);
a_call_name(list,'FPC_HANDLEERROR',false);
a_label(list,oklabel);
@ -2346,10 +2236,10 @@ implementation
begin
cgpara1.init;
cgpara2.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,2,cgpara2);
paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
if (cs_check_object in current_settings.localswitches) then
begin
paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
reference_reset_symbol(hrefvmt,current_asmdata.RefAsmSymbol(objdef.vmt_mangledname),0,sizeof(pint));
a_loadaddr_ref_cgpara(list,hrefvmt,cgpara2);
a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
@ -2406,7 +2296,7 @@ implementation
{ do getmem call }
cgpara1.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,1,ptruinttype,cgpara1);
a_load_reg_cgpara(list,OS_INT,sizereg,cgpara1);
paramanager.freecgpara(list,cgpara1);
allocallcpuregisters(list);
@ -2420,11 +2310,11 @@ implementation
cgpara1.init;
cgpara2.init;
cgpara3.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,2,cgpara2);
paramanager.getintparaloc(pocall_default,3,cgpara3);
paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
paramanager.getintparaloc(pocall_default,3,ptrsinttype,cgpara3);
{ load size }
a_load_reg_cgpara(list,OS_INT,sizereg,cgpara3);
a_load_reg_cgpara(list,OS_SINT,sizereg,cgpara3);
{ load destination }
a_load_reg_cgpara(list,OS_ADDR,destreg,cgpara2);
{ load source }
@ -2447,7 +2337,7 @@ implementation
begin
{ do move call }
cgpara1.init;
paramanager.getintparaloc(pocall_default,1,cgpara1);
paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
{ load source }
a_load_loc_cgpara(list,l,cgpara1);
paramanager.freecgpara(list,cgpara1);

18
compiler/hlcg2ll.pas
View File

@ -286,13 +286,10 @@ unit hlcg2ll;
}
procedure g_copyshortstring(list : TAsmList;const source,dest : treference;strdef:tstringdef);override;
procedure g_copyvariant(list : TAsmList;const source,dest : treference;vardef:tvariantdef);override;
procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);override;
procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation;
const name: string);override;
procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);override;
procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);override;
{# Generates overflow checking code for a node }
procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); override;
@ -948,11 +945,6 @@ implementation
cg.g_copyshortstring(list,source,dest,strdef.len);
end;
procedure thlcg2ll.g_copyvariant(list: TAsmList; const source, dest: treference; vardef: tvariantdef);
begin
cg.g_copyvariant(list,source,dest);
end;
procedure thlcg2ll.g_incrrefcount(list: TAsmList; t: tdef; const ref: treference);
begin
cg.g_incrrefcount(list,t,ref);
@ -963,16 +955,6 @@ implementation
cg.g_array_rtti_helper(list, t, ref, highloc, name);
end;
procedure thlcg2ll.g_initialize(list: TAsmList; t: tdef; const ref: treference);
begin
cg.g_initialize(list,t,ref);
end;
procedure thlcg2ll.g_finalize(list: TAsmList; t: tdef; const ref: treference);
begin
cg.g_finalize(list,t,ref);
end;
procedure thlcg2ll.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
begin
cg.g_overflowcheck(list,loc,def);

168
compiler/hlcgobj.pas
View File

@ -77,6 +77,16 @@ unit hlcgobj;
the cpu specific child cg object have such a method?}
function uses_registers(rt:Tregistertype):boolean; inline;
{# Get a specific register.}
procedure getcpuregister(list:TAsmList;r:Tregister);virtual;
procedure ungetcpuregister(list:TAsmList;r:Tregister);virtual;
{# Get multiple registers specified.}
procedure alloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);virtual;
{# Free multiple registers specified.}
procedure dealloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);virtual;
procedure allocallcpuregisters(list:TAsmList);virtual;
procedure deallocallcpuregisters(list:TAsmList);virtual;
procedure do_register_allocation(list:TAsmList;headertai:tai); inline;
procedure translate_register(var reg : tregister); inline;
@ -386,11 +396,11 @@ unit hlcgobj;
}
procedure g_copyshortstring(list : TAsmList;const source,dest : treference;strdef:tstringdef);virtual;abstract;
procedure g_copyvariant(list : TAsmList;const source,dest : treference;vardef:tvariantdef);virtual;abstract;
procedure g_copyvariant(list : TAsmList;const source,dest : treference;vardef:tvariantdef);virtual;
procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);virtual;abstract;
procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);virtual;abstract;
procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);virtual;abstract;
procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);virtual;
procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);virtual;
procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation;
const name: string);virtual;abstract;
@ -543,7 +553,7 @@ implementation
fmodule,export,
verbose,defutil,paramgr,
symbase,symsym,symtable,
ncon,nld,pass_1,pass_2,
ncon,nld,ncgrtti,pass_1,pass_2,
cpuinfo,cgobj,tgobj,cutils,procinfo,
ncgutil,ngenutil;
@ -624,6 +634,36 @@ implementation
result:=cg.uses_registers(rt);
end;
procedure thlcgobj.getcpuregister(list: TAsmList; r: Tregister);
begin
cg.getcpuregister(list,r);
end;
procedure thlcgobj.ungetcpuregister(list: TAsmList; r: Tregister);
begin
cg.ungetcpuregister(list,r);
end;
procedure thlcgobj.alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset);
begin
cg.alloccpuregisters(list,rt,r);
end;
procedure thlcgobj.dealloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset);
begin
cg.dealloccpuregisters(list,rt,r);
end;
procedure thlcgobj.allocallcpuregisters(list: TAsmList);
begin
cg.allocallcpuregisters(list);
end;
procedure thlcgobj.deallocallcpuregisters(list: TAsmList);
begin
cg.deallocallcpuregisters(list);
end;
procedure thlcgobj.do_register_allocation(list: TAsmList; headertai: tai);
begin
cg.do_register_allocation(list,headertai);
@ -2734,6 +2774,124 @@ implementation
g_concatcopy(list,size,source,dest);
end;
procedure thlcgobj.g_copyvariant(list: TAsmList; const source, dest: treference; vardef: tvariantdef);
var
cgpara1,cgpara2 : TCGPara;
pvardata : tdef;
begin
cgpara1.init;
cgpara2.init;
pvardata:=getpointerdef(search_system_type('TVARDATA').typedef);
paramanager.getintparaloc(pocall_default,1,pvardata,cgpara1);
paramanager.getintparaloc(pocall_default,2,pvardata,cgpara2);
a_loadaddr_ref_cgpara(list,vardef,dest,cgpara2);
a_loadaddr_ref_cgpara(list,vardef,source,cgpara1);
paramanager.freecgpara(list,cgpara2);
paramanager.freecgpara(list,cgpara1);
g_call_system_proc(list,'fpc_variant_copy_overwrite');
cgpara2.done;
cgpara1.done;
end;
procedure thlcgobj.g_initialize(list: TAsmList; t: tdef; const ref: treference);
var
href : treference;
cgpara1,cgpara2 : TCGPara;
pvardata : tdef;
begin
cgpara1.init;
cgpara2.init;
if is_ansistring(t) or
is_widestring(t) or
is_unicodestring(t) or
is_interfacecom_or_dispinterface(t) or
is_dynamic_array(t) then
a_load_const_ref(list,t,0,ref)
else if t.typ=variantdef then
begin
pvardata:=getpointerdef(search_system_type('TVARDATA').typedef);
paramanager.getintparaloc(pocall_default,1,pvardata,cgpara1);
a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
allocallcpuregisters(list);
g_call_system_proc(list,'fpc_variant_init');
deallocallcpuregisters(list);
end
else
begin
if is_open_array(t) then
InternalError(201103052);
paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
paramanager.freecgpara(list,cgpara2);
allocallcpuregisters(list);
g_call_system_proc(list,'fpc_initialize');
deallocallcpuregisters(list);
end;
cgpara1.done;
cgpara2.done;
end;
procedure thlcgobj.g_finalize(list: TAsmList; t: tdef; const ref: treference);
var
href : treference;
cgpara1,cgpara2 : TCGPara;
paratype : tdef;
decrfunc : string;
dynarr: boolean;
begin
paratype:=getpointerdef(voidpointertype);
if is_interfacecom_or_dispinterface(t) then
decrfunc:='fpc_intf_decr_ref'
else if is_ansistring(t) then
decrfunc:='fpc_ansistr_decr_ref'
else if is_widestring(t) then
decrfunc:='fpc_widestr_decr_ref'
else if is_unicodestring(t) then
decrfunc:='fpc_unicodestr_decr_ref'
else if t.typ=variantdef then
begin
paratype:=getpointerdef(search_system_type('TVARDATA').typedef);
decrfunc:='fpc_variant_clear'
end
else
begin
cgpara1.init;
cgpara2.init;
if is_open_array(t) then
InternalError(201103051);
dynarr:=is_dynamic_array(t);
{ fpc_finalize takes a pointer value parameter, fpc_dynarray_clear a
pointer var parameter }
if not dynarr then
paratype:=voidpointertype;
paramanager.getintparaloc(pocall_default,1,paratype,cgpara1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
a_loadaddr_ref_cgpara(list,voidpointertype,href,cgpara2);
a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
paramanager.freecgpara(list,cgpara2);
if dynarr then
g_call_system_proc(list,'fpc_dynarray_clear')
else
g_call_system_proc(list,'fpc_finalize');
cgpara1.done;
cgpara2.done;
exit;
end;
cgpara1.init;
paramanager.getintparaloc(pocall_default,1,paratype,cgpara1);
a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
g_call_system_proc(list,decrfunc);
cgpara1.done;
end;
procedure thlcgobj.g_rangecheck(list: TAsmList; const l: tlocation; fromdef, todef: tdef);
var
{$if defined(cpu64bitalu) or defined(cpu32bitalu)}
@ -4032,7 +4190,9 @@ implementation
(srsym.typ<>procsym) then
Message1(cg_f_unknown_compilerproc,procname);
pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
allocallcpuregisters(list);
a_call_name(list,pd,pd.mangledname,false);
deallocallcpuregisters(list);
end;

9
compiler/i386/cpupara.pas
View File

@ -45,7 +45,7 @@ unit cpupara;
and if the calling conventions for the helper routines of the
rtl are used.
}
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
@ -270,14 +270,15 @@ unit cpupara;
end;
procedure ti386paramanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);
procedure ti386paramanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
begin
cgpara.reset;
cgpara.size:=OS_ADDR;
cgpara.intsize:=sizeof(pint);
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=get_para_align(calloption);
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
begin

6
compiler/jvm/cpupara.pas
View File

@ -42,7 +42,7 @@ interface
{Returns a structure giving the information on the storage of the parameter
(which must be an integer parameter)
@param(nr Parameter number of routine, starting from 1)}
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
function create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
@ -64,9 +64,9 @@ implementation
hlcgobj;
procedure TJVMParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint;var cgpara : tcgpara);
procedure TJVMParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
begin
{ don't know whether it's an actual integer or a pointer (necessary for cgpara.def) }
{ not yet implemented/used }
internalerror(2010121001);
end;

8
compiler/m68k/cpupara.pas
View File

@ -41,7 +41,7 @@ unit cpupara;
rtl are used.
}
tm68kparamanager = class(tparamanager)
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
@ -65,15 +65,17 @@ unit cpupara;
cpuinfo,cgutils,
defutil;
procedure tm68kparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);
procedure tm68kparamanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
begin
if nr<1 then
internalerror(2002070801);
cgpara.reset;
cgpara.size:=OS_INT;
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=std_param_align;
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
begin

8
compiler/mips/cgcpu.pas
View File

@ -1597,10 +1597,10 @@ begin
paraloc1.init;
paraloc2.init;
paraloc3.init;
paramanager.getintparaloc(pocall_default, 1, paraloc1);
paramanager.getintparaloc(pocall_default, 2, paraloc2);
paramanager.getintparaloc(pocall_default, 3, paraloc3);
a_load_const_cgpara(list, OS_INT, len, paraloc3);
paramanager.getintparaloc(pocall_default, 1, voidpointertype, paraloc1);
paramanager.getintparaloc(pocall_default, 2, voidpointertype, paraloc2);
paramanager.getintparaloc(pocall_default, 3, ptrsinttype, paraloc3);
a_load_const_cgpara(list, OS_SINT, len, paraloc3);
a_loadaddr_ref_cgpara(list, dest, paraloc2);
a_loadaddr_ref_cgpara(list, Source, paraloc1);
paramanager.freecgpara(list, paraloc3);

11
compiler/mips/cpupara.pas
View File

@ -76,7 +76,7 @@ interface
{Returns a structure giving the information on the storage of the parameter
(which must be an integer parameter)
@param(nr Parameter number of routine, starting from 1)}
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
function create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
@ -110,16 +110,17 @@ implementation
end;
procedure TMIPSParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint;var cgpara : tcgpara);
procedure TMIPSParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
begin
if nr<1 then
InternalError(2002100806);
cgpara.reset;
cgpara.size:=OS_INT;
cgpara.intsize:=tcgsize2size[OS_INT];
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=std_param_align;
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
@ -220,7 +221,7 @@ implementation
end
else
begin
getIntParaLoc(p.proccalloption,1,result);
getIntParaLoc(p.proccalloption,1,result.def,result);
end;
result.def:=getpointerdef(def);
end;

4
compiler/ncgcal.pas
View File

@ -971,8 +971,8 @@ implementation
(tf_safecall_exceptions in target_info.flags) then
begin
cgpara.init;
paramanager.getintparaloc(pocall_default,1,cgpara);
cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_INT,NR_FUNCTION_RESULT_REG,cgpara);
paramanager.getintparaloc(pocall_default,1,s32inttype,cgpara);
cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_S32,NR_FUNCTION_RESULT_REG,cgpara);
paramanager.freecgpara(current_asmdata.CurrAsmList,cgpara);
cgpara.done;
cg.g_call(current_asmdata.CurrAsmList,'FPC_SAFECALLCHECK');

30
compiler/ncgflw.pas
View File

@ -93,7 +93,7 @@ implementation
uses
verbose,globals,systems,globtype,constexp,
symconst,symdef,symsym,aasmtai,aasmdata,aasmcpu,defutil,
symconst,symdef,symsym,symtable,aasmtai,aasmdata,aasmcpu,defutil,
procinfo,cgbase,pass_2,parabase,
cpubase,cpuinfo,
nld,ncon,
@ -962,16 +962,17 @@ implementation
href2: treference;
paraloc1,paraloc2,paraloc3 : tcgpara;
begin
paraloc1.init;
paraloc2.init;
paraloc3.init;
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,2,paraloc2);
paramanager.getintparaloc(pocall_default,3,paraloc3);
location_reset(location,LOC_VOID,OS_NO);
if assigned(left) then
begin
paraloc1.init;
paraloc2.init;
paraloc3.init;
paramanager.getintparaloc(pocall_default,1,class_tobject,paraloc1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,paraloc2);
paramanager.getintparaloc(pocall_default,3,voidpointertype,paraloc3);
{ multiple parameters? }
if assigned(right) then
begin
@ -991,7 +992,7 @@ implementation
if assigned(third) then
cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,third.location,paraloc3)
else
cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_INT,0,paraloc3);
cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_ADDR,0,paraloc3);
{ push address }
cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,right.location,paraloc2);
end
@ -1007,7 +1008,7 @@ implementation
if target_info.system <> system_powerpc_macos then
cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,href2,paraloc2)
else
cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_INT,0,paraloc2);
cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_ADDR,0,paraloc2);
end;
cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,left.location,paraloc1);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
@ -1016,6 +1017,10 @@ implementation
cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RAISEEXCEPTION',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
paraloc1.done;
paraloc2.done;
paraloc3.done;
end
else
begin
@ -1024,9 +1029,6 @@ implementation
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end;
paraloc1.done;
paraloc2.done;
paraloc3.done;
end;
@ -1330,7 +1332,7 @@ implementation
{ send the vmt parameter }
reference_reset_symbol(href2,current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname),0,sizeof(pint));
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,1,search_system_type('TCLASS').typedef,paraloc1);
cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,href2,paraloc1);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
cg.g_call(current_asmdata.CurrAsmList,'FPC_CATCHES');
@ -1446,7 +1448,7 @@ implementation
{ call fpc_safecallhandler, passing self for methods of classes,
nil otherwise. }
cgpara.init;
paramanager.getintparaloc(pocall_default,1,cgpara);
paramanager.getintparaloc(pocall_default,1,class_tobject,cgpara);
if is_class(current_procinfo.procdef.struct) then
begin
selfsym:=tparavarsym(current_procinfo.procdef.parast.Find('self'));

10
compiler/ncginl.pas
View File

@ -204,10 +204,10 @@ implementation
paraloc2.init;
paraloc3.init;
paraloc4.init;
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,2,paraloc2);
paramanager.getintparaloc(pocall_default,3,paraloc3);
paramanager.getintparaloc(pocall_default,4,paraloc4);
paramanager.getintparaloc(pocall_default,1,getpointerdef(cshortstringtype),paraloc1);
paramanager.getintparaloc(pocall_default,2,getpointerdef(cshortstringtype),paraloc2);
paramanager.getintparaloc(pocall_default,3,s32inttype,paraloc3);
paramanager.getintparaloc(pocall_default,4,voidpointertype,paraloc4);
otlabel:=current_procinfo.CurrTrueLabel;
oflabel:=current_procinfo.CurrFalseLabel;
current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
@ -231,7 +231,7 @@ implementation
{ push erroraddr }
cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_ADDR,NR_FRAME_POINTER_REG,paraloc4);
{ push lineno }
cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_INT,current_filepos.line,paraloc3);
cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_S32,current_filepos.line,paraloc3);
{ push filename }
cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,hp2.location.reference,paraloc2);
{ push msg }

2
compiler/ncgld.pas
View File

@ -362,7 +362,7 @@ implementation
current_asmdata.getjumplabel(endrelocatelab);
{ make sure hregister can't allocate the register necessary for the parameter }
paraloc1.init;
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
reference_reset_symbol(href,current_asmdata.RefAsmSymbol('FPC_THREADVAR_RELOCATE'),0,sizeof(pint));
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister);

2
compiler/ncgmat.pas
View File

@ -380,7 +380,7 @@ implementation
current_asmdata.getjumplabel(hl);
cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,0,hdenom,hl);
paraloc1.init;
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,1,s32inttype,paraloc1);
cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_S32,aint(200),paraloc1);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_HANDLEERROR',false);

12
compiler/ncgmem.pas
View File

@ -263,7 +263,7 @@ implementation
(location.reference.base<>NR_NO) then
begin
paraloc1.init;
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
cg.a_load_reg_cgpara(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
paraloc1.done;
@ -332,7 +332,7 @@ implementation
(cs_checkpointer in current_settings.localswitches) and
not(cs_compilesystem in current_settings.moduleswitches) then
begin
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
cg.a_load_reg_cgpara(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
cg.allocallcpuregisters(current_asmdata.CurrAsmList);
@ -674,8 +674,8 @@ implementation
else
if is_dynamic_array(left.resultdef) then
begin
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,2,paraloc2);
paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
paramanager.getintparaloc(pocall_default,2,search_system_type('TDYNARRAYINDEX').typedef,paraloc2);
cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,right.location,paraloc2);
cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,left.location,paraloc1);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
@ -704,8 +704,8 @@ implementation
st_widestring,
st_ansistring:
begin
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,2,paraloc2);
paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
paramanager.getintparaloc(pocall_default,2,ptrsinttype,paraloc2);
cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,left.location,paraloc1);
cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,right.location,paraloc2);

16
compiler/ncgutil.pas
View File

@ -417,9 +417,9 @@ implementation
paraloc1.init;
paraloc2.init;
paraloc3.init;
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,2,paraloc2);
paramanager.getintparaloc(pocall_default,3,paraloc3);
paramanager.getintparaloc(pocall_default,1,s32inttype,paraloc1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,paraloc2);
paramanager.getintparaloc(pocall_default,3,voidpointertype,paraloc3);
cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc3);
cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc2);
{ push type of exceptionframe }
@ -431,7 +431,7 @@ implementation
cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
cg.deallocallcpuregisters(list);
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,1,search_system_type('PJMP_BUF').typedef,paraloc1);
cg.a_load_reg_cgpara(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
paramanager.freecgpara(list,paraloc1);
cg.allocallcpuregisters(list);
@ -689,7 +689,7 @@ implementation
so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
}
include(current_procinfo.flags,pi_do_call);
cg.g_copyvariant(list,href,localcopyloc.reference)
hlcg.g_copyvariant(list,href,localcopyloc.reference,tvariantdef(tparavarsym(p).vardef))
end
else
begin
@ -760,7 +760,7 @@ implementation
cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_INITIALIZE_ARRAY');
end
else
cg.g_initialize(list,tparavarsym(p).vardef,href);
hlcg.g_initialize(list,tparavarsym(p).vardef,href);
end;
end;
end;
@ -1310,7 +1310,7 @@ implementation
paraloc1 : tcgpara;
begin
paraloc1.init;
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,1,ptruinttype,paraloc1);
cg.a_load_const_cgpara(list,OS_INT,current_procinfo.calc_stackframe_size,paraloc1);
paramanager.freecgpara(list,paraloc1);
paraloc1.done;
@ -1323,7 +1323,7 @@ implementation
begin
paraloc1.init;
{ Also alloc the register needed for the parameter }
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,1,ptruinttype,paraloc1);
paramanager.freecgpara(list,paraloc1);
{ Call the helper }
cg.allocallcpuregisters(list);

2
compiler/paramgr.pas
View File

@ -81,7 +81,7 @@ unit paramgr;
function get_volatile_registers_flags(calloption : tproccalloption):tcpuregisterset;virtual;
function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;virtual;
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);virtual;abstract;
procedure getintparaloc(calloption : tproccalloption; nr : longint; def: tdef; var cgpara : tcgpara);virtual;abstract;
{# allocate an individual pcgparalocation that's part of a tcgpara

9
compiler/powerpc/cpupara.pas
View File

@ -37,7 +37,7 @@ unit cpupara;
function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
@ -78,14 +78,15 @@ unit cpupara;
end;
procedure tppcparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);
procedure tppcparamanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
begin
cgpara.reset;
cgpara.size:=OS_ADDR;
cgpara.intsize:=sizeof(pint);
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=get_para_align(calloption);
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
begin

11
compiler/powerpc64/cpupara.pas
View File

@ -40,8 +40,7 @@ type
function push_addr_param(varspez: tvarspez; def: tdef; calloption:
tproccalloption): boolean; override;
procedure getintparaloc(calloption: tproccalloption; nr: longint; var
cgpara: TCGPara); override;
procedure getintparaloc(calloption: tproccalloption; nr: longint; def: tdef; var cgpara: tcgpara); override;
function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
function create_varargs_paraloc_info(p: tabstractprocdef; varargspara:
tvarargsparalist): longint; override;
@ -79,15 +78,15 @@ begin
result := [RS_F0..RS_F13];
end;
procedure tppcparamanager.getintparaloc(calloption: tproccalloption; nr:
longint; var cgpara: TCGPara);
procedure tppcparamanager.getintparaloc(calloption: tproccalloption; nr: longint; def : tdef; var cgpara: tcgpara);
var
paraloc: pcgparalocation;
begin
cgpara.reset;
cgpara.size := OS_ADDR;
cgpara.intsize := sizeof(pint);
cgpara.size := def_cgsize(def);
cgpara.intsize := tcgsize2size[cgpara.size];
cgpara.alignment := get_para_align(calloption);
cgpara.def:=def;
paraloc := cgpara.add_location;
with paraloc^ do begin
size := OS_INT;

2
compiler/ppcgen/cgppc.pas
View File

@ -657,7 +657,7 @@ unit cgppc;
if (target_info.system in [system_powerpc_darwin]) then
begin
paraloc1.init;
paramanager.getintparaloc(pocall_cdecl,1,paraloc1);
paramanager.getintparaloc(pocall_cdecl,1,voidpointertype,paraloc1);
a_load_reg_cgpara(list,OS_ADDR,NR_R0,paraloc1);
paramanager.freecgpara(list,paraloc1);
paraloc1.done;

8
compiler/sparc/cgcpu.pas
View File

@ -1177,10 +1177,10 @@ implementation
paraloc1.init;
paraloc2.init;
paraloc3.init;
paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.getintparaloc(pocall_default,2,paraloc2);
paramanager.getintparaloc(pocall_default,3,paraloc3);
a_load_const_cgpara(list,OS_INT,len,paraloc3);
paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,paraloc2);
paramanager.getintparaloc(pocall_default,3,ptrsinttype,paraloc3);
a_load_const_cgpara(list,OS_SINT,len,paraloc3);
a_loadaddr_ref_cgpara(list,dest,paraloc2);
a_loadaddr_ref_cgpara(list,source,paraloc1);
paramanager.freecgpara(list,paraloc3);

9
compiler/sparc/cpupara.pas
View File

@ -38,7 +38,7 @@ interface
{Returns a structure giving the information on the storage of the parameter
(which must be an integer parameter)
@param(nr Parameter number of routine, starting from 1)}
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override;
procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
function create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override;
@ -75,16 +75,17 @@ implementation
end;
procedure TSparcParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint;var cgpara : tcgpara);
procedure TSparcParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
begin
if nr<1 then
InternalError(2002100806);
cgpara.reset;
cgpara.size:=OS_ADDR;
cgpara.intsize:=sizeof(pint);
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=std_param_align;
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
begin

4
compiler/x86_64/cgcpu.pas
View File

@ -298,8 +298,8 @@ unit cgcpu;
end;
para1.init;
para2.init;
paramanager.getintparaloc(pocall_default,1,para1);
paramanager.getintparaloc(pocall_default,2,para2);
paramanager.getintparaloc(pocall_default,1,voidpointertype,para1);
paramanager.getintparaloc(pocall_default,2,voidpointertype,para2);
reference_reset_symbol(href,l,0,1);
{ TODO: using RSP is correct only while the stack is fixed!!
(true now, but will change if/when allocating from stack is implemented) }

9
compiler/x86_64/cpupara.pas
View File

@ -42,7 +42,7 @@ unit cpupara;
function param_use_paraloc(const cgpara:tcgpara):boolean;override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override;
procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
@ -742,14 +742,15 @@ unit cpupara;
end;
procedure tx86_64paramanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);
procedure tx86_64paramanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
begin
cgpara.reset;
cgpara.size:=OS_ADDR;
cgpara.intsize:=sizeof(pint);
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=get_para_align(calloption);
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
begin

2
rtl/inc/compproc.inc
View File

@ -421,7 +421,7 @@ procedure fpc_variant_init(var v: tvardata);compilerproc;
procedure fpc_variant_clear(var v: tvardata);compilerproc;
{$ifdef FPC_VARIANTCOPY_FIXED}
procedure fpc_variant_copy(var d: tvardata; const s : tvardata);compilerproc;
procedure fpc_variant_copy_overwrite(const source: tvardata; var dest : tvardata);compilerproc;
procedure fpc_variant_copy_overwrite(constref source: tvardata; var dest : tvardata);compilerproc;
{$else FPC_VARIANTCOPY_FIXED}
procedure fpc_variant_copy(d,s : pointer);compilerproc;
procedure fpc_variant_copy_overwrite(source, dest : pointer);compilerproc;

2
rtl/inc/variant.inc
View File

@ -52,7 +52,7 @@ procedure fpc_variant_copy(var d: tvardata; const s : tvardata);[Public,Alias:'F
VarCopyProc(d,s);
end;
procedure fpc_variant_copy_overwrite(const source: tvardata; var dest : tvardata);[Public,Alias:'FPC_VARIANT_COPY_OVERWRITE']; compilerproc;
procedure fpc_variant_copy_overwrite(constref source: tvardata; var dest : tvardata);[Public,Alias:'FPC_VARIANT_COPY_OVERWRITE']; compilerproc;
begin
dest.VType := varEmpty;
if assigned(VarCopyProc) then

2
rtl/java/jcompproc.inc
View File

@ -376,7 +376,7 @@ procedure fpc_variant_init(var v: tvardata);compilerproc;
procedure fpc_variant_clear(var v: tvardata);compilerproc;
{$ifdef FPC_VARIANTCOPY_FIXED}
procedure fpc_variant_copy(var d: tvardata; const s : tvardata);compilerproc;
procedure fpc_variant_copy_overwrite(const source: tvardata; var dest : tvardata);compilerproc;
procedure fpc_variant_copy_overwrite(constref source: tvardata; var dest : tvardata);compilerproc;
{$else FPC_VARIANTCOPY_FIXED}
procedure fpc_variant_copy(d,s : pointer);compilerproc;
procedure fpc_variant_copy_overwrite(source, dest : pointer);compilerproc;