1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
5 * I N I T I A L I Z E *
7 * C Implementation File *
9 * Copyright (C) 2014-2023, Free Software Foundation, Inc. *
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. *
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. *
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/>. *
27 * GNAT was originally developed by the GNAT team at New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
30 ****************************************************************************/
32 /* This unit provides implementation for __gnat_runtime_initialize ()
33 which is called in adainit() to do special initialization needed by
37 /* The following include is here to meet the published VxWorks requirement
38 that the __vxworks header appear before any other include. */
44 /* We don't have libiberty, so use malloc. */
45 #define xmalloc(S) malloc (S)
46 #define xrealloc(V,S) realloc (V,S)
59 /**************************************************/
60 /* __gnat_runtime_initialize (NT-mingw32 Version) */
61 /**************************************************/
63 extern void __gnat_install_handler (void);
65 int __gnat_wide_text_translation_required
= 0;
66 /* wide text translation, 0=none, 1=activated */
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. */
72 #if defined (__MINGW32__)
73 #define WIN32_LEAN_AND_MEAN
77 extern void __gnat_init_float (void);
80 extern char **gnat_argv
;
81 extern CRITICAL_SECTION ProcListCS
;
82 extern HANDLE ProcListEvt
;
84 #ifdef GNAT_UNICODE_SUPPORT
86 #define EXPAND_ARGV_RATE 128
88 int __gnat_do_argv_expansion
= 1;
89 #pragma weak __gnat_do_argv_expansion
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
,
96 /* Number of backslashes buffered. */
99 /* Pointer to current input character. */
100 const WCHAR
*ci
= *current_in
;
102 /* Pointer to next output character. */
103 WCHAR
*co
= *current_out
;
105 /* Skip initial quote. */
112 /* Buffer incoming backslashes. */
117 /* Append qbs_count / 2 backslahes. */
118 for (int i
=0; i
<qbs_count
/ 2; i
++)
123 if ((qbs_count
& 1) == 0)
125 /* 2n backslashes means that the quotation mark is the end of
126 the quoted portion. */
132 /* Otherwise this is a double quote literal. */
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
++)
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
157 for (int i
=0; i
<qbs_count
; i
++)
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
,
173 /* Number of backslashes buffered. */
176 /* Pointer to current input character. */
177 const WCHAR
*ci
= *current_in
;
179 /* Pointer to next output character. */
180 WCHAR
*co
= *current_out
;
182 while (*ci
&& ! (*ci
== ' ' || *ci
== '\t'))
186 /* Buffer incoming backslashes. */
191 /* Append qbs_count / 2 backslahes. */
192 for (int i
=0; i
< bs_count
/ 2; i
++)
196 if ((bs_count
& 1) == 0)
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
);
204 /* Otherwise this is quotation mark literal. */
212 /* This is a regular character. */
213 /* Backslashes are interpreted literally. */
214 for (int i
=0; i
<bs_count
; i
++)
228 for (int i
=0; i
<bs_count
; i
++)
234 /* End the argument with a null character. */
243 void __gnat_get_argw (const WCHAR
*command_line
, WCHAR
***argv
, int *argc
)
251 (WCHAR
*) xmalloc ((wcslen (command_line
) + 1) * sizeof (WCHAR
));
254 /* Start iteration on command line characters. */
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
);
261 /* Count remaining arguments. */
265 while (*ci
&& (*ci
== ' ' || *ci
== '\t')) { ci
++; }
268 skip_argument (&ci
, &co
);
275 /* Allocate table with pointer to each arguments */
276 argv
[0] = (WCHAR
**) xmalloc (arg_count
* sizeof (WCHAR
*));
278 for (int idx
= 0; idx
< arg_count
; idx
++)
280 argv
[0][idx
] = inline_argv
;
291 append_arg (int *index
, LPWSTR dir
, LPWSTR value
,
292 char ***argv
, int *last
, int quoted
)
296 int vallen
= _tcslen (value
);
303 fullvalue
= (LPWSTR
) xmalloc ((vallen
+ 1) * sizeof (TCHAR
));
308 dirlen
= _tcslen (dir
);
310 fullvalue
= (LPWSTR
) xmalloc ((dirlen
+ vallen
+ 1) * sizeof (TCHAR
));
311 _tcscpy (fullvalue
, dir
);
318 _tcsncpy (fullvalue
+ dirlen
, value
+ 1, vallen
- 1);
319 fullvalue
[dirlen
+ vallen
- sizeof (TCHAR
)] = _T ('\0');
322 _tcscpy (fullvalue
+ dirlen
, value
);
326 *last
+= EXPAND_ARGV_RATE
;
327 *argv
= (char **) xrealloc (*argv
, (*last
) * sizeof (char *));
330 size
= WS2SC (NULL
, fullvalue
, 0);
331 (*argv
)[*index
] = (char *) xmalloc (size
+ sizeof (TCHAR
));
332 WS2SC ((*argv
)[*index
], fullvalue
, size
);
341 __gnat_runtime_initialize (int install_handler
)
343 /* increment the reference counter */
345 __gnat_rt_init_count
++;
347 /* if already initialized return now */
348 if (__gnat_rt_init_count
> 1)
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 */
356 __gnat_init_float ();
358 /* Initialize the critical section and event handle for the win32_wait()
359 implementation, see adaint.c */
361 InitializeCriticalSection (&ProcListCS
);
362 ProcListEvt
= CreateEvent (NULL
, FALSE
, FALSE
, NULL
);
364 #ifdef GNAT_UNICODE_SUPPORT
365 /* Set current code page for filenames handling. */
367 char *codepage
= getenv ("GNAT_CODE_PAGE");
369 /* Default code page is UTF-8. */
370 __gnat_current_codepage
= CP_UTF8
;
372 if (codepage
!= NULL
)
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
;
381 /* Set current encoding for the IO. */
383 char *ccsencoding
= getenv ("GNAT_CCS_ENCODING");
385 /* Default CCS Encoding. */
386 __gnat_current_ccs_encoding
= _O_TEXT
;
387 __gnat_wide_text_translation_required
= 0;
389 if (ccsencoding
!= NULL
)
391 if (strcmp (ccsencoding
, "U16TEXT") == 0)
393 __gnat_current_ccs_encoding
= _O_U16TEXT
;
394 __gnat_wide_text_translation_required
= 1;
396 else if (strcmp (ccsencoding
, "TEXT") == 0)
398 __gnat_current_ccs_encoding
= _O_TEXT
;
399 __gnat_wide_text_translation_required
= 0;
401 else if (strcmp (ccsencoding
, "WTEXT") == 0)
403 __gnat_current_ccs_encoding
= _O_WTEXT
;
404 __gnat_wide_text_translation_required
= 1;
406 else if (strcmp (ccsencoding
, "U8TEXT") == 0)
408 __gnat_current_ccs_encoding
= _O_U8TEXT
;
409 __gnat_wide_text_translation_required
= 1;
414 /* Adjust gnat_argv to support Unicode characters. */
420 int argc_expanded
= 0;
421 TCHAR result
[MAX_PATH
];
424 __gnat_get_argw (GetCommandLineW (), &wargv
, &wargc
);
428 /* Set gnat_argv with arguments encoded in UTF-8. */
430 gnat_argv
= (char **) xmalloc ((last
) * sizeof (char *));
432 /* argv[0] is the executable full path-name. */
434 SearchPath (NULL
, wargv
[0], _T(".exe"), MAX_PATH
, result
, NULL
);
435 append_arg (&argc_expanded
, NULL
, result
, &gnat_argv
, &last
, 0);
437 for (k
=1; k
<wargc
; k
++)
439 quoted
= (wargv
[k
][0] == _T('\''));
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))
446 /* Wilcards are present, append all corresponding matches. */
447 WIN32_FIND_DATA FileData
;
448 HANDLE hDir
= FindFirstFile (wargv
[k
], &FileData
);
450 LPWSTR ldir
= _tcsrchr (wargv
[k
], _T('\\'));
453 ldir
= _tcsrchr (wargv
[k
], _T('/'));
455 if (hDir
== INVALID_HANDLE_VALUE
)
457 /* No match, append arg as-is. */
458 append_arg (&argc_expanded
, NULL
, wargv
[k
],
459 &gnat_argv
, &last
, quoted
);
465 int n
= ldir
- wargv
[k
] + 1;
466 dir
= (LPWSTR
) xmalloc ((n
+ 1) * sizeof (TCHAR
));
467 _tcsncpy (dir
, wargv
[k
], n
);
471 /* Append first match and all remaining ones. */
474 /* Do not add . and .. special entries */
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
));
490 /* No wildcard. Store parameter as-is. Remove quote if
492 append_arg (&argc_expanded
, NULL
, wargv
[k
],
494 quoted
&& __gnat_do_argv_expansion
);
500 gnat_argc
= argc_expanded
;
501 gnat_argv
= (char **) xrealloc
502 (gnat_argv
, argc_expanded
* sizeof (char *));
508 __gnat_install_handler();
511 /**************************************************/
512 /* __gnat_runtime_initialize (init_float version) */
513 /**************************************************/
515 #elif defined (__Lynx__) || defined (__FreeBSD__) || defined(__NetBSD__) \
516 || defined (__OpenBSD__)
518 extern void __gnat_init_float (void);
521 __gnat_runtime_initialize(int install_handler
)
523 /* increment the reference counter */
525 __gnat_rt_init_count
++;
527 /* if already initialized return now */
528 if (__gnat_rt_init_count
> 1)
531 __gnat_init_float ();
534 __gnat_install_handler();
537 /***********************************************/
538 /* __gnat_runtime_initialize (VxWorks Version) */
539 /***********************************************/
541 #elif defined(__vxworks)
543 extern void __gnat_init_float (void);
546 __gnat_runtime_initialize(int install_handler
)
548 /* increment the reference counter */
550 __gnat_rt_init_count
++;
552 /* if already initialized return now */
553 if (__gnat_rt_init_count
> 1)
556 __gnat_init_float ();
559 __gnat_install_handler();
564 /***********************************************/
565 /* __gnat_runtime_initialize (default version) */
566 /***********************************************/
569 __gnat_runtime_initialize(int install_handler
)
571 /* increment the reference counter */
573 __gnat_rt_init_count
++;
575 /* if already initialized return now */
576 if (__gnat_rt_init_count
> 1)
580 __gnat_install_handler();