+ 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

@@ -13,15 +13,15 @@ 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
+  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
+  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
+  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
+  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)
@@ -32,4 +32,5 @@ Changes in the syntax or semantic of FPC:
   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