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 #ifdef GNAT_UNICODE_SUPPORT
  71
  72 #define EXPAND_ARGV_RATE 128
  73
  74 static void
  75 append_arg (int *index, LPWSTR dir, LPWSTR value,
  76             char ***argv, int *last, int quoted)
  77 {
  78   int size;
  79   LPWSTR fullvalue;
  80   int vallen = _tcslen (value);
  81   int dirlen;
  82
  83   if (dir == NULL)
  84     {
  85       /* no dir prefix */
  86       dirlen = 0;
  87       fullvalue = xmalloc ((vallen + 1) * sizeof(TCHAR));
  88     }
  89   else
  90     {
  91       /* Add dir first */
  92       dirlen = _tcslen (dir);
  93
  94       fullvalue = xmalloc ((dirlen + vallen + 1) * sizeof(TCHAR));
  95       _tcscpy (fullvalue, dir);
  96     }
  97
  98   /* Append value */
  99
 100   if (quoted)
 101     {
 102       _tcsncpy (fullvalue + dirlen, value + 1, vallen - 1);
 103       fullvalue [dirlen + vallen - sizeof(TCHAR)] = _T('\0');
 104     }
 105   else
 106     _tcscpy (fullvalue + dirlen, value);
 107
 108   if (*last <= *index)
 109     {
 110       *last += EXPAND_ARGV_RATE;
 111       *argv = (char **) xrealloc (*argv, (*last) * sizeof (char *));
 112     }
 113
 114   size = WS2SC (NULL, fullvalue, 0);
 115   (*argv)[*index] = (char *) xmalloc (size + sizeof(TCHAR));
 116   WS2SC ((*argv)[*index], fullvalue, size);
 117
 118   free (fullvalue);
 119
 120   (*index)++;
 121 }
 122 #endif
 123
 124 void
 125 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 126 {
 127    /* Initialize floating-point coprocessor. This call is needed because
 128       the MS libraries default to 64-bit precision instead of 80-bit
 129       precision, and we require the full precision for proper operation,
 130       given that we have set Max_Digits etc with this in mind */
 131    __gnat_init_float ();
 132
 133 #ifdef GNAT_UNICODE_SUPPORT
 134    /* Set current code page for filenames handling. */
 135    {
 136      char *codepage = getenv ("GNAT_CODE_PAGE");
 137
 138      /* Default code page is UTF-8.  */
 139      CurrentCodePage = CP_UTF8;
 140
 141      if (codepage != NULL)
 142        {
 143          if (strcmp (codepage, "CP_ACP") == 0)
 144            CurrentCodePage = CP_ACP;
 145          else if (strcmp (codepage, "CP_UTF8") == 0)
 146            CurrentCodePage = CP_UTF8;
 147        }
 148    }
 149
 150    /* Adjust gnat_argv to support Unicode characters. */
 151    {
 152      LPWSTR *wargv;
 153      int wargc;
 154      int k;
 155      int last;
 156      int argc_expanded = 0;
 157      TCHAR result [MAX_PATH];
 158      int quoted;
 159
 160      wargv = CommandLineToArgvW (GetCommandLineW(), &wargc);
 161
 162      if (wargv != NULL)
 163        {
 164          /* Set gnat_argv with arguments encoded in UTF-8. */
 165          last = wargc + 1;
 166          gnat_argv = (char **) xmalloc ((last) * sizeof (char *));
 167
 168          /* argv[0] is the executable full path-name. */
 169
 170          SearchPath (NULL, wargv[0], _T(".exe"), MAX_PATH, result, NULL);
 171          append_arg (&argc_expanded, NULL, result, &gnat_argv, &last, 0);
 172
 173          for (k=1; k<wargc; k++)
 174            {
 175              quoted = (wargv[k][0] == _T('\''));
 176
 177              /* Check for wildcard expansion if the argument is not quoted. */
 178              if (!quoted
 179                  && (_tcsstr (wargv[k], _T("?")) != 0 ||
 180                      _tcsstr (wargv[k], _T("*")) != 0))
 181                {
 182                  /* Wilcards are present, append all corresponding matches. */
 183                  WIN32_FIND_DATA FileData;
 184                  HANDLE hDir = FindFirstFile (wargv[k], &FileData);
 185                  LPWSTR dir = NULL;
 186                  LPWSTR ldir = _tcsrchr (wargv[k], _T('\\'));
 187
 188                  if (ldir == NULL)
 189                    ldir = _tcsrchr (wargv[k], _T('/'));
 190
 191                  if (hDir == INVALID_HANDLE_VALUE)
 192                    {
 193                      /* No match, append arg as-is. */
 194                      append_arg (&argc_expanded, NULL, wargv[k],
 195                                  &gnat_argv, &last, quoted);
 196                    }
 197                  else
 198                    {
 199                      if (ldir != NULL)
 200                        {
 201                          int n = ldir - wargv[k] + 1;
 202                          dir = xmalloc ((n + 1) * sizeof (TCHAR));
 203                          _tcsncpy (dir, wargv[k], n);
 204                          dir[n] = _T('\0');
 205                        }
 206
 207                      /* Append first match and all remaining ones.  */
 208
 209                      do {
 210                        /* Do not add . and .. special entries */
 211
 212                        if (_tcscmp (FileData.cFileName, _T(".")) != 0
 213                            && _tcscmp (FileData.cFileName, _T("..")) != 0)
 214                          append_arg (&argc_expanded, dir, FileData.cFileName,
 215                                      &gnat_argv, &last, 0);
 216                      } while (FindNextFile (hDir, &FileData));
 217
 218                      FindClose (hDir);
 219
 220                      if (dir != NULL)
 221                        free (dir);
 222                    }
 223                }
 224              else
 225                {
 226                  /*  No wildcard. Store parameter as-is. Remove quote if
 227                      needed. */
 228                  append_arg (&argc_expanded, NULL, wargv[k],
 229                              &gnat_argv, &last, quoted);
 230                }
 231            }
 232
 233          LocalFree (wargv);
 234          gnat_argc = argc_expanded;
 235          gnat_argv = (char **) xrealloc
 236            (gnat_argv, argc_expanded * sizeof (char *));
 237        }
 238    }
 239 #endif
 240
 241    /* Note that we do not activate this for the compiler itself to avoid a
 242       bootstrap path problem.  Older version of gnatbind will generate a call
 243       to __gnat_initialize() without argument. Therefore we cannot use eh in
 244       this case.  It will be possible to remove the following #ifdef at some
 245       point.  */
 246 #ifdef IN_RTS
 247    /* Install the Structured Exception handler.  */
 248    if (eh)
 249      __gnat_install_SEH_handler (eh);
 250 #endif
 251 }
 252
 253 /******************************************/
 254 /* __gnat_initialize (init_float version) */
 255 /******************************************/
 256
 257 #elif defined (__Lynx__) || defined (__FreeBSD__) || defined(__NetBSD__) \
 258   || defined (__OpenBSD__)
 259
 260 extern void __gnat_init_float (void);
 261
 262 void
 263 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 264 {
 265    __gnat_init_float ();
 266 }
 267
 268 /***************************************/
 269 /* __gnat_initialize (VxWorks Version) */
 270 /***************************************/
 271
 272 #elif defined(__vxworks)
 273
 274 extern void __gnat_init_float (void);
 275
 276 void
 277 __gnat_initialize (void *eh)
 278 {
 279   __gnat_init_float ();
 280
 281   /* On targets where we use the ZCX scheme, we need to register the frame
 282      tables at load/startup time.
 283
 284      For applications loaded as a set of "modules", the crtstuff objects
 285      linked in (crtbegin.o/end.o) are tailored to provide this service
 286      automatically, a-la C++ constructor fashion, triggered by the VxWorks
 287      loader thanks to a special variable declaration in crtbegin.o (_ctors).
 288
 289      Automatic de-registration is handled symmetrically, a-la C++ destructor
 290      fashion (with a _dtors variable also in crtbegin.o) triggered by the
 291      dynamic unloader.
 292
 293      Note that since the tables shall be registered against a common
 294      data structure, libgcc should be one of the modules (vs being partially
 295      linked against all the others at build time) and shall be loaded first.
 296
 297      For applications linked with the kernel, the scheme above would lead to
 298      duplicated symbols because the VxWorks kernel build "munches" by default,
 299      so we link against crtbeginT.o instead of crtbegin.o, which doesn't
 300      include the special variables. We know which set of crt objects is used
 301      thanks to a boolean indicator present in both sets (__module_has_ctors),
 302      and directly call the appropriate function here in the not-automatic
 303      case. We'll never unload that, so there is no de-registration to worry
 304      about.
 305
 306      For whole applications loaded as a single module, we may use one scheme
 307      or the other, except for the mixed Ada/C++ case in which the first scheme
 308      would fail for the same reason as in the linked-with-kernel situation.
 309
 310      Selecting the crt set with the ctors/dtors capabilities (first scheme
 311      above) is triggered by adding "-dynamic" to the gcc *link* command line
 312      options. Selecting the other set is achieved by using "-static" instead.
 313
 314      This is a first approach, tightly synchronized with a number of GCC
 315      configuration and crtstuff changes. We need to ensure that those changes
 316      are there to activate this circuitry.  */
 317
 318 #if (__GNUC__ >= 3) && (defined (_ARCH_PPC) || defined (__ppc))
 319  {
 320    /* The scheme described above is only useful for the actual ZCX case, and
 321       we don't want any reference to the crt provided symbols otherwise.  We
 322       may not link with any of the crt objects in the non-ZCX case, e.g. from
 323       documented procedures instructing the use of -nostdlib, and references
 324       to the ctors symbols here would just remain unsatisfied.
 325
 326       We have no way to avoid those references in the right conditions in this
 327       C module, because we have nothing like a IN_ZCX_RTS macro.  This aspect
 328       is then deferred to an Ada routine, which can do that based on a test
 329       against a constant System flag value.  */
 330
 331    extern void __gnat_vxw_setup_for_eh (void);
 332    __gnat_vxw_setup_for_eh ();
 333  }
 334 #endif
 335 }
 336
 337 #elif defined(_T_HPUX10) || (!defined(IN_RTS) && defined(_X_HPUX10))
 338
 339 /************************************************/
 340 /* __gnat_initialize (PA-RISC HP-UX 10 Version) */
 341 /************************************************/
 342
 343 extern void __main (void);
 344
 345 void
 346 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 347 {
 348   __main ();
 349 }
 350
 351 #else
 352
 353 /* For all other versions of GNAT, the initialize routine and handler
 354    installation do nothing */
 355
 356 /***************************************/
 357 /* __gnat_initialize (Default Version) */
 358 /***************************************/
 359
 360 void
 361 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 362 {
 363 }
 364
 365 #endif