mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 09:39:32 +01:00
105 lines
2.7 KiB
ObjectPascal
105 lines
2.7 KiB
ObjectPascal
{
|
|
$Id$
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1999-2000 by Pierre Muller
|
|
|
|
Code to generate execution of all c functions
|
|
with constructors attributes
|
|
|
|
Based on .ctor and .dtor sections of DJGPP gcc compiler
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
unit InitC;
|
|
|
|
interface
|
|
|
|
implementation
|
|
|
|
{ we need to include dpmiexcp unit
|
|
to avoid getting troubles with _exit found both
|
|
in libc and in v2prt0.as PM }
|
|
uses
|
|
dpmiexcp;
|
|
|
|
type
|
|
simple_proc = procedure;
|
|
var
|
|
first_ctor : longint;external name 'djgpp_first_ctor';
|
|
ctor : array [0..maxlongint div sizeof(simple_proc)] of simple_proc;external name 'djgpp_first_ctor';
|
|
last_ctor : longint;external name 'djgpp_last_ctor';
|
|
first_dtor : longint;external name 'djgpp_first_dtor';
|
|
dtor : array [0..maxlongint div sizeof(simple_proc)] of simple_proc;external name 'djgpp_first_dtor';
|
|
last_dtor : longint;external name 'djgpp_last_dtor';
|
|
bss_count : longint;external name '___bss_count';
|
|
const
|
|
save_exit : pointer = nil;
|
|
|
|
procedure run_c_constructors;
|
|
|
|
const
|
|
already_done : longint = -1;
|
|
var
|
|
f : simple_proc;
|
|
i,nb : longint;
|
|
begin
|
|
if already_done=bss_count then
|
|
exit;
|
|
already_done:=bss_count;
|
|
f:=ctor[0];
|
|
nb:=((cardinal(@last_ctor)-cardinal(@first_ctor)) div sizeof(pointer));
|
|
for i:=1 to nb do
|
|
begin
|
|
f();
|
|
f:=ctor[i];
|
|
end;
|
|
end;
|
|
|
|
procedure run_c_destructors;
|
|
const
|
|
already_done : longint = -1;
|
|
var
|
|
f : simple_proc;
|
|
i,nb : longint;
|
|
begin
|
|
exitproc:=save_exit;
|
|
if already_done=bss_count then
|
|
exit;
|
|
already_done:=bss_count;
|
|
f:=dtor[0];
|
|
nb:=((cardinal(last_dtor)-cardinal(first_dtor)) div sizeof(pointer));
|
|
for i:=1 to nb do
|
|
begin
|
|
f();
|
|
f:=dtor[i];
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
run_c_constructors;
|
|
If cardinal(@first_dtor)<>cardinal(@last_dtor) then
|
|
begin
|
|
{ can exitproc be allready non nil here ?
|
|
you have to make really weird things to achieve
|
|
that be lets suppose it is possible !! (PM) }
|
|
save_exit:=exitproc;
|
|
exitproc:=@run_c_destructors;
|
|
end;
|
|
end.
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.4 2002-09-07 16:01:18 peter
|
|
* old logs removed and tabs fixed
|
|
|
|
Revision 1.3 2002/04/26 13:19:56 peter
|
|
* fixed too large arrays
|
|
|
|
}
|