From 6120616a2064b91fa0dac9b9d24698a2d2fb6e15 Mon Sep 17 00:00:00 2001 From: peter Date: Thu, 15 Apr 1999 12:19:59 +0000 Subject: [PATCH] + finalization support --- compiler/pmodules.pas | 47 +++++++++++++++++++++++++--- compiler/readme | 71 ++++++++++++++++++++++--------------------- rtl/inc/system.inc | 60 +++++++++++++++++++++++++++++++++++- 3 files changed, 138 insertions(+), 40 deletions(-) diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 924f6e7f28..3cf9ecbf76 100644 --- a/compiler/pmodules.pas +++ b/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 diff --git a/compiler/readme b/compiler/readme index dd12f7bab4..b4c0e91b99 100644 --- a/compiler/readme +++ b/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 + diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index d785fd7009..ad237d2614 100644 --- a/rtl/inc/system.inc +++ b/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