浏览代码

* 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: trunk@23325 -

Jonas Maebe 12 年之前
父节点
当前提交
69c29a415f

+ 4 - 2
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];

+ 6 - 4
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);

+ 4 - 2
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];

+ 11 - 7
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);

+ 4 - 2
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];

+ 9 - 5
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;

+ 76 - 65
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;
 

+ 6 - 4
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

+ 2 - 2
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);

+ 15 - 11
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

+ 4 - 2
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];

+ 11 - 9
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;

+ 6 - 3
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);

+ 6 - 3
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);

+ 4 - 2
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}
 

+ 11 - 5
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'));

+ 5 - 1
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);

+ 2 - 3
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

+ 36 - 16
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;
 

+ 15 - 8
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);

+ 1 - 1
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
 

+ 5 - 3
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

+ 5 - 3
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

+ 4 - 2
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;

+ 6 - 3
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);

+ 4 - 2
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];

+ 18 - 0
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;

+ 6 - 4
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) }

+ 5 - 3
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

+ 4 - 1
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}
 

+ 3 - 3
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

+ 1 - 0
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;

+ 2 - 0
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 !! }

+ 1 - 1
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

+ 4 - 3
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}

+ 1 - 1
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

+ 1 - 1
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

+ 1 - 1
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

+ 4 - 0
rtl/win/sysosh.inc

@@ -78,3 +78,7 @@ type
 
 var
   LibModuleList: PLibModule = nil;
+
+{$ifdef win64}
+procedure _fpc_local_unwind(frame,target: Pointer);compilerproc;
+{$endif}

+ 1 - 1
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