+ finalization support

compiler/pmodules.pas

@@ -46,8 +46,7 @@ unit pmodules;
 {$ifdef i386}
 {$ifdef Ag386Bin}
        ,i386base,i386asm
-{$else}
-       ,i386
+{$else}       ,i386
 {$endif}
 {$endif}
 {$ifdef m68k}
@@ -139,6 +138,43 @@ unit pmodules;
 {$endif GDB}
       end;
 
+    procedure InsertInitFinalTable;
+      var
+        hp : pused_unit;
+        unitinits : taasmoutput;
+        count : longint;
+      begin
+        unitinits.init;
+        count:=0;
+        hp:=pused_unit(usedunits.first);
+        while assigned(hp) do
+         begin
+           { 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(new(pai_const_symbol,init('INIT$$'+hp^.u^.modulename^)))
+              else
+               unitinits.concat(new(pai_const,init_32bit(0)));
+              if (hp^.u^.flags and uf_finalize)<>0 then
+               unitinits.concat(new(pai_const_symbol,init('FINALIZE$$'+hp^.u^.modulename^)))
+              else
+               unitinits.concat(new(pai_const,init_32bit(0)));
+              inc(count);
+            end;
+           hp:=Pused_unit(hp^.next);
+         end;
+        { TableCount,InitCount }
+        unitinits.insert(new(pai_const,init_32bit(0)));
+        unitinits.insert(new(pai_const,init_32bit(count)));
+        unitinits.insert(new(pai_symbol,init_global('INITFINAL')));
+        { insert in data segment }
+        if (cs_smartlink in aktmoduleswitches) then
+          datasegment^.concat(new(pai_cut,init));
+        datasegment^.concatlist(@unitinits);
+        unitinits.done;
+      end;
+
 
     procedure insertheap;
       begin
@@ -1315,8 +1351,8 @@ unit pmodules;
            exportlib^.generatelib;
 
          { insert heap }
+         insertinitfinaltable;
          insertheap;
-
          inserttargetspecific;
 
          datasize:=symtablestack^.datasize;
@@ -1346,7 +1382,10 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.108  1999-04-14 09:14:52  peter
+  Revision 1.109  1999-04-15 12:19:59  peter
+    + finalization support
+
+  Revision 1.108  1999/04/14 09:14:52  peter
     * first things to store the symbol/def number in the ppu
 
   Revision 1.107  1999/04/08 10:53:54  michael

compiler/readme

@@ -1,35 +1,36 @@
-This directory contains the sources of the Free Pascal Compiler
-
-To recompile the compiler, use the batch file
-mppc386.bat
-
-If you want to build a m68k version to cross compile from i386 to m68k
-use the batch file
-mppc68k.bat
-
-If you want to modify the compiler, please read first the compiler
-writer's guide (cws.txt) in that directory.
-
-
-Changes in the syntax or semantic of FPC:
------------------------------------------
-  28/01/99 : implicit conversion from boolean to integer is not possible
-             anymore (solved several bugs) but this could lead to errors
-             on previously accepted code (PM)
-  01/02/99:  c styled comments are supported (/* ... */), mainly
-             for the Sibyl sources of Medigo (FK)
-  02/02/99:  class destructors take now two parameters: flag
-             if the helper routine should free the instance and
-             self pointer (FK)
-  22/02/99:  PROTECTED and PRIVATE have now the same behavior
-             as in TP
-  09/03/99   small records and arrays passed by value to a function are now directly copied
-             into a 4 bytes parameter (needed for C and DLL calls) (PM)
-  11/03/99   the makefile.fpc is now also needed for the compiler and RTL, you can
-             find it in the base.zip package (PFV)
-  24/03/99   new directives UNITPATH,INCLUDEPATH,OBJECTPATH,LIBRARYPATH to
-             set the searchpaths where to find the files for that module (PFV)
-  25/03/99   new directive STATIC +/- or on/off , works like -St commandline
-             switch
-  02/04/99   rtl/cfg/ directory has been removed, it's not used anymore
-
+This directory contains the sources of the Free Pascal Compiler
+
+To recompile the compiler, use the batch file
+mppc386.bat
+
+If you want to build a m68k version to cross compile from i386 to m68k
+use the batch file
+mppc68k.bat
+
+If you want to modify the compiler, please read first the compiler
+writer's guide (cws.txt) in that directory.
+
+
+Changes in the syntax or semantic of FPC:
+-----------------------------------------
+  28/01/99   implicit conversion from boolean to integer is not possible
+             anymore (solved several bugs) but this could lead to errors
+             on previously accepted code (PM)
+  01/02/99   c styled comments are supported (/* ... */), mainly
+             for the Sibyl sources of Medigo (FK)
+  02/02/99   class destructors take now two parameters: flag
+             if the helper routine should free the instance and
+             self pointer (FK)
+  22/02/99   PROTECTED and PRIVATE have now the same behavior
+             as in TP
+  09/03/99   small records and arrays passed by value to a function are now directly copied
+             into a 4 bytes parameter (needed for C and DLL calls) (PM)
+  11/03/99   the makefile.fpc is now also needed for the compiler and RTL, you can
+             find it in the base.zip package (PFV)
+  24/03/99   new directives UNITPATH,INCLUDEPATH,OBJECTPATH,LIBRARYPATH to
+             set the searchpaths where to find the files for that module (PFV)
+  25/03/99   new directive STATIC +/- or on/off , works like -St commandline
+             switch
+  02/04/99   rtl/cfg/ directory has been removed, it's not used anymore
+  15/04/99   FINALIZATION is supported
+

rtl/inc/system.inc

@@ -311,6 +311,56 @@ end;
                           Init / Exit / ExitProc
 *****************************************************************************}
 
+{$ifdef HASFINALIZE}
+
+const
+  maxunits=1024; { See also files.pas of the compiler source }
+type
+  TInitFinalRec=record
+    InitProc,
+    FinalProc : TProcedure;
+  end;
+  TInitFinalTable=record
+    TableCount,
+    InitCount  : longint;
+    Procs      : array[1..maxunits] of TInitFinalRec;
+  end;
+
+var
+  InitFinalTable : TInitFinalTable;external name 'INITFINAL';
+
+procedure InitializeUnits;[public,alias:'FPC_INITIALIZEUNITS'];
+var
+  i : longint;
+begin
+  with InitFinalTable do
+   begin
+     for i:=1to TableCount do
+      begin
+        if assigned(Procs[i].InitProc) then
+         Procs[i].InitProc();
+        InitCount:=i;
+      end;
+   end;
+end;
+
+
+procedure FinalizeUnits;[public,alias:'FPC_FINALIZEUNITS'];
+begin
+  with InitFinalTable do
+   begin
+     while (InitCount>0) do
+      begin
+        if assigned(Procs[InitCount].FinalProc) then
+         Procs[InitCount].FinalProc();
+        dec(InitCount);
+      end;
+   end;
+end;
+
+{$endif}
+
+
 Procedure HandleErrorFrame (Errno : longint;frame : longint);
 {
   Procedure to handle internal errors, i.e. not user-invoked errors
@@ -394,6 +444,11 @@ Begin
      exitProc:=nil;
      current_exit();
    End;
+{$ifdef HASFINALIZE}
+  { Finalize units }
+  FinalizeUnits;
+{$endif}
+  { Show runtime error }
   If erroraddr<>nil Then
    Begin
      Writeln(stdout,'Run time error  ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8));
@@ -485,7 +540,10 @@ end;
 
 {
   $Log$
-  Revision 1.55  1999-03-01 15:41:03  peter
+  Revision 1.56  1999-04-15 12:20:01  peter
+    + finalization support
+
+  Revision 1.55  1999/03/01 15:41:03  peter
     * use external names
     * removed all direct assembler modes