mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-07 20:50:42 +02:00
+ finalization support
This commit is contained in:
peter
parent
e796c55074
commit
6120616a20
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user