← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to rtl/go32v2/initc.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/go32v2/initc.pp
1
 
{
2
 
    $Id: initc.pp,v 1.4 2002/09/07 16:01:18 peter Exp $
3
 
    This file is part of the Free Pascal run time library.
4
 
    Copyright (c) 1999-2000 by Pierre Muller
5
 
 
6
 
    Code to generate execution of all c functions
7
 
    with constructors attributes
8
 
 
9
 
    Based on .ctor and .dtor sections of DJGPP gcc compiler
10
 
 
11
 
    See the file COPYING.FPC, included in this distribution,
12
 
    for details about the copyright.
13
 
 
14
 
    This program is distributed in the hope that it will be useful,
15
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
16
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
17
 
 
18
 
 **********************************************************************}
19
 
unit InitC;
20
 
 
21
 
interface
22
 
 
23
 
implementation
24
 
 
25
 
  { we need to include dpmiexcp unit
26
 
    to avoid getting troubles with _exit found both
27
 
    in libc and in v2prt0.as PM }
28
 
  uses
29
 
    dpmiexcp;
30
 
 
31
 
  type
32
 
     simple_proc = procedure;
33
 
  var
34
 
     first_ctor : longint;external name 'djgpp_first_ctor';
35
 
     ctor       : array [0..maxlongint div sizeof(simple_proc)] of simple_proc;external name 'djgpp_first_ctor';
36
 
     last_ctor  : longint;external name 'djgpp_last_ctor';
37
 
     first_dtor : longint;external name 'djgpp_first_dtor';
38
 
     dtor       : array [0..maxlongint div sizeof(simple_proc)] of simple_proc;external name 'djgpp_first_dtor';
39
 
     last_dtor  : longint;external name 'djgpp_last_dtor';
40
 
     bss_count : longint;external name '___bss_count';
41
 
  const
42
 
     save_exit : pointer = nil;
43
 
 
44
 
procedure run_c_constructors;
45
 
 
46
 
  const
47
 
     already_done : longint = -1;
48
 
  var
49
 
     f : simple_proc;
50
 
     i,nb : longint;
51
 
  begin
52
 
     if already_done=bss_count then
53
 
       exit;
54
 
     already_done:=bss_count;
55
 
     f:=ctor[0];
56
 
     nb:=((cardinal(@last_ctor)-cardinal(@first_ctor)) div sizeof(pointer));
57
 
     for i:=1 to nb do
58
 
       begin
59
 
          f();
60
 
          f:=ctor[i];
61
 
       end;
62
 
  end;
63
 
 
64
 
procedure run_c_destructors;
65
 
  const
66
 
     already_done : longint = -1;
67
 
  var
68
 
     f : simple_proc;
69
 
     i,nb : longint;
70
 
  begin
71
 
     exitproc:=save_exit;
72
 
     if already_done=bss_count then
73
 
       exit;
74
 
     already_done:=bss_count;
75
 
     f:=dtor[0];
76
 
     nb:=((cardinal(last_dtor)-cardinal(first_dtor)) div sizeof(pointer));
77
 
     for i:=1 to nb do
78
 
       begin
79
 
          f();
80
 
          f:=dtor[i];
81
 
       end;
82
 
  end;
83
 
 
84
 
begin
85
 
   run_c_constructors;
86
 
   If cardinal(@first_dtor)<>cardinal(@last_dtor) then
87
 
     begin
88
 
        { can exitproc be allready non nil here ?
89
 
          you have to make really weird things to achieve
90
 
          that be lets suppose it is possible !! (PM) }
91
 
        save_exit:=exitproc;
92
 
        exitproc:=@run_c_destructors;
93
 
     end;
94
 
end.
95
 
 
96
 
{
97
 
  $Log: initc.pp,v $
98
 
  Revision 1.4  2002/09/07 16:01:18  peter
99
 
    * old logs removed and tabs fixed
100
 
 
101
 
  Revision 1.3  2002/04/26 13:19:56  peter
102
 
    * fixed too large arrays
103
 
 
104
 
}