summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjonas <jonas@3ad0048d-3df7-0310-abae-a5850022a9f2>2013-01-06 15:05:40 +0000
committerjonas <jonas@3ad0048d-3df7-0310-abae-a5850022a9f2>2013-01-06 15:05:40 +0000
commit4d6426cefa69553d4e13911d77979f73ece885a7 (patch)
treea13ead72441b43e2f60c093f80d56b0cbd1b279c
parentaed970802355a02175b1c0197fedf57c789e5a4d (diff)
downloadfpc-4d6426cefa69553d4e13911d77979f73ece885a7.tar.gz
* pass the procdef to getintparaloc instead of only the proccalloption, so
that the type of the parameters can be determined automatically o added compilerproc declarations for all helpers called in the compiler via their assembler name, so we can look up the corresponding procdef git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@23325 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r--compiler/aarch64/cpupara.pas6
-rw-r--r--compiler/arm/cgcpu.pas10
-rw-r--r--compiler/arm/cpupara.pas6
-rw-r--r--compiler/avr/cgcpu.pas18
-rw-r--r--compiler/avr/cpupara.pas6
-rw-r--r--compiler/cgobj.pas14
-rw-r--r--compiler/hlcgobj.pas141
-rw-r--r--compiler/i386/cpupara.pas10
-rw-r--r--compiler/jvm/cpupara.pas4
-rw-r--r--compiler/m68k/cgcpu.pas26
-rw-r--r--compiler/m68k/cpupara.pas6
-rw-r--r--compiler/m68k/n68kmat.pas20
-rw-r--r--compiler/mips/cgcpu.pas9
-rw-r--r--compiler/mips/cpupara.pas9
-rw-r--r--compiler/ncgcal.pas6
-rw-r--r--compiler/ncgflw.pas16
-rw-r--r--compiler/ncgld.pas6
-rw-r--r--compiler/ncgmat.pas5
-rw-r--r--compiler/ncgmem.pas52
-rw-r--r--compiler/ncgutil.pas23
-rw-r--r--compiler/paramgr.pas2
-rw-r--r--compiler/powerpc/cpupara.pas8
-rw-r--r--compiler/powerpc64/cpupara.pas8
-rw-r--r--compiler/ppcgen/cgppc.pas6
-rw-r--r--compiler/sparc/cgcpu.pas9
-rw-r--r--compiler/sparc/cpupara.pas6
-rw-r--r--compiler/symtable.pas18
-rw-r--r--compiler/x86_64/cgcpu.pas10
-rw-r--r--compiler/x86_64/cpupara.pas8
-rw-r--r--rtl/bsd/sysosh.inc5
-rw-r--r--rtl/inc/compproc.inc6
-rw-r--r--rtl/inc/dynarrh.inc1
-rw-r--r--rtl/inc/heaptrc.pp2
-rw-r--r--rtl/inc/system.inc2
-rw-r--r--rtl/java/jcompproc.inc7
-rw-r--r--rtl/java/jsystem.inc2
-rw-r--r--rtl/netware/system.pp2
-rw-r--r--rtl/netwlibc/system.pp2
-rw-r--r--rtl/win/sysosh.inc4
-rw-r--r--rtl/win64/seh64.inc2
40 files changed, 314 insertions, 189 deletions
diff --git a/compiler/aarch64/cpupara.pas b/compiler/aarch64/cpupara.pas
index 4f0e032fc4..c5b50924f9 100644
--- a/compiler/aarch64/cpupara.pas
+++ b/compiler/aarch64/cpupara.pas
@@ -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; def : tdef; var cgpara : tcgpara);override;
+ procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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; forcetempdef: tdef): tcgpara;override;
@@ -75,12 +75,14 @@ unit cpupara;
end;
- procedure taarch64paramanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
+ procedure taarch64paramanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
+ def : tdef;
begin
if nr<1 then
internalerror(2002070801);
+ def:=tparavarsym(pd.paras[nr-1]).vardef;
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
diff --git a/compiler/arm/cgcpu.pas b/compiler/arm/cgcpu.pas
index d967374ab0..40b8dbe937 100644
--- a/compiler/arm/cgcpu.pas
+++ b/compiler/arm/cgcpu.pas
@@ -189,7 +189,7 @@ unit cgcpu;
globals,verbose,systems,cutils,
aopt,aoptcpu,
fmodule,
- symconst,symsym,
+ symconst,symsym,symtable,
tgobj,
procinfo,cpupi,
paramgr;
@@ -2098,13 +2098,15 @@ unit cgcpu;
procedure tcgarm.g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint);
var
paraloc1,paraloc2,paraloc3 : TCGPara;
+ pd : tprocdef;
begin
+ pd:=search_system_proc('MOVE');
paraloc1.init;
paraloc2.init;
paraloc3.init;
- paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
- paramanager.getintparaloc(pocall_default,2,voidpointertype,paraloc2);
- paramanager.getintparaloc(pocall_default,3,ptrsinttype,paraloc3);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ paramanager.getintparaloc(pd,2,paraloc2);
+ paramanager.getintparaloc(pd,3,paraloc3);
a_load_const_cgpara(list,OS_SINT,len,paraloc3);
a_loadaddr_ref_cgpara(list,dest,paraloc2);
a_loadaddr_ref_cgpara(list,source,paraloc1);
diff --git a/compiler/arm/cpupara.pas b/compiler/arm/cpupara.pas
index 1eb224bf79..9fadf988b4 100644
--- a/compiler/arm/cpupara.pas
+++ b/compiler/arm/cpupara.pas
@@ -38,7 +38,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; def : tdef; var cgpara : tcgpara);override;
+ procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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; forcetempdef: tdef): tcgpara;override;
@@ -76,12 +76,14 @@ unit cpupara;
end;
- procedure tarmparamanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
+ procedure tarmparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
+ def : tdef;
begin
if nr<1 then
internalerror(2002070801);
+ def:=tparavarsym(pd.paras[nr-1]).vardef;
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
diff --git a/compiler/avr/cgcpu.pas b/compiler/avr/cgcpu.pas
index 2e7230d3cb..0bbedc9adc 100644
--- a/compiler/avr/cgcpu.pas
+++ b/compiler/avr/cgcpu.pas
@@ -128,7 +128,7 @@ unit cgcpu;
uses
globals,verbose,systems,cutils,
fmodule,
- symconst,symsym,
+ symconst,symsym,symtable,
tgobj,rgobj,
procinfo,cpupi,
paramgr;
@@ -358,6 +358,7 @@ unit cgcpu;
instr : taicpu;
paraloc1,paraloc2,paraloc3 : TCGPara;
l1,l2 : tasmlabel;
+ pd : tprocdef;
procedure NextSrcDst;
begin
@@ -450,12 +451,13 @@ unit cgcpu;
list.concat(taicpu.op_reg_reg(topcg2asmop[op],dst,src))
else if size=OS_16 then
begin
+ pd:=search_system_proc('fpc_mul_word');
paraloc1.init;
paraloc2.init;
paraloc3.init;
- paramanager.getintparaloc(pocall_default,1,u16inttype,paraloc1);
- paramanager.getintparaloc(pocall_default,2,u16inttype,paraloc2);
- paramanager.getintparaloc(pocall_default,3,pasbool8type,paraloc3);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ paramanager.getintparaloc(pd,2,paraloc2);
+ paramanager.getintparaloc(pd,3,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);
@@ -1508,13 +1510,15 @@ unit cgcpu;
procedure tcgavr.g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint);
var
paraloc1,paraloc2,paraloc3 : TCGPara;
+ pd : tprocdef;
begin
+ pd:=search_system_proc('MOVE');
paraloc1.init;
paraloc2.init;
paraloc3.init;
- paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
- paramanager.getintparaloc(pocall_default,2,voidpointertype,paraloc2);
- paramanager.getintparaloc(pocall_default,3,ptrsinttype,paraloc3);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ paramanager.getintparaloc(pd,2,paraloc2);
+ paramanager.getintparaloc(pd,3,paraloc3);
a_load_const_cgpara(list,OS_SINT,len,paraloc3);
a_loadaddr_ref_cgpara(list,dest,paraloc2);
a_loadaddr_ref_cgpara(list,source,paraloc1);
diff --git a/compiler/avr/cpupara.pas b/compiler/avr/cpupara.pas
index ed5ed2154c..7b7e6617f2 100644
--- a/compiler/avr/cpupara.pas
+++ b/compiler/avr/cpupara.pas
@@ -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; def : tdef; var cgpara : tcgpara);override;
+ procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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; forcetempdef: tdef): tcgpara;override;
@@ -68,12 +68,14 @@ unit cpupara;
end;
- procedure tavrparamanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
+ procedure tavrparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
+ def : tdef;
begin
if nr<1 then
internalerror(2002070801);
+ def:=tparavarsym(pd.paras[nr-1]).vardef;
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas
index 93988246f2..0840ff1c5b 100644
--- a/compiler/cgobj.pas
+++ b/compiler/cgobj.pas
@@ -574,7 +574,7 @@ implementation
uses
globals,systems,
- verbose,paramgr,symsym,
+ verbose,paramgr,symtable,symsym,
tgobj,cutils,procinfo;
{*****************************************************************************
@@ -2093,29 +2093,33 @@ implementation
var
hrefvmt : treference;
cgpara1,cgpara2 : TCGPara;
+ pd: tprocdef;
begin
cgpara1.init;
cgpara2.init;
- paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
if (cs_check_object in current_settings.localswitches) then
begin
- paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
+ pd:=search_system_proc('fpc_check_object_ext');
+ paramanager.getintparaloc(pd,1,cgpara1);
+ paramanager.getintparaloc(pd,2,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);
paramanager.freecgpara(list,cgpara1);
paramanager.freecgpara(list,cgpara2);
allocallcpuregisters(list);
- a_call_name(list,'FPC_CHECK_OBJECT_EXT',false);
+ a_call_name(list,'fpc_check_object_ext',false);
deallocallcpuregisters(list);
end
else
if (cs_check_range in current_settings.localswitches) then
begin
+ pd:=search_system_proc('fpc_check_object');
+ paramanager.getintparaloc(pd,1,cgpara1);
a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1);
paramanager.freecgpara(list,cgpara1);
allocallcpuregisters(list);
- a_call_name(list,'FPC_CHECK_OBJECT',false);
+ a_call_name(list,'fpc_check_object',false);
deallocallcpuregisters(list);
end;
cgpara1.done;
diff --git a/compiler/hlcgobj.pas b/compiler/hlcgobj.pas
index 770e47bb05..1603c70a89 100644
--- a/compiler/hlcgobj.pas
+++ b/compiler/hlcgobj.pas
@@ -536,6 +536,7 @@ unit hlcgobj;
{ generate a call to a routine in the system unit }
function g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
+ function g_call_system_proc(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
protected
function g_call_system_proc_intern(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara; virtual;
public
@@ -2780,17 +2781,19 @@ implementation
var
OKLabel : tasmlabel;
cgpara1 : TCGPara;
+ pd : tprocdef;
begin
if (cs_check_object in current_settings.localswitches) or
(cs_check_range in current_settings.localswitches) then
begin
+ pd:=search_system_proc('fpc_handleerror');
current_asmdata.getjumplabel(oklabel);
a_cmp_const_reg_label(list,selftype,OC_NE,0,reg,oklabel);
cgpara1.init;
- paramanager.getintparaloc(pocall_default,1,s32inttype,cgpara1);
+ paramanager.getintparaloc(pd,1,cgpara1);
a_load_const_cgpara(list,s32inttype,aint(210),cgpara1);
paramanager.freecgpara(list,cgpara1);
- g_call_system_proc(list,'fpc_handleerror',nil);
+ g_call_system_proc(list,pd,nil);
cgpara1.done;
a_label(list,oklabel);
end;
@@ -2817,20 +2820,22 @@ implementation
procedure thlcgobj.g_copyshortstring(list: TAsmList; const source, dest: treference; strdef: tstringdef);
var
cgpara1,cgpara2,cgpara3 : TCGPara;
+ pd : tprocdef;
begin
+ pd:=search_system_proc('fpc_shortstr_assign');
cgpara1.init;
cgpara2.init;
cgpara3.init;
- paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
- paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
- paramanager.getintparaloc(pocall_default,3,s32inttype,cgpara3);
+ paramanager.getintparaloc(pd,1,cgpara1);
+ paramanager.getintparaloc(pd,2,cgpara2);
+ paramanager.getintparaloc(pd,3,cgpara3);
a_loadaddr_ref_cgpara(list,strdef,dest,cgpara3);
a_loadaddr_ref_cgpara(list,strdef,source,cgpara2);
a_load_const_cgpara(list,s32inttype,strdef.len,cgpara1);
paramanager.freecgpara(list,cgpara3);
paramanager.freecgpara(list,cgpara2);
paramanager.freecgpara(list,cgpara1);
- g_call_system_proc(list,'fpc_shortstr_assign',nil);
+ g_call_system_proc(list,pd,nil);
cgpara3.done;
cgpara2.done;
cgpara1.done;
@@ -2839,18 +2844,18 @@ implementation
procedure thlcgobj.g_copyvariant(list: TAsmList; const source, dest: treference; vardef: tvariantdef);
var
cgpara1,cgpara2 : TCGPara;
- pvardata : tdef;
+ pd : tprocdef;
begin
+ pd:=search_system_proc('fpc_variant_copy_overwrite');
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);
+ paramanager.getintparaloc(pd,1,cgpara1);
+ paramanager.getintparaloc(pd,2,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',nil);
+ g_call_system_proc(list,pd,nil);
cgpara2.done;
cgpara1.done;
end;
@@ -2860,11 +2865,10 @@ implementation
href : treference;
incrfunc : string;
cgpara1,cgpara2 : TCGPara;
+ pd : tprocdef;
begin
cgpara1.init;
cgpara2.init;
- 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
@@ -2880,6 +2884,8 @@ implementation
{ call the special incr function or the generic addref }
if incrfunc<>'' then
begin
+ pd:=search_system_proc(incrfunc);
+ paramanager.getintparaloc(pd,1,cgpara1);
{ widestrings aren't ref. counted on all platforms so we need the address
to create a real copy }
if is_widestring(t) then
@@ -2888,10 +2894,13 @@ implementation
{ these functions get the pointer by value }
a_load_ref_cgpara(list,t,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
- g_call_system_proc(list,incrfunc,nil);
+ g_call_system_proc(list,pd,nil);
end
else
begin
+ pd:=search_system_proc('fpc_addref');
+ paramanager.getintparaloc(pd,1,cgpara1);
+ paramanager.getintparaloc(pd,2,cgpara2);
if is_open_array(t) then
InternalError(201103054);
reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
@@ -2899,7 +2908,7 @@ implementation
a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
paramanager.freecgpara(list,cgpara2);
- g_call_system_proc(list,'fpc_addref',nil);
+ g_call_system_proc(list,pd,nil);
end;
cgpara2.done;
cgpara1.done;
@@ -2909,10 +2918,10 @@ implementation
var
href : treference;
cgpara1,cgpara2 : TCGPara;
- pvardata : tdef;
+ pd : tprocdef;
begin
- cgpara1.init;
- cgpara2.init;
+ cgpara1.init;
+ cgpara2.init;
if is_ansistring(t) or
is_widestring(t) or
is_unicodestring(t) or
@@ -2921,38 +2930,37 @@ implementation
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);
+ pd:=search_system_proc('fpc_variant_init');
+ paramanager.getintparaloc(pd,1,cgpara1);
a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
- g_call_system_proc(list,'fpc_variant_init',nil);
+ g_call_system_proc(list,pd,nil);
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);
+ pd:=search_system_proc('fpc_initialize');
+ paramanager.getintparaloc(pd,1,cgpara1);
+ paramanager.getintparaloc(pd,2,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);
- g_call_system_proc(list,'fpc_initialize',nil);
+ g_call_system_proc(list,pd,nil);
end;
- cgpara1.done;
- cgpara2.done;
+ cgpara1.done;
+ cgpara2.done;
end;
procedure thlcgobj.g_finalize(list: TAsmList; t: tdef; const ref: treference);
var
href : treference;
cgpara1,cgpara2 : TCGPara;
- paratype : tdef;
+ pd : tprocdef;
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
@@ -2962,41 +2970,37 @@ implementation
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
+ decrfunc:='fpc_variant_clear'
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);
+ if is_dynamic_array(t) then
+ pd:=search_system_proc('fpc_dynarray_clear')
+ else
+ pd:=search_system_proc('fpc_finalize');
+ paramanager.getintparaloc(pd,1,cgpara1);
+ paramanager.getintparaloc(pd,2,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',nil)
- else
- g_call_system_proc(list,'fpc_finalize',nil);
+ g_call_system_proc(list,pd,nil);
cgpara1.done;
cgpara2.done;
exit;
end;
+ pd:=search_system_proc(decrfunc);
cgpara1.init;
- paramanager.getintparaloc(pocall_default,1,paratype,cgpara1);
+ paramanager.getintparaloc(pd,1,cgpara1);
a_loadaddr_ref_cgpara(list,t,ref,cgpara1);
paramanager.freecgpara(list,cgpara1);
- g_call_system_proc(list,decrfunc,nil);
+ g_call_system_proc(list,pd,nil);
cgpara1.done;
end;
@@ -3005,13 +3009,15 @@ implementation
cgpara1,cgpara2,cgpara3: TCGPara;
href: TReference;
hreg, lenreg: TRegister;
+ pd: tprocdef;
begin
cgpara1.init;
cgpara2.init;
cgpara3.init;
- paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
- paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
- paramanager.getintparaloc(pocall_default,3,ptrsinttype,cgpara3);
+ pd:=search_system_proc(name);
+ paramanager.getintparaloc(pd,1,cgpara1);
+ paramanager.getintparaloc(pd,2,cgpara2);
+ paramanager.getintparaloc(pd,3,cgpara3);
reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint));
if highloc.loc=LOC_CONSTANT then
@@ -3036,7 +3042,7 @@ implementation
paramanager.freecgpara(list,cgpara1);
paramanager.freecgpara(list,cgpara2);
paramanager.freecgpara(list,cgpara3);
- g_call_system_proc(list,name,nil);
+ g_call_system_proc(list,pd,nil);
cgpara3.done;
cgpara2.done;
@@ -3254,6 +3260,7 @@ implementation
sizereg,sourcereg,lenreg : tregister;
cgpara1,cgpara2,cgpara3 : TCGPara;
ptrarrdef : tdef;
+ pd : tprocdef;
getmemres : tcgpara;
destloc : tlocation;
begin
@@ -3281,11 +3288,12 @@ implementation
a_loadaddr_ref_reg(list,arrdef,ptrarrdef,ref,sourcereg);
{ do getmem call }
+ pd:=search_system_proc('fpc_getmem');
cgpara1.init;
- paramanager.getintparaloc(pocall_default,1,ptruinttype,cgpara1);
+ paramanager.getintparaloc(pd,1,cgpara1);
a_load_reg_cgpara(list,sinttype,sizereg,cgpara1);
paramanager.freecgpara(list,cgpara1);
- getmemres:=g_call_system_proc(list,'fpc_getmem',ptrarrdef);
+ getmemres:=g_call_system_proc(list,pd,ptrarrdef);
cgpara1.done;
{ return the new address }
location_reset(destloc,LOC_REGISTER,OS_ADDR);
@@ -3293,12 +3301,13 @@ implementation
gen_load_cgpara_loc(list,ptrarrdef,getmemres,destloc,false);
{ do move call }
+ pd:=search_system_proc('MOVE');
cgpara1.init;
cgpara2.init;
cgpara3.init;
- paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
- paramanager.getintparaloc(pocall_default,2,voidpointertype,cgpara2);
- paramanager.getintparaloc(pocall_default,3,ptrsinttype,cgpara3);
+ paramanager.getintparaloc(pd,1,cgpara1);
+ paramanager.getintparaloc(pd,2,cgpara2);
+ paramanager.getintparaloc(pd,3,cgpara3);
{ load size }
a_load_reg_cgpara(list,ptrsinttype,sizereg,cgpara3);
{ load destination }
@@ -3308,7 +3317,7 @@ implementation
paramanager.freecgpara(list,cgpara3);
paramanager.freecgpara(list,cgpara2);
paramanager.freecgpara(list,cgpara1);
- g_call_system_proc(list,'MOVE',nil);
+ g_call_system_proc(list,pd,nil);
cgpara3.done;
cgpara2.done;
cgpara1.done;
@@ -3318,14 +3327,16 @@ implementation
procedure thlcgobj.g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation);
var
cgpara1 : TCGPara;
+ pd : tprocdef;
begin
{ do freemem call }
+ pd:=search_system_proc('fpc_freemem');
cgpara1.init;
- paramanager.getintparaloc(pocall_default,1,voidpointertype,cgpara1);
+ paramanager.getintparaloc(pd,1,cgpara1);
{ load source }
a_load_loc_cgpara(list,getpointerdef(arrdef),l,cgpara1);
paramanager.freecgpara(list,cgpara1);
- g_call_system_proc(list,'fpc_freemem',nil);
+ g_call_system_proc(list,pd,nil);
cgpara1.done;
end;
@@ -4430,17 +4441,17 @@ implementation
function thlcgobj.g_call_system_proc(list: TAsmList; const procname: string; forceresdef: tdef): tcgpara;
var
- srsym: tsym;
pd: tprocdef;
begin
- srsym:=tsym(systemunit.find(procname));
- if not assigned(srsym) and
- (cs_compilesystem in current_settings.moduleswitches) then
- srsym:=tsym(systemunit.Find(upper(procname)));
- if not assigned(srsym) or
- (srsym.typ<>procsym) then
- Message1(cg_f_unknown_compilerproc,procname);
- pd:=tprocdef(tprocsym(srsym).procdeflist[0]);
+ pd:=search_system_proc(procname);
+ result:=g_call_system_proc_intern(list,pd,forceresdef);
+ end;
+
+ function thlcgobj.g_call_system_proc(list: TAsmList; pd: tprocdef; forceresdef: tdef): tcgpara;
+ begin
+ { separate non-virtual routine to make it clear that the routine to
+ override, if any, is g_call_system_proc_intern (and that none of
+ the g_call_system_proc variants should be made virtual) }
result:=g_call_system_proc_intern(list,pd,forceresdef);
end;
diff --git a/compiler/i386/cpupara.pas b/compiler/i386/cpupara.pas
index a0a2d974f5..67c140b408 100644
--- a/compiler/i386/cpupara.pas
+++ b/compiler/i386/cpupara.pas
@@ -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; def : tdef; var cgpara : tcgpara);override;
+ procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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;
@@ -278,20 +278,22 @@ unit cpupara;
end;
- procedure ti386paramanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
+ procedure ti386paramanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
+ def : tdef;
begin
+ def:=tparavarsym(pd.paras[nr-1]).vardef;
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
- cgpara.alignment:=get_para_align(calloption);
+ cgpara.alignment:=get_para_align(pd.proccalloption);
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
size:=OS_INT;
- if calloption=pocall_register then
+ if pd.proccalloption=pocall_register then
begin
if (nr<=length(parasupregs)) then
begin
diff --git a/compiler/jvm/cpupara.pas b/compiler/jvm/cpupara.pas
index b169825b13..cac1a19d2a 100644
--- a/compiler/jvm/cpupara.pas
+++ b/compiler/jvm/cpupara.pas
@@ -43,7 +43,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; def : tdef; var cgpara : tcgpara);override;
+ procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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; forcetempdef: tdef): tcgpara;override;
@@ -64,7 +64,7 @@ implementation
hlcgobj;
- procedure TJVMParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
+ procedure TJVMParaManager.GetIntParaLoc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
begin
{ not yet implemented/used }
internalerror(2010121001);
diff --git a/compiler/m68k/cgcpu.pas b/compiler/m68k/cgcpu.pas
index 7613b2a9cd..7c7688cb0f 100644
--- a/compiler/m68k/cgcpu.pas
+++ b/compiler/m68k/cgcpu.pas
@@ -140,7 +140,7 @@ unit cgcpu;
uses
globals,verbose,systems,cutils,
- symsym,defutil,paramgr,procinfo,
+ symsym,symtable,defutil,paramgr,procinfo,
rgobj,tgobj,rgcpu,fmodule;
@@ -610,13 +610,15 @@ unit cgcpu;
procedure tcg68k.call_rtl_mul_const_reg(list:tasmlist;size:tcgsize;a:tcgint;reg:tregister;const name:string);
var
paraloc1,paraloc2,paraloc3 : tcgpara;
+ pd : tprocdef;
begin
+ pd:=search_system_proc(name);
paraloc1.init;
paraloc2.init;
paraloc3.init;
- paramanager.getintparaloc(pocall_default,1,u32inttype,paraloc1);
- paramanager.getintparaloc(pocall_default,2,u32inttype,paraloc2);
- paramanager.getintparaloc(pocall_default,3,pasbool8type,paraloc3);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ paramanager.getintparaloc(pd,2,paraloc2);
+ paramanager.getintparaloc(pd,3,paraloc3);
a_load_const_cgpara(list,OS_8,0,paraloc3);
a_load_const_cgpara(list,size,a,paraloc2);
a_load_reg_cgpara(list,OS_32,reg,paraloc1);
@@ -637,13 +639,15 @@ unit cgcpu;
procedure tcg68k.call_rtl_mul_reg_reg(list:tasmlist;reg1,reg2:tregister;const name:string);
var
paraloc1,paraloc2,paraloc3 : tcgpara;
+ pd : tprocdef;
begin
+ pd:=search_system_proc(name);
paraloc1.init;
paraloc2.init;
paraloc3.init;
- paramanager.getintparaloc(pocall_default,1,u32inttype,paraloc1);
- paramanager.getintparaloc(pocall_default,2,u32inttype,paraloc2);
- paramanager.getintparaloc(pocall_default,3,pasbool8type,paraloc3);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ paramanager.getintparaloc(pd,2,paraloc2);
+ paramanager.getintparaloc(pd,3,paraloc3);
a_load_const_cgpara(list,OS_8,0,paraloc3);
a_load_reg_cgpara(list,OS_32,reg1,paraloc2);
a_load_reg_cgpara(list,OS_32,reg2,paraloc1);
@@ -1019,7 +1023,7 @@ unit cgcpu;
OP_IMUL :
begin
if current_settings.cputype<>cpu_MC68020 then
- call_rtl_mul_const_reg(list,size,a,reg,'FPC_MUL_LONGINT')
+ call_rtl_mul_const_reg(list,size,a,reg,'fpc_mul_longint')
else
begin
if (isaddressregister(reg)) then
@@ -1040,7 +1044,7 @@ unit cgcpu;
OP_MUL :
begin
if current_settings.cputype<>cpu_MC68020 then
- call_rtl_mul_const_reg(list,size,a,reg,'FPC_MUL_DWORD')
+ call_rtl_mul_const_reg(list,size,a,reg,'fpc_mul_dword')
else
begin
if (isaddressregister(reg)) then
@@ -1234,7 +1238,7 @@ unit cgcpu;
sign_extend(list, size,reg1);
sign_extend(list, size,reg2);
if current_settings.cputype<>cpu_MC68020 then
- call_rtl_mul_reg_reg(list,reg1,reg2,'FPC_MUL_LONGINT')
+ call_rtl_mul_reg_reg(list,reg1,reg2,'fpc_mul_longint')
else
begin
// writeln('doing 68020');
@@ -1272,7 +1276,7 @@ unit cgcpu;
sign_extend(list, size,reg1);
sign_extend(list, size,reg2);
if current_settings.cputype <> cpu_MC68020 then
- call_rtl_mul_reg_reg(list,reg1,reg2,'FPC_MUL_DWORD')
+ call_rtl_mul_reg_reg(list,reg1,reg2,'fpc_mul_dword')
else
begin
if (isaddressregister(reg1)) then
diff --git a/compiler/m68k/cpupara.pas b/compiler/m68k/cpupara.pas
index 488c160815..8b9e87aa8a 100644
--- a/compiler/m68k/cpupara.pas
+++ b/compiler/m68k/cpupara.pas
@@ -41,7 +41,7 @@ unit cpupara;
rtl are used.
}
tm68kparamanager = class(tparamanager)
- procedure getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);override;
+ procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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; forcetempdef: tdef): tcgpara;override;
@@ -65,12 +65,14 @@ unit cpupara;
cpuinfo,
defutil;
- procedure tm68kparamanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
+ procedure tm68kparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
+ def : tdef;
begin
if nr<1 then
internalerror(2002070801);
+ def:=tparavarsym(pd.paras[nr-1]).vardef;
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
diff --git a/compiler/m68k/n68kmat.pas b/compiler/m68k/n68kmat.pas
index 2b955f770b..b2ee555b11 100644
--- a/compiler/m68k/n68kmat.pas
+++ b/compiler/m68k/n68kmat.pas
@@ -55,7 +55,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,
- symconst,symdef,aasmbase,aasmtai,aasmdata,aasmcpu,
+ symconst,symdef,symtable,aasmbase,aasmtai,aasmdata,aasmcpu,
pass_1,pass_2,procinfo,
ncon,
cpuinfo,paramgr,defutil,parabase,
@@ -146,18 +146,20 @@ implementation
procedure tm68kmoddivnode.call_rtl_divmod_reg_reg(denum,num:tregister;const name:string);
var
paraloc1,paraloc2 : tcgpara;
+ pd : tprocdef;
begin
+ pd:=search_system_proc(name);
paraloc1.init;
paraloc2.init;
- paramanager.getintparaloc(pocall_default,1,u32inttype,paraloc1);
- paramanager.getintparaloc(pocall_default,2,u32inttype,paraloc2);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ paramanager.getintparaloc(pd,2,paraloc2);
cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_32,num,paraloc2);
cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_32,denum,paraloc1);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc2);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
- cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+ cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,paramanager.get_volatile_registers_int(pd.proccalloption));
cg.a_call_name(current_asmdata.CurrAsmList,name,false);
- cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+ cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,paramanager.get_volatile_registers_int(pd.proccalloption));
cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,NR_FUNCTION_RESULT_REG,num);
paraloc2.done;
@@ -196,9 +198,9 @@ implementation
begin
{ On MC68000/68010/Coldfire we must pass through RTL routines }
if signed then
- call_rtl_divmod_reg_reg(denum,num,'FPC_DIV_LONGINT')
+ call_rtl_divmod_reg_reg(denum,num,'fpc_div_longint')
else
- call_rtl_divmod_reg_reg(denum,num,'FPC_DIV_DWORD');
+ call_rtl_divmod_reg_reg(denum,num,'fpc_div_dword');
end;
end;
@@ -248,9 +250,9 @@ implementation
begin
{ On MC68000/68010/coldfire we must pass through RTL routines }
if signed then
- call_rtl_divmod_reg_reg(denum,num,'FPC_MOD_LONGINT')
+ call_rtl_divmod_reg_reg(denum,num,'fpc_mod_longint')
else
- call_rtl_divmod_reg_reg(denum,num,'FPC_MOD_DWORD');
+ call_rtl_divmod_reg_reg(denum,num,'fpc_mod_dword');
end;
// writeln('exits');
end;
diff --git a/compiler/mips/cgcpu.pas b/compiler/mips/cgcpu.pas
index c9955e5740..13c90820d0 100644
--- a/compiler/mips/cgcpu.pas
+++ b/compiler/mips/cgcpu.pas
@@ -118,6 +118,7 @@ implementation
uses
globals, verbose, systems, cutils,
paramgr, fmodule,
+ symtable,
tgobj,
procinfo, cpupi;
@@ -1670,13 +1671,15 @@ end;
procedure TCGMIPS.g_concatcopy_move(list: tasmlist; const Source, dest: treference; len: tcgint);
var
paraloc1, paraloc2, paraloc3: TCGPara;
+ pd: tprocdef;
begin
+ pd:=search_system_proc('MOVE');
paraloc1.init;
paraloc2.init;
paraloc3.init;
- paramanager.getintparaloc(pocall_default, 1, voidpointertype, paraloc1);
- paramanager.getintparaloc(pocall_default, 2, voidpointertype, paraloc2);
- paramanager.getintparaloc(pocall_default, 3, ptrsinttype, paraloc3);
+ paramanager.getintparaloc(pd, 1, paraloc1);
+ paramanager.getintparaloc(pd, 2, paraloc2);
+ paramanager.getintparaloc(pd, 3, paraloc3);
a_load_const_cgpara(list, OS_SINT, len, paraloc3);
a_loadaddr_ref_cgpara(list, dest, paraloc2);
a_loadaddr_ref_cgpara(list, Source, paraloc1);
diff --git a/compiler/mips/cpupara.pas b/compiler/mips/cpupara.pas
index 366846c0b5..ffd625e780 100644
--- a/compiler/mips/cpupara.pas
+++ b/compiler/mips/cpupara.pas
@@ -79,7 +79,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; def : tdef; var cgpara : tcgpara);override;
+ procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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; forcetempdef: tdef): tcgpara;override;
@@ -113,12 +113,14 @@ implementation
end;
- procedure TMIPSParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
+ procedure TMIPSParaManager.GetIntParaLoc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
+ def : tdef;
begin
if nr<1 then
InternalError(2002100806);
+ def:=tparavarsym(pd.paras[nr-1]).vardef;
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
@@ -222,7 +224,8 @@ implementation
end
else
begin
- getIntParaLoc(p.proccalloption,1,retdef,result);
+ getIntParaLoc(p,1,result);
+ result.def:=retdef;
end;
// This is now done in set_common_funcretloc_info already
// result.def:=getpointerdef(result.def);
diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas
index bccbcecae4..088ca42970 100644
--- a/compiler/ncgcal.pas
+++ b/compiler/ncgcal.pas
@@ -688,6 +688,7 @@ implementation
vmtreg : tregister;
oldaktcallnode : tcallnode;
retlocitem: pcgparalocation;
+ pd : tprocdef;
{$ifdef vtentry}
sym : tasmsymbol;
{$endif vtentry}
@@ -981,12 +982,13 @@ implementation
if (procdefinition.proccalloption=pocall_safecall) and
(tf_safecall_exceptions in target_info.flags) then
begin
+ pd:=search_system_proc('fpc_safecallcheck');
cgpara.init;
- paramanager.getintparaloc(pocall_default,1,s32inttype,cgpara);
+ paramanager.getintparaloc(pd,1,cgpara);
cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_INT,NR_FUNCTION_RESULT_REG,cgpara);
paramanager.freecgpara(current_asmdata.CurrAsmList,cgpara);
- cgpara.done;
cg.g_call(current_asmdata.CurrAsmList,'FPC_SAFECALLCHECK');
+ cgpara.done;
end;
{$endif}
diff --git a/compiler/ncgflw.pas b/compiler/ncgflw.pas
index 7784d2d3de..40c12e47c6 100644
--- a/compiler/ncgflw.pas
+++ b/compiler/ncgflw.pas
@@ -959,17 +959,19 @@ implementation
a : tasmlabel;
href2: treference;
paraloc1,paraloc2,paraloc3 : tcgpara;
+ pd : tprocdef;
begin
location_reset(location,LOC_VOID,OS_NO);
if assigned(left) then
begin
+ pd:=search_system_proc('fpc_raiseexception');
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);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ paramanager.getintparaloc(pd,2,paraloc2);
+ paramanager.getintparaloc(pd,3,paraloc3);
{ multiple parameters? }
if assigned(right) then
@@ -1320,6 +1322,7 @@ implementation
href2: treference;
paraloc1 : tcgpara;
exceptvarsym : tlocalvarsym;
+ pd : tprocdef;
begin
paraloc1.init;
location_reset(location,LOC_VOID,OS_NO);
@@ -1329,8 +1332,9 @@ implementation
current_asmdata.getjumplabel(nextonlabel);
{ send the vmt parameter }
+ pd:=search_system_proc('fpc_catches');
reference_reset_symbol(href2,current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname),0,sizeof(pint));
- paramanager.getintparaloc(pocall_default,1,search_system_type('TCLASS').typedef,paraloc1);
+ paramanager.getintparaloc(pd,1,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');
@@ -1442,11 +1446,13 @@ implementation
var
cgpara: tcgpara;
selfsym: tparavarsym;
+ pd: tprocdef;
begin
{ call fpc_safecallhandler, passing self for methods of classes,
nil otherwise. }
+ pd:=search_system_proc('fpc_safecallhandler');
cgpara.init;
- paramanager.getintparaloc(pocall_default,1,class_tobject,cgpara);
+ paramanager.getintparaloc(pd,1,cgpara);
if is_class(current_procinfo.procdef.struct) then
begin
selfsym:=tparavarsym(current_procinfo.procdef.parast.Find('self'));
diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas
index 0310c28e77..d2a0388376 100644
--- a/compiler/ncgld.pas
+++ b/compiler/ncgld.pas
@@ -266,6 +266,7 @@ implementation
endrelocatelab,
norelocatelab : tasmlabel;
paraloc1 : tcgpara;
+ pvd : tdef;
begin
{ we don't know the size of all arrays }
newsize:=def_cgsize(resultdef);
@@ -360,8 +361,11 @@ implementation
current_asmdata.getjumplabel(norelocatelab);
current_asmdata.getjumplabel(endrelocatelab);
{ make sure hregister can't allocate the register necessary for the parameter }
+ pvd:=search_system_type('TRELOCATETHREADVARHANDLER').typedef;
+ if pvd.typ<>procvardef then
+ internalerror(2012120901);
paraloc1.init;
- paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
+ paramanager.getintparaloc(tprocvardef(pvd),1,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);
diff --git a/compiler/ncgmat.pas b/compiler/ncgmat.pas
index 77d4bcc8f4..e2cc54575a 100644
--- a/compiler/ncgmat.pas
+++ b/compiler/ncgmat.pas
@@ -127,7 +127,7 @@ implementation
uses
globtype,systems,
cutils,verbose,globals,
- symconst,symtype,symdef,aasmbase,aasmtai,aasmdata,aasmcpu,defutil,
+ symtable,symconst,symtype,symdef,aasmbase,aasmtai,aasmdata,aasmcpu,defutil,
parabase,
pass_2,
ncon,
@@ -384,10 +384,9 @@ 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,s32inttype,paraloc1);
+ paramanager.getintparaloc(search_system_proc('fpc_handleerror'),1,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);
paraloc1.done;
cg.a_label(current_asmdata.CurrAsmList,hl);
if nodetype = modn then
diff --git a/compiler/ncgmem.pas b/compiler/ncgmem.pas
index c7173e4790..10c0d05af2 100644
--- a/compiler/ncgmem.pas
+++ b/compiler/ncgmem.pas
@@ -81,7 +81,7 @@ implementation
uses
systems,
cutils,cclasses,verbose,globals,constexp,
- symconst,symdef,symsym,symtable,defutil,paramgr,
+ symconst,symbase,symtype,symdef,symsym,symtable,defutil,paramgr,
aasmbase,aasmtai,aasmdata,
procinfo,pass_2,parabase,
pass_1,nld,ncon,nadd,nutils,
@@ -215,6 +215,9 @@ implementation
procedure tcgderefnode.pass_generate_code;
var
paraloc1 : tcgpara;
+ pd : tprocdef;
+ sym : tsym;
+ st : tsymtable;
begin
secondpass(left);
{ assume natural alignment, except for packed records }
@@ -262,14 +265,18 @@ implementation
{ can be NR_NO in case of LOC_CONSTANT }
(location.reference.base<>NR_NO) then
begin
+ if not searchsym_in_named_module('HEAPTRC','CHECKPOINTER',sym,st) or
+ (sym.typ<>procsym) then
+ internalerror(2012010601);
+ pd:=tprocdef(tprocsym(sym).ProcdefList[0]);
paraloc1.init;
- paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
- cg.a_load_reg_cgpara(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ hlcg.a_load_reg_cgpara(current_asmdata.CurrAsmList,resultdef,location.reference.base,paraloc1);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
paraloc1.done;
- cg.allocallcpuregisters(current_asmdata.CurrAsmList);
- cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER',false);
- cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
+ hlcg.allocallcpuregisters(current_asmdata.CurrAsmList);
+ hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',nil,false);
+ hlcg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end;
end;
@@ -285,6 +292,9 @@ implementation
tmpref: treference;
sref: tsubsetreference;
offsetcorrection : aint;
+ pd : tprocdef;
+ srym : tsym;
+ st : tsymtable;
begin
secondpass(left);
if codegenerror then
@@ -332,12 +342,16 @@ implementation
(cs_checkpointer in current_settings.localswitches) and
not(cs_compilesystem in current_settings.moduleswitches) then
begin
- paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
- cg.a_load_reg_cgpara(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1);
+ if not searchsym_in_named_module('HEAPTRC','CHECKPOINTER',srym,st) or
+ (srym.typ<>procsym) then
+ internalerror(2012010602);
+ pd:=tprocdef(tprocsym(srym).ProcdefList[0]);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ hlcg.a_load_reg_cgpara(current_asmdata.CurrAsmList,resultdef,location.reference.base,paraloc1);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
- cg.allocallcpuregisters(current_asmdata.CurrAsmList);
- cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER',false);
- cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
+ hlcg.allocallcpuregisters(current_asmdata.CurrAsmList);
+ hlcg.a_call_name(current_asmdata.CurrAsmList,pd,'FPC_CHECKPOINTER',nil,false);
+ hlcg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end;
end
else
@@ -655,6 +669,7 @@ implementation
neglabel : tasmlabel;
hreg : tregister;
paraloc1,paraloc2 : tcgpara;
+ pd : tprocdef;
begin
{ omit range checking when this is an array access to a pointer which has been
typecasted from an array }
@@ -698,8 +713,9 @@ implementation
else
if is_dynamic_array(left.resultdef) then
begin
- paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
- paramanager.getintparaloc(pocall_default,2,search_system_type('TDYNARRAYINDEX').typedef,paraloc2);
+ pd:=search_system_proc('fpc_dynarray_rangecheck');
+ paramanager.getintparaloc(pd,1,paraloc1);
+ paramanager.getintparaloc(pd,2,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);
@@ -719,6 +735,8 @@ implementation
var
paraloc1,
paraloc2: tcgpara;
+ helpername: TIDString;
+ pd: tprocdef;
begin
paraloc1.init;
paraloc2.init;
@@ -728,15 +746,17 @@ implementation
st_widestring,
st_ansistring:
begin
- paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
- paramanager.getintparaloc(pocall_default,2,ptrsinttype,paraloc2);
+ helpername:='fpc_'+tstringdef(left.resultdef).stringtypname+'_rangecheck';
+ pd:=search_system_proc(helpername);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ paramanager.getintparaloc(pd,2,paraloc2);
cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,left.location,paraloc1);
cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,right.location,paraloc2);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1);
paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc2);
cg.allocallcpuregisters(current_asmdata.CurrAsmList);
- cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_RANGECHECK',false);
+ cg.a_call_name(current_asmdata.CurrAsmList,helpername,false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end;
diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas
index 5b413db7d9..a8ab5856db 100644
--- a/compiler/ncgutil.pas
+++ b/compiler/ncgutil.pas
@@ -422,13 +422,15 @@ implementation
procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel);
var
paraloc1,paraloc2,paraloc3 : tcgpara;
+ pd: tprocdef;
begin
+ pd:=search_system_proc('fpc_pushexceptaddr');
paraloc1.init;
paraloc2.init;
paraloc3.init;
- paramanager.getintparaloc(pocall_default,1,s32inttype,paraloc1);
- paramanager.getintparaloc(pocall_default,2,voidpointertype,paraloc2);
- paramanager.getintparaloc(pocall_default,3,voidpointertype,paraloc3);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ paramanager.getintparaloc(pd,2,paraloc2);
+ paramanager.getintparaloc(pd,3,paraloc3);
cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc3);
cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc2);
{ push type of exceptionframe }
@@ -440,7 +442,8 @@ implementation
cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
cg.deallocallcpuregisters(list);
- paramanager.getintparaloc(pocall_default,1,search_system_type('PJMP_BUF').typedef,paraloc1);
+ pd:=search_system_proc('fpc_setjmp');
+ paramanager.getintparaloc(pd,1,paraloc1);
cg.a_load_reg_cgpara(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
paramanager.freecgpara(list,paraloc1);
cg.allocallcpuregisters(list);
@@ -1413,10 +1416,12 @@ implementation
procedure gen_stack_check_size_para(list:TAsmList);
var
- paraloc1 : tcgpara;
+ paraloc1 : tcgpara;
+ pd : tprocdef;
begin
+ pd:=search_system_proc('fpc_stackcheck');
paraloc1.init;
- paramanager.getintparaloc(pocall_default,1,ptruinttype,paraloc1);
+ paramanager.getintparaloc(pd,1,paraloc1);
cg.a_load_const_cgpara(list,OS_INT,current_procinfo.calc_stackframe_size,paraloc1);
paramanager.freecgpara(list,paraloc1);
paraloc1.done;
@@ -1425,11 +1430,13 @@ implementation
procedure gen_stack_check_call(list:TAsmList);
var
- paraloc1 : tcgpara;
+ paraloc1 : tcgpara;
+ pd : tprocdef;
begin
+ pd:=search_system_proc('fpc_stackcheck');
paraloc1.init;
{ Also alloc the register needed for the parameter }
- paramanager.getintparaloc(pocall_default,1,ptruinttype,paraloc1);
+ paramanager.getintparaloc(pd,1,paraloc1);
paramanager.freecgpara(list,paraloc1);
{ Call the helper }
cg.allocallcpuregisters(list);
diff --git a/compiler/paramgr.pas b/compiler/paramgr.pas
index 79ae8f1308..b698c47c67 100644
--- a/compiler/paramgr.pas
+++ b/compiler/paramgr.pas
@@ -82,7 +82,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; def: tdef; var cgpara : tcgpara);virtual;abstract;
+ procedure getintparaloc(pd: tabstractprocdef; nr : longint; var cgpara: tcgpara);virtual;abstract;
{# allocate an individual pcgparalocation that's part of a tcgpara
diff --git a/compiler/powerpc/cpupara.pas b/compiler/powerpc/cpupara.pas
index 550f04a128..7252a48592 100644
--- a/compiler/powerpc/cpupara.pas
+++ b/compiler/powerpc/cpupara.pas
@@ -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; def : tdef; var cgpara : tcgpara);override;
+ procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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; forcetempdef: tdef): tcgpara;override;
@@ -77,14 +77,16 @@ unit cpupara;
end;
- procedure tppcparamanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
+ procedure tppcparamanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
+ def : tdef;
begin
+ def:=tparavarsym(pd.paras[nr-1]).vardef;
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
- cgpara.alignment:=get_para_align(calloption);
+ cgpara.alignment:=get_para_align(pd.proccalloption);
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
diff --git a/compiler/powerpc64/cpupara.pas b/compiler/powerpc64/cpupara.pas
index 700e00df3c..94e8bc4af6 100644
--- a/compiler/powerpc64/cpupara.pas
+++ b/compiler/powerpc64/cpupara.pas
@@ -40,7 +40,7 @@ type
function push_addr_param(varspez: tvarspez; def: tdef; calloption:
tproccalloption): boolean; override;
- procedure getintparaloc(calloption: tproccalloption; nr: longint; def: tdef; var cgpara: tcgpara); override;
+ procedure getintparaloc(pd : tabstractprocdef; nr: longint; 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;
@@ -77,14 +77,16 @@ begin
result := [RS_F0..RS_F13];
end;
-procedure tppcparamanager.getintparaloc(calloption: tproccalloption; nr: longint; def : tdef; var cgpara: tcgpara);
+procedure tppcparamanager.getintparaloc(pd : tabstractprocdef; nr: longint; var cgpara: tcgpara);
var
paraloc: pcgparalocation;
+ def: tdef;
begin
+ def:=tparavarsym(pd.paras[nr-1]).vardef;
cgpara.reset;
cgpara.size := def_cgsize(def);
cgpara.intsize := tcgsize2size[cgpara.size];
- cgpara.alignment := get_para_align(calloption);
+ cgpara.alignment := get_para_align(pd.proccalloption);
cgpara.def:=def;
paraloc := cgpara.add_location;
with paraloc^ do begin
diff --git a/compiler/ppcgen/cgppc.pas b/compiler/ppcgen/cgppc.pas
index 0974fcd714..6628a0f002 100644
--- a/compiler/ppcgen/cgppc.pas
+++ b/compiler/ppcgen/cgppc.pas
@@ -138,7 +138,7 @@ unit cgppc;
uses
{$ifdef extdebug}sysutils,{$endif}
globals,verbose,systems,cutils,
- symconst,symsym,fmodule,
+ symconst,symsym,symtable,fmodule,
rgobj,tgobj,cpupi,procinfo,paramgr;
{ We know that macos_direct_globals is a const boolean
@@ -653,11 +653,13 @@ unit cgppc;
procedure tcgppcgen.g_profilecode(list: TAsmList);
var
paraloc1 : tcgpara;
+ pd : tprocdef;
begin
if (target_info.system in [system_powerpc_darwin]) then
begin
+ pd:=search_system_proc('mcount');
paraloc1.init;
- paramanager.getintparaloc(pocall_cdecl,1,voidpointertype,paraloc1);
+ paramanager.getintparaloc(pd,1,paraloc1);
a_load_reg_cgpara(list,OS_ADDR,NR_R0,paraloc1);
paramanager.freecgpara(list,paraloc1);
paraloc1.done;
diff --git a/compiler/sparc/cgcpu.pas b/compiler/sparc/cgcpu.pas
index 1749a3a7ff..aa695d86d4 100644
--- a/compiler/sparc/cgcpu.pas
+++ b/compiler/sparc/cgcpu.pas
@@ -134,6 +134,7 @@ implementation
uses
globals,verbose,systems,cutils,
paramgr,fmodule,
+ symtable,
tgobj,
procinfo,cpupi;
@@ -1352,13 +1353,15 @@ implementation
procedure tcgsparc.g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint);
var
paraloc1,paraloc2,paraloc3 : TCGPara;
+ pd : tprocdef;
begin
+ pd:=search_system_proc('MOVE');
paraloc1.init;
paraloc2.init;
paraloc3.init;
- paramanager.getintparaloc(pocall_default,1,voidpointertype,paraloc1);
- paramanager.getintparaloc(pocall_default,2,voidpointertype,paraloc2);
- paramanager.getintparaloc(pocall_default,3,ptrsinttype,paraloc3);
+ paramanager.getintparaloc(pd,1,paraloc1);
+ paramanager.getintparaloc(pd,2,paraloc2);
+ paramanager.getintparaloc(pd,3,paraloc3);
a_load_const_cgpara(list,OS_SINT,len,paraloc3);
a_loadaddr_ref_cgpara(list,dest,paraloc2);
a_loadaddr_ref_cgpara(list,source,paraloc1);
diff --git a/compiler/sparc/cpupara.pas b/compiler/sparc/cpupara.pas
index 3d6cb21ad2..c27d84e263 100644
--- a/compiler/sparc/cpupara.pas
+++ b/compiler/sparc/cpupara.pas
@@ -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; def : tdef; var cgpara : tcgpara);override;
+ procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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; forcetempdef: tdef): tcgpara;override;
@@ -74,12 +74,14 @@ implementation
end;
- procedure TSparcParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
+ procedure TSparcParaManager.GetIntParaLoc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
+ def : tdef;
begin
if nr<1 then
InternalError(2002100806);
+ def:=tparavarsym(pd.paras[nr-1]).vardef;
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 07802a955a..49786bdc3c 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -245,6 +245,7 @@ interface
function searchsym_in_helper(classh,contextclassh:tobjectdef;const s: TIDString;out srsym:tsym;out srsymtable:TSymtable;aHasInherited:boolean):boolean;
function search_system_type(const s: TIDString): ttypesym;
function try_search_system_type(const s: TIDString): ttypesym;
+ function search_system_proc(const s: TIDString): tprocdef;
function search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym;
function search_struct_member(pd : tabstractrecorddef;const s : string):tsym;
function search_struct_member_no_helper(pd : tabstractrecorddef;const s : string):tsym;
@@ -263,6 +264,7 @@ interface
{ Additionally to searching for a macro, also checks whether it's still }
{ actually defined (could be disable using "undef") }
function defined_macro(const s : string):boolean;
+ { Look for a system procedure (no overloads supported) }
{*** Object Helpers ***}
function search_default_property(pd : tabstractrecorddef) : tpropertysym;
@@ -2981,6 +2983,22 @@ implementation
end;
+ function search_system_proc(const s: TIDString): tprocdef;
+ var
+ srsym: tsym;
+ pd: tprocdef;
+ begin
+ srsym:=tsym(systemunit.find(s));
+ if not assigned(srsym) and
+ (cs_compilesystem in current_settings.moduleswitches) then
+ srsym:=tsym(systemunit.Find(upper(s)));
+ if not assigned(srsym) or
+ (srsym.typ<>procsym) then
+ cgmessage1(cg_f_unknown_compilerproc,s);
+ result:=tprocdef(tprocsym(srsym).procdeflist[0]);
+ end;
+
+
function search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym;
var
srsymtable: tsymtable;
diff --git a/compiler/x86_64/cgcpu.pas b/compiler/x86_64/cgcpu.pas
index 49e0cda2db..bd564f9f87 100644
--- a/compiler/x86_64/cgcpu.pas
+++ b/compiler/x86_64/cgcpu.pas
@@ -51,7 +51,7 @@ unit cgcpu;
uses
globtype,globals,verbose,systems,cutils,cclasses,
- symsym,defutil,paramgr,fmodule,cpupi,
+ symsym,symtable,defutil,paramgr,fmodule,cpupi,
rgobj,tgobj,rgcpu;
@@ -289,17 +289,19 @@ unit cgcpu;
procedure tcgx86_64.g_local_unwind(list: TAsmList; l: TAsmLabel);
var
para1,para2: tcgpara;
- href:treference;
+ href: treference;
+ pd: tprocdef;
begin
if (target_info.system<>system_x86_64_win64) then
begin
inherited g_local_unwind(list,l);
exit;
end;
+ pd:=search_system_proc('_fpc_local_unwind');
para1.init;
para2.init;
- paramanager.getintparaloc(pocall_default,1,voidpointertype,para1);
- paramanager.getintparaloc(pocall_default,2,voidpointertype,para2);
+ paramanager.getintparaloc(pd,1,para1);
+ paramanager.getintparaloc(pd,2,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) }
diff --git a/compiler/x86_64/cpupara.pas b/compiler/x86_64/cpupara.pas
index 9f68bad9bc..f21f1e3287 100644
--- a/compiler/x86_64/cpupara.pas
+++ b/compiler/x86_64/cpupara.pas
@@ -41,7 +41,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; def : tdef; var cgpara : tcgpara);override;
+ procedure getintparaloc(pd : tabstractprocdef; nr : longint; 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;
@@ -767,14 +767,16 @@ unit cpupara;
end;
- procedure tx86_64paramanager.getintparaloc(calloption : tproccalloption; nr : longint; def : tdef; var cgpara : tcgpara);
+ procedure tx86_64paramanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
+ def : tdef;
begin
+ def:=tparavarsym(pd.paras[nr-1]).vardef;
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
- cgpara.alignment:=get_para_align(calloption);
+ cgpara.alignment:=get_para_align(pd.proccalloption);
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
diff --git a/rtl/bsd/sysosh.inc b/rtl/bsd/sysosh.inc
index 4bb5fd284d..d4442596d7 100644
--- a/rtl/bsd/sysosh.inc
+++ b/rtl/bsd/sysosh.inc
@@ -26,5 +26,8 @@ type
PRTLCriticalSection = ^TRTLCriticalSection;
TRTLCriticalSection = {$i pmutext.inc}
-
+{$if defined(darwin) and defined(powerpc)}
+ { for profiling support }
+ procedure mcount(p: pointer); compilerproc; cdecl; external;
+{$endif}
diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc
index 4d6680c008..7d0e916998 100644
--- a/rtl/inc/compproc.inc
+++ b/rtl/inc/compproc.inc
@@ -544,6 +544,7 @@ Function fpc_Catches(Objtype : TClass) : TObject; compilerproc;
Procedure fpc_DestroyException(o : TObject); compilerproc;
function fpc_GetExceptionAddr : Pointer; compilerproc;
function fpc_safecallhandler(obj: TObject): HResult; compilerproc;
+function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
procedure fpc_doneexception; compilerproc;
procedure fpc_raise_nested; compilerproc;
{$endif FPC_HAS_FEATURE_EXCEPTIONS}
@@ -556,10 +557,8 @@ procedure fpc_help_fail(_self:pointer;var _vmt:pointer;vmt_pos:cardinal);compile
{$endif FPC_HAS_FEATURE_OBJECTS}
-{$ifdef dummy}
-procedure fpc_check_object(obj:pointer); compilerproc;
+procedure fpc_check_object(_vmt:pointer); compilerproc;
procedure fpc_check_object_ext(vmt,expvmt:pointer);compilerproc;
-{$endif dummy}
{$ifdef FPC_HAS_FEATURE_RTTI}
@@ -607,6 +606,7 @@ procedure fpc_rangeerror; compilerproc;
procedure fpc_divbyzero; compilerproc;
procedure fpc_overflow; compilerproc;
procedure fpc_iocheck; compilerproc;
+procedure fpc_stackcheck(stack_size:SizeUInt); compilerproc;
procedure fpc_InitializeUnits; compilerproc;
// not generated by compiler, called directly in system unit
diff --git a/rtl/inc/dynarrh.inc b/rtl/inc/dynarrh.inc
index a332a44dfe..c355227d4c 100644
--- a/rtl/inc/dynarrh.inc
+++ b/rtl/inc/dynarrh.inc
@@ -30,3 +30,4 @@ type
end;
procedure DynArraySetLength(var a: Pointer; typeInfo: Pointer; dimCnt: SizeInt; lengthVec: PSizeInt);
+procedure fpc_dynarray_rangecheck(p : pointer;i : tdynarrayindex); compilerproc;
diff --git a/rtl/inc/heaptrc.pp b/rtl/inc/heaptrc.pp
index 92a73f4fed..6e80e8e66d 100644
--- a/rtl/inc/heaptrc.pp
+++ b/rtl/inc/heaptrc.pp
@@ -50,6 +50,8 @@ procedure SetHeapExtraInfo(size : ptruint;fillproc : tfillextrainfoproc;displayp
procedure SetHeapTraceOutput(const name : string);overload;
procedure SetHeapTraceOutput(var ATextOutput : Text);overload;
+procedure CheckPointer(p : pointer);
+
const
{ tracing level
splitted in two if memory is released !! }
diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc
index 070391cc57..86aaa94f84 100644
--- a/rtl/inc/system.inc
+++ b/rtl/inc/system.inc
@@ -786,7 +786,7 @@ end;
{$PUSH}
{$S-}
-procedure fpc_stackcheck(stack_size:SizeUInt);[public,alias:'FPC_STACKCHECK'];
+procedure fpc_stackcheck(stack_size:SizeUInt);[public,alias:'FPC_STACKCHECK']; compilerproc;
var
c : Pointer;
begin
diff --git a/rtl/java/jcompproc.inc b/rtl/java/jcompproc.inc
index 6c45aaec9b..87eeae4c29 100644
--- a/rtl/java/jcompproc.inc
+++ b/rtl/java/jcompproc.inc
@@ -502,6 +502,7 @@ Function fpc_Catches(Objtype : TClass) : TObject; compilerproc;
Procedure fpc_DestroyException(o : TObject); compilerproc;
function fpc_GetExceptionAddr : Pointer; compilerproc;
function fpc_safecallhandler(obj: TObject): HResult; compilerproc;
+function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
procedure fpc_doneexception; compilerproc;
procedure fpc_raise_nested; compilerproc;
{$endif FPC_HAS_FEATURE_EXCEPTIONS}
@@ -514,10 +515,10 @@ procedure fpc_help_fail(_self:pointer;var _vmt:pointer;vmt_pos:cardinal);compile
{$endif FPC_HAS_FEATURE_OBJECTS}
-{$ifdef dummy}
-procedure fpc_check_object(obj:pointer); compilerproc;
+(*
+procedure fpc_check_object(_vmt:pointer); compilerproc;
procedure fpc_check_object_ext(vmt,expvmt:pointer);compilerproc;
-{$endif dummy}
+*)
(*
{$ifdef FPC_HAS_FEATURE_RTTI}
diff --git a/rtl/java/jsystem.inc b/rtl/java/jsystem.inc
index 8c4ded41ca..f749426152 100644
--- a/rtl/java/jsystem.inc
+++ b/rtl/java/jsystem.inc
@@ -804,7 +804,7 @@ end;
{$PUSH}
{$S-}
-procedure fpc_stackcheck(stack_size:SizeUInt);[public,alias:'FPC_STACKCHECK'];
+procedure fpc_stackcheck(stack_size:SizeUInt);[public,alias:'FPC_STACKCHECK']; compilerproc;
var
c : Pointer;
begin
diff --git a/rtl/netware/system.pp b/rtl/netware/system.pp
index 4bdefb039c..698edaf85d 100644
--- a/rtl/netware/system.pp
+++ b/rtl/netware/system.pp
@@ -177,7 +177,7 @@ end;
const StackErr : boolean = false;
-procedure int_stackcheck(stack_size:Cardinal);[public,alias:'FPC_STACKCHECK'];
+procedure int_stackcheck(stack_size:SizeUInt);[public,alias:'FPC_STACKCHECK']; compilerproc;
{
called when trying to get local stack if the compiler directive $S
is set this function must preserve all registers
diff --git a/rtl/netwlibc/system.pp b/rtl/netwlibc/system.pp
index b581b316eb..2532669c33 100644
--- a/rtl/netwlibc/system.pp
+++ b/rtl/netwlibc/system.pp
@@ -165,7 +165,7 @@ end;
const StackErr : boolean = false;
-procedure int_stackcheck(stack_size:Cardinal);[public,alias:'FPC_STACKCHECK'];
+procedure fpc_stackcheck(stack_size:SizeUInt);[public,alias:'FPC_STACKCHECK']; compilerproc;
{
called when trying to get local stack if the compiler directive $S
is set this function must preserve all registers
diff --git a/rtl/win/sysosh.inc b/rtl/win/sysosh.inc
index 0f4be7f524..205d1c8be6 100644
--- a/rtl/win/sysosh.inc
+++ b/rtl/win/sysosh.inc
@@ -78,3 +78,7 @@ type
var
LibModuleList: PLibModule = nil;
+
+{$ifdef win64}
+procedure _fpc_local_unwind(frame,target: Pointer);compilerproc;
+{$endif}
diff --git a/rtl/win64/seh64.inc b/rtl/win64/seh64.inc
index 07d50787b3..c25e7cfbeb 100644
--- a/rtl/win64/seh64.inc
+++ b/rtl/win64/seh64.inc
@@ -306,7 +306,7 @@ begin
RaiseException(FPC_EXCEPTION_CODE,EXCEPTION_NONCONTINUABLE,4,@args[0]);
end;
-procedure localUnwind(frame,target: Pointer);[public,alias:'_FPC_local_unwind'];
+procedure _fpc_local_unwind(frame,target: Pointer);[public,alias:'_FPC_local_unwind'];compilerproc;
var
ctx: TContext;
begin