development/compilers/freepascal/rtl/go32v2/initc.pp

   1 {
   2     $Id$
   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] 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] 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$
  98   Revision 1.1  2002/02/19 08:25:11  sasu
  99   Initial revision
 100
 101   Revision 1.1  2000/07/13 06:30:38  michael
 102   + Initial import
 103
 104   Revision 1.6  2000/02/09 16:59:29  peter
 105     * truncated log
 106
 107   Revision 1.5  2000/01/09 00:35:17  pierre
 108    * initc now loads dpmiexcp unit to avoid linker problems
 109
 110   Revision 1.4  2000/01/07 16:41:32  daniel
 111     * copyright 2000
 112
 113   Revision 1.3  2000/01/07 16:32:23  daniel
 114     * copyright 2000 added
 115
 116 }