* generate init_final table from actual uses clauses

compiler/jvm/njvmutil.pas

@@ -55,7 +55,7 @@ interface
       class procedure InsertResStrInits; override;
       class procedure InsertMemorySizes; override;
      protected
-       class procedure insert_init_final_table(entries:tfplist); override;
+       class procedure insert_init_final_table(main: tmodule; entries:tfplist); override;
      strict protected
        class procedure add_main_procdef_paras(pd: tdef); override;
     end;
@@ -387,24 +387,27 @@ implementation
         inherited;
     end;
 
-  class procedure tjvmnodeutils.insert_init_final_table(entries:tfplist);
+  class procedure tjvmnodeutils.insert_init_final_table(main: tmodule; entries:tfplist);
+
     var
       hp : tused_unit;
       unitinits : TAsmList;
       unitclassname: string;
       mainpsym: tsym;
       mainpd: tprocdef;
-    begin
-      { JVM does not use the entries list }
+      m : tmodule;
+      i : integer;
 
+    begin
       unitinits:=TAsmList.Create;
-      hp:=tused_unit(usedunits.first);
-      while assigned(hp) do
+      for I:=0 to entries.Count-1 do
         begin
+          hp:=tused_unit(entries[i]);
+          m:=hp.u;
           { class constructors are automatically handled by the JVM }
 
-          { call the unit init code and make it external }
-          if (hp.u.moduleflags*[mf_init,mf_finalize])<>[] then
+          { for non-main module, call the unit init code and make it external }
+          if (m<>main) and ((m.moduleflags*[mf_init,mf_finalize])<>[]) then
             begin
               { trigger init code by referencing the class representing the
                 unit; if necessary, it will register the fini code to run on
@@ -419,10 +422,10 @@ implementation
               unitinits.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(unitclassname,AT_METADATA)));
               unitinits.concat(taicpu.op_none(a_pop));
             end;
-          hp:=tused_unit(hp.next);
         end;
+
       { insert in main program routine }
-      mainpsym:=tsym(current_module.localsymtable.find(mainaliasname));
+      mainpsym:=tsym(main.localsymtable.find(mainaliasname));
       if not assigned(mainpsym) or
          (mainpsym.typ<>procsym) then
         internalerror(2011041901);

compiler/ngenutil.pas

@@ -113,14 +113,14 @@ interface
       class procedure insertbssdata(sym : tstaticvarsym); virtual;
 
       class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
-      class procedure InsertInitFinalTable;
+      class procedure InsertInitFinalTable(main : tmodule);
      protected
       class procedure InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:tmoduleflag); virtual;
       class procedure InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:tmoduleflag); virtual;
 
-      class procedure insert_init_final_table(entries:tfplist); virtual;
+      class procedure insert_init_final_table(main: tmodule; entries:tfplist); virtual;
 
-      class function get_init_final_list: tfplist;
+      class function get_init_final_list(main : tmodule): tfplist;
       class procedure release_init_final_list(list:tfplist);
      public
       class procedure InsertThreadvarTablesTable; virtual;
@@ -1020,37 +1020,56 @@ implementation
     end;
 
 
-  class function tnodeutils.get_init_final_list:tfplist;
+  class function tnodeutils.get_init_final_list(main : tmodule):tfplist;
+
+    procedure addusedunits(m : tmodule);
+
     var
       hp : tused_unit;
       entry : pinitfinalentry;
     begin
-      result:=tfplist.create;
-      { Insert initialization/finalization of the used units }
-      hp:=tused_unit(usedunits.first);
+      hp:=tused_unit(m.used_units.first);
       while assigned(hp) do
        begin
-         if (hp.u.moduleflags * [mf_init,mf_finalize])<>[] then
+         if (not hp.u.initfinalchecked) then
            begin
-             new(entry);
-             entry^.module:=hp.u;
-             entry^.initpd:=nil;
-             entry^.finipd:=nil;
-             if mf_init in hp.u.moduleflags then
-               entry^.initfunc:=make_mangledname('INIT$',hp.u.globalsymtable,'')
-             else
-               entry^.initfunc:='';
-             if mf_finalize in hp.u.moduleflags then
-               entry^.finifunc:=make_mangledname('FINALIZE$',hp.u.globalsymtable,'')
-             else
-               entry^.finifunc:='';
-             result.add(entry);
+           hp.u.initfinalchecked:=True;
+           addusedunits(hp.u);
+           if ((hp.u.moduleflags * [mf_init,mf_finalize])<>[]) then
+             begin
+               new(entry);
+               entry^.module:=hp.u;
+               entry^.initpd:=nil;
+               entry^.finipd:=nil;
+               if mf_init in hp.u.moduleflags then
+                 entry^.initfunc:=make_mangledname('INIT$',hp.u.globalsymtable,'')
+               else
+                 entry^.initfunc:='';
+               if mf_finalize in hp.u.moduleflags then
+                 entry^.finifunc:=make_mangledname('FINALIZE$',hp.u.globalsymtable,'')
+               else
+                 entry^.finifunc:='';
+               { Writeln('Adding Init/final for: ',hp.u.modulename^); }
+               result.add(entry);
+             end
+           {else
+              Writeln('NOT Adding Init/final for: ',hp.u.modulename^);}
            end;
          hp:=tused_unit(hp.next);
        end;
 
+    end;
+
+    var
+      entry : pinitfinalentry;
+    begin
+      result:=tfplist.create;
+
+      { Insert initialization/finalization of the used units }
+      addusedunits(main);
+
       { Insert initialization/finalization of the program }
-      if (current_module.moduleflags * [mf_init,mf_finalize])<>[] then
+      if (main.moduleflags * [mf_init,mf_finalize])<>[] then
         begin
           new(entry);
           entry^.module:=current_module;
@@ -1081,19 +1100,19 @@ implementation
     end;
 
 
-  class procedure tnodeutils.InsertInitFinalTable;
+  class procedure tnodeutils.InsertInitFinalTable(main : tmodule);
     var
       entries : tfplist;
     begin
-      entries := get_init_final_list;
+      entries := get_init_final_list(main);
 
-      insert_init_final_table(entries);
+      insert_init_final_table(main,entries);
 
       release_init_final_list(entries);
     end;
 
 
-  class procedure tnodeutils.insert_init_final_table(entries:tfplist);
+  class procedure tnodeutils.insert_init_final_table(main : tmodule; entries:tfplist);
     var
       i : longint;
       unitinits : ttai_typedconstbuilder;

compiler/pmodules.pas

@@ -1028,7 +1028,7 @@ implementation
 
 
 {$ifdef jvm}
-      procedure addmoduleclass;
+      procedure addmoduleclass(curr : tmodule);
         var
           def: tobjectdef;
           typesym: ttypesym;
@@ -1065,8 +1065,6 @@ type
 
 
       begin
-        if (curr.modulename^='OGBASE') then
-          Writeln('Here');
         result:=true;
         init_procinfo:=nil;
         finalize_procinfo:=nil;
@@ -1160,7 +1158,7 @@ type
 
 {$ifdef jvm}
          { fake classdef to represent the class corresponding to the unit }
-         addmoduleclass;
+         addmoduleclass(curr);
 {$endif}
         read_interface_declarations;
 
@@ -2476,7 +2474,7 @@ type
 
   {$ifdef jvm}
         { fake classdef to represent the class corresponding to the unit }
-        addmoduleclass;
+        addmoduleclass(curr);
   {$endif}
 
         { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it }