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-2012, 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 #ifdef __cplusplus
  57 extern "C" {
  58 #endif
  59
  60 /******************************************/
  61 /* __gnat_initialize (NT-mingw32 Version) */
  62 /******************************************/
  63
  64 #if defined (__MINGW32__)
  65 #include "mingw32.h"
  66 #include <windows.h>
  67
  68 extern void __gnat_init_float (void);
  69 extern void __gnat_install_SEH_handler (void *);
  70
  71 extern int gnat_argc;
  72 extern char **gnat_argv;
  73
  74 #ifdef GNAT_UNICODE_SUPPORT
  75
  76 #define EXPAND_ARGV_RATE 128
  77
  78 static void
  79 append_arg (int *index, LPWSTR dir, LPWSTR value,
  80             char ***argv, int *last, int quoted)
  81 {
  82   int size;
  83   LPWSTR fullvalue;
  84   int vallen = _tcslen (value);
  85   int dirlen;
  86
  87   if (dir == NULL)
  88     {
  89       /* no dir prefix */
  90       dirlen = 0;
  91       fullvalue = (LPWSTR) xmalloc ((vallen + 1) * sizeof(TCHAR));
  92     }
  93   else
  94     {
  95       /* Add dir first */
  96       dirlen = _tcslen (dir);
  97
  98       fullvalue = (LPWSTR) xmalloc ((dirlen + vallen + 1) * sizeof(TCHAR));
  99       _tcscpy (fullvalue, dir);
 100     }
 101
 102   /* Append value */
 103
 104   if (quoted)
 105     {
 106       _tcsncpy (fullvalue + dirlen, value + 1, vallen - 1);
 107       fullvalue [dirlen + vallen - sizeof(TCHAR)] = _T('\0');
 108     }
 109   else
 110     _tcscpy (fullvalue + dirlen, value);
 111
 112   if (*last <= *index)
 113     {
 114       *last += EXPAND_ARGV_RATE;
 115       *argv = (char **) xrealloc (*argv, (*last) * sizeof (char *));
 116     }
 117
 118   size = WS2SC (NULL, fullvalue, 0);
 119   (*argv)[*index] = (char *) xmalloc (size + sizeof(TCHAR));
 120   WS2SC ((*argv)[*index], fullvalue, size);
 121
 122   free (fullvalue);
 123
 124   (*index)++;
 125 }
 126 #endif
 127
 128 void
 129 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 130 {
 131    /* Initialize floating-point coprocessor. This call is needed because
 132       the MS libraries default to 64-bit precision instead of 80-bit
 133       precision, and we require the full precision for proper operation,
 134       given that we have set Max_Digits etc with this in mind */
 135    __gnat_init_float ();
 136
 137 #ifdef GNAT_UNICODE_SUPPORT
 138    /* Set current code page for filenames handling. */
 139    {
 140      char *codepage = getenv ("GNAT_CODE_PAGE");
 141
 142      /* Default code page is UTF-8.  */
 143      CurrentCodePage = CP_UTF8;
 144
 145      if (codepage != NULL)
 146        {
 147          if (strcmp (codepage, "CP_ACP") == 0)
 148            CurrentCodePage = CP_ACP;
 149          else if (strcmp (codepage, "CP_UTF8") == 0)
 150            CurrentCodePage = CP_UTF8;
 151        }
 152    }
 153
 154    /* Adjust gnat_argv to support Unicode characters. */
 155    {
 156      LPWSTR *wargv;
 157      int wargc;
 158      int k;
 159      int last;
 160      int argc_expanded = 0;
 161      TCHAR result [MAX_PATH];
 162      int quoted;
 163
 164      wargv = CommandLineToArgvW (GetCommandLineW(), &wargc);
 165
 166      if (wargv != NULL)
 167        {
 168          /* Set gnat_argv with arguments encoded in UTF-8. */
 169          last = wargc + 1;
 170          gnat_argv = (char **) xmalloc ((last) * sizeof (char *));
 171
 172          /* argv[0] is the executable full path-name. */
 173
 174          SearchPath (NULL, wargv[0], _T(".exe"), MAX_PATH, result, NULL);
 175          append_arg (&argc_expanded, NULL, result, &gnat_argv, &last, 0);
 176
 177          for (k=1; k<wargc; k++)
 178            {
 179              quoted = (wargv[k][0] == _T('\''));
 180
 181              /* Check for wildcard expansion if the argument is not quoted. */
 182              if (!quoted
 183                  && (_tcsstr (wargv[k], _T("?")) != 0 ||
 184                      _tcsstr (wargv[k], _T("*")) != 0))
 185                {
 186                  /* Wilcards are present, append all corresponding matches. */
 187                  WIN32_FIND_DATA FileData;
 188                  HANDLE hDir = FindFirstFile (wargv[k], &FileData);
 189                  LPWSTR dir = NULL;
 190                  LPWSTR ldir = _tcsrchr (wargv[k], _T('\\'));
 191
 192                  if (ldir == NULL)
 193                    ldir = _tcsrchr (wargv[k], _T('/'));
 194
 195                  if (hDir == INVALID_HANDLE_VALUE)
 196                    {
 197                      /* No match, append arg as-is. */
 198                      append_arg (&argc_expanded, NULL, wargv[k],
 199                                  &gnat_argv, &last, quoted);
 200                    }
 201                  else
 202                    {
 203                      if (ldir != NULL)
 204                        {
 205                          int n = ldir - wargv[k] + 1;
 206                          dir = (LPWSTR) xmalloc ((n + 1) * sizeof (TCHAR));
 207                          _tcsncpy (dir, wargv[k], n);
 208                          dir[n] = _T('\0');
 209                        }
 210
 211                      /* Append first match and all remaining ones.  */
 212
 213                      do {
 214                        /* Do not add . and .. special entries */
 215
 216                        if (_tcscmp (FileData.cFileName, _T(".")) != 0
 217                            && _tcscmp (FileData.cFileName, _T("..")) != 0)
 218                          append_arg (&argc_expanded, dir, FileData.cFileName,
 219                                      &gnat_argv, &last, 0);
 220                      } while (FindNextFile (hDir, &FileData));
 221
 222                      FindClose (hDir);
 223
 224                      if (dir != NULL)
 225                        free (dir);
 226                    }
 227                }
 228              else
 229                {
 230                  /*  No wildcard. Store parameter as-is. Remove quote if
 231                      needed. */
 232                  append_arg (&argc_expanded, NULL, wargv[k],
 233                              &gnat_argv, &last, quoted);
 234                }
 235            }
 236
 237          LocalFree (wargv);
 238          gnat_argc = argc_expanded;
 239          gnat_argv = (char **) xrealloc
 240            (gnat_argv, argc_expanded * sizeof (char *));
 241        }
 242    }
 243 #endif
 244
 245    /* Note that we do not activate this for the compiler itself to avoid a
 246       bootstrap path problem.  Older version of gnatbind will generate a call
 247       to __gnat_initialize() without argument. Therefore we cannot use eh in
 248       this case.  It will be possible to remove the following #ifdef at some
 249       point.  */
 250 #ifdef IN_RTS
 251    /* Install the Structured Exception handler.  */
 252    if (eh)
 253      __gnat_install_SEH_handler (eh);
 254 #endif
 255 }
 256
 257 /******************************************/
 258 /* __gnat_initialize (init_float version) */
 259 /******************************************/
 260
 261 #elif defined (__Lynx__) || defined (__FreeBSD__) || defined(__NetBSD__) \
 262   || defined (__OpenBSD__)
 263
 264 extern void __gnat_init_float (void);
 265
 266 void
 267 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 268 {
 269    __gnat_init_float ();
 270 }
 271
 272 /***************************************/
 273 /* __gnat_initialize (VxWorks Version) */
 274 /***************************************/
 275
 276 #elif defined(__vxworks)
 277
 278 extern void __gnat_init_float (void);
 279
 280 void
 281 __gnat_initialize (void *eh)
 282 {
 283   __gnat_init_float ();
 284 }
 285
 286 #elif defined(_T_HPUX10) || (!defined(IN_RTS) && defined(_X_HPUX10))
 287
 288 /************************************************/
 289 /* __gnat_initialize (PA-RISC HP-UX 10 Version) */
 290 /************************************************/
 291
 292 extern void __main (void);
 293
 294 void
 295 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 296 {
 297   __main ();
 298 }
 299
 300 #else
 301
 302 /* For all other versions of GNAT, the initialize routine and handler
 303    installation do nothing */
 304
 305 /***************************************/
 306 /* __gnat_initialize (Default Version) */
 307 /***************************************/
 308
 309 void
 310 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
 311 {
 312 }
 313
 314 #endif
 315
 316 #ifdef __cplusplus
 317 }
 318 #endif