* Add finalization of typed consts

  * Finalization of globals in the main program

compiler/ncgutil.pas

@@ -971,18 +971,31 @@ implementation
         list : taasmoutput;
       begin
         list:=taasmoutput(arg);
-        if (tsym(p).typ=varsym) and
-           not(vo_is_local_copy in tvarsym(p).varoptions) and
-           assigned(tvarsym(p).vartype.def) and
-           not(is_class(tvarsym(p).vartype.def)) and
-           tvarsym(p).vartype.def.needs_inittable then
-         begin
-           if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
-            reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
-           else
-            reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(p).mangledname),0);
-           cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
-         end;
+        case tsym(p).typ of
+          varsym :
+            begin
+              if not(vo_is_local_copy in tvarsym(p).varoptions) and
+                 assigned(tvarsym(p).vartype.def) and
+                 not(is_class(tvarsym(p).vartype.def)) and
+                 tvarsym(p).vartype.def.needs_inittable then
+               begin
+                 if tsym(p).owner.symtabletype in [localsymtable,inlinelocalsymtable] then
+                  reference_reset_base(href,procinfo.framepointer,-tvarsym(p).address+tvarsym(p).owner.address_fixup)
+                 else
+                  reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(p).mangledname),0);
+                 cg.g_finalize(list,tvarsym(p).vartype.def,href,false);
+               end;
+            end;
+          typedconstsym :
+            begin
+              if ttypedconstsym(p).is_writable and
+                 ttypedconstsym(p).typedconsttype.def.needs_inittable then
+               begin
+                 reference_reset_symbol(href,objectlibrary.newasmsymbol(ttypedconstsym(p).mangledname),0);
+                 cg.g_finalize(list,ttypedconstsym(p).typedconsttype.def,href,false);
+               end;
+            end;
+        end;
       end;
 
 
@@ -1295,6 +1308,8 @@ implementation
              end;
            { units have seperate code for initilization and finalization }
            potype_unitfinalize: ;
+           { program init/final is generated in separate procedure }
+           potype_proginit: ;
            else
              aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}initialize_data,list);
         end;
@@ -1537,8 +1552,10 @@ implementation
                 tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
                 tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data,list);
              end;
-           { units have seperate code for initialization and finalization }
+           { units/progs have separate code for initialization and finalization }
            potype_unitinit: ;
+           { program init/final is generated in separate procedure }
+           potype_proginit: ;
            else
              aktprocdef.localst.foreach_static({$ifndef TP}@{$endif}finalize_data,list);
         end;
@@ -1827,7 +1844,8 @@ implementation
          list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_init',0));
          { using current_module.globalsymtable is hopefully      }
          { more robust than symtablestack and symtablestack.next }
-         tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
+         if assigned(current_module.globalsymtable) then
+           tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
          tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
          cg.g_return_from_proc(list,0);
       end;
@@ -1844,7 +1862,8 @@ implementation
          list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_finalize',0));
          { using current_module.globalsymtable is hopefully      }
          { more robust than symtablestack and symtablestack.next }
-         tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
+         if assigned(current_module.globalsymtable) then
+           tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
          tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
          cg.g_return_from_proc(list,0);
       end;
@@ -1854,7 +1873,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.53  2002-10-05 15:18:42  carl
+  Revision 1.54  2002-10-06 19:41:30  peter
+    * Add finalization of typed consts
+    * Finalization of globals in the main program
+
+  Revision 1.53  2002/10/05 15:18:42  carl
     * fix heap leaks
 
   Revision 1.52  2002/09/30 07:00:46  florian

compiler/pmodules.pas

@@ -212,9 +212,6 @@ implementation
       end;
 
 
-
-
-
     procedure InsertInitFinalTable;
       var
         hp : tused_unit;
@@ -241,14 +238,19 @@ implementation
             end;
            hp:=tused_unit(hp.next);
          end;
-        if current_module.islibrary then
-          if (current_module.flags and uf_finalize)<>0 then
-            begin
-              { INIT code is done by PASCALMAIN calling }
-              unitinits.concat(Tai_const.Create_32bit(0));
-              unitinits.concat(Tai_const_symbol.Createname('FINALIZE$$'+current_module.modulename^));
-              inc(count);
-            end;
+        { 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_symbol.Createname('INIT$$'+current_module.modulename^))
+           else
+            unitinits.concat(Tai_const.Create_32bit(0));
+           if (current_module.flags and uf_finalize)<>0 then
+            unitinits.concat(Tai_const_symbol.Createname('FINALIZE$$'+current_module.modulename^))
+           else
+            unitinits.concat(Tai_const.Create_32bit(0));
+           inc(count);
+         end;
         { TableCount,InitCount }
         unitinits.insert(Tai_const.Create_32bit(0));
         unitinits.insert(Tai_const.Create_32bit(count));
@@ -1262,6 +1264,20 @@ implementation
          insertLocalThreadvarsTablesTable;
          compile_proc_body(true,false);
 
+         { should we force unit initialization? }
+         if tstaticsymtable(current_module.localsymtable).needs_init_final then
+           begin
+              current_module.flags:=current_module.flags or (uf_init or uf_finalize);
+              { Add initialize section }
+              if (cs_create_smart in aktmoduleswitches) then
+                codeSegment.concat(Tai_cut.Create);
+              genimplicitunitinit(codesegment);
+              { Add finalize section }
+              if (cs_create_smart in aktmoduleswitches) then
+                codeSegment.concat(Tai_cut.Create);
+              genimplicitunitfinal(codesegment);
+           end;
+
          { Add symbol to the exports section for win32 so smartlinking a
            DLL will include the edata section }
          if assigned(exportlib) and
@@ -1388,7 +1404,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.79  2002-09-09 17:34:15  peter
+  Revision 1.80  2002-10-06 19:41:30  peter
+    * Add finalization of typed consts
+    * Finalization of globals in the main program
+
+  Revision 1.79  2002/09/09 17:34:15  peter
     * tdicationary.replace added to replace and item in a dictionary. This
       is only allowed for the same name
     * varsyms are inserted in symtable before the types are parsed. This

compiler/symtable.pas

@@ -932,12 +932,22 @@ implementation
 
     procedure TStoredSymtable._needs_init_final(p : tnamedindexitem;arg:pointer);
       begin
-         if (not b_needs_init_final) and
-            (tsym(p).typ=varsym) and
-            assigned(tvarsym(p).vartype.def) and
-            not is_class(tvarsym(p).vartype.def) and
-            tstoreddef(tvarsym(p).vartype.def).needs_inittable then
-           b_needs_init_final:=true;
+         if b_needs_init_final then
+          exit;
+         case tsym(p).typ of
+           varsym :
+             begin
+               if not(is_class(tvarsym(p).vartype.def)) and
+                  tstoreddef(tvarsym(p).vartype.def).needs_inittable then
+                 b_needs_init_final:=true;
+             end;
+           typedconstsym :
+             begin
+               if ttypedconstsym(p).is_writable and
+                  tstoreddef(ttypedconstsym(p).typedconsttype.def).needs_inittable then
+                 b_needs_init_final:=true;
+             end;
+         end;
       end;
 
 
@@ -2311,7 +2321,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.73  2002-10-05 12:43:29  carl
+  Revision 1.74  2002-10-06 19:41:31  peter
+    * Add finalization of typed consts
+    * Finalization of globals in the main program
+
+  Revision 1.73  2002/10/05 12:43:29  carl
     * fixes for Delphi 6 compilation
      (warning : Some features do not work under Delphi)