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