gcc/ada/initialize.c

   1 /****************************************************************************
   2  *                                                                          *
   3  *                         GNAT COMPILER COMPONENTS                         *
   4  *                                                                          *
   5  *                           I N I T I A L I Z E                            *
   6  *                                                                          *
   7  *                          C Implementation File                           *
   8  *                                                                          *
   9  *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
  10  *                                                                          *
  11  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  12  * terms of the  GNU General Public License as published  by the Free Soft- *
  13  * ware  Foundation;  either version 3,  or (at your option) any later ver- *
  14  * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
  15  * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
  16  * or FITNESS FOR A PARTICULAR PURPOSE.                                     *
  17  *                                                                          *
  18  * As a special exception under Section 7 of GPL version 3, you are granted *
  19  * additional permissions described in the GCC Runtime Library Exception,   *
  20  * version 3.1, as published by the Free Software Foundation.               *
  21  *                                                                          *
  22  * You should have received a copy of the GNU General Public License and    *
  23  * a copy of the GCC Runtime Library Exception along with this program;     *
  24  * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
  25  * <http://www.gnu.org/licenses/>.                                          *
  26  *                                                                          *
  27  * GNAT was originally developed  by the GNAT team at  New York University. *
  28  * Extensive contributions were provided by Ada Core Technologies Inc.      *
  29  *                                                                          *
  30  ****************************************************************************/
  31
  32 /*  This unit provides default implementation for __gnat_initialize ()
  33     which is called before the elaboration of the partition. It is provided
  34     in a separate file/object so that users can replace it easily.
  35     The default implementation should be null on most targets. */
  36
  37 /* The following include is here to meet the published VxWorks requirement
  38    that the __vxworks header appear before any other include. */
  39 #ifdef __vxworks
  40 #include "vxWorks.h"
  41 #endif
  42
  43 #ifdef IN_RTS
  44 #include "tconfig.h"
  45 #include "tsystem.h"
  46 /* We don't have libiberty, so use malloc.  */
  47 #define xmalloc(S) malloc (S)
  48 #define xrealloc(V,S) realloc (V,S)
  49 #else
  50 #include "config.h"
  51 #include "system.h"
  52 #endif
  53
  54 #include "raise.h"
  55
  56 /******************************************/
  57 /* __gnat_initialize (NT-mingw32 Version) */
  58 /******************************************/
  59
  60 #if defined (__MINGW32__)
  61 #include "mingw32.h"
  62 #include <windows.h>
  63
  64 extern void __gnat_init_float (void);
  65 extern void __gnat_install_SEH_handler (void *);
  66
  67 extern int gnat_argc;
  68 extern char **gnat_argv;
  69
  70 #ifndef RTX
  71 /* Do not define for RTX since it is only used for creating child processes
  72    which is not supported in RTX. */
  73 extern void __gnat_plist_init (void);
  74 #endif
  75
  76 #ifdef GNAT_UNICODE_SUPPORT
  77
  78 #define EXPAND_ARGV_RATE 128
  79
  80 static void
  81 append_arg (int *index, LPWSTR dir, LPWSTR value,
  82             char ***argv, int *last, int quoted)
  83 {
  84   int size;
  85   LPWSTR fullvalue;
  86   int vallen = _tcslen (value);
  87   int dirlen;
  88
  89   if (dir == NULL)
  90     {
  91       /* no dir prefix */
  92       dirlen = 0;
  93       fullvalue = xmalloc ((vallen + 1) * sizeof(TCHAR));
  94     }
  95   else
  96     {
  97       /* Add dir first */
  98       dirlen = _tcslen (dir);
  99
 100       fullvalue = xmalloc ((dirlen + vallen + 1) * sizeof(TCHAR));
 101       _tcscpy (fullvalue, dir);
 102     }
 103
 104   /* Append value */
 105
 106   if (quoted)
 107     {
 108       _tcsncpy (fullvalue + dirlen, value + 1, vallen - 1);
 109       fullvalue [dirlen + vallen - sizeof(TCHAR)] = _T('\0');
 110     }
 111   else
 112     _tcscpy (fullvalue + dirlen, value);
 113
 114   if (*last <= *index)
 115     {
 116       *last += EXPAND_ARGV_RATE;
 117       *argv = (char **) xrealloc (*argv, (*last) * sizeof (char *));
 118     }
 119
 120   size = WS2SC (NULL, fullvalue, 0);
 121   (*argv)[*index] = (char *) xmalloc (size + sizeof(TCHAR));
 122   WS2SC ((*argv)[*index], fullvalue, size);
 123
 124   free (fullvalue);
 125
 126   (*index)++;
 127 }
 128 #endif
 129
 130 void
 131 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 132 {
 133    /* Initialize floating-point coprocessor. This call is needed because
 134       the MS libraries default to 64-bit precision instead of 80-bit
 135       precision, and we require the full precision for proper operation,
 136       given that we have set Max_Digits etc with this in mind */
 137    __gnat_init_float ();
 138
 139 #ifdef GNAT_UNICODE_SUPPORT
 140    /* Set current code page for filenames handling. */
 141    {
 142      char *codepage = getenv ("GNAT_CODE_PAGE");
 143
 144      /* Default code page is UTF-8.  */
 145      CurrentCodePage = CP_UTF8;
 146
 147      if (codepage != NULL)
 148        {
 149          if (strcmp (codepage, "CP_ACP") == 0)
 150            CurrentCodePage = CP_ACP;
 151          else if (strcmp (codepage, "CP_UTF8") == 0)
 152            CurrentCodePage = CP_UTF8;
 153        }
 154    }
 155
 156    /* Adjust gnat_argv to support Unicode characters. */
 157    {
 158      LPWSTR *wargv;
 159      int wargc;
 160      int k;
 161      int last;
 162      int argc_expanded = 0;
 163      TCHAR result [MAX_PATH];
 164      int quoted;
 165
 166      wargv = CommandLineToArgvW (GetCommandLineW(), &wargc);
 167
 168      if (wargv != NULL)
 169        {
 170          /* Set gnat_argv with arguments encoded in UTF-8. */
 171          last = wargc + 1;
 172          gnat_argv = (char **) xmalloc ((last) * sizeof (char *));
 173
 174          /* argv[0] is the executable full path-name. */
 175
 176          SearchPath (NULL, wargv[0], _T(".exe"), MAX_PATH, result, NULL);
 177          append_arg (&argc_expanded, NULL, result, &gnat_argv, &last, 0);
 178
 179          for (k=1; k<wargc; k++)
 180            {
 181              quoted = (wargv[k][0] == _T('\''));
 182
 183              /* Check for wildcard expansion if the argument is not quoted. */
 184              if (!quoted
 185                  && (_tcsstr (wargv[k], _T("?")) != 0 ||
 186                      _tcsstr (wargv[k], _T("*")) != 0))
 187                {
 188                  /* Wilcards are present, append all corresponding matches. */
 189                  WIN32_FIND_DATA FileData;
 190                  HANDLE hDir = FindFirstFile (wargv[k], &FileData);
 191                  LPWSTR dir = NULL;
 192                  LPWSTR ldir = _tcsrchr (wargv[k], _T('\\'));
 193
 194                  if (ldir == NULL)
 195                    ldir = _tcsrchr (wargv[k], _T('/'));
 196
 197                  if (hDir == INVALID_HANDLE_VALUE)
 198                    {
 199                      /* No match, append arg as-is. */
 200                      append_arg (&argc_expanded, NULL, wargv[k],
 201                                  &gnat_argv, &last, quoted);
 202                    }
 203                  else
 204                    {
 205                      if (ldir != NULL)
 206                        {
 207                          int n = ldir - wargv[k] + 1;
 208                          dir = xmalloc ((n + 1) * sizeof (TCHAR));
 209                          _tcsncpy (dir, wargv[k], n);
 210                          dir[n] = _T('\0');
 211                        }
 212
 213                      /* Append first match and all remaining ones.  */
 214
 215                      do {
 216                        /* Do not add . and .. special entries */
 217
 218                        if (_tcscmp (FileData.cFileName, _T(".")) != 0
 219                            && _tcscmp (FileData.cFileName, _T("..")) != 0)
 220                          append_arg (&argc_expanded, dir, FileData.cFileName,
 221                                      &gnat_argv, &last, 0);
 222                      } while (FindNextFile (hDir, &FileData));
 223
 224                      FindClose (hDir);
 225
 226                      if (dir != NULL)
 227                        free (dir);
 228                    }
 229                }
 230              else
 231                {
 232                  /*  No wildcard. Store parameter as-is. Remove quote if
 233                      needed. */
 234                  append_arg (&argc_expanded, NULL, wargv[k],
 235                              &gnat_argv, &last, quoted);
 236                }
 237            }
 238
 239          LocalFree (wargv);
 240          gnat_argc = argc_expanded;
 241          gnat_argv = (char **) xrealloc
 242            (gnat_argv, argc_expanded * sizeof (char *));
 243        }
 244    }
 245 #endif
 246
 247    /* Note that we do not activate this for the compiler itself to avoid a
 248       bootstrap path problem.  Older version of gnatbind will generate a call
 249       to __gnat_initialize() without argument. Therefore we cannot use eh in
 250       this case.  It will be possible to remove the following #ifdef at some
 251       point.  */
 252 #ifdef IN_RTS
 253    /* Install the Structured Exception handler.  */
 254    if (eh)
 255      __gnat_install_SEH_handler (eh);
 256 #endif
 257 }
 258
 259 /******************************************/
 260 /* __gnat_initialize (init_float version) */
 261 /******************************************/
 262
 263 #elif defined (__Lynx__) || defined (__FreeBSD__) || defined(__NetBSD__) \
 264   || defined (__OpenBSD__)
 265
 266 extern void __gnat_init_float (void);
 267
 268 void
 269 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 270 {
 271    __gnat_init_float ();
 272 }
 273
 274 /***************************************/
 275 /* __gnat_initialize (VxWorks Version) */
 276 /***************************************/
 277
 278 #elif defined(__vxworks)
 279
 280 extern void __gnat_init_float (void);
 281
 282 void
 283 __gnat_initialize (void *eh)
 284 {
 285   __gnat_init_float ();
 286
 287   /* On targets where we use the ZCX scheme, we need to register the frame
 288      tables at load/startup time.
 289
 290      For applications loaded as a set of "modules", the crtstuff objects
 291      linked in (crtbegin.o/end.o) are tailored to provide this service
 292      automatically, a-la C++ constructor fashion, triggered by the VxWorks
 293      loader thanks to a special variable declaration in crtbegin.o (_ctors).
 294
 295      Automatic de-registration is handled symmetrically, a-la C++ destructor
 296      fashion (with a _dtors variable also in crtbegin.o) triggered by the
 297      dynamic unloader.
 298
 299      Note that since the tables shall be registered against a common
 300      data structure, libgcc should be one of the modules (vs being partially
 301      linked against all the others at build time) and shall be loaded first.
 302
 303      For applications linked with the kernel, the scheme above would lead to
 304      duplicated symbols because the VxWorks kernel build "munches" by default,
 305      so we link against crtbeginT.o instead of crtbegin.o, which doesn't
 306      include the special variables. We know which set of crt objects is used
 307      thanks to a boolean indicator present in both sets (__module_has_ctors),
 308      and directly call the appropriate function here in the not-automatic
 309      case. We'll never unload that, so there is no de-registration to worry
 310      about.
 311
 312      For whole applications loaded as a single module, we may use one scheme
 313      or the other, except for the mixed Ada/C++ case in which the first scheme
 314      would fail for the same reason as in the linked-with-kernel situation.
 315
 316      Selecting the crt set with the ctors/dtors capabilities (first scheme
 317      above) is triggered by adding "-dynamic" to the gcc *link* command line
 318      options. Selecting the other set is achieved by using "-static" instead.
 319
 320      This is a first approach, tightly synchronized with a number of GCC
 321      configuration and crtstuff changes. We need to ensure that those changes
 322      are there to activate this circuitry.  */
 323
 324 #if (__GNUC__ >= 3) && (defined (_ARCH_PPC) || defined (__ppc))
 325  {
 326    /* The scheme described above is only useful for the actual ZCX case, and
 327       we don't want any reference to the crt provided symbols otherwise.  We
 328       may not link with any of the crt objects in the non-ZCX case, e.g. from
 329       documented procedures instructing the use of -nostdlib, and references
 330       to the ctors symbols here would just remain unsatisfied.
 331
 332       We have no way to avoid those references in the right conditions in this
 333       C module, because we have nothing like a IN_ZCX_RTS macro.  This aspect
 334       is then deferred to an Ada routine, which can do that based on a test
 335       against a constant System flag value.  */
 336
 337    extern void __gnat_vxw_setup_for_eh (void);
 338    __gnat_vxw_setup_for_eh ();
 339  }
 340 #endif
 341 }
 342
 343 #elif defined(_T_HPUX10) || (!defined(IN_RTS) && defined(_X_HPUX10))
 344
 345 /************************************************/
 346 /* __gnat_initialize (PA-RISC HP-UX 10 Version) */
 347 /************************************************/
 348
 349 extern void __main (void);
 350
 351 void
 352 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 353 {
 354   __main ();
 355 }
 356
 357 #else
 358
 359 /* For all other versions of GNAT, the initialize routine and handler
 360    installation do nothing */
 361
 362 /***************************************/
 363 /* __gnat_initialize (Default Version) */
 364 /***************************************/
 365
 366 void
 367 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 368 {
 369 }
 370
 371 #endif