2014-10-10 Robert Dewar <dewar@adacore.com>
[official-gcc.git] / gcc / ada / initialize.c
blob36df501ec85d5678eb1fa798fe1a16ce1e732c18
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) 1992-2014, 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 default implementation for __gnat_initialize ()
33 which is called before the elaboration of the partition. It is provided
34 in a separate file/object so that users can replace it easily.
35 The default implementation should be null on most targets. */
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_initialize (NT-mingw32 Version) */
63 /******************************************/
65 int __gnat_wide_text_translation_required = 0;
66 /* wide text translation, 0=none, 1=activated */
68 #if defined (__MINGW32__)
69 #include "mingw32.h"
70 #include <windows.h>
72 extern void __gnat_init_float (void);
73 extern void __gnat_install_SEH_handler (void *);
75 extern int gnat_argc;
76 extern char **gnat_argv;
78 #ifdef GNAT_UNICODE_SUPPORT
80 #define EXPAND_ARGV_RATE 128
82 static void
83 append_arg (int *index, LPWSTR dir, LPWSTR value,
84 char ***argv, int *last, int quoted)
86 int size;
87 LPWSTR fullvalue;
88 int vallen = _tcslen (value);
89 int dirlen;
91 if (dir == NULL)
93 /* no dir prefix */
94 dirlen = 0;
95 fullvalue = (LPWSTR) xmalloc ((vallen + 1) * sizeof(TCHAR));
97 else
99 /* Add dir first */
100 dirlen = _tcslen (dir);
102 fullvalue = (LPWSTR) xmalloc ((dirlen + vallen + 1) * sizeof(TCHAR));
103 _tcscpy (fullvalue, dir);
106 /* Append value */
108 if (quoted)
110 _tcsncpy (fullvalue + dirlen, value + 1, vallen - 1);
111 fullvalue [dirlen + vallen - sizeof(TCHAR)] = _T('\0');
113 else
114 _tcscpy (fullvalue + dirlen, value);
116 if (*last <= *index)
118 *last += EXPAND_ARGV_RATE;
119 *argv = (char **) xrealloc (*argv, (*last) * sizeof (char *));
122 size = WS2SC (NULL, fullvalue, 0);
123 (*argv)[*index] = (char *) xmalloc (size + sizeof(TCHAR));
124 WS2SC ((*argv)[*index], fullvalue, size);
126 free (fullvalue);
128 (*index)++;
130 #endif
132 void
133 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
135 /* Initialize floating-point coprocessor. This call is needed because
136 the MS libraries default to 64-bit precision instead of 80-bit
137 precision, and we require the full precision for proper operation,
138 given that we have set Max_Digits etc with this in mind */
139 __gnat_init_float ();
141 #ifdef GNAT_UNICODE_SUPPORT
142 /* Set current code page for filenames handling. */
144 char *codepage = getenv ("GNAT_CODE_PAGE");
146 /* Default code page is UTF-8. */
147 CurrentCodePage = CP_UTF8;
149 if (codepage != NULL)
151 if (strcmp (codepage, "CP_ACP") == 0)
152 CurrentCodePage = CP_ACP;
153 else if (strcmp (codepage, "CP_UTF8") == 0)
154 CurrentCodePage = CP_UTF8;
158 /* Set current encoding for the IO. */
160 char *ccsencoding = getenv ("GNAT_CCS_ENCODING");
162 /* Default CCS Encoding. */
163 CurrentCCSEncoding = _O_TEXT;
164 __gnat_wide_text_translation_required = 0;
166 if (ccsencoding != NULL)
168 if (strcmp (ccsencoding, "U16TEXT") == 0)
170 CurrentCCSEncoding = _O_U16TEXT;
171 __gnat_wide_text_translation_required = 1;
173 else if (strcmp (ccsencoding, "TEXT") == 0)
175 CurrentCCSEncoding = _O_TEXT;
176 __gnat_wide_text_translation_required = 0;
178 else if (strcmp (ccsencoding, "WTEXT") == 0)
180 CurrentCCSEncoding = _O_WTEXT;
181 __gnat_wide_text_translation_required = 1;
183 else if (strcmp (ccsencoding, "U8TEXT") == 0)
185 CurrentCCSEncoding = _O_U8TEXT;
186 __gnat_wide_text_translation_required = 1;
191 /* Adjust gnat_argv to support Unicode characters. */
193 LPWSTR *wargv;
194 int wargc;
195 int k;
196 int last;
197 int argc_expanded = 0;
198 TCHAR result [MAX_PATH];
199 int quoted;
201 wargv = CommandLineToArgvW (GetCommandLineW(), &wargc);
203 if (wargv != NULL)
205 /* Set gnat_argv with arguments encoded in UTF-8. */
206 last = wargc + 1;
207 gnat_argv = (char **) xmalloc ((last) * sizeof (char *));
209 /* argv[0] is the executable full path-name. */
211 SearchPath (NULL, wargv[0], _T(".exe"), MAX_PATH, result, NULL);
212 append_arg (&argc_expanded, NULL, result, &gnat_argv, &last, 0);
214 for (k=1; k<wargc; k++)
216 quoted = (wargv[k][0] == _T('\''));
218 /* Check for wildcard expansion if the argument is not quoted. */
219 if (!quoted
220 && (_tcsstr (wargv[k], _T("?")) != 0 ||
221 _tcsstr (wargv[k], _T("*")) != 0))
223 /* Wilcards are present, append all corresponding matches. */
224 WIN32_FIND_DATA FileData;
225 HANDLE hDir = FindFirstFile (wargv[k], &FileData);
226 LPWSTR dir = NULL;
227 LPWSTR ldir = _tcsrchr (wargv[k], _T('\\'));
229 if (ldir == NULL)
230 ldir = _tcsrchr (wargv[k], _T('/'));
232 if (hDir == INVALID_HANDLE_VALUE)
234 /* No match, append arg as-is. */
235 append_arg (&argc_expanded, NULL, wargv[k],
236 &gnat_argv, &last, quoted);
238 else
240 if (ldir != NULL)
242 int n = ldir - wargv[k] + 1;
243 dir = (LPWSTR) xmalloc ((n + 1) * sizeof (TCHAR));
244 _tcsncpy (dir, wargv[k], n);
245 dir[n] = _T('\0');
248 /* Append first match and all remaining ones. */
250 do {
251 /* Do not add . and .. special entries */
253 if (_tcscmp (FileData.cFileName, _T(".")) != 0
254 && _tcscmp (FileData.cFileName, _T("..")) != 0)
255 append_arg (&argc_expanded, dir, FileData.cFileName,
256 &gnat_argv, &last, 0);
257 } while (FindNextFile (hDir, &FileData));
259 FindClose (hDir);
261 if (dir != NULL)
262 free (dir);
265 else
267 /* No wildcard. Store parameter as-is. Remove quote if
268 needed. */
269 append_arg (&argc_expanded, NULL, wargv[k],
270 &gnat_argv, &last, quoted);
274 LocalFree (wargv);
275 gnat_argc = argc_expanded;
276 gnat_argv = (char **) xrealloc
277 (gnat_argv, argc_expanded * sizeof (char *));
280 #endif
282 /* Note that we do not activate this for the compiler itself to avoid a
283 bootstrap path problem. Older version of gnatbind will generate a call
284 to __gnat_initialize() without argument. Therefore we cannot use eh in
285 this case. It will be possible to remove the following #ifdef at some
286 point. */
287 #ifdef IN_RTS
288 /* Install the Structured Exception handler. */
289 if (eh)
290 __gnat_install_SEH_handler (eh);
291 #endif
294 /******************************************/
295 /* __gnat_initialize (init_float version) */
296 /******************************************/
298 #elif defined (__Lynx__) || defined (__FreeBSD__) || defined(__NetBSD__) \
299 || defined (__OpenBSD__)
301 extern void __gnat_init_float (void);
303 void
304 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
306 __gnat_init_float ();
309 /***************************************/
310 /* __gnat_initialize (VxWorks Version) */
311 /***************************************/
313 #elif defined(__vxworks)
315 extern void __gnat_init_float (void);
317 void
318 __gnat_initialize (void *eh)
320 __gnat_init_float ();
323 #elif defined(_T_HPUX10) || (!defined(IN_RTS) && defined(_X_HPUX10))
325 /************************************************/
326 /* __gnat_initialize (PA-RISC HP-UX 10 Version) */
327 /************************************************/
329 extern void __main (void);
331 void
332 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
334 __main ();
337 #else
339 /* For all other versions of GNAT, the initialize routine and handler
340 installation do nothing */
342 /***************************************/
343 /* __gnat_initialize (Default Version) */
344 /***************************************/
346 void
347 __gnat_initialize (void *eh ATTRIBUTE_UNUSED)
351 #endif
353 #ifdef __cplusplus
355 #endif