compiler: add class constructors, class destructors to the initfinal table as regular initialization/finalization sections (class constructors is still not striped away with the class)

git-svn-id: trunk@15143 -

compiler/nflw.pas

@@ -556,7 +556,7 @@ begin
   if enumerator_is_class then
   begin
     { insert a try-finally and call the destructor for the enumerator in the finally section }
-    enumerator_destructor:=tobjectdef(enumerator_get.returndef).Finddestructor;
+    enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor;
     if assigned(enumerator_destructor) then
     begin
       whileloopnode:=ctryfinallynode.create(
@@ -577,7 +577,7 @@ begin
   if is_object(enumerator_get.returndef) then
   begin
     // call the object destructor too
-    enumerator_destructor:=tobjectdef(enumerator_get.returndef).Finddestructor;
+    enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor;
     if assigned(enumerator_destructor) then
     begin
       addstatement(loopstatement,

compiler/pdecobj.pas

@@ -40,7 +40,7 @@ implementation
       symbase,symsym,symtable,
       node,nld,nmem,ncon,ncnv,ncal,
       fmodule,scanner,
-      pbase,pexpr,pdecsub,pdecvar,ptype,pdecl
+      pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,ppu
       ;
 
     const
@@ -68,6 +68,7 @@ implementation
           Message(parser_e_no_paras_for_class_constructor);
         consume(_SEMICOLON);
         include(current_objectdef.objectoptions,oo_has_class_constructor);
+        current_module.flags:=current_module.flags or uf_classinits;
         { no return value }
         pd.returndef:=voidtype;
         result:=pd;
@@ -180,6 +181,7 @@ implementation
           Message(parser_e_no_paras_for_class_destructor);
         consume(_SEMICOLON);
         include(current_objectdef.objectoptions,oo_has_class_destructor);
+        current_module.flags:=current_module.flags or uf_classinits;
         { no return value }
         pd.returndef:=voidtype;
         result:=pd;

compiler/pmodules.pas

@@ -376,46 +376,89 @@ implementation
         ResourceStringTables.free;
       end;
 
+    procedure AddToClasInits(p:TObject;arg:pointer);
+      var
+        ClassList: TFPList absolute arg;
+      begin
+        if (tdef(p).typ=objectdef) and
+           ([oo_has_class_constructor,oo_has_class_destructor] * tobjectdef(p).objectoptions <> []) then
+          ClassList.Add(p);
+      end;
 
     procedure InsertInitFinalTable;
       var
         hp : tused_unit;
         unitinits : TAsmList;
         count : longint;
+
+        procedure write_class_inits(u: tmodule);
+          var
+            i: integer;
+            classlist: TFPList;
+            pd: tprocdef;
+          begin
+            classlist := TFPList.Create;
+            if assigned(u.globalsymtable) then
+              u.globalsymtable.DefList.ForEachCall(@AddToClasInits,classlist);
+            u.localsymtable.DefList.ForEachCall(@AddToClasInits,classlist);
+            { write classes }
+            for i := 0 to classlist.Count - 1 do
+            begin
+              pd := tobjectdef(classlist[i]).find_procdef_bytype(potype_class_constructor);
+              if assigned(pd) then
+                unitinits.concat(Tai_const.Createname(pd.mangledname,0))
+              else
+                unitinits.concat(Tai_const.Create_pint(0));
+              pd := tobjectdef(classlist[i]).find_procdef_bytype(potype_class_destructor);
+              if assigned(pd) then
+                unitinits.concat(Tai_const.Createname(pd.mangledname,0))
+              else
+                unitinits.concat(Tai_const.Create_pint(0));
+              inc(count);
+            end;
+            classlist.free;
+          end;
+
       begin
         unitinits:=TAsmList.Create;
         count:=0;
         hp:=tused_unit(usedunits.first);
         while assigned(hp) do
          begin
+           { insert class constructors/destructors of the unit }
+           if (hp.u.flags and uf_classinits) <> 0 then
+             write_class_inits(hp.u);
            { call the unit init code and make it external }
            if (hp.u.flags and (uf_init or uf_finalize))<>0 then
-            begin
-              if (hp.u.flags and uf_init)<>0 then
-               unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',hp.u.globalsymtable,''),0))
-              else
-               unitinits.concat(Tai_const.Create_sym(nil));
-              if (hp.u.flags and uf_finalize)<>0 then
-               unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',hp.u.globalsymtable,''),0))
-              else
-               unitinits.concat(Tai_const.Create_sym(nil));
-              inc(count);
-            end;
+             begin
+               if (hp.u.flags and uf_init)<>0 then
+                 unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',hp.u.globalsymtable,''),0))
+               else
+                 unitinits.concat(Tai_const.Create_sym(nil));
+               if (hp.u.flags and uf_finalize)<>0 then
+                 unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',hp.u.globalsymtable,''),0))
+               else
+                 unitinits.concat(Tai_const.Create_sym(nil));
+               inc(count);
+             end;
            hp:=tused_unit(hp.next);
          end;
+        { insert class constructors/destructor of the program }
+        if (current_module.flags and uf_classinits) <> 0 then
+          write_class_inits(current_module);
         { Insert initialization/finalization of the program }
         if (current_module.flags and (uf_init or uf_finalize))<>0 then
-         begin
-           if (current_module.flags and uf_init)<>0 then
-            unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',current_module.localsymtable,''),0))
-           else
-            unitinits.concat(Tai_const.Create_sym(nil));
-           if (current_module.flags and uf_finalize)<>0 then
-            unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',current_module.localsymtable,''),0))
-           else
-            unitinits.concat(Tai_const.Create_sym(nil));
-           inc(count);
-         end;
+          begin
+            if (current_module.flags and uf_init)<>0 then
+              unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',current_module.localsymtable,''),0))
+            else
+              unitinits.concat(Tai_const.Create_sym(nil));
+            if (current_module.flags and uf_finalize)<>0 then
+              unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',current_module.localsymtable,''),0))
+            else
+              unitinits.concat(Tai_const.Create_sym(nil));
+            inc(count);
+          end;
         { Insert TableCount,InitCount at start }
         unitinits.insert(Tai_const.Create_32bit(0));
         unitinits.insert(Tai_const.Create_32bit(count));
@@ -429,7 +472,7 @@ implementation
       end;
 
 
-    procedure insertmemorysizes;
+    procedure InsertMemorySizes;
 {$IFDEF POWERPC}
       var
         stkcookie: string;
@@ -1343,7 +1386,7 @@ implementation
          write_persistent_type_info(current_module.localsymtable);
 
          { Tables }
-         insertThreadVars;
+         InsertThreadvars;
 
          { Resource strings }
          GenerateResourceStrings;
@@ -2329,11 +2372,11 @@ implementation
          InsertWideInits;
 
          { insert Tables and StackLength }
-         insertinitfinaltable;
+         InsertInitFinalTable;
          InsertThreadvarTablesTable;
          InsertResourceTablesTable;
          InsertWideInitsTablesTable;
-         insertmemorysizes;
+         InsertMemorySizes;
 
          { Insert symbol to resource info }
          InsertResourceInfo(resources_used);

compiler/ppu.pas

@@ -135,30 +135,29 @@ const
   iblinkotherframeworks = 100;
 
 { unit flags }
-  uf_init          = $1;
-  uf_finalize      = $2;
-  uf_big_endian    = $4;
-//  uf_has_browser   = $10;
-  uf_in_library    = $20;     { is the file in another file than <ppufile>.* ? }
-  uf_smart_linked  = $40;     { the ppu can be smartlinked }
-  uf_static_linked = $80;     { the ppu can be linked static }
-  uf_shared_linked = $100;    { the ppu can be linked shared }
-//  uf_local_browser = $200;
-  uf_no_link       = $400;    { unit has no .o generated, but can still have
-                                external linking! }
-  uf_has_resourcestrings = $800;    { unit has resource string section }
-  uf_little_endian = $1000;
-  uf_release       = $2000;   { unit was compiled with -Ur option }
-  uf_threadvars    = $4000;   { unit has threadvars }
-  uf_fpu_emulation = $8000;   { this unit was compiled with fpu emulation on }
-  uf_has_stabs_debuginfo = $10000;  { this unit has stabs debuginfo generated }
-  uf_local_symtable = $20000; { this unit has a local symtable stored }
-  uf_uses_variants  = $40000; { this unit uses variants }
-  uf_has_resourcefiles = $80000; { this unit has external resources (using $R directive)}
-  uf_has_exports = $100000;   { this module or a used unit has exports }
-  uf_has_dwarf_debuginfo = $200000;  { this unit has dwarf debuginfo generated }
-  uf_wideinits = $400000;     { this unit has winlike widestring typed constants }
-
+  uf_init                = $000001; { unit has initialization section }
+  uf_finalize            = $000002; { unit has finalization section   }
+  uf_big_endian          = $000004;
+//uf_has_browser         = $000010;
+  uf_in_library          = $000020; { is the file in another file than <ppufile>.* ? }
+  uf_smart_linked        = $000040; { the ppu can be smartlinked }
+  uf_static_linked       = $000080; { the ppu can be linked static }
+  uf_shared_linked       = $000100; { the ppu can be linked shared }
+//uf_local_browser       = $000200;
+  uf_no_link             = $000400; { unit has no .o generated, but can still have external linking! }
+  uf_has_resourcestrings = $000800; { unit has resource string section }
+  uf_little_endian       = $001000;
+  uf_release             = $002000; { unit was compiled with -Ur option }
+  uf_threadvars          = $004000; { unit has threadvars }
+  uf_fpu_emulation       = $008000; { this unit was compiled with fpu emulation on }
+  uf_has_stabs_debuginfo = $010000; { this unit has stabs debuginfo generated }
+  uf_local_symtable      = $020000; { this unit has a local symtable stored }
+  uf_uses_variants       = $040000; { this unit uses variants }
+  uf_has_resourcefiles   = $080000; { this unit has external resources (using $R directive)}
+  uf_has_exports         = $100000; { this module or a used unit has exports }
+  uf_has_dwarf_debuginfo = $200000; { this unit has dwarf debuginfo generated }
+  uf_wideinits           = $400000; { this unit has winlike widestring typed constants }
+  uf_classinits          = $800000; { this unit has class constructors/destructors }
 
 type
   { bestreal is defined based on the target architecture }

compiler/psub.pas

@@ -490,7 +490,7 @@ implementation
             { why (JM)                                                      }
             oldlocalswitches:=current_settings.localswitches;
             current_settings.localswitches:=oldlocalswitches-[cs_check_object,cs_check_range];
-            pd:=current_objectdef.Finddestructor;
+            pd:=current_objectdef.find_destructor;
             if assigned(pd) then
               begin
                 { if vmt<>0 then call destructor }

compiler/symdef.pas

@@ -293,14 +293,15 @@ interface
           { this should be called when this class implements an interface }
           procedure prepareguid;
           function  is_publishable : boolean;override;
+          function  is_related(d : tdef) : boolean;override;
           function  needs_inittable : boolean;override;
           function  rtti_mangledname(rt:trttitype):string;override;
           function  vmt_mangledname : string;
           procedure check_forwards;
-          function  is_related(d : tdef) : boolean;override;
           procedure insertvmt;
           procedure set_parent(c : tobjectdef);
-          function FindDestructor : tprocdef;
+          function find_procdef_bytype(pt:tproctypeoption): tprocdef;
+          function find_destructor: tprocdef;
           function implements_any_interfaces: boolean;
           procedure reset; override;
           { dispinterface support }
@@ -3299,7 +3300,8 @@ implementation
         if assigned(_class) then
          begin
            s:=_class.RttiName+'.';
-           if (po_classmethod in procoptions) then
+           if (po_classmethod in procoptions) and
+              not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then
              s:='class ' + s;
          end;
         if owner.symtabletype=localsymtable then
@@ -3333,7 +3335,8 @@ implementation
         { forced calling convention? }
         if (po_hascallingconvention in procoptions) then
           s:=s+' '+ProcCallOptionStr[proccalloption]+';';
-        if po_staticmethod in procoptions then
+        if (po_staticmethod in procoptions) and
+           not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then
           s:=s+' Static;';
         fullprocname:=s;
       end;
@@ -4398,33 +4401,37 @@ implementation
         is_related:=false;
      end;
 
+   function tobjectdef.find_procdef_bytype(pt:tproctypeoption): tprocdef;
+     var
+       i: longint;
+       sym: tsym;
+     begin
+       for i:=0 to symtable.SymList.Count-1 do
+         begin
+           sym:=tsym(symtable.SymList[i]);
+           if sym.typ=procsym then
+             begin
+               result:=tprocsym(sym).find_procdef_bytype(pt);
+               if assigned(result) then
+                 exit;
+             end;
+         end;
+         result:=nil;
+     end;
 
-   function tobjectdef.FindDestructor : tprocdef;
+   function tobjectdef.find_destructor: tprocdef;
      var
-        objdef : tobjectdef;
-        i   : longint;
-        sym : tsym;
-        pd  : tprocdef;
+       objdef: tobjectdef;
      begin
-        result:=nil;
         objdef:=self;
         while assigned(objdef) do
           begin
-            for i:=0 to objdef.symtable.SymList.Count-1 do
-              begin
-                sym:=TSym(objdef.symtable.SymList[i]);
-                if sym.typ=procsym then
-                  begin
-                    pd:=Tprocsym(sym).Find_procdef_bytype(potype_destructor);
-                    if assigned(pd) then
-                      begin
-                        result:=pd;
-                        exit;
-                      end;
-                  end;
-               end;
-             objdef:=objdef.childof;
+            result:=find_procdef_bytype(potype_destructor);
+            if assigned(result) then
+              exit;
+            objdef:=objdef.childof;
           end;
+        result:=nil;
      end;
 
     function tobjectdef.implements_any_interfaces: boolean;