diff options
author | jonas <jonas@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2013-01-06 15:05:40 +0000 |
---|---|---|
committer | jonas <jonas@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2013-01-06 15:05:40 +0000 |
commit | 4d6426cefa69553d4e13911d77979f73ece885a7 (patch) | |
tree | a13ead72441b43e2f60c093f80d56b0cbd1b279c | |
parent | aed970802355a02175b1c0197fedf57c789e5a4d (diff) | |
download | fpc-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
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 |