]>
Commit | Line | Data |
---|---|---|
27becfc8 | 1 | /**************************************************************************** |
2 | * * | |
3 | * GNAT COMPILER COMPONENTS * | |
4 | * * | |
5 | * M I S C * | |
6 | * * | |
7 | * C Implementation File * | |
8 | * * | |
7b91b384 | 9 | * Copyright (C) 1992-2014, Free Software Foundation, Inc. * |
27becfc8 | 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- * | |
6bc9506f | 13 | * ware Foundation; either version 3, or (at your option) any later ver- * |
27becfc8 | 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. See the GNU General Public License * | |
17 | * for more details. You should have received a copy of the GNU General * | |
6bc9506f | 18 | * Public License distributed with GNAT; see file COPYING3. If not see * |
19 | * <http://www.gnu.org/licenses/>. * | |
27becfc8 | 20 | * * |
21 | * GNAT was originally developed by the GNAT team at New York University. * | |
22 | * Extensive contributions were provided by Ada Core Technologies Inc. * | |
23 | * * | |
24 | ****************************************************************************/ | |
25 | ||
27becfc8 | 26 | #include "config.h" |
27 | #include "system.h" | |
28 | #include "coretypes.h" | |
d3b7ee7c | 29 | #include "opts.h" |
30 | #include "options.h" | |
27becfc8 | 31 | #include "tm.h" |
32 | #include "tree.h" | |
9ed99284 | 33 | #include "stor-layout.h" |
34 | #include "print-tree.h" | |
27becfc8 | 35 | #include "diagnostic.h" |
a9a42d49 | 36 | #include "target.h" |
27becfc8 | 37 | #include "ggc.h" |
38 | #include "flags.h" | |
39 | #include "debug.h" | |
27becfc8 | 40 | #include "toplev.h" |
27becfc8 | 41 | #include "langhooks.h" |
42 | #include "langhooks-def.h" | |
1f63d337 | 43 | #include "plugin.h" |
547350f1 | 44 | #include "real.h" |
f70a50e7 | 45 | #include "function.h" /* For pass_by_reference. */ |
27becfc8 | 46 | |
47 | #include "ada.h" | |
a9a42d49 | 48 | #include "adadecode.h" |
27becfc8 | 49 | #include "types.h" |
50 | #include "atree.h" | |
51 | #include "elists.h" | |
52 | #include "namet.h" | |
53 | #include "nlists.h" | |
54 | #include "stringt.h" | |
55 | #include "uintp.h" | |
56 | #include "fe.h" | |
57 | #include "sinfo.h" | |
58 | #include "einfo.h" | |
59 | #include "ada-tree.h" | |
60 | #include "gigi.h" | |
27becfc8 | 61 | |
5e342322 | 62 | /* This symbol needs to be defined for the front-end. */ |
63 | void *callgraph_info_file = NULL; | |
64 | ||
e61798eb | 65 | /* Command-line argc and argv. These variables are global since they are |
66 | imported in back_end.adb. */ | |
27becfc8 | 67 | unsigned int save_argc; |
68 | const char **save_argv; | |
69 | ||
4880a940 | 70 | /* GNAT argc and argv. */ |
27becfc8 | 71 | extern int gnat_argc; |
72 | extern char **gnat_argv; | |
73 | ||
becb63f5 | 74 | #ifdef __cplusplus |
75 | extern "C" { | |
76 | #endif | |
77 | ||
27becfc8 | 78 | /* Declare functions we use as part of startup. */ |
e61798eb | 79 | extern void __gnat_initialize (void *); |
80 | extern void __gnat_install_SEH_handler (void *); | |
81 | extern void adainit (void); | |
82 | extern void _ada_gnat1drv (void); | |
27becfc8 | 83 | |
becb63f5 | 84 | #ifdef __cplusplus |
85 | } | |
86 | #endif | |
87 | ||
27becfc8 | 88 | /* The parser for the language. For us, we process the GNAT tree. */ |
89 | ||
90 | static void | |
b8ba44e7 | 91 | gnat_parse_file (void) |
27becfc8 | 92 | { |
93 | int seh[2]; | |
94 | ||
95 | /* Call the target specific initializations. */ | |
96 | __gnat_initialize (NULL); | |
97 | ||
98 | /* ??? Call the SEH initialization routine. This is to workaround | |
99 | a bootstrap path problem. The call below should be removed at some | |
100 | point and the SEH pointer passed to __gnat_initialize() above. */ | |
101 | __gnat_install_SEH_handler((void *)seh); | |
102 | ||
103 | /* Call the front-end elaboration procedures. */ | |
104 | adainit (); | |
105 | ||
106 | /* Call the front end. */ | |
107 | _ada_gnat1drv (); | |
27becfc8 | 108 | } |
109 | ||
fbb6fbd8 | 110 | /* Return language mask for option processing. */ |
111 | ||
112 | static unsigned int | |
113 | gnat_option_lang_mask (void) | |
114 | { | |
115 | return CL_Ada; | |
116 | } | |
117 | ||
27becfc8 | 118 | /* Decode all the language specific options that cannot be decoded by GCC. |
119 | The option decoding phase of GCC calls this routine on the flags that | |
b78351e5 | 120 | are marked as Ada-specific. Return true on success or false on failure. */ |
27becfc8 | 121 | |
b78351e5 | 122 | static bool |
123 | gnat_handle_option (size_t scode, const char *arg ATTRIBUTE_UNUSED, int value, | |
3c6c0e40 | 124 | int kind ATTRIBUTE_UNUSED, location_t loc ATTRIBUTE_UNUSED, |
b78351e5 | 125 | const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED) |
27becfc8 | 126 | { |
27becfc8 | 127 | enum opt_code code = (enum opt_code) scode; |
27becfc8 | 128 | |
27becfc8 | 129 | switch (code) |
130 | { | |
27becfc8 | 131 | case OPT_Wall: |
fbb6fbd8 | 132 | handle_generated_option (&global_options, &global_options_set, |
133 | OPT_Wunused, NULL, value, | |
134 | gnat_option_lang_mask (), kind, loc, | |
135 | handlers, global_dc); | |
6bda7b34 | 136 | warn_uninitialized = value; |
04df77d7 | 137 | warn_maybe_uninitialized = value; |
27becfc8 | 138 | break; |
139 | ||
27becfc8 | 140 | case OPT_gant: |
141 | warning (0, "%<-gnat%> misspelled as %<-gant%>"); | |
142 | ||
143 | /* ... fall through ... */ | |
144 | ||
145 | case OPT_gnat: | |
27becfc8 | 146 | case OPT_gnatO: |
6761caec | 147 | case OPT_fRTS_: |
148 | case OPT_I: | |
149 | case OPT_nostdinc: | |
150 | case OPT_nostdlib: | |
151 | /* These are handled by the front-end. */ | |
27becfc8 | 152 | break; |
153 | ||
7f7d3e62 | 154 | case OPT_fshort_enums: |
155 | /* This is handled by the middle-end. */ | |
156 | break; | |
157 | ||
27becfc8 | 158 | default: |
159 | gcc_unreachable (); | |
160 | } | |
161 | ||
d14317ea | 162 | Ada_handle_option_auto (&global_options, &global_options_set, |
163 | scode, arg, value, | |
164 | gnat_option_lang_mask (), kind, | |
165 | loc, handlers, global_dc); | |
b78351e5 | 166 | return true; |
27becfc8 | 167 | } |
168 | ||
f3f006ad | 169 | /* Initialize options structure OPTS. */ |
170 | ||
171 | static void | |
172 | gnat_init_options_struct (struct gcc_options *opts) | |
173 | { | |
174 | /* Uninitialized really means uninitialized in Ada. */ | |
175 | opts->x_flag_zero_initialized_in_bss = 0; | |
bc0dfc8d | 176 | |
177 | /* We can delete dead instructions that may throw exceptions in Ada. */ | |
178 | opts->x_flag_delete_dead_exceptions = 1; | |
f3f006ad | 179 | } |
180 | ||
e88d34f6 | 181 | /* Initialize for option processing. */ |
182 | ||
183 | static void | |
184 | gnat_init_options (unsigned int decoded_options_count, | |
185 | struct cl_decoded_option *decoded_options) | |
186 | { | |
187 | /* Reconstruct an argv array for use of back_end.adb. | |
188 | ||
e61798eb | 189 | ??? back_end.adb should not rely on this; instead, it should work with |
190 | decoded options without such reparsing, to ensure consistency in how | |
191 | options are decoded. */ | |
e88d34f6 | 192 | unsigned int i; |
193 | ||
194 | save_argv = XNEWVEC (const char *, 2 * decoded_options_count + 1); | |
195 | save_argc = 0; | |
196 | for (i = 0; i < decoded_options_count; i++) | |
197 | { | |
e61798eb | 198 | size_t num_elements = decoded_options[i].canonical_option_num_elements; |
199 | ||
71a2f35e | 200 | if (decoded_options[i].errors |
75dbc0d5 | 201 | || decoded_options[i].opt_index == OPT_SPECIAL_unknown |
e61798eb | 202 | || num_elements == 0) |
71a2f35e | 203 | continue; |
e61798eb | 204 | |
9f5eade0 | 205 | /* Deal with -I- specially since it must be a single switch. */ |
206 | if (decoded_options[i].opt_index == OPT_I | |
207 | && num_elements == 2 | |
208 | && decoded_options[i].canonical_option[1][0] == '-' | |
209 | && decoded_options[i].canonical_option[1][1] == '\0') | |
210 | save_argv[save_argc++] = "-I-"; | |
75dbc0d5 | 211 | else |
212 | { | |
e61798eb | 213 | gcc_assert (num_elements >= 1 && num_elements <= 2); |
75dbc0d5 | 214 | save_argv[save_argc++] = decoded_options[i].canonical_option[0]; |
e61798eb | 215 | if (num_elements >= 2) |
75dbc0d5 | 216 | save_argv[save_argc++] = decoded_options[i].canonical_option[1]; |
217 | } | |
e88d34f6 | 218 | } |
219 | save_argv[save_argc] = NULL; | |
27becfc8 | 220 | |
e88d34f6 | 221 | gnat_argv = (char **) xmalloc (sizeof (save_argv[0])); |
222 | gnat_argv[0] = xstrdup (save_argv[0]); /* name of the command */ | |
223 | gnat_argc = 1; | |
27becfc8 | 224 | } |
225 | ||
789e0a77 | 226 | /* Ada code requires variables for these settings rather than elements |
227 | of the global_options structure. */ | |
228 | #undef optimize | |
229 | #undef optimize_size | |
ab3728ee | 230 | #undef flag_compare_debug |
980e9cdf | 231 | #undef flag_short_enums |
ab3728ee | 232 | #undef flag_stack_check |
789e0a77 | 233 | int optimize; |
234 | int optimize_size; | |
ab3728ee | 235 | int flag_compare_debug; |
980e9cdf | 236 | int flag_short_enums; |
ab3728ee | 237 | enum stack_check_type flag_stack_check = NO_STACK_CHECK; |
789e0a77 | 238 | |
6b452e89 | 239 | /* Settings adjustments after switches processing by the back-end. |
240 | Note that the front-end switches processing (Scan_Compiler_Arguments) | |
241 | has not been done yet at this point! */ | |
27becfc8 | 242 | |
47c154d9 | 243 | static bool |
27becfc8 | 244 | gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED) |
245 | { | |
aa854249 | 246 | /* Excess precision other than "fast" requires front-end support. */ |
c6418a4e | 247 | if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD |
248 | && TARGET_FLT_EVAL_METHOD_NON_DEFAULT) | |
249 | sorry ("-fexcess-precision=standard for Ada"); | |
250 | flag_excess_precision_cmdline = EXCESS_PRECISION_FAST; | |
251 | ||
27becfc8 | 252 | /* ??? The warning machinery is outsmarted by Ada. */ |
253 | warn_unused_parameter = 0; | |
254 | ||
0ff5b865 | 255 | /* No psABI change warnings for Ada. */ |
256 | warn_psabi = 0; | |
257 | ||
cd3ef822 | 258 | /* No caret by default for Ada. */ |
259 | if (!global_options_set.x_flag_diagnostics_show_caret) | |
260 | global_dc->show_caret = false; | |
261 | ||
789e0a77 | 262 | optimize = global_options.x_optimize; |
263 | optimize_size = global_options.x_optimize_size; | |
ab3728ee | 264 | flag_compare_debug = global_options.x_flag_compare_debug; |
265 | flag_stack_check = global_options.x_flag_stack_check; | |
980e9cdf | 266 | flag_short_enums = global_options.x_flag_short_enums; |
267 | ||
7f7d3e62 | 268 | /* Unfortunately the post_options hook is called before the value of |
269 | flag_short_enums is autodetected, if need be. Mimic the process | |
270 | for our private flag_short_enums. */ | |
271 | if (flag_short_enums == 2) | |
272 | flag_short_enums = targetm.default_short_enums (); | |
273 | ||
27becfc8 | 274 | return false; |
275 | } | |
276 | ||
277 | /* Here is the function to handle the compiler error processing in GCC. */ | |
278 | ||
279 | static void | |
1f63d337 | 280 | internal_error_function (diagnostic_context *context, |
281 | const char *msgid, va_list *ap) | |
27becfc8 | 282 | { |
283 | text_info tinfo; | |
284 | char *buffer, *p, *loc; | |
285 | String_Template temp, temp_loc; | |
e95b1019 | 286 | Fat_Pointer fp, fp_loc; |
287 | expanded_location s; | |
27becfc8 | 288 | |
1f63d337 | 289 | /* Warn if plugins present. */ |
290 | warn_if_plugins (); | |
291 | ||
27becfc8 | 292 | /* Reset the pretty-printer. */ |
1f63d337 | 293 | pp_clear_output_area (context->printer); |
27becfc8 | 294 | |
295 | /* Format the message into the pretty-printer. */ | |
296 | tinfo.format_spec = msgid; | |
297 | tinfo.args_ptr = ap; | |
298 | tinfo.err_no = errno; | |
1f63d337 | 299 | pp_format_verbatim (context->printer, &tinfo); |
27becfc8 | 300 | |
301 | /* Extract a (writable) pointer to the formatted text. */ | |
1f63d337 | 302 | buffer = xstrdup (pp_formatted_text (context->printer)); |
27becfc8 | 303 | |
304 | /* Go up to the first newline. */ | |
305 | for (p = buffer; *p; p++) | |
306 | if (*p == '\n') | |
307 | { | |
308 | *p = '\0'; | |
309 | break; | |
310 | } | |
311 | ||
312 | temp.Low_Bound = 1; | |
313 | temp.High_Bound = p - buffer; | |
e95b1019 | 314 | fp.Bounds = &temp; |
315 | fp.Array = buffer; | |
27becfc8 | 316 | |
e95b1019 | 317 | s = expand_location (input_location); |
318 | if (context->show_column && s.column != 0) | |
319 | asprintf (&loc, "%s:%d:%d", s.file, s.line, s.column); | |
27becfc8 | 320 | else |
e95b1019 | 321 | asprintf (&loc, "%s:%d", s.file, s.line); |
27becfc8 | 322 | temp_loc.Low_Bound = 1; |
323 | temp_loc.High_Bound = strlen (loc); | |
e95b1019 | 324 | fp_loc.Bounds = &temp_loc; |
325 | fp_loc.Array = loc; | |
27becfc8 | 326 | |
327 | Current_Error_Node = error_gnat_node; | |
e95b1019 | 328 | Compiler_Abort (fp, -1, fp_loc); |
27becfc8 | 329 | } |
330 | ||
331 | /* Perform all the initialization steps that are language-specific. */ | |
332 | ||
333 | static bool | |
334 | gnat_init (void) | |
335 | { | |
22582d86 | 336 | /* Do little here, most of the standard declarations are set up after the |
526c9857 | 337 | front-end has been run. Use the same `char' as C, this doesn't really |
338 | matter since we'll use the explicit `unsigned char' for Character. */ | |
c38a75b7 | 339 | build_common_tree_nodes (flag_signed_char, false); |
3e70070e | 340 | |
22582d86 | 341 | /* In Ada, we use an unsigned 8-bit type for the default boolean type. */ |
342 | boolean_type_node = make_unsigned_type (8); | |
343 | TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE); | |
344 | SET_TYPE_RM_MAX_VALUE (boolean_type_node, | |
345 | build_int_cst (boolean_type_node, 1)); | |
346 | SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1)); | |
eca04deb | 347 | boolean_true_node = TYPE_MAX_VALUE (boolean_type_node); |
348 | boolean_false_node = TYPE_MIN_VALUE (boolean_type_node); | |
22582d86 | 349 | |
3fa661c4 | 350 | sbitsize_one_node = sbitsize_int (1); |
351 | sbitsize_unit_node = sbitsize_int (BITS_PER_UNIT); | |
22582d86 | 352 | |
353 | ptr_void_type_node = build_pointer_type (void_type_node); | |
354 | ||
355 | /* Show that REFERENCE_TYPEs are internal and should be Pmode. */ | |
356 | internal_reference_types (); | |
27becfc8 | 357 | |
22582d86 | 358 | /* Register our internal error function. */ |
27becfc8 | 359 | global_dc->internal_error = &internal_error_function; |
360 | ||
27becfc8 | 361 | return true; |
362 | } | |
363 | ||
0ba78e57 | 364 | /* Initialize the GCC support for exception handling. */ |
27becfc8 | 365 | |
366 | void | |
367 | gnat_init_gcc_eh (void) | |
368 | { | |
27becfc8 | 369 | /* We shouldn't do anything if the No_Exceptions_Handler pragma is set, |
370 | though. This could for instance lead to the emission of tables with | |
371 | references to symbols (such as the Ada eh personality routine) within | |
372 | libraries we won't link against. */ | |
373 | if (No_Exception_Handlers_Set ()) | |
374 | return; | |
375 | ||
376 | /* Tell GCC we are handling cleanup actions through exception propagation. | |
377 | This opens possibilities that we don't take advantage of yet, but is | |
378 | nonetheless necessary to ensure that fixup code gets assigned to the | |
379 | right exception regions. */ | |
380 | using_eh_for_cleanups (); | |
381 | ||
474db119 | 382 | /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers |
383 | the generation of the necessary exception tables. The second one is | |
384 | useful for two reasons: 1/ we map some asynchronous signals like SEGV to | |
385 | exceptions, so we need to ensure that the insns which can lead to such | |
27becfc8 | 386 | signals are correctly attached to the exception region they pertain to, |
387 | 2/ Some calls to pure subprograms are handled as libcall blocks and then | |
388 | marked as "cannot trap" if the flag is not set (see emit_libcall_block). | |
389 | We should not let this be since it is possible for such calls to actually | |
390 | raise in Ada. */ | |
391 | flag_exceptions = 1; | |
392 | flag_non_call_exceptions = 1; | |
393 | ||
394 | init_eh (); | |
27becfc8 | 395 | } |
396 | ||
0ba78e57 | 397 | /* Initialize the GCC support for floating-point operations. */ |
398 | ||
399 | void | |
400 | gnat_init_gcc_fp (void) | |
401 | { | |
402 | /* Disable FP optimizations that ignore the signedness of zero if | |
c6ac288c | 403 | S'Signed_Zeros is true, but don't override the user if not. */ |
0ba78e57 | 404 | if (Signed_Zeros_On_Target) |
405 | flag_signed_zeros = 1; | |
406 | else if (!global_options_set.x_flag_signed_zeros) | |
407 | flag_signed_zeros = 0; | |
408 | ||
c6ac288c | 409 | /* Assume that FP operations can trap if S'Machine_Overflow is true, |
0ba78e57 | 410 | but don't override the user if not. |
411 | ||
412 | ??? Alpha/VMS enables FP traps without declaring it. */ | |
413 | if (Machine_Overflows_On_Target || TARGET_ABI_OPEN_VMS) | |
414 | flag_trapping_math = 1; | |
415 | else if (!global_options_set.x_flag_trapping_math) | |
416 | flag_trapping_math = 0; | |
417 | } | |
418 | ||
4880a940 | 419 | /* Print language-specific items in declaration NODE. */ |
27becfc8 | 420 | |
421 | static void | |
422 | gnat_print_decl (FILE *file, tree node, int indent) | |
423 | { | |
424 | switch (TREE_CODE (node)) | |
425 | { | |
426 | case CONST_DECL: | |
91c756e6 | 427 | print_node (file, "corresponding var", |
27becfc8 | 428 | DECL_CONST_CORRESPONDING_VAR (node), indent + 4); |
429 | break; | |
430 | ||
431 | case FIELD_DECL: | |
91c756e6 | 432 | print_node (file, "original field", DECL_ORIGINAL_FIELD (node), |
27becfc8 | 433 | indent + 4); |
434 | break; | |
435 | ||
436 | case VAR_DECL: | |
1d957068 | 437 | if (DECL_LOOP_PARM_P (node)) |
438 | print_node (file, "induction var", DECL_INDUCTION_VAR (node), | |
439 | indent + 4); | |
440 | else | |
441 | print_node (file, "renamed object", DECL_RENAMED_OBJECT (node), | |
442 | indent + 4); | |
27becfc8 | 443 | break; |
444 | ||
445 | default: | |
446 | break; | |
447 | } | |
448 | } | |
449 | ||
4880a940 | 450 | /* Print language-specific items in type NODE. */ |
451 | ||
27becfc8 | 452 | static void |
453 | gnat_print_type (FILE *file, tree node, int indent) | |
454 | { | |
455 | switch (TREE_CODE (node)) | |
456 | { | |
457 | case FUNCTION_TYPE: | |
91c756e6 | 458 | print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4); |
27becfc8 | 459 | break; |
460 | ||
27becfc8 | 461 | case INTEGER_TYPE: |
462 | if (TYPE_MODULAR_P (node)) | |
211df513 | 463 | print_node_brief (file, "modulus", TYPE_MODULUS (node), indent + 4); |
27becfc8 | 464 | else if (TYPE_HAS_ACTUAL_BOUNDS_P (node)) |
465 | print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node), | |
466 | indent + 4); | |
467 | else if (TYPE_VAX_FLOATING_POINT_P (node)) | |
468 | ; | |
469 | else | |
470 | print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4); | |
471 | ||
4880a940 | 472 | /* ... fall through ... */ |
473 | ||
474 | case ENUMERAL_TYPE: | |
475 | case BOOLEAN_TYPE: | |
211df513 | 476 | print_node_brief (file, "RM size", TYPE_RM_SIZE (node), indent + 4); |
a9538d68 | 477 | |
478 | /* ... fall through ... */ | |
479 | ||
480 | case REAL_TYPE: | |
481 | print_node_brief (file, "RM min", TYPE_RM_MIN_VALUE (node), indent + 4); | |
482 | print_node_brief (file, "RM max", TYPE_RM_MAX_VALUE (node), indent + 4); | |
27becfc8 | 483 | break; |
484 | ||
485 | case ARRAY_TYPE: | |
486 | print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4); | |
487 | break; | |
488 | ||
52dd2567 | 489 | case VECTOR_TYPE: |
490 | print_node (file,"representative array", | |
491 | TYPE_REPRESENTATIVE_ARRAY (node), indent + 4); | |
492 | break; | |
493 | ||
27becfc8 | 494 | case RECORD_TYPE: |
a98f6bec | 495 | if (TYPE_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node)) |
27becfc8 | 496 | print_node (file, "unconstrained array", |
497 | TYPE_UNCONSTRAINED_ARRAY (node), indent + 4); | |
498 | else | |
499 | print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4); | |
500 | break; | |
501 | ||
502 | case UNION_TYPE: | |
503 | case QUAL_UNION_TYPE: | |
504 | print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4); | |
505 | break; | |
506 | ||
507 | default: | |
508 | break; | |
509 | } | |
510 | } | |
511 | ||
4880a940 | 512 | /* Return the name to be printed for DECL. */ |
27becfc8 | 513 | |
514 | static const char * | |
515 | gnat_printable_name (tree decl, int verbosity) | |
516 | { | |
517 | const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl)); | |
ba72912a | 518 | char *ada_name = (char *) ggc_alloc_atomic (strlen (coded_name) * 2 + 60); |
27becfc8 | 519 | |
520 | __gnat_decode (coded_name, ada_name, 0); | |
521 | ||
515c6c6c | 522 | if (verbosity == 2 && !DECL_IS_BUILTIN (decl)) |
27becfc8 | 523 | { |
b9837360 | 524 | Set_Identifier_Casing (ada_name, DECL_SOURCE_FILE (decl)); |
065c8a7b | 525 | return ggc_strdup (Name_Buffer); |
27becfc8 | 526 | } |
4880a940 | 527 | |
528 | return ada_name; | |
529 | } | |
530 | ||
531 | /* Return the name to be used in DWARF debug info for DECL. */ | |
532 | ||
533 | static const char * | |
534 | gnat_dwarf_name (tree decl, int verbosity ATTRIBUTE_UNUSED) | |
535 | { | |
536 | gcc_assert (DECL_P (decl)); | |
537 | return (const char *) IDENTIFIER_POINTER (DECL_NAME (decl)); | |
27becfc8 | 538 | } |
539 | ||
818dee1b | 540 | /* Return the descriptive type associated with TYPE, if any. */ |
541 | ||
542 | static tree | |
543 | gnat_descriptive_type (const_tree type) | |
544 | { | |
545 | if (TYPE_STUB_DECL (type)) | |
546 | return DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)); | |
547 | else | |
548 | return NULL_TREE; | |
549 | } | |
550 | ||
47c154d9 | 551 | /* Return true if types T1 and T2 are identical for type hashing purposes. |
552 | Called only after doing all language independent checks. At present, | |
553 | this function is only called when both types are FUNCTION_TYPE. */ | |
554 | ||
555 | static bool | |
556 | gnat_type_hash_eq (const_tree t1, const_tree t2) | |
557 | { | |
558 | gcc_assert (TREE_CODE (t1) == FUNCTION_TYPE); | |
559 | return fntype_same_flags_p (t1, TYPE_CI_CO_LIST (t2), | |
560 | TYPE_RETURN_UNCONSTRAINED_P (t2), | |
561 | TYPE_RETURN_BY_DIRECT_REF_P (t2), | |
562 | TREE_ADDRESSABLE (t2)); | |
563 | } | |
564 | ||
27becfc8 | 565 | /* Do nothing (return the tree node passed). */ |
566 | ||
567 | static tree | |
568 | gnat_return_tree (tree t) | |
569 | { | |
570 | return t; | |
571 | } | |
572 | ||
27becfc8 | 573 | /* Get the alias set corresponding to a type or expression. */ |
574 | ||
575 | static alias_set_type | |
576 | gnat_get_alias_set (tree type) | |
577 | { | |
578 | /* If this is a padding type, use the type of the first field. */ | |
a98f6bec | 579 | if (TYPE_IS_PADDING_P (type)) |
27becfc8 | 580 | return get_alias_set (TREE_TYPE (TYPE_FIELDS (type))); |
581 | ||
582 | /* If the type is an unconstrained array, use the type of the | |
583 | self-referential array we make. */ | |
584 | else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) | |
585 | return | |
586 | get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type))))); | |
587 | ||
588 | /* If the type can alias any other types, return the alias set 0. */ | |
589 | else if (TYPE_P (type) | |
590 | && TYPE_UNIVERSAL_ALIASING_P (TYPE_MAIN_VARIANT (type))) | |
591 | return 0; | |
592 | ||
593 | return -1; | |
594 | } | |
595 | ||
596 | /* GNU_TYPE is a type. Return its maximum size in bytes, if known, | |
597 | as a constant when possible. */ | |
598 | ||
599 | static tree | |
600 | gnat_type_max_size (const_tree gnu_type) | |
601 | { | |
602 | /* First see what we can get from TYPE_SIZE_UNIT, which might not | |
603 | be constant even for simple expressions if it has already been | |
604 | elaborated and possibly replaced by a VAR_DECL. */ | |
605 | tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true); | |
606 | ||
607 | /* If we don't have a constant, see what we can get from TYPE_ADA_SIZE, | |
608 | which should stay untouched. */ | |
cd4547bf | 609 | if (!tree_fits_uhwi_p (max_unitsize) |
4a17ee95 | 610 | && RECORD_OR_UNION_TYPE_P (gnu_type) |
611 | && !TYPE_FAT_POINTER_P (gnu_type) | |
27becfc8 | 612 | && TYPE_ADA_SIZE (gnu_type)) |
613 | { | |
614 | tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true); | |
615 | ||
616 | /* If we have succeeded in finding a constant, round it up to the | |
617 | type's alignment and return the result in units. */ | |
cd4547bf | 618 | if (tree_fits_uhwi_p (max_adasize)) |
27becfc8 | 619 | max_unitsize |
620 | = size_binop (CEIL_DIV_EXPR, | |
621 | round_up (max_adasize, TYPE_ALIGN (gnu_type)), | |
622 | bitsize_unit_node); | |
623 | } | |
624 | ||
625 | return max_unitsize; | |
626 | } | |
627 | ||
a9538d68 | 628 | /* GNU_TYPE is a subtype of an integral type. Set LOWVAL to the low bound |
629 | and HIGHVAL to the high bound, respectively. */ | |
630 | ||
631 | static void | |
632 | gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval) | |
633 | { | |
7cdef07d | 634 | *lowval = TYPE_MIN_VALUE (gnu_type); |
635 | *highval = TYPE_MAX_VALUE (gnu_type); | |
a9538d68 | 636 | } |
637 | ||
aacd5a58 | 638 | /* GNU_TYPE is the type of a subprogram parameter. Determine if it should be |
639 | passed by reference by default. */ | |
27becfc8 | 640 | |
641 | bool | |
642 | default_pass_by_ref (tree gnu_type) | |
643 | { | |
97658fc9 | 644 | /* We pass aggregates by reference if they are sufficiently large for |
645 | their alignment. The ratio is somewhat arbitrary. We also pass by | |
27becfc8 | 646 | reference if the target machine would either pass or return by |
647 | reference. Strictly speaking, we need only check the return if this | |
648 | is an In Out parameter, but it's probably best to err on the side of | |
649 | passing more things by reference. */ | |
650 | ||
aacd5a58 | 651 | if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true)) |
27becfc8 | 652 | return true; |
653 | ||
654 | if (targetm.calls.return_in_memory (gnu_type, NULL_TREE)) | |
655 | return true; | |
656 | ||
657 | if (AGGREGATE_TYPE_P (gnu_type) | |
97658fc9 | 658 | && (!valid_constant_size_p (TYPE_SIZE_UNIT (gnu_type)) |
659 | || 0 < compare_tree_int (TYPE_SIZE_UNIT (gnu_type), | |
660 | TYPE_ALIGN (gnu_type)))) | |
27becfc8 | 661 | return true; |
662 | ||
663 | return false; | |
664 | } | |
665 | ||
aacd5a58 | 666 | /* GNU_TYPE is the type of a subprogram parameter. Determine if it must be |
667 | passed by reference. */ | |
27becfc8 | 668 | |
669 | bool | |
670 | must_pass_by_ref (tree gnu_type) | |
671 | { | |
672 | /* We pass only unconstrained objects, those required by the language | |
673 | to be passed by reference, and objects of variable size. The latter | |
674 | is more efficient, avoids problems with variable size temporaries, | |
675 | and does not produce compatibility problems with C, since C does | |
676 | not have such objects. */ | |
677 | return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE | |
a3b35344 | 678 | || TYPE_IS_BY_REFERENCE_P (gnu_type) |
97658fc9 | 679 | || (TYPE_SIZE_UNIT (gnu_type) |
680 | && TREE_CODE (TYPE_SIZE_UNIT (gnu_type)) != INTEGER_CST)); | |
27becfc8 | 681 | } |
682 | ||
547350f1 | 683 | /* This function is called by the front-end to enumerate all the supported |
684 | modes for the machine, as well as some predefined C types. F is a function | |
685 | which is called back with the parameters as listed below, first a string, | |
7b91b384 | 686 | then seven ints. The name is any arbitrary null-terminated string and has |
547350f1 | 687 | no particular significance, except for the case of predefined C types, where |
688 | it should be the name of the C type. For integer types, only signed types | |
689 | should be listed, unsigned versions are assumed. The order of types should | |
690 | be in order of preference, with the smallest/cheapest types first. | |
691 | ||
692 | In particular, C predefined types should be listed before other types, | |
693 | binary floating point types before decimal ones, and narrower/cheaper | |
694 | type versions before more expensive ones. In type selection the first | |
695 | matching variant will be used. | |
696 | ||
697 | NAME pointer to first char of type name | |
698 | DIGS number of decimal digits for floating-point modes, else 0 | |
699 | COMPLEX_P nonzero is this represents a complex mode | |
700 | COUNT count of number of items, nonzero for vector mode | |
701 | FLOAT_REP Float_Rep_Kind for FP, otherwise undefined | |
7b91b384 | 702 | PRECISION number of bits used to store data |
703 | SIZE number of bits occupied by the mode | |
547350f1 | 704 | ALIGN number of bits to which mode is aligned. */ |
705 | ||
706 | void | |
7b91b384 | 707 | enumerate_modes (void (*f) (const char *, int, int, int, int, int, int, int)) |
547350f1 | 708 | { |
709 | const tree c_types[] | |
710 | = { float_type_node, double_type_node, long_double_type_node }; | |
711 | const char *const c_names[] | |
712 | = { "float", "double", "long double" }; | |
713 | int iloop; | |
714 | ||
715 | for (iloop = 0; iloop < NUM_MACHINE_MODES; iloop++) | |
716 | { | |
717 | enum machine_mode i = (enum machine_mode) iloop; | |
718 | enum machine_mode inner_mode = i; | |
719 | bool float_p = false; | |
720 | bool complex_p = false; | |
721 | bool vector_p = false; | |
722 | bool skip_p = false; | |
723 | int digs = 0; | |
724 | unsigned int nameloop; | |
725 | Float_Rep_Kind float_rep = IEEE_Binary; /* Until proven otherwise */ | |
726 | ||
727 | switch (GET_MODE_CLASS (i)) | |
728 | { | |
729 | case MODE_INT: | |
730 | break; | |
731 | case MODE_FLOAT: | |
732 | float_p = true; | |
733 | break; | |
734 | case MODE_COMPLEX_INT: | |
735 | complex_p = true; | |
736 | inner_mode = GET_MODE_INNER (i); | |
737 | break; | |
738 | case MODE_COMPLEX_FLOAT: | |
739 | float_p = true; | |
740 | complex_p = true; | |
741 | inner_mode = GET_MODE_INNER (i); | |
742 | break; | |
743 | case MODE_VECTOR_INT: | |
744 | vector_p = true; | |
745 | inner_mode = GET_MODE_INNER (i); | |
746 | break; | |
747 | case MODE_VECTOR_FLOAT: | |
748 | float_p = true; | |
749 | vector_p = true; | |
750 | inner_mode = GET_MODE_INNER (i); | |
751 | break; | |
752 | default: | |
753 | skip_p = true; | |
754 | } | |
755 | ||
756 | if (float_p) | |
757 | { | |
758 | const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode); | |
759 | ||
23255a5b | 760 | /* ??? Cope with the ghost XFmode of the ARM port. */ |
761 | if (!fmt) | |
762 | continue; | |
763 | ||
547350f1 | 764 | if (fmt->b == 2) |
765 | digs = (fmt->p - 1) * 1233 / 4096; /* scale by log (2) */ | |
766 | ||
767 | else if (fmt->b == 10) | |
768 | digs = fmt->p; | |
769 | ||
770 | else | |
771 | gcc_unreachable(); | |
772 | ||
773 | if (fmt == &vax_f_format | |
774 | || fmt == &vax_d_format | |
775 | || fmt == &vax_g_format) | |
776 | float_rep = VAX_Native; | |
777 | } | |
778 | ||
779 | /* First register any C types for this mode that the front end | |
780 | may need to know about, unless the mode should be skipped. */ | |
7b91b384 | 781 | if (!skip_p && !vector_p) |
547350f1 | 782 | for (nameloop = 0; nameloop < ARRAY_SIZE (c_types); nameloop++) |
783 | { | |
7b91b384 | 784 | tree type = c_types[nameloop]; |
785 | const char *name = c_names[nameloop]; | |
547350f1 | 786 | |
7b91b384 | 787 | if (TYPE_MODE (type) == i) |
547350f1 | 788 | { |
7b91b384 | 789 | f (name, digs, complex_p, 0, float_rep, TYPE_PRECISION (type), |
790 | TREE_INT_CST_LOW (TYPE_SIZE (type)), TYPE_ALIGN (type)); | |
547350f1 | 791 | skip_p = true; |
792 | } | |
793 | } | |
794 | ||
795 | /* If no predefined C types were found, register the mode itself. */ | |
547350f1 | 796 | if (!skip_p) |
797 | f (GET_MODE_NAME (i), digs, complex_p, | |
798 | vector_p ? GET_MODE_NUNITS (i) : 0, float_rep, | |
7b91b384 | 799 | GET_MODE_PRECISION (i), GET_MODE_BITSIZE (i), |
800 | GET_MODE_ALIGNMENT (i)); | |
547350f1 | 801 | } |
802 | } | |
803 | ||
4880a940 | 804 | /* Return the size of the FP mode with precision PREC. */ |
805 | ||
27becfc8 | 806 | int |
807 | fp_prec_to_size (int prec) | |
808 | { | |
809 | enum machine_mode mode; | |
810 | ||
811 | for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode; | |
812 | mode = GET_MODE_WIDER_MODE (mode)) | |
813 | if (GET_MODE_PRECISION (mode) == prec) | |
814 | return GET_MODE_BITSIZE (mode); | |
815 | ||
816 | gcc_unreachable (); | |
817 | } | |
818 | ||
4880a940 | 819 | /* Return the precision of the FP mode with size SIZE. */ |
820 | ||
27becfc8 | 821 | int |
822 | fp_size_to_prec (int size) | |
823 | { | |
824 | enum machine_mode mode; | |
825 | ||
826 | for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode; | |
827 | mode = GET_MODE_WIDER_MODE (mode)) | |
828 | if (GET_MODE_BITSIZE (mode) == size) | |
829 | return GET_MODE_PRECISION (mode); | |
830 | ||
831 | gcc_unreachable (); | |
832 | } | |
58d82cd0 | 833 | |
834 | static GTY(()) tree gnat_eh_personality_decl; | |
835 | ||
e61798eb | 836 | /* Return the GNAT personality function decl. */ |
837 | ||
58d82cd0 | 838 | static tree |
839 | gnat_eh_personality (void) | |
840 | { | |
841 | if (!gnat_eh_personality_decl) | |
382597e4 | 842 | gnat_eh_personality_decl = build_personality_function ("gnat"); |
58d82cd0 | 843 | return gnat_eh_personality_decl; |
844 | } | |
845 | ||
9b88d08d | 846 | /* Initialize language-specific bits of tree_contains_struct. */ |
847 | ||
848 | static void | |
849 | gnat_init_ts (void) | |
850 | { | |
851 | MARK_TS_COMMON (UNCONSTRAINED_ARRAY_TYPE); | |
852 | ||
853 | MARK_TS_TYPED (UNCONSTRAINED_ARRAY_REF); | |
854 | MARK_TS_TYPED (NULL_EXPR); | |
855 | MARK_TS_TYPED (PLUS_NOMOD_EXPR); | |
856 | MARK_TS_TYPED (MINUS_NOMOD_EXPR); | |
857 | MARK_TS_TYPED (ATTR_ADDR_EXPR); | |
858 | MARK_TS_TYPED (STMT_STMT); | |
859 | MARK_TS_TYPED (LOOP_STMT); | |
860 | MARK_TS_TYPED (EXIT_STMT); | |
861 | } | |
862 | ||
e61798eb | 863 | /* Definitions for our language-specific hooks. */ |
864 | ||
865 | #undef LANG_HOOKS_NAME | |
866 | #define LANG_HOOKS_NAME "GNU Ada" | |
867 | #undef LANG_HOOKS_IDENTIFIER_SIZE | |
868 | #define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier) | |
869 | #undef LANG_HOOKS_INIT | |
870 | #define LANG_HOOKS_INIT gnat_init | |
871 | #undef LANG_HOOKS_OPTION_LANG_MASK | |
872 | #define LANG_HOOKS_OPTION_LANG_MASK gnat_option_lang_mask | |
873 | #undef LANG_HOOKS_INIT_OPTIONS_STRUCT | |
874 | #define LANG_HOOKS_INIT_OPTIONS_STRUCT gnat_init_options_struct | |
875 | #undef LANG_HOOKS_INIT_OPTIONS | |
876 | #define LANG_HOOKS_INIT_OPTIONS gnat_init_options | |
877 | #undef LANG_HOOKS_HANDLE_OPTION | |
878 | #define LANG_HOOKS_HANDLE_OPTION gnat_handle_option | |
879 | #undef LANG_HOOKS_POST_OPTIONS | |
880 | #define LANG_HOOKS_POST_OPTIONS gnat_post_options | |
881 | #undef LANG_HOOKS_PARSE_FILE | |
882 | #define LANG_HOOKS_PARSE_FILE gnat_parse_file | |
883 | #undef LANG_HOOKS_TYPE_HASH_EQ | |
884 | #define LANG_HOOKS_TYPE_HASH_EQ gnat_type_hash_eq | |
885 | #undef LANG_HOOKS_GETDECLS | |
886 | #define LANG_HOOKS_GETDECLS lhd_return_null_tree_v | |
887 | #undef LANG_HOOKS_PUSHDECL | |
888 | #define LANG_HOOKS_PUSHDECL gnat_return_tree | |
889 | #undef LANG_HOOKS_WRITE_GLOBALS | |
890 | #define LANG_HOOKS_WRITE_GLOBALS gnat_write_global_declarations | |
891 | #undef LANG_HOOKS_GET_ALIAS_SET | |
892 | #define LANG_HOOKS_GET_ALIAS_SET gnat_get_alias_set | |
893 | #undef LANG_HOOKS_PRINT_DECL | |
894 | #define LANG_HOOKS_PRINT_DECL gnat_print_decl | |
895 | #undef LANG_HOOKS_PRINT_TYPE | |
896 | #define LANG_HOOKS_PRINT_TYPE gnat_print_type | |
897 | #undef LANG_HOOKS_TYPE_MAX_SIZE | |
898 | #define LANG_HOOKS_TYPE_MAX_SIZE gnat_type_max_size | |
899 | #undef LANG_HOOKS_DECL_PRINTABLE_NAME | |
900 | #define LANG_HOOKS_DECL_PRINTABLE_NAME gnat_printable_name | |
901 | #undef LANG_HOOKS_DWARF_NAME | |
902 | #define LANG_HOOKS_DWARF_NAME gnat_dwarf_name | |
903 | #undef LANG_HOOKS_GIMPLIFY_EXPR | |
904 | #define LANG_HOOKS_GIMPLIFY_EXPR gnat_gimplify_expr | |
905 | #undef LANG_HOOKS_TYPE_FOR_MODE | |
906 | #define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode | |
907 | #undef LANG_HOOKS_TYPE_FOR_SIZE | |
908 | #define LANG_HOOKS_TYPE_FOR_SIZE gnat_type_for_size | |
909 | #undef LANG_HOOKS_TYPES_COMPATIBLE_P | |
910 | #define LANG_HOOKS_TYPES_COMPATIBLE_P gnat_types_compatible_p | |
911 | #undef LANG_HOOKS_GET_SUBRANGE_BOUNDS | |
912 | #define LANG_HOOKS_GET_SUBRANGE_BOUNDS gnat_get_subrange_bounds | |
818dee1b | 913 | #undef LANG_HOOKS_DESCRIPTIVE_TYPE |
914 | #define LANG_HOOKS_DESCRIPTIVE_TYPE gnat_descriptive_type | |
e61798eb | 915 | #undef LANG_HOOKS_ATTRIBUTE_TABLE |
916 | #define LANG_HOOKS_ATTRIBUTE_TABLE gnat_internal_attribute_table | |
917 | #undef LANG_HOOKS_BUILTIN_FUNCTION | |
918 | #define LANG_HOOKS_BUILTIN_FUNCTION gnat_builtin_function | |
919 | #undef LANG_HOOKS_EH_PERSONALITY | |
920 | #define LANG_HOOKS_EH_PERSONALITY gnat_eh_personality | |
921 | #undef LANG_HOOKS_DEEP_UNSHARING | |
922 | #define LANG_HOOKS_DEEP_UNSHARING true | |
9b88d08d | 923 | #undef LANG_HOOKS_INIT_TS |
924 | #define LANG_HOOKS_INIT_TS gnat_init_ts | |
e61798eb | 925 | |
926 | struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; | |
927 | ||
58d82cd0 | 928 | #include "gt-ada-misc.h" |