paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-23 06:10:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ finalization support

Browse Source
This commit is contained in:
peter 1999-04-15 12:19:59 +00:00
parent e796c55074
commit 6120616a20
3 changed files with 138 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
compiler/pmodules.pas
View File

@ -46,8 +46,7 @@ unit pmodules;
{$ifdef i386} {$ifdef i386}
{$ifdef Ag386Bin} {$ifdef Ag386Bin}
,i386base,i386asm ,i386base,i386asm
{$else} {$else} ,i386
,i386
{$endif} {$endif}
{$endif} {$endif}
{$ifdef m68k} {$ifdef m68k}
@ -139,6 +138,43 @@ unit pmodules;
{$endif GDB} {$endif GDB}
end; 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; procedure insertheap;
begin begin
@ -1315,8 +1351,8 @@ unit pmodules;
exportlib^.generatelib; exportlib^.generatelib;
{ insert heap } { insert heap }
insertinitfinaltable;
insertheap; insertheap;
inserttargetspecific; inserttargetspecific;
datasize:=symtablestack^.datasize; datasize:=symtablestack^.datasize;
@ -1346,7 +1382,10 @@ unit pmodules;
end. end.
{ {
$Log$ $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 * first things to store the symbol/def number in the ppu
Revision 1.107 1999/04/08 10:53:54 michael Revision 1.107 1999/04/08 10:53:54 michael

71
compiler/readme
View File

@ -1,35 +1,36 @@
This directory contains the sources of the Free Pascal Compiler This directory contains the sources of the Free Pascal Compiler
To recompile the compiler, use the batch file To recompile the compiler, use the batch file
mppc386.bat mppc386.bat
If you want to build a m68k version to cross compile from i386 to m68k If you want to build a m68k version to cross compile from i386 to m68k
use the batch file use the batch file
mppc68k.bat mppc68k.bat
If you want to modify the compiler, please read first the compiler If you want to modify the compiler, please read first the compiler
writer's guide (cws.txt) in that directory. writer's guide (cws.txt) in that directory.
Changes in the syntax or semantic of FPC: 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 anymore (solved several bugs) but this could lead to errors
on previously accepted code (PM) 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) 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 if the helper routine should free the instance and
self pointer (FK) 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 as in TP
09/03/99 small records and arrays passed by value to a function are now directly copied 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) 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 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) find it in the base.zip package (PFV)
24/03/99 new directives UNITPATH,INCLUDEPATH,OBJECTPATH,LIBRARYPATH to 24/03/99 new directives UNITPATH,INCLUDEPATH,OBJECTPATH,LIBRARYPATH to
set the searchpaths where to find the files for that module (PFV) 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 25/03/99 new directive STATIC +/- or on/off , works like -St commandline
switch switch
02/04/99 rtl/cfg/ directory has been removed, it's not used anymore 02/04/99 rtl/cfg/ directory has been removed, it's not used anymore
15/04/99 FINALIZATION is supported

60
rtl/inc/system.inc
View File

@ -311,6 +311,56 @@ end;
Init / Exit / ExitProc 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 HandleErrorFrame (Errno : longint;frame : longint);
{ {
Procedure to handle internal errors, i.e. not user-invoked errors Procedure to handle internal errors, i.e. not user-invoked errors
@ -394,6 +444,11 @@ Begin
exitProc:=nil; exitProc:=nil;
current_exit(); current_exit();
End; End;
{$ifdef HASFINALIZE}
{ Finalize units }
FinalizeUnits;
{$endif}
{ Show runtime error }
If erroraddr<>nil Then If erroraddr<>nil Then
Begin Begin
Writeln(stdout,'Run time error ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8)); Writeln(stdout,'Run time error ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8));
@ -485,7 +540,10 @@ end;
{ {
$Log$ $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 * use external names
* removed all direct assembler modes * removed all direct assembler modes