gcc/ada/rtinit.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) 2014-2018, 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 implementation for __gnat_runtime_initialize ()
  33     which is called in adainit() to do special initialization needed by
  34     the GNAT runtime.  */
  35
  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 #include <fcntl.h>
  56
  57 #ifdef __cplusplus
  58 extern "C" {
  59 #endif
  60
  61 /**************************************************/
  62 /* __gnat_runtime_initialize (NT-mingw32 Version) */
  63 /**************************************************/
  64
  65 extern void __gnat_install_handler(void);
  66
  67 int __gnat_wide_text_translation_required = 0;
  68 /* wide text translation, 0=none, 1=activated */
  69
  70 int __gnat_rt_init_count = 0;
  71 /* number of references to the GNAT runtime, this is used to initialize
  72    and finalize properly the run-time. */
  73
  74 #if defined (__MINGW32__)
  75 #include "mingw32.h"
  76 #include <windows.h>
  77
  78 extern void __gnat_init_float (void);
  79
  80 extern int gnat_argc;
  81 extern char **gnat_argv;
  82 extern CRITICAL_SECTION ProcListCS;
  83 extern HANDLE ProcListEvt;
  84
  85 #ifdef GNAT_UNICODE_SUPPORT
  86
  87 #define EXPAND_ARGV_RATE 128
  88
  89 int __gnat_do_argv_expansion = 1;
  90 #pragma weak __gnat_do_argv_expansion
  91
  92 static void
  93 append_arg (int *index, LPWSTR dir, LPWSTR value,
  94             char ***argv, int *last, int quoted)
  95 {
  96   int size;
  97   LPWSTR fullvalue;
  98   int vallen = _tcslen (value);
  99   int dirlen;
 100
 101   if (dir == NULL)
 102     {
 103       /* no dir prefix */
 104       dirlen = 0;
 105       fullvalue = (LPWSTR) xmalloc ((vallen + 1) * sizeof(TCHAR));
 106     }
 107   else
 108     {
 109       /* Add dir first */
 110       dirlen = _tcslen (dir);
 111
 112       fullvalue = (LPWSTR) xmalloc ((dirlen + vallen + 1) * sizeof(TCHAR));
 113       _tcscpy (fullvalue, dir);
 114     }
 115
 116   /* Append value */
 117
 118   if (quoted)
 119     {
 120       _tcsncpy (fullvalue + dirlen, value + 1, vallen - 1);
 121       fullvalue [dirlen + vallen - sizeof(TCHAR)] = _T('\0');
 122     }
 123   else
 124     _tcscpy (fullvalue + dirlen, value);
 125
 126   if (*last <= *index)
 127     {
 128       *last += EXPAND_ARGV_RATE;
 129       *argv = (char **) xrealloc (*argv, (*last) * sizeof (char *));
 130     }
 131
 132   size = WS2SC (NULL, fullvalue, 0);
 133   (*argv)[*index] = (char *) xmalloc (size + sizeof(TCHAR));
 134   WS2SC ((*argv)[*index], fullvalue, size);
 135
 136   free (fullvalue);
 137
 138   (*index)++;
 139 }
 140 #endif
 141
 142 void
 143 __gnat_runtime_initialize(int install_handler)
 144 {
 145   /*  increment the reference counter */
 146
 147   __gnat_rt_init_count++;
 148
 149   /*  if already initialized return now */
 150   if (__gnat_rt_init_count > 1)
 151     return;
 152
 153    /* Initialize floating-point coprocessor. This call is needed because
 154       the MS libraries default to 64-bit precision instead of 80-bit
 155       precision, and we require the full precision for proper operation,
 156       given that we have set Max_Digits etc with this in mind */
 157
 158    __gnat_init_float ();
 159
 160    /* Initialize the critical section and event handle for the win32_wait()
 161       implementation, see adaint.c */
 162
 163    InitializeCriticalSection (&ProcListCS);
 164    ProcListEvt = CreateEvent (NULL, FALSE, FALSE, NULL);
 165
 166 #ifdef GNAT_UNICODE_SUPPORT
 167    /* Set current code page for filenames handling. */
 168    {
 169      char *codepage = getenv ("GNAT_CODE_PAGE");
 170
 171      /* Default code page is UTF-8.  */
 172      __gnat_current_codepage = CP_UTF8;
 173
 174      if (codepage != NULL)
 175        {
 176          if (strcmp (codepage, "CP_ACP") == 0)
 177            __gnat_current_codepage = CP_ACP;
 178          else if (strcmp (codepage, "CP_UTF8") == 0)
 179            __gnat_current_codepage = CP_UTF8;
 180        }
 181    }
 182
 183    /* Set current encoding for the IO.  */
 184    {
 185      char *ccsencoding = getenv ("GNAT_CCS_ENCODING");
 186
 187      /* Default CCS Encoding.  */
 188      __gnat_current_ccs_encoding = _O_TEXT;
 189      __gnat_wide_text_translation_required = 0;
 190
 191      if (ccsencoding != NULL)
 192        {
 193          if (strcmp (ccsencoding, "U16TEXT") == 0)
 194            {
 195              __gnat_current_ccs_encoding = _O_U16TEXT;
 196              __gnat_wide_text_translation_required = 1;
 197            }
 198          else if (strcmp (ccsencoding, "TEXT") == 0)
 199            {
 200              __gnat_current_ccs_encoding = _O_TEXT;
 201              __gnat_wide_text_translation_required = 0;
 202            }
 203          else if (strcmp (ccsencoding, "WTEXT") == 0)
 204            {
 205              __gnat_current_ccs_encoding = _O_WTEXT;
 206              __gnat_wide_text_translation_required = 1;
 207            }
 208          else if (strcmp (ccsencoding, "U8TEXT") == 0)
 209            {
 210              __gnat_current_ccs_encoding = _O_U8TEXT;
 211              __gnat_wide_text_translation_required = 1;
 212            }
 213        }
 214    }
 215
 216    /* Adjust gnat_argv to support Unicode characters. */
 217    {
 218      LPWSTR *wargv;
 219      int wargc;
 220      int k;
 221      int last;
 222      int argc_expanded = 0;
 223      TCHAR result [MAX_PATH];
 224      int quoted;
 225
 226      wargv = CommandLineToArgvW (GetCommandLineW(), &wargc);
 227
 228      if (wargv != NULL)
 229        {
 230          /* Set gnat_argv with arguments encoded in UTF-8. */
 231          last = wargc + 1;
 232          gnat_argv = (char **) xmalloc ((last) * sizeof (char *));
 233
 234          /* argv[0] is the executable full path-name. */
 235
 236          SearchPath (NULL, wargv[0], _T(".exe"), MAX_PATH, result, NULL);
 237          append_arg (&argc_expanded, NULL, result, &gnat_argv, &last, 0);
 238
 239          for (k=1; k<wargc; k++)
 240            {
 241              quoted = (wargv[k][0] == _T('\''));
 242
 243              /* Check for wildcard expansion if the argument is not quoted. */
 244              if (!quoted && __gnat_do_argv_expansion
 245                  && (_tcsstr (wargv[k], _T("?")) != 0 ||
 246                      _tcsstr (wargv[k], _T("*")) != 0))
 247                {
 248                  /* Wilcards are present, append all corresponding matches. */
 249                  WIN32_FIND_DATA FileData;
 250                  HANDLE hDir = FindFirstFile (wargv[k], &FileData);
 251                  LPWSTR dir = NULL;
 252                  LPWSTR ldir = _tcsrchr (wargv[k], _T('\\'));
 253
 254                  if (ldir == NULL)
 255                    ldir = _tcsrchr (wargv[k], _T('/'));
 256
 257                  if (hDir == INVALID_HANDLE_VALUE)
 258                    {
 259                      /* No match, append arg as-is. */
 260                      append_arg (&argc_expanded, NULL, wargv[k],
 261                                  &gnat_argv, &last, quoted);
 262                    }
 263                  else
 264                    {
 265                      if (ldir != NULL)
 266                        {
 267                          int n = ldir - wargv[k] + 1;
 268                          dir = (LPWSTR) xmalloc ((n + 1) * sizeof (TCHAR));
 269                          _tcsncpy (dir, wargv[k], n);
 270                          dir[n] = _T('\0');
 271                        }
 272
 273                      /* Append first match and all remaining ones.  */
 274
 275                      do {
 276                        /* Do not add . and .. special entries */
 277
 278                        if (_tcscmp (FileData.cFileName, _T(".")) != 0
 279                            && _tcscmp (FileData.cFileName, _T("..")) != 0)
 280                          append_arg (&argc_expanded, dir, FileData.cFileName,
 281                                      &gnat_argv, &last, 0);
 282                      } while (FindNextFile (hDir, &FileData));
 283
 284                      FindClose (hDir);
 285
 286                      if (dir != NULL)
 287                        free (dir);
 288                    }
 289                }
 290              else
 291                {
 292                  /*  No wildcard. Store parameter as-is. Remove quote if
 293                      needed. */
 294                  append_arg (&argc_expanded, NULL, wargv[k],
 295                              &gnat_argv, &last,
 296                              quoted && __gnat_do_argv_expansion);
 297                }
 298            }
 299
 300          LocalFree (wargv);
 301          gnat_argc = argc_expanded;
 302          gnat_argv = (char **) xrealloc
 303            (gnat_argv, argc_expanded * sizeof (char *));
 304        }
 305    }
 306 #endif
 307
 308   if (install_handler)
 309     __gnat_install_handler();
 310 }
 311
 312 /**************************************************/
 313 /* __gnat_runtime_initialize (init_float version) */
 314 /**************************************************/
 315
 316 #elif defined (__Lynx__) || defined (__FreeBSD__) || defined(__NetBSD__) \
 317   || defined (__OpenBSD__)
 318
 319 extern void __gnat_init_float (void);
 320
 321 void
 322 __gnat_runtime_initialize(int install_handler)
 323 {
 324   /*  increment the reference counter */
 325
 326   __gnat_rt_init_count++;
 327
 328   /*  if already initialized return now */
 329   if (__gnat_rt_init_count > 1)
 330     return;
 331
 332    __gnat_init_float ();
 333
 334   if (install_handler)
 335     __gnat_install_handler();
 336 }
 337
 338 /***********************************************/
 339 /* __gnat_runtime_initialize (VxWorks Version) */
 340 /***********************************************/
 341
 342 #elif defined(__vxworks)
 343
 344 extern void __gnat_init_float (void);
 345
 346 void
 347 __gnat_runtime_initialize(int install_handler)
 348 {
 349   /*  increment the reference counter */
 350
 351   __gnat_rt_init_count++;
 352
 353   /*  if already initialized return now */
 354   if (__gnat_rt_init_count > 1)
 355     return;
 356
 357   __gnat_init_float ();
 358
 359   if (install_handler)
 360     __gnat_install_handler();
 361 }
 362
 363 #else
 364
 365 /***********************************************/
 366 /* __gnat_runtime_initialize (default version) */
 367 /***********************************************/
 368
 369 void
 370 __gnat_runtime_initialize(int install_handler)
 371 {
 372   /*  increment the reference counter */
 373
 374   __gnat_rt_init_count++;
 375
 376   /*  if already initialized return now */
 377   if (__gnat_rt_init_count > 1)
 378     return;
 379
 380   if (install_handler)
 381     __gnat_install_handler();
 382 }
 383
 384 #endif
 385
 386 #ifdef __cplusplus
 387 }
 388 #endif