+ support for unit initialisation sections for the JVM target,

    and initialise global variables that are wrapped (records, arrays)
    in those sections
   o check whether pd.localst is assigned in dbgjasm, because it's
     not for the unit initialisation routine
   o moved insertbssdata() from ncgutil to ngenutil and override it
     njvmutil (it does nothing in the latter, since global variables
     are added as fields to the class representing the unit; the
     initialisation is done in gen_initialize_code() in thlcgjvm)
   o added force_init() and force_final() methods to ngenutil, so
     that targets can force init/final routines separate from the
     regular managed types infrastructure (used by JVM for forcing
     an init section in case of records/arrays)

git-svn-id: branches/jvmbackend@18460 -

compiler/jvm/dbgjasm.pas

@@ -116,7 +116,9 @@ implementation
       fcurrprocend:=procendlabel;
 
       write_symtable_parasyms(list,def.paras);
-      write_symtable_syms(list,def.localst);
+      { not assigned for unit init }
+      if assigned(def.localst) then
+        write_symtable_syms(list,def.localst);
     end;
 
 

compiler/jvm/hlcgcpu.pas

@@ -29,7 +29,7 @@ interface
 uses
   globtype,
   aasmbase,aasmdata,
-  symbase,symconst,symtype,symdef,
+  symbase,symconst,symtype,symdef,symsym,
   cpubase, hlcgobj, cgbase, cgutils, parabase;
 
   type
@@ -98,6 +98,8 @@ uses
       procedure g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister); override;
       procedure g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation); override;
 
+      procedure gen_initialize_code(list: TAsmList); override;
+
       { JVM-specific routines }
 
       procedure a_load_stack_reg(list : TAsmList;size: tdef;reg: tregister);
@@ -149,7 +151,8 @@ uses
 
       procedure gen_initialize_fields_code(list:TAsmList);
      protected
-      procedure allocate_implicit_structs_for_st_with_base_ref(list: TAsmList; st: tsymtable; ref: treference; allocvartyp: tsymtyp);
+      procedure allocate_implicit_structs_for_st_with_base_ref(list: TAsmList; st: tsymtable; const ref: treference; allocvartyp: tsymtyp);
+      procedure allocate_implicit_struct_with_base_ref(list: TAsmList; vs: tabstractvarsym; ref: treference);
       procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
 
       procedure inittempvariables(list:TAsmList);override;
@@ -196,10 +199,10 @@ uses
 implementation
 
   uses
-    verbose,cutils,globals,
+    verbose,cutils,globals,fmodule,
     defutil,
     aasmtai,aasmcpu,
-    symtable,symsym,jvmdef,
+    symtable,jvmdef,
     procinfo,cgcpu,tgobj;
 
   const
@@ -1431,6 +1434,24 @@ implementation
       // do nothing, long live garbage collection!
     end;
 
+  procedure thlcgjvm.gen_initialize_code(list: TAsmList);
+    var
+      ref: treference;
+    begin
+      { create globals with wrapped types such as arrays/records  }
+      case current_procinfo.procdef.proctypeoption of
+        potype_unitinit:
+          begin
+            reference_reset_base(ref,NR_NO,0,1);
+            if assigned(current_module.globalsymtable) then
+              allocate_implicit_structs_for_st_with_base_ref(list,current_module.globalsymtable,ref,staticvarsym);
+            allocate_implicit_structs_for_st_with_base_ref(list,current_module.localsymtable,ref,staticvarsym);
+          end;
+        else
+          inherited
+      end;
+    end;
+
   procedure thlcgjvm.a_load_stack_reg(list: TAsmList; size: tdef; reg: tregister);
     var
       opc: tasmop;
@@ -1677,9 +1698,21 @@ implementation
         end;
     end;
 
-  procedure thlcgjvm.allocate_implicit_structs_for_st_with_base_ref(list: TAsmList; st: tsymtable; ref: treference; allocvartyp: tsymtyp);
+  procedure thlcgjvm.allocate_implicit_struct_with_base_ref(list: TAsmList; vs: tabstractvarsym; ref: treference);
     var
       tmpref: treference;
+    begin
+      ref.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname);
+      tg.gethltemp(list,vs.vardef,vs.vardef.size,tt_persistent,tmpref);
+      { only copy the reference, not the actual data }
+      a_load_ref_ref(list,java_jlobject,java_jlobject,tmpref,ref);
+      { remains live since there's still a reference to the created
+        entity }
+      tg.ungettemp(list,tmpref);
+    end;
+
+  procedure thlcgjvm.allocate_implicit_structs_for_st_with_base_ref(list: TAsmList; st: tsymtable; const ref: treference; allocvartyp: tsymtyp);
+    var
       vs: tabstractvarsym;
       i: longint;
     begin
@@ -1690,13 +1723,7 @@ implementation
           vs:=tabstractvarsym(st.symlist[i]);
           if not jvmimplicitpointertype(vs.vardef) then
             continue;
-          ref.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname);
-          tg.gethltemp(list,vs.vardef,vs.vardef.size,tt_persistent,tmpref);
-          { only copy the reference, not the actual data }
-          a_load_ref_ref(list,java_jlobject,java_jlobject,tmpref,ref);
-          { remains live since there's still a reference to the created
-            entity }
-          tg.ungettemp(list,tmpref);
+          allocate_implicit_struct_with_base_ref(list,vs,ref);
         end;
     end;
 

compiler/jvm/njvmutil.pas

@@ -27,13 +27,16 @@ interface
 
   uses
     node,
-    ngenutil;
+    ngenutil,
+    symsym;
 
 
   type
     tjvmnodeutils = class(tnodeutils)
       class function initialize_data_node(p:tnode):tnode; override;
       class function finalize_data_node(p:tnode):tnode; override;
+      class function force_init: boolean; override;
+      class procedure insertbssdata(sym: tstaticvarsym); override;
     end;
 
 
@@ -41,7 +44,8 @@ implementation
 
     uses
       verbose,constexp,
-      symconst,symtype,symdef,symsym,symbase,symtable,defutil,
+      aasmdata,aasmtai,
+      symconst,symtype,symdef,symbase,symtable,defutil,jvmdef,
       nbas,ncnv,ncon,ninl,ncal,
       pass_1;
 
@@ -81,6 +85,24 @@ implementation
       result:=cnothingnode.create;
     end;
 
+
+  class function tjvmnodeutils.force_init: boolean;
+    begin
+      { we need an initialisation in case the al_globals list is not empty
+        (that's where the initialisation for global records is added) }
+      result:=not current_asmdata.asmlists[al_globals].empty;
+    end;
+
+  class procedure tjvmnodeutils.insertbssdata(sym: tstaticvarsym);
+    begin
+      { handled while generating the unit/program init code, or class
+        constructor; add something to al_globals to indicate that we need to
+        insert an init section though }
+      if current_asmdata.asmlists[al_globals].empty and
+         jvmimplicitpointertype(sym.vardef) then
+        current_asmdata.asmlists[al_globals].concat(cai_align.Create(1));
+    end;
+
 begin
   cnodeutils:=tjvmnodeutils;
 end.

compiler/ncgutil.pas

@@ -144,8 +144,6 @@ interface
     procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel);
     procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
 
-    procedure insertbssdata(sym : tstaticvarsym);
-
     procedure gen_alloc_symtable(list:TAsmList;st:TSymtable);
     procedure gen_free_symtable(list:TAsmList;st:TSymtable);
 
@@ -2128,66 +2126,6 @@ implementation
                                Const Data
 ****************************************************************************}
 
-    procedure insertbssdata(sym : tstaticvarsym);
-      var
-        l : asizeint;
-        varalign : shortint;
-        storefilepos : tfileposinfo;
-        list : TAsmList;
-        sectype : TAsmSectiontype;
-      begin
-        storefilepos:=current_filepos;
-        current_filepos:=sym.fileinfo;
-        l:=sym.getsize;
-        varalign:=sym.vardef.alignment;
-        if (varalign=0) then
-          varalign:=var_align_size(l)
-        else
-          varalign:=var_align(varalign);
-        if tf_section_threadvars in target_info.flags then
-          begin
-            if (vo_is_thread_var in sym.varoptions) then
-              begin
-                list:=current_asmdata.asmlists[al_threadvars];
-                sectype:=sec_threadvar;
-              end
-            else
-              begin
-                list:=current_asmdata.asmlists[al_globals];
-                sectype:=sec_bss;
-              end;
-          end
-        else
-          begin
-            if (vo_is_thread_var in sym.varoptions) then
-              begin
-                inc(l,sizeof(pint));
-                { it doesn't help to set a higher alignment, as  }
-                { the first sizeof(pint) bytes field will offset }
-                { everything anyway                              }
-                varalign:=sizeof(pint);
-              end;
-            list:=current_asmdata.asmlists[al_globals];
-            sectype:=sec_bss;
-          end;
-        maybe_new_object_file(list);
-        if vo_has_section in sym.varoptions then
-          new_section(list,sec_user,sym.section,varalign)
-        else
-          new_section(list,sectype,lower(sym.mangledname),varalign);
-        if (sym.owner.symtabletype=globalsymtable) or
-           create_smartlink or
-           DLLSource or
-           (assigned(current_procinfo) and
-            (po_inline in current_procinfo.procdef.procoptions)) or
-           (vo_is_public in sym.varoptions) then
-          list.concat(Tai_datablock.create_global(sym.mangledname,l))
-        else
-          list.concat(Tai_datablock.create(sym.mangledname,l));
-        current_filepos:=storefilepos;
-      end;
-
-
     procedure gen_alloc_symtable(list:TAsmList;st:TSymtable);
 
         procedure setlocalloc(vs:tabstractnormalvarsym);

compiler/ngenutil.pas

@@ -27,7 +27,7 @@ unit ngenutil;
 interface
 
   uses
-    node;
+    node,symsym;
 
 
   type
@@ -35,6 +35,15 @@ interface
       class function call_fail_node:tnode; virtual;
       class function initialize_data_node(p:tnode):tnode; virtual;
       class function finalize_data_node(p:tnode):tnode; virtual;
+      { returns true if the unit requires an initialisation section (e.g.,
+        to force class constructors for the JVM target to initialise global
+        records/arrays) }
+      class function force_init: boolean; virtual;
+      { idem for finalization }
+      class function force_final: boolean; virtual;
+
+      class procedure insertbssdata(sym : tstaticvarsym); virtual;
+
     end;
     tnodeutilsclass = class of tnodeutils;
 
@@ -45,9 +54,12 @@ interface
 implementation
 
     uses
-      verbose,constexp,
-      symconst,symtype,symdef,symsym,symbase,symtable,defutil,
+      verbose,globtype,globals,cutils,constexp,
+      scanner,systems,procinfo,
+      aasmbase,aasmdata,aasmtai,
+      symconst,symtype,symdef,symbase,symtable,defutil,
       nadd,nbas,ncal,ncnv,ncon,nflw,nld,nmem,nobj,nutils,
+
       pass_1;
 
   class function tnodeutils.call_fail_node:tnode;
@@ -205,4 +217,76 @@ implementation
     end;
 
 
+  class function tnodeutils.force_init: boolean;
+    begin
+      result:=false;
+    end;
+
+
+  class function tnodeutils.force_final: boolean;
+    begin
+      result:=false;
+    end;
+
+
+  class procedure tnodeutils.insertbssdata(sym: tstaticvarsym);
+    var
+      l : asizeint;
+      varalign : shortint;
+      storefilepos : tfileposinfo;
+      list : TAsmList;
+      sectype : TAsmSectiontype;
+    begin
+      storefilepos:=current_filepos;
+      current_filepos:=sym.fileinfo;
+      l:=sym.getsize;
+      varalign:=sym.vardef.alignment;
+      if (varalign=0) then
+        varalign:=var_align_size(l)
+      else
+        varalign:=var_align(varalign);
+      if tf_section_threadvars in target_info.flags then
+        begin
+          if (vo_is_thread_var in sym.varoptions) then
+            begin
+              list:=current_asmdata.asmlists[al_threadvars];
+              sectype:=sec_threadvar;
+            end
+          else
+            begin
+              list:=current_asmdata.asmlists[al_globals];
+              sectype:=sec_bss;
+            end;
+        end
+      else
+        begin
+          if (vo_is_thread_var in sym.varoptions) then
+            begin
+              inc(l,sizeof(pint));
+              { it doesn't help to set a higher alignment, as  }
+              { the first sizeof(pint) bytes field will offset }
+              { everything anyway                              }
+              varalign:=sizeof(pint);
+            end;
+          list:=current_asmdata.asmlists[al_globals];
+          sectype:=sec_bss;
+        end;
+      maybe_new_object_file(list);
+      if vo_has_section in sym.varoptions then
+        new_section(list,sec_user,sym.section,varalign)
+      else
+        new_section(list,sectype,lower(sym.mangledname),varalign);
+      if (sym.owner.symtabletype=globalsymtable) or
+         create_smartlink or
+         DLLSource or
+         (assigned(current_procinfo) and
+          (po_inline in current_procinfo.procdef.procoptions)) or
+         (vo_is_public in sym.varoptions) then
+        list.concat(Tai_datablock.create_global(sym.mangledname,l))
+      else
+        list.concat(Tai_datablock.create(sym.mangledname,l));
+      current_filepos:=storefilepos;
+    end;
+
+
 end.

compiler/pdecl.pas

@@ -67,7 +67,7 @@ implementation
        { pass 1 }
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj,
        { codegen }
-       ncgutil,
+       ncgutil,ngenutil,
        { parser }
        scanner,
        pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,
@@ -332,7 +332,7 @@ implementation
                       begin
                         labelsym.jumpbuf:=tstaticvarsym.create('LABEL$_'+labelsym.name,vs_value,rec_jmp_buf,[]);
                         symtablestack.top.insert(labelsym.jumpbuf);
-                        insertbssdata(tstaticvarsym(labelsym.jumpbuf));
+                        cnodeutils.insertbssdata(tstaticvarsym(labelsym.jumpbuf));
                       end;
                     include(labelsym.jumpbuf.symoptions,sp_internal);
                     { the buffer will be setup later, but avoid a hint }

compiler/pdecvar.pas

@@ -62,7 +62,7 @@ implementation
        node,pass_1,aasmdata,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,nutils,
        { codegen }
-       ncgutil,
+       ncgutil,ngenutil,
        { parser }
        scanner,
        pbase,pexpr,ptype,ptconst,pdecsub,
@@ -1493,7 +1493,7 @@ implementation
                  if (vs.typ=staticvarsym) and
                     not(vo_is_typed_const in vs.varoptions) and
                     not(vo_is_external in vs.varoptions) then
-                   insertbssdata(tstaticvarsym(vs));
+                   cnodeutils.insertbssdata(tstaticvarsym(vs));
                end;
            end;
          block_type:=old_block_type;
@@ -1705,7 +1705,7 @@ implementation
                      hstaticvs:=tstaticvarsym.create(internal_static_field_name(static_name),vs_value,hdef,[]);
                      include(hstaticvs.symoptions,sp_internal);
                      recst.get_unit_symtable.insert(hstaticvs);
-                     insertbssdata(hstaticvs);
+                     cnodeutils.insertbssdata(hstaticvs);
 {$else not jvm}
                      { for the JVM, static field accesses are name-based and
                        hence we have to keep the original name of the field.

compiler/pmodules.pas

@@ -39,7 +39,7 @@ implementation
        symconst,symbase,symtype,symdef,symsym,symtable,symcreat,
        wpoinfo,
        aasmtai,aasmdata,aasmcpu,aasmbase,
-       cgbase,cgobj,
+       cgbase,cgobj,ngenutil,
        nbas,ncgutil,
        link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
        cresstr,procinfo,
@@ -1284,7 +1284,8 @@ implementation
 
          { should we force unit initialization? }
          { this is a hack, but how can it be done better ? }
-         if force_init_final and ((current_module.flags and uf_init)=0) then
+         if (force_init_final or cnodeutils.force_init) and
+            ((current_module.flags and uf_init)=0) then
            begin
              { first release the not used init procinfo }
              if assigned(init_procinfo) then
@@ -1302,7 +1303,7 @@ implementation
               finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
               finalize_procinfo.parse_body;
            end
-         else if force_init_final then
+         else if force_init_final or cnodeutils.force_final then
            finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
 
          { Now both init and finalize bodies are read and it is known
@@ -1872,7 +1873,7 @@ implementation
 
          { should we force unit initialization? }
          force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final;
-         if force_init_final then
+         if force_init_final or cnodeutils.force_init then
            {init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable)};
 
          { Add symbol to the exports section for win32 so smartlinking a
@@ -2203,7 +2204,7 @@ implementation
 
          { should we force unit initialization? }
          force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final;
-         if force_init_final then
+         if force_init_final or cnodeutils.force_init then
            init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
 
          { Add symbol to the exports section for win32 so smartlinking a
@@ -2226,7 +2227,7 @@ implementation
               finalize_procinfo.parse_body;
            end
          else
-           if force_init_final then
+           if force_init_final or cnodeutils.force_final then
              finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
 
           { the finalization routine of libraries is generic (and all libraries need to }

compiler/symdef.pas

@@ -4331,7 +4331,7 @@ implementation
         { special names for constructors and class constructors }
         if proctypeoption=potype_constructor then
           tmpresult:='<init>'
-        else if proctypeoption=potype_class_constructor then
+        else if proctypeoption in [potype_class_constructor,potype_unitinit] then
           tmpresult:='<clinit>'
         else if po_has_importname in procoptions then
           begin