PR libgomp/64635
[official-gcc.git] / gcc / ada / rtinit.c
blob97582db3a0f20e3ef10c13f43847199aa115aa82
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-2015, 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 ****************************************************************************/
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. */
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
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
54 #include "raise.h"
55 #include <fcntl.h>
57 #ifdef __cplusplus
58 extern "C" {
59 #endif
61 /**************************************************/
62 /* __gnat_runtime_initialize (NT-mingw32 Version) */
63 /**************************************************/
65 extern void __gnat_install_handler(void);
67 int __gnat_wide_text_translation_required = 0;
68 /* wide text translation, 0=none, 1=activated */
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. */
74 #if defined (__MINGW32__)
75 #include "mingw32.h"
76 #include <windows.h>
78 extern void __gnat_init_float (void);
80 extern int gnat_argc;
81 extern char **gnat_argv;
82 extern CRITICAL_SECTION ProcListCS;
83 extern HANDLE ProcListEvt;
85 #ifdef GNAT_UNICODE_SUPPORT
87 #define EXPAND_ARGV_RATE 128
89 static void
90 append_arg (int *index, LPWSTR dir, LPWSTR value,
91 char ***argv, int *last, int quoted)
93 int size;
94 LPWSTR fullvalue;
95 int vallen = _tcslen (value);
96 int dirlen;
98 if (dir == NULL)
100 /* no dir prefix */
101 dirlen = 0;
102 fullvalue = (LPWSTR) xmalloc ((vallen + 1) * sizeof(TCHAR));
104 else
106 /* Add dir first */
107 dirlen = _tcslen (dir);
109 fullvalue = (LPWSTR) xmalloc ((dirlen + vallen + 1) * sizeof(TCHAR));
110 _tcscpy (fullvalue, dir);
113 /* Append value */
115 if (quoted)
117 _tcsncpy (fullvalue + dirlen, value + 1, vallen - 1);
118 fullvalue [dirlen + vallen - sizeof(TCHAR)] = _T('\0');
120 else
121 _tcscpy (fullvalue + dirlen, value);
123 if (*last <= *index)
125 *last += EXPAND_ARGV_RATE;
126 *argv = (char **) xrealloc (*argv, (*last) * sizeof (char *));
129 size = WS2SC (NULL, fullvalue, 0);
130 (*argv)[*index] = (char *) xmalloc (size + sizeof(TCHAR));
131 WS2SC ((*argv)[*index], fullvalue, size);
133 free (fullvalue);
135 (*index)++;
137 #endif
139 void
140 __gnat_runtime_initialize(int install_handler)
142 /* increment the reference counter */
144 __gnat_rt_init_count++;
146 /* if already initialized return now */
147 if (__gnat_rt_init_count > 1)
148 return;
150 /* Initialize floating-point coprocessor. This call is needed because
151 the MS libraries default to 64-bit precision instead of 80-bit
152 precision, and we require the full precision for proper operation,
153 given that we have set Max_Digits etc with this in mind */
155 __gnat_init_float ();
157 /* Initialize the critical section and event handle for the win32_wait()
158 implementation, see adaint.c */
160 InitializeCriticalSection (&ProcListCS);
161 ProcListEvt = CreateEvent (NULL, FALSE, FALSE, NULL);
163 #ifdef GNAT_UNICODE_SUPPORT
164 /* Set current code page for filenames handling. */
166 char *codepage = getenv ("GNAT_CODE_PAGE");
168 /* Default code page is UTF-8. */
169 CurrentCodePage = CP_UTF8;
171 if (codepage != NULL)
173 if (strcmp (codepage, "CP_ACP") == 0)
174 CurrentCodePage = CP_ACP;
175 else if (strcmp (codepage, "CP_UTF8") == 0)
176 CurrentCodePage = CP_UTF8;
180 /* Set current encoding for the IO. */
182 char *ccsencoding = getenv ("GNAT_CCS_ENCODING");
184 /* Default CCS Encoding. */
185 CurrentCCSEncoding = _O_TEXT;
186 __gnat_wide_text_translation_required = 0;
188 if (ccsencoding != NULL)
190 if (strcmp (ccsencoding, "U16TEXT") == 0)
192 CurrentCCSEncoding = _O_U16TEXT;
193 __gnat_wide_text_translation_required = 1;
195 else if (strcmp (ccsencoding, "TEXT") == 0)
197 CurrentCCSEncoding = _O_TEXT;
198 __gnat_wide_text_translation_required = 0;
200 else if (strcmp (ccsencoding, "WTEXT") == 0)
202 CurrentCCSEncoding = _O_WTEXT;
203 __gnat_wide_text_translation_required = 1;
205 else if (strcmp (ccsencoding, "U8TEXT") == 0)
207 CurrentCCSEncoding = _O_U8TEXT;
208 __gnat_wide_text_translation_required = 1;
213 /* Adjust gnat_argv to support Unicode characters. */
215 LPWSTR *wargv;
216 int wargc;
217 int k;
218 int last;
219 int argc_expanded = 0;
220 TCHAR result [MAX_PATH];
221 int quoted;
223 wargv = CommandLineToArgvW (GetCommandLineW(), &wargc);
225 if (wargv != NULL)
227 /* Set gnat_argv with arguments encoded in UTF-8. */
228 last = wargc + 1;
229 gnat_argv = (char **) xmalloc ((last) * sizeof (char *));
231 /* argv[0] is the executable full path-name. */
233 SearchPath (NULL, wargv[0], _T(".exe"), MAX_PATH, result, NULL);
234 append_arg (&argc_expanded, NULL, result, &gnat_argv, &last, 0);
236 for (k=1; k<wargc; k++)
238 quoted = (wargv[k][0] == _T('\''));
240 /* Check for wildcard expansion if the argument is not quoted. */
241 if (!quoted
242 && (_tcsstr (wargv[k], _T("?")) != 0 ||
243 _tcsstr (wargv[k], _T("*")) != 0))
245 /* Wilcards are present, append all corresponding matches. */
246 WIN32_FIND_DATA FileData;
247 HANDLE hDir = FindFirstFile (wargv[k], &FileData);
248 LPWSTR dir = NULL;
249 LPWSTR ldir = _tcsrchr (wargv[k], _T('\\'));
251 if (ldir == NULL)
252 ldir = _tcsrchr (wargv[k], _T('/'));
254 if (hDir == INVALID_HANDLE_VALUE)
256 /* No match, append arg as-is. */
257 append_arg (&argc_expanded, NULL, wargv[k],
258 &gnat_argv, &last, quoted);
260 else
262 if (ldir != NULL)
264 int n = ldir - wargv[k] + 1;
265 dir = (LPWSTR) xmalloc ((n + 1) * sizeof (TCHAR));
266 _tcsncpy (dir, wargv[k], n);
267 dir[n] = _T('\0');
270 /* Append first match and all remaining ones. */
272 do {
273 /* Do not add . and .. special entries */
275 if (_tcscmp (FileData.cFileName, _T(".")) != 0
276 && _tcscmp (FileData.cFileName, _T("..")) != 0)
277 append_arg (&argc_expanded, dir, FileData.cFileName,
278 &gnat_argv, &last, 0);
279 } while (FindNextFile (hDir, &FileData));
281 FindClose (hDir);
283 if (dir != NULL)
284 free (dir);
287 else
289 /* No wildcard. Store parameter as-is. Remove quote if
290 needed. */
291 append_arg (&argc_expanded, NULL, wargv[k],
292 &gnat_argv, &last, quoted);
296 LocalFree (wargv);
297 gnat_argc = argc_expanded;
298 gnat_argv = (char **) xrealloc
299 (gnat_argv, argc_expanded * sizeof (char *));
302 #endif
304 if (install_handler)
305 __gnat_install_handler();
308 /**************************************************/
309 /* __gnat_runtime_initialize (init_float version) */
310 /**************************************************/
312 #elif defined (__Lynx__) || defined (__FreeBSD__) || defined(__NetBSD__) \
313 || defined (__OpenBSD__)
315 extern void __gnat_init_float (void);
317 void
318 __gnat_runtime_initialize(int install_handler)
320 /* increment the reference counter */
322 __gnat_rt_init_count++;
324 /* if already initialized return now */
325 if (__gnat_rt_init_count > 1)
326 return;
328 __gnat_init_float ();
330 if (install_handler)
331 __gnat_install_handler();
334 /***********************************************/
335 /* __gnat_runtime_initialize (VxWorks Version) */
336 /***********************************************/
338 #elif defined(__vxworks)
340 extern void __gnat_init_float (void);
342 void
343 __gnat_runtime_initialize(int install_handler)
345 /* increment the reference counter */
347 __gnat_rt_init_count++;
349 /* if already initialized return now */
350 if (__gnat_rt_init_count > 1)
351 return;
353 __gnat_init_float ();
355 if (install_handler)
356 __gnat_install_handler();
359 #else
361 /***********************************************/
362 /* __gnat_runtime_initialize (default version) */
363 /***********************************************/
365 void
366 __gnat_runtime_initialize(int install_handler)
368 /* increment the reference counter */
370 __gnat_rt_init_count++;
372 /* if already initialized return now */
373 if (__gnat_rt_init_count > 1)
374 return;
376 if (install_handler)
377 __gnat_install_handler();
380 #endif
382 #ifdef __cplusplus
384 #endif