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

* problems with procvar address solved

Browse Source
This commit is contained in:
pierre 1998-12-21 14:13:07 +00:00
parent 39a719b39b
commit 00b80eff57
1 changed files with 21 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
rtl/go32v2/initc.pp
View File

@ -25,10 +25,12 @@ implementation
type type
simple_proc = procedure; simple_proc = procedure;
var var
first_ctor : simple_proc;external name 'djgpp_first_ctor'; first_ctor : longint;external name 'djgpp_first_ctor';
last_ctor : simple_proc;external name 'djgpp_last_ctor'; ctor : array [0..maxlongint] of simple_proc;external name 'djgpp_first_ctor';
first_dtor : simple_proc;external name 'djgpp_first_dtor'; last_ctor : longint;external name 'djgpp_last_ctor';
last_dtor : simple_proc;external name 'djgpp_last_dtor'; first_dtor : longint;external name 'djgpp_first_dtor';
dtor : array [0..maxlongint] of simple_proc;external name 'djgpp_first_dtor';
last_dtor : longint;external name 'djgpp_last_dtor';
bss_count : longint;external name '___bss_count'; bss_count : longint;external name '___bss_count';
const const
save_exit : pointer = nil; save_exit : pointer = nil;
@ -39,16 +41,17 @@ procedure run_c_constructors;
already_done : longint = -1; already_done : longint = -1;
var var
f : simple_proc; f : simple_proc;
i : longint; i,nb : longint;
begin begin
if already_done=bss_count then if already_done=bss_count then
exit; exit;
already_done:=bss_count; already_done:=bss_count;
f:=first_ctor; f:=ctor[0];
for i:=1 to ((longint(last_ctor)-longint(first_ctor)) div sizeof(pointer)) do nb:=((cardinal(@last_ctor)-cardinal(@first_ctor)) div sizeof(pointer));
for i:=1 to nb do
begin begin
f(); f();
inc(longint(f),sizeof(pointer)); f:=ctor[i];
end; end;
end; end;
@ -57,23 +60,24 @@ procedure run_c_destructors;
already_done : longint = -1; already_done : longint = -1;
var var
f : simple_proc; f : simple_proc;
i : longint; i,nb : longint;
begin begin
exitproc:=save_exit; exitproc:=save_exit;
if already_done=bss_count then if already_done=bss_count then
exit; exit;
already_done:=bss_count; already_done:=bss_count;
f:=first_dtor; f:=dtor[0];
for i:=1 to ((longint(last_dtor)-longint(first_dtor)) div sizeof(pointer)) do nb:=((cardinal(last_dtor)-cardinal(first_dtor)) div sizeof(pointer));
for i:=1 to nb do
begin begin
f(); f();
inc(longint(f),sizeof(pointer)); f:=dtor[i];
end; end;
end; end;
begin begin
run_c_constructors; run_c_constructors;
If first_dtor<>last_dtor then If cardinal(@first_dtor)<>cardinal(@last_dtor) then
begin begin
{ can exitproc be allready non nil here ? { can exitproc be allready non nil here ?
you have to make really weird things to achieve you have to make really weird things to achieve
@ -85,7 +89,10 @@ end.
{ {
$Log$ $Log$
Revision 1.1 1998-12-21 13:14:30 peter Revision 1.2 1998-12-21 14:13:07 pierre
* problems with procvar address solved
Revision 1.1 1998/12/21 13:14:30 peter
* moved * moved
Revision 1.1 1998/12/21 11:56:26 pierre Revision 1.1 1998/12/21 11:56:26 pierre