* extend tabstractprocdef.getcopyas by a parameter to control whether the copy should be registered or not

compiler/arm/symcpu.pas

@@ -101,7 +101,7 @@ type
     { library symbol for AROS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -208,7 +208,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

compiler/blockutl.pas

@@ -207,7 +207,7 @@ implementation
           exit;
         end;
       { bare copy, so that self etc are not inserted }
-      result:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,''));
+      result:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,'',true));
       { will be called accoding to the ABI conventions }
       result.proccalloption:=pocall_cdecl;
       { add po_is_block so that a block "self" pointer gets added (of the type

compiler/i386/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AROS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

compiler/i8086/symcpu.pas

@@ -110,7 +110,7 @@ type
 
   tcpuprocvardef = class(ti86procvardef)
     constructor create(level:byte;doregister:boolean);override;
-    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;override;
+    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string;doregister:boolean):tstoreddef;override;
     function address_type:tdef;override;
     function ofs_address_type:tdef;override;
     function size:asizeint;override;
@@ -134,7 +134,7 @@ type
     procedure Setinterfacedef(AValue: boolean);override;
    public
     constructor create(level:byte;doregister:boolean);override;
-    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;override;
+    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string;doregister:boolean):tstoreddef;override;
     function address_type:tdef;override;
     function ofs_address_type:tdef;override;
     function size:asizeint;override;
@@ -357,7 +357,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string;doregister:boolean):tstoreddef;
     begin
       result:=inherited;
       handle_procdef_copyas(self,is_far,copytyp,tabstractprocdef(result));
@@ -448,7 +448,7 @@ implementation
     end;
 
 
-  function tcpuprocvardef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;
+  function tcpuprocvardef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string;doregister:boolean):tstoreddef;
     begin
       result:=inherited;
       handle_procdef_copyas(self,is_far,copytyp,tabstractprocdef(result));

compiler/jvm/pjvm.pas

@@ -370,7 +370,7 @@ implementation
 
         { add a method to call the procvar using unwrapped arguments, which
           then wraps them and calls through to JLRMethod.invoke }
-        methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
+        methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,'',true));
         finish_copied_procdef(methoddef,'invoke',pvclass.symtable,pvclass);
         methoddef.synthetickind:=tsk_jvm_procvar_invoke;
         methoddef.calcparas;
@@ -403,7 +403,7 @@ implementation
             { add a method prototype matching the procvar (like the invoke
               in the procvarclass itself) }
             symtablestack.push(pvintf.symtable);
-            methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
+            methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,'',true));
             finish_copied_procdef(methoddef,name+'Callback',pvintf.symtable,pvintf);
             { can't be final/static/private/protected, and must be virtual
               since it's an interface method }
@@ -467,7 +467,7 @@ implementation
         { wrapper is part of the same symtable as the original procdef }
         symtablestack.push(pd.owner);
         { get a copy of the virtual class method }
-        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_normal_no_hidden,''));
+        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_normal_no_hidden,'',true));
         { this one is not virtual nor override }
         exclude(wrapperpd.procoptions,po_virtualmethod);
         exclude(wrapperpd.procoptions,po_overridingmethod);
@@ -498,7 +498,7 @@ implementation
         wrapperpd.synthetickind:=tsk_jvm_virtual_clmethod;
         wrapperpd.skpara:=pd;
         { also create procvar type that we can use in the implementation }
-        wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal_no_hidden,''));
+        wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal_no_hidden,'',true));
         handle_calling_convention(wrapperpv,hcc_default_actions_intf);
         { no use in creating a callback wrapper here, this procvar type isn't
           for public consumption }
@@ -526,7 +526,7 @@ implementation
         { wrapper is part of the same symtable as the original procdef }
         symtablestack.push(pd.owner);
         { get a copy of the constructor }
-        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_bareproc,''));
+        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_bareproc,'',true));
         { this one is a class method rather than a constructor }
         include(wrapperpd.procoptions,po_classmethod);
         wrapperpd.proctypeoption:=potype_function;

compiler/jvm/symcpu.pas

@@ -336,7 +336,7 @@ implementation
                           proc_add_definition will give an error }
                       end;
                     { add method with the correct visibility }
-                    pd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,''));
+                    pd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,'',true));
                     { get rid of the import accessorname for inherited virtual class methods,
                       it has to be regenerated rather than amended }
                     if [po_classmethod,po_virtualmethod]<=pd.procoptions then
@@ -396,7 +396,7 @@ implementation
           begin
             { getter/setter could have parameters in case of indexed access
               -> copy original procdef }
-            pd:=tprocdef(orgaccesspd.getcopyas(procdef,pc_normal_no_hidden,''));
+            pd:=tprocdef(orgaccesspd.getcopyas(procdef,pc_normal_no_hidden,'',true));
             exclude(pd.procoptions,po_abstractmethod);
             exclude(pd.procoptions,po_overridingmethod);
             { can only construct the artificial accessorname now, because it requires

compiler/m68k/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AmigaOS/MorphOS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

compiler/powerpc/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AmigaOS/MorphOS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

compiler/symcreat.pas

@@ -357,7 +357,7 @@ implementation
             end;
           { if we get here, we did not find it in the current objectdef ->
             add }
-          childpd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,''));
+          childpd:=tprocdef(parentpd.getcopyas(procdef,pc_normal_no_hidden,'',true));
           { get rid of the import name for inherited virtual class methods,
             it has to be regenerated rather than amended }
           if [po_classmethod,po_virtualmethod]<=childpd.procoptions then
@@ -1163,7 +1163,7 @@ implementation
         parameter names so we don't get issues in the body in case
         we e.g. reference system.initialize and one of the parameters
         is called "system") }
-      result:=tprocdef(pd.getcopyas(procdef,pc_bareproc,'__FPCW_'));
+      result:=tprocdef(pd.getcopyas(procdef,pc_bareproc,'__FPCW_',true));
       { set the mangled name to the wrapper name }
       result.setmangledname(newmangledname);
       { finish creating the copy }
@@ -1436,7 +1436,7 @@ implementation
 
       { prefixing the parameters here is useless, because the new procdef will
         just be an external declaration without a body }
-      newpd:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,''));
+      newpd:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,'',true));
       insert_funcret_para(newpd);
       newpd.procoptions:=newpd.procoptions+orgpd.procoptions*[po_external,po_has_importname,po_has_importdll];
       stringdispose(orgpd.import_name);

compiler/symdef.pas

@@ -711,7 +711,7 @@ interface
           function  is_addressonly:boolean;virtual;
           function  no_self_node:boolean;
           { get either a copy as a procdef or procvardef }
-          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef; virtual;
+          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; virtual;
           function  compatible_with_pointerdef_size(ptr: tpointerdef): boolean; virtual;
           procedure check_mark_as_nested;
           procedure init_paraloc_info(side: tcallercallee);
@@ -752,7 +752,7 @@ interface
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
           function  getmangledparaname:TSymStr;override;
-          function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
+          function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
        end;
        tprocvardefclass = class of tprocvardef;
 
@@ -895,7 +895,7 @@ interface
                 needs to be finalised afterwards by calling
                 symcreat.finish_copied_procdef() afterwards
           }
-          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef; override;
+          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
           function  getcopy: tstoreddef; override;
           function  GetTypeName : string;override;
           function  mangledname : TSymStr; virtual;
@@ -5774,7 +5774,7 @@ implementation
       end;
 
 
-    function tabstractprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef;
+    function tabstractprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
       var
         j, nestinglevel: longint;
         pvs, npvs: tparavarsym;
@@ -5783,9 +5783,9 @@ implementation
         if newtyp=procdef then
           begin
             if (copytyp<>pc_bareproc) then
-              result:=cprocdef.create(nestinglevel,true)
+              result:=cprocdef.create(nestinglevel,doregister)
             else
-              result:=cprocdef.create(normal_function_level,true);
+              result:=cprocdef.create(normal_function_level,doregister);
             tprocdef(result).visibility:=vis_public;
           end
         else
@@ -6815,7 +6815,7 @@ implementation
       end;
 
 
-    function tprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
+    function tprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
       var
         j : longint;
       begin
@@ -6886,7 +6886,7 @@ implementation
 
     function tprocdef.getcopy: tstoreddef;
       begin
-        result:=getcopyas(procdef,pc_normal,'');
+        result:=getcopyas(procdef,pc_normal,'',true);
       end;
 
 
@@ -7281,7 +7281,7 @@ implementation
             { do not simply push/pop current_module.localsymtable, because
               that can have side-effects (e.g., it removes helpers) }
             symtablestack:=nil;
-            result:=tprocvardef(def.getcopyas(procvardef,copytyp,''));
+            result:=tprocvardef(def.getcopyas(procvardef,copytyp,'',true));
             setup_reusable_def(def,result,res,oldsymtablestack);
             { res^.Data may still be nil -> don't overwrite result }
             exit;
@@ -7420,7 +7420,7 @@ implementation
       end;
 
 
-    function tprocvardef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
+    function tprocvardef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
       begin
         result:=inherited;
         tabstractprocdef(result).calcparas;

compiler/x86_64/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AROS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string;doregister:boolean): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then