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-2019, 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 /* We don't have libiberty, so use malloc.  */
  45 #define xmalloc(S) malloc (S)
  46 #define xrealloc(V,S) realloc (V,S)
  47 #else
  48 #include "config.h"
  49 #include "system.h"
  50 #endif
  51
  52 #include "raise.h"
  53 #include <fcntl.h>
  54
  55 #ifdef __cplusplus
  56 extern "C" {
  57 #endif
  58
  59 /**************************************************/
  60 /* __gnat_runtime_initialize (NT-mingw32 Version) */
  61 /**************************************************/
  62
  63 extern void __gnat_install_handler (void);
  64
  65 int __gnat_wide_text_translation_required = 0;
  66 /* wide text translation, 0=none, 1=activated */
  67
  68 int __gnat_rt_init_count = 0;
  69 /* number of references to the GNAT runtime, this is used to initialize
  70    and finalize properly the run-time. */
  71
  72 #if defined (__MINGW32__)
  73 #include "mingw32.h"
  74 #include <windows.h>
  75
  76 extern void __gnat_init_float (void);
  77
  78 extern int gnat_argc;
  79 extern char **gnat_argv;
  80 extern CRITICAL_SECTION ProcListCS;
  81 extern HANDLE ProcListEvt;
  82
  83 #ifdef GNAT_UNICODE_SUPPORT
  84
  85 #define EXPAND_ARGV_RATE 128
  86
  87 int __gnat_do_argv_expansion = 1;
  88 #pragma weak __gnat_do_argv_expansion
  89
  90 /* Assuming we are pointing to the beginning of a quoted part of an
  91 argument, skip until the end of the quoted part.  */
  92 static void skip_quoted_string (const WCHAR **current_in,
  93                                 WCHAR **current_out)
  94 {
  95   /* Number of backslashes buffered.  */
  96   int qbs_count = 0;
  97
  98   /* Pointer to current input character.  */
  99   const WCHAR *ci = *current_in;
 100
 101   /* Pointer to next output character.  */
 102   WCHAR *co = *current_out;
 103
 104   /* Skip initial quote.  */
 105   ci++;
 106
 107   while (*ci)
 108     {
 109       if (*ci == '\\')
 110         {
 111           /* Buffer incoming backslashes.  */
 112           qbs_count++;
 113         }
 114       else if (*ci == '"')
 115         {
 116           /* Append qbs_count / 2 backslahes.  */
 117           for (int i=0; i<qbs_count / 2; i++)
 118             {
 119               *co = '\\';
 120               co++;
 121             }
 122           if ((qbs_count & 1) == 0)
 123             {
 124               /* 2n backslashes means that the quotation mark is the end of
 125                  the quoted portion.  */
 126               qbs_count = 0;
 127               break;
 128             }
 129           else
 130             {
 131               /* Otherwise this is a double quote literal.  */
 132               qbs_count = 0;
 133               *co = '"'; co++;
 134             }
 135         }
 136       else
 137         {
 138           /* If the character is not a double quote we should append
 139              qbs_count backslashes.  */
 140           for (int i=0; i<qbs_count; i++)
 141             {
 142               *co = '\\';
 143               co++;
 144             }
 145           *co = *ci; co++;
 146           qbs_count = 0;
 147         }
 148       ci++;
 149     }
 150   *current_in = ci;
 151   *current_out = co;
 152 }
 153
 154 /* Assuming that this is the beginning of an argument. Skip characters
 155    until we reach the character right after the last argument character.  */
 156 static void skip_argument (const WCHAR **current_in,
 157                            WCHAR **current_out)
 158 {
 159   /* Number of backslashes buffered.  */
 160   int bs_count = 0;
 161
 162   /* Pointer to current input character.  */
 163   const WCHAR *ci = *current_in;
 164
 165   /* Pointer to next output character.  */
 166   WCHAR *co = *current_out;
 167
 168   while (*ci && ! (*ci == ' ' || *ci == '\t'))
 169     {
 170       if (*ci == '\\')
 171         {
 172           /* Buffer incoming backslashes.  */
 173           bs_count++;
 174         }
 175       else if (*ci == '"')
 176         {
 177           /* Append qbs_count / 2 backslahes.  */
 178           for (int i=0; i< bs_count / 2; i++)
 179             {
 180               *co = '\\'; co++;
 181             }
 182           if ((bs_count & 1) == 0)
 183             {
 184               /* 2n backslashes followed by a quotation mark means that
 185                  this is a start of a quoted string.  */
 186               skip_quoted_string (&ci, &co);
 187             }
 188           else
 189             {
 190               /* Otherwise this is quotation mark literal.  */
 191               *co = '"';
 192               co++;
 193             }
 194           bs_count = 0;
 195         }
 196       else
 197         {
 198           /* This is a regular character. */
 199           /* Backslashes are interpreted literally.  */
 200           for (int i=0; i<bs_count; i++)
 201             {
 202               *co = '\\';
 203               co++;
 204             }
 205           bs_count = 0;
 206           *co = *ci; co++;
 207         }
 208       ci++;
 209     }
 210
 211   for (int i=0; i<bs_count; i++)
 212     {
 213       *co = '\\';
 214       co++;
 215     }
 216
 217   /* End the argument with a null character. */
 218   *co = '\0';
 219   co++;
 220
 221   *current_in = ci;
 222   *current_out = co;
 223 }
 224
 225
 226 void __gnat_get_argw (const WCHAR *command_line, WCHAR ***argv, int *argc)
 227 {
 228   WCHAR *inline_argv;
 229   WCHAR *co;
 230   int arg_count = 1;
 231   const WCHAR *ci;
 232
 233   inline_argv =
 234     (WCHAR *) xmalloc ((wcslen (command_line) + 1) * sizeof (WCHAR));
 235   co = inline_argv;
 236
 237   /* Start iteration on command line characters. */
 238   ci = command_line;
 239
 240   /* Skip command name. Note that if the command line starts with whitechars
 241      then the command name will be the empty string. */
 242   skip_argument (&ci, &co);
 243
 244   /* Count remaining arguments. */
 245   while (*ci)
 246     {
 247       /* skip whitechar */
 248       while (*ci && (*ci == ' ' || *ci == '\t')) { ci++; }
 249       if (*ci)
 250         {
 251           skip_argument (&ci, &co);
 252           arg_count++;
 253         }
 254       else
 255         break;
 256     }
 257
 258   /* Allocate table with pointer to each arguments */
 259   argv[0] = (WCHAR **) xmalloc (arg_count * sizeof (WCHAR *));
 260
 261   for (int idx = 0; idx < arg_count; idx++)
 262     {
 263       argv[0][idx] = inline_argv;
 264       while (*inline_argv)
 265         {
 266           inline_argv++;
 267         }
 268       inline_argv++;
 269      }
 270   *argc = arg_count;
 271 }
 272
 273 static void
 274 append_arg (int *index, LPWSTR dir, LPWSTR value,
 275             char ***argv, int *last, int quoted)
 276 {
 277   int size;
 278   LPWSTR fullvalue;
 279   int vallen = _tcslen (value);
 280   int dirlen;
 281
 282   if (dir == NULL)
 283     {
 284       /* no dir prefix */
 285       dirlen = 0;
 286       fullvalue = (LPWSTR) xmalloc ((vallen + 1) * sizeof (TCHAR));
 287     }
 288   else
 289     {
 290       /* Add dir first */
 291       dirlen = _tcslen (dir);
 292
 293       fullvalue = (LPWSTR) xmalloc ((dirlen + vallen + 1) * sizeof (TCHAR));
 294       _tcscpy (fullvalue, dir);
 295     }
 296
 297   /* Append value */
 298
 299   if (quoted)
 300     {
 301       _tcsncpy (fullvalue + dirlen, value + 1, vallen - 1);
 302       fullvalue [dirlen + vallen - sizeof (TCHAR)] = _T ('\0');
 303     }
 304   else
 305     _tcscpy (fullvalue + dirlen, value);
 306
 307   if (*last <= *index)
 308     {
 309       *last += EXPAND_ARGV_RATE;
 310       *argv = (char **) xrealloc (*argv, (*last) * sizeof (char *));
 311     }
 312
 313   size = WS2SC (NULL, fullvalue, 0);
 314   (*argv)[*index] = (char *) xmalloc (size + sizeof (TCHAR));
 315   WS2SC ((*argv)[*index], fullvalue, size);
 316
 317   free (fullvalue);
 318
 319   (*index)++;
 320 }
 321 #endif
 322
 323 void
 324 __gnat_runtime_initialize (int install_handler)
 325 {
 326   /*  increment the reference counter */
 327
 328   __gnat_rt_init_count++;
 329
 330   /*  if already initialized return now */
 331   if (__gnat_rt_init_count > 1)
 332     return;
 333
 334    /* Initialize floating-point coprocessor. This call is needed because
 335       the MS libraries default to 64-bit precision instead of 80-bit
 336       precision, and we require the full precision for proper operation,
 337       given that we have set Max_Digits etc with this in mind */
 338
 339    __gnat_init_float ();
 340
 341    /* Initialize the critical section and event handle for the win32_wait()
 342       implementation, see adaint.c */
 343
 344    InitializeCriticalSection (&ProcListCS);
 345    ProcListEvt = CreateEvent (NULL, FALSE, FALSE, NULL);
 346
 347 #ifdef GNAT_UNICODE_SUPPORT
 348    /* Set current code page for filenames handling. */
 349    {
 350      char *codepage = getenv ("GNAT_CODE_PAGE");
 351
 352      /* Default code page is UTF-8.  */
 353      __gnat_current_codepage = CP_UTF8;
 354
 355      if (codepage != NULL)
 356        {
 357          if (strcmp (codepage, "CP_ACP") == 0)
 358            __gnat_current_codepage = CP_ACP;
 359          else if (strcmp (codepage, "CP_UTF8") == 0)
 360            __gnat_current_codepage = CP_UTF8;
 361        }
 362    }
 363
 364    /* Set current encoding for the IO.  */
 365    {
 366      char *ccsencoding = getenv ("GNAT_CCS_ENCODING");
 367
 368      /* Default CCS Encoding.  */
 369      __gnat_current_ccs_encoding = _O_TEXT;
 370      __gnat_wide_text_translation_required = 0;
 371
 372      if (ccsencoding != NULL)
 373        {
 374          if (strcmp (ccsencoding, "U16TEXT") == 0)
 375            {
 376              __gnat_current_ccs_encoding = _O_U16TEXT;
 377              __gnat_wide_text_translation_required = 1;
 378            }
 379          else if (strcmp (ccsencoding, "TEXT") == 0)
 380            {
 381              __gnat_current_ccs_encoding = _O_TEXT;
 382              __gnat_wide_text_translation_required = 0;
 383            }
 384          else if (strcmp (ccsencoding, "WTEXT") == 0)
 385            {
 386              __gnat_current_ccs_encoding = _O_WTEXT;
 387              __gnat_wide_text_translation_required = 1;
 388            }
 389          else if (strcmp (ccsencoding, "U8TEXT") == 0)
 390            {
 391              __gnat_current_ccs_encoding = _O_U8TEXT;
 392              __gnat_wide_text_translation_required = 1;
 393            }
 394        }
 395    }
 396
 397    /* Adjust gnat_argv to support Unicode characters. */
 398    {
 399      LPWSTR *wargv;
 400      int wargc;
 401      int k;
 402      int last;
 403      int argc_expanded = 0;
 404      TCHAR result [MAX_PATH];
 405      int quoted;
 406
 407      __gnat_get_argw (GetCommandLineW (), &wargv, &wargc);
 408
 409      if (wargv != NULL)
 410        {
 411          /* Set gnat_argv with arguments encoded in UTF-8. */
 412          last = wargc + 1;
 413          gnat_argv = (char **) xmalloc ((last) * sizeof (char *));
 414
 415          /* argv[0] is the executable full path-name. */
 416
 417          SearchPath (NULL, wargv[0], _T(".exe"), MAX_PATH, result, NULL);
 418          append_arg (&argc_expanded, NULL, result, &gnat_argv, &last, 0);
 419
 420          for (k=1; k<wargc; k++)
 421            {
 422              quoted = (wargv[k][0] == _T('\''));
 423
 424              /* Check for wildcard expansion if the argument is not quoted. */
 425              if (!quoted && __gnat_do_argv_expansion
 426                  && (_tcsstr (wargv[k], _T("?")) != 0 ||
 427                      _tcsstr (wargv[k], _T("*")) != 0))
 428                {
 429                  /* Wilcards are present, append all corresponding matches. */
 430                  WIN32_FIND_DATA FileData;
 431                  HANDLE hDir = FindFirstFile (wargv[k], &FileData);
 432                  LPWSTR dir = NULL;
 433                  LPWSTR ldir = _tcsrchr (wargv[k], _T('\\'));
 434
 435                  if (ldir == NULL)
 436                    ldir = _tcsrchr (wargv[k], _T('/'));
 437
 438                  if (hDir == INVALID_HANDLE_VALUE)
 439                    {
 440                      /* No match, append arg as-is. */
 441                      append_arg (&argc_expanded, NULL, wargv[k],
 442                                  &gnat_argv, &last, quoted);
 443                    }
 444                  else
 445                    {
 446                      if (ldir != NULL)
 447                        {
 448                          int n = ldir - wargv[k] + 1;
 449                          dir = (LPWSTR) xmalloc ((n + 1) * sizeof (TCHAR));
 450                          _tcsncpy (dir, wargv[k], n);
 451                          dir[n] = _T('\0');
 452                        }
 453
 454                      /* Append first match and all remaining ones.  */
 455
 456                      do {
 457                        /* Do not add . and .. special entries */
 458
 459                        if (_tcscmp (FileData.cFileName, _T(".")) != 0
 460                            && _tcscmp (FileData.cFileName, _T("..")) != 0)
 461                          append_arg (&argc_expanded, dir, FileData.cFileName,
 462                                      &gnat_argv, &last, 0);
 463                      } while (FindNextFile (hDir, &FileData));
 464
 465                      FindClose (hDir);
 466
 467                      if (dir != NULL)
 468                        free (dir);
 469                    }
 470                }
 471              else
 472                {
 473                  /*  No wildcard. Store parameter as-is. Remove quote if
 474                      needed. */
 475                  append_arg (&argc_expanded, NULL, wargv[k],
 476                              &gnat_argv, &last,
 477                              quoted && __gnat_do_argv_expansion);
 478                }
 479            }
 480
 481          free (wargv[0]);
 482          free (wargv);
 483          gnat_argc = argc_expanded;
 484          gnat_argv = (char **) xrealloc
 485            (gnat_argv, argc_expanded * sizeof (char *));
 486        }
 487    }
 488 #endif
 489
 490   if (install_handler)
 491     __gnat_install_handler();
 492 }
 493
 494 /**************************************************/
 495 /* __gnat_runtime_initialize (init_float version) */
 496 /**************************************************/
 497
 498 #elif defined (__Lynx__) || defined (__FreeBSD__) || defined(__NetBSD__) \
 499   || defined (__OpenBSD__)
 500
 501 extern void __gnat_init_float (void);
 502
 503 void
 504 __gnat_runtime_initialize(int install_handler)
 505 {
 506   /*  increment the reference counter */
 507
 508   __gnat_rt_init_count++;
 509
 510   /*  if already initialized return now */
 511   if (__gnat_rt_init_count > 1)
 512     return;
 513
 514    __gnat_init_float ();
 515
 516   if (install_handler)
 517     __gnat_install_handler();
 518 }
 519
 520 /***********************************************/
 521 /* __gnat_runtime_initialize (VxWorks Version) */
 522 /***********************************************/
 523
 524 #elif defined(__vxworks)
 525
 526 extern void __gnat_init_float (void);
 527
 528 void
 529 __gnat_runtime_initialize(int install_handler)
 530 {
 531   /*  increment the reference counter */
 532
 533   __gnat_rt_init_count++;
 534
 535   /*  if already initialized return now */
 536   if (__gnat_rt_init_count > 1)
 537     return;
 538
 539   __gnat_init_float ();
 540
 541   if (install_handler)
 542     __gnat_install_handler();
 543 }
 544
 545 #else
 546
 547 /***********************************************/
 548 /* __gnat_runtime_initialize (default version) */
 549 /***********************************************/
 550
 551 void
 552 __gnat_runtime_initialize(int install_handler)
 553 {
 554   /*  increment the reference counter */
 555
 556   __gnat_rt_init_count++;
 557
 558   /*  if already initialized return now */
 559   if (__gnat_rt_init_count > 1)
 560     return;
 561
 562   if (install_handler)
 563     __gnat_install_handler();
 564 }
 565
 566 #endif
 567
 568 #ifdef __cplusplus
 569 }
 570 #endif