]>
Commit | Line | Data |
---|---|---|
27becfc8 | 1 | /**************************************************************************** |
2 | * * | |
3 | * GNAT COMPILER COMPONENTS * | |
4 | * * | |
5 | * M I S C * | |
6 | * * | |
7 | * C Implementation File * | |
8 | * * | |
17b7eb98 | 9 | * Copyright (C) 1992-2017, 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" | |
4cba6f60 | 29 | #include "target.h" |
30 | #include "tree.h" | |
31 | #include "diagnostic.h" | |
d3b7ee7c | 32 | #include "opts.h" |
b20a8bb4 | 33 | #include "alias.h" |
b20a8bb4 | 34 | #include "fold-const.h" |
9ed99284 | 35 | #include "stor-layout.h" |
36 | #include "print-tree.h" | |
27becfc8 | 37 | #include "toplev.h" |
27becfc8 | 38 | #include "langhooks.h" |
39 | #include "langhooks-def.h" | |
1f63d337 | 40 | #include "plugin.h" |
a3c76fda | 41 | #include "calls.h" /* For pass_by_reference. */ |
2c3209cd | 42 | #include "dwarf2out.h" |
27becfc8 | 43 | |
44 | #include "ada.h" | |
a9a42d49 | 45 | #include "adadecode.h" |
27becfc8 | 46 | #include "types.h" |
47 | #include "atree.h" | |
27becfc8 | 48 | #include "namet.h" |
49 | #include "nlists.h" | |
27becfc8 | 50 | #include "uintp.h" |
51 | #include "fe.h" | |
52 | #include "sinfo.h" | |
53 | #include "einfo.h" | |
54 | #include "ada-tree.h" | |
55 | #include "gigi.h" | |
27becfc8 | 56 | |
5e342322 | 57 | /* This symbol needs to be defined for the front-end. */ |
58 | void *callgraph_info_file = NULL; | |
59 | ||
e61798eb | 60 | /* Command-line argc and argv. These variables are global since they are |
61 | imported in back_end.adb. */ | |
27becfc8 | 62 | unsigned int save_argc; |
63 | const char **save_argv; | |
64 | ||
0c1b6ca8 | 65 | /* GNAT argc and argv generated by the binder for all Ada programs. */ |
27becfc8 | 66 | extern int gnat_argc; |
0c1b6ca8 | 67 | extern const char **gnat_argv; |
68 | ||
69 | /* Ada code requires variables for these settings rather than elements | |
70 | of the global_options structure because they are imported. */ | |
f78f10d6 | 71 | #undef gnat_encodings |
72 | enum dwarf_gnat_encodings gnat_encodings = DWARF_GNAT_ENCODINGS_DEFAULT; | |
0c1b6ca8 | 73 | |
74 | #undef optimize | |
75 | int optimize; | |
76 | ||
77 | #undef optimize_size | |
78 | int optimize_size; | |
79 | ||
80 | #undef flag_compare_debug | |
81 | int flag_compare_debug; | |
82 | ||
83 | #undef flag_short_enums | |
84 | int flag_short_enums; | |
85 | ||
86 | #undef flag_stack_check | |
87 | enum stack_check_type flag_stack_check = NO_STACK_CHECK; | |
27becfc8 | 88 | |
becb63f5 | 89 | #ifdef __cplusplus |
90 | extern "C" { | |
91 | #endif | |
92 | ||
27becfc8 | 93 | /* Declare functions we use as part of startup. */ |
e61798eb | 94 | extern void __gnat_initialize (void *); |
95 | extern void __gnat_install_SEH_handler (void *); | |
96 | extern void adainit (void); | |
97 | extern void _ada_gnat1drv (void); | |
27becfc8 | 98 | |
becb63f5 | 99 | #ifdef __cplusplus |
100 | } | |
101 | #endif | |
102 | ||
27becfc8 | 103 | /* The parser for the language. For us, we process the GNAT tree. */ |
104 | ||
105 | static void | |
b8ba44e7 | 106 | gnat_parse_file (void) |
27becfc8 | 107 | { |
108 | int seh[2]; | |
109 | ||
110 | /* Call the target specific initializations. */ | |
111 | __gnat_initialize (NULL); | |
112 | ||
113 | /* ??? Call the SEH initialization routine. This is to workaround | |
114 | a bootstrap path problem. The call below should be removed at some | |
ea780bd9 | 115 | point and the SEH pointer passed to __gnat_initialize above. */ |
116 | __gnat_install_SEH_handler ((void *)seh); | |
27becfc8 | 117 | |
118 | /* Call the front-end elaboration procedures. */ | |
119 | adainit (); | |
120 | ||
121 | /* Call the front end. */ | |
122 | _ada_gnat1drv (); | |
3a1c9df2 | 123 | |
0c6fd2e5 | 124 | /* Write the global declarations. */ |
125 | gnat_write_global_declarations (); | |
27becfc8 | 126 | } |
127 | ||
fbb6fbd8 | 128 | /* Return language mask for option processing. */ |
129 | ||
130 | static unsigned int | |
131 | gnat_option_lang_mask (void) | |
132 | { | |
133 | return CL_Ada; | |
134 | } | |
135 | ||
27becfc8 | 136 | /* Decode all the language specific options that cannot be decoded by GCC. |
137 | The option decoding phase of GCC calls this routine on the flags that | |
b78351e5 | 138 | are marked as Ada-specific. Return true on success or false on failure. */ |
27becfc8 | 139 | |
b78351e5 | 140 | static bool |
0c1b6ca8 | 141 | gnat_handle_option (size_t scode, const char *arg, int value, int kind, |
142 | location_t loc, const struct cl_option_handlers *handlers) | |
27becfc8 | 143 | { |
27becfc8 | 144 | enum opt_code code = (enum opt_code) scode; |
27becfc8 | 145 | |
27becfc8 | 146 | switch (code) |
147 | { | |
27becfc8 | 148 | case OPT_Wall: |
fbb6fbd8 | 149 | handle_generated_option (&global_options, &global_options_set, |
150 | OPT_Wunused, NULL, value, | |
151 | gnat_option_lang_mask (), kind, loc, | |
09fd09eb | 152 | handlers, true, global_dc); |
6bda7b34 | 153 | warn_uninitialized = value; |
04df77d7 | 154 | warn_maybe_uninitialized = value; |
27becfc8 | 155 | break; |
156 | ||
27becfc8 | 157 | case OPT_gant: |
158 | warning (0, "%<-gnat%> misspelled as %<-gant%>"); | |
159 | ||
b7066486 | 160 | /* ... fall through ... */ |
27becfc8 | 161 | |
162 | case OPT_gnat: | |
27becfc8 | 163 | case OPT_gnatO: |
6761caec | 164 | case OPT_fRTS_: |
165 | case OPT_I: | |
166 | case OPT_nostdinc: | |
167 | case OPT_nostdlib: | |
168 | /* These are handled by the front-end. */ | |
27becfc8 | 169 | break; |
170 | ||
7f7d3e62 | 171 | case OPT_fshort_enums: |
96536a9d | 172 | case OPT_fsigned_char: |
173 | /* These are handled by the middle-end. */ | |
7f7d3e62 | 174 | break; |
175 | ||
1006f7a9 | 176 | case OPT_fbuiltin_printf: |
177 | /* This is ignored in Ada but needs to be accepted so it can be | |
178 | defaulted. */ | |
179 | break; | |
180 | ||
27becfc8 | 181 | default: |
182 | gcc_unreachable (); | |
183 | } | |
184 | ||
d14317ea | 185 | Ada_handle_option_auto (&global_options, &global_options_set, |
186 | scode, arg, value, | |
0c1b6ca8 | 187 | gnat_option_lang_mask (), kind, loc, |
188 | handlers, global_dc); | |
b78351e5 | 189 | return true; |
27becfc8 | 190 | } |
191 | ||
f3f006ad | 192 | /* Initialize options structure OPTS. */ |
193 | ||
194 | static void | |
195 | gnat_init_options_struct (struct gcc_options *opts) | |
196 | { | |
197 | /* Uninitialized really means uninitialized in Ada. */ | |
198 | opts->x_flag_zero_initialized_in_bss = 0; | |
bc0dfc8d | 199 | |
30488079 | 200 | /* We don't care about errno in Ada and it causes __builtin_sqrt to |
201 | call the libm function rather than do it inline. */ | |
202 | opts->x_flag_errno_math = 0; | |
203 | opts->frontend_set_flag_errno_math = true; | |
f3f006ad | 204 | } |
205 | ||
e88d34f6 | 206 | /* Initialize for option processing. */ |
207 | ||
208 | static void | |
209 | gnat_init_options (unsigned int decoded_options_count, | |
210 | struct cl_decoded_option *decoded_options) | |
211 | { | |
212 | /* Reconstruct an argv array for use of back_end.adb. | |
213 | ||
e61798eb | 214 | ??? back_end.adb should not rely on this; instead, it should work with |
215 | decoded options without such reparsing, to ensure consistency in how | |
216 | options are decoded. */ | |
e88d34f6 | 217 | save_argv = XNEWVEC (const char *, 2 * decoded_options_count + 1); |
218 | save_argc = 0; | |
0c1b6ca8 | 219 | for (unsigned int i = 0; i < decoded_options_count; i++) |
e88d34f6 | 220 | { |
e61798eb | 221 | size_t num_elements = decoded_options[i].canonical_option_num_elements; |
222 | ||
71a2f35e | 223 | if (decoded_options[i].errors |
75dbc0d5 | 224 | || decoded_options[i].opt_index == OPT_SPECIAL_unknown |
e61798eb | 225 | || num_elements == 0) |
71a2f35e | 226 | continue; |
e61798eb | 227 | |
9f5eade0 | 228 | /* Deal with -I- specially since it must be a single switch. */ |
229 | if (decoded_options[i].opt_index == OPT_I | |
230 | && num_elements == 2 | |
231 | && decoded_options[i].canonical_option[1][0] == '-' | |
232 | && decoded_options[i].canonical_option[1][1] == '\0') | |
233 | save_argv[save_argc++] = "-I-"; | |
75dbc0d5 | 234 | else |
235 | { | |
e61798eb | 236 | gcc_assert (num_elements >= 1 && num_elements <= 2); |
75dbc0d5 | 237 | save_argv[save_argc++] = decoded_options[i].canonical_option[0]; |
e61798eb | 238 | if (num_elements >= 2) |
75dbc0d5 | 239 | save_argv[save_argc++] = decoded_options[i].canonical_option[1]; |
240 | } | |
e88d34f6 | 241 | } |
242 | save_argv[save_argc] = NULL; | |
27becfc8 | 243 | |
0c1b6ca8 | 244 | /* Pass just the name of the command through the regular channel. */ |
245 | gnat_argv = (const char **) xmalloc (sizeof (char *)); | |
246 | gnat_argv[0] = xstrdup (save_argv[0]); | |
e88d34f6 | 247 | gnat_argc = 1; |
27becfc8 | 248 | } |
249 | ||
6b452e89 | 250 | /* Settings adjustments after switches processing by the back-end. |
251 | Note that the front-end switches processing (Scan_Compiler_Arguments) | |
252 | has not been done yet at this point! */ | |
27becfc8 | 253 | |
47c154d9 | 254 | static bool |
27becfc8 | 255 | gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED) |
256 | { | |
aa854249 | 257 | /* Excess precision other than "fast" requires front-end support. */ |
4267ed07 | 258 | if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD) |
c6418a4e | 259 | sorry ("-fexcess-precision=standard for Ada"); |
260 | flag_excess_precision_cmdline = EXCESS_PRECISION_FAST; | |
261 | ||
0ff5b865 | 262 | /* No psABI change warnings for Ada. */ |
263 | warn_psabi = 0; | |
264 | ||
cd3ef822 | 265 | /* No caret by default for Ada. */ |
266 | if (!global_options_set.x_flag_diagnostics_show_caret) | |
267 | global_dc->show_caret = false; | |
268 | ||
b2bf7f84 | 269 | /* Warn only if STABS is not the default: we don't want to emit a warning if |
270 | the user did not use a -gstabs option. */ | |
271 | if (PREFERRED_DEBUGGING_TYPE != DBX_DEBUG && write_symbols == DBX_DEBUG) | |
272 | warning (0, "STABS debugging information for Ada is obsolete and not " | |
273 | "supported anymore"); | |
274 | ||
275 | /* Copy global settings to local versions. */ | |
f78f10d6 | 276 | gnat_encodings = global_options.x_gnat_encodings; |
789e0a77 | 277 | optimize = global_options.x_optimize; |
278 | optimize_size = global_options.x_optimize_size; | |
ab3728ee | 279 | flag_compare_debug = global_options.x_flag_compare_debug; |
280 | flag_stack_check = global_options.x_flag_stack_check; | |
980e9cdf | 281 | flag_short_enums = global_options.x_flag_short_enums; |
282 | ||
7f7d3e62 | 283 | /* Unfortunately the post_options hook is called before the value of |
284 | flag_short_enums is autodetected, if need be. Mimic the process | |
285 | for our private flag_short_enums. */ | |
286 | if (flag_short_enums == 2) | |
287 | flag_short_enums = targetm.default_short_enums (); | |
288 | ||
27becfc8 | 289 | return false; |
290 | } | |
291 | ||
292 | /* Here is the function to handle the compiler error processing in GCC. */ | |
293 | ||
294 | static void | |
0c1b6ca8 | 295 | internal_error_function (diagnostic_context *context, const char *msgid, |
296 | va_list *ap) | |
27becfc8 | 297 | { |
298 | text_info tinfo; | |
299 | char *buffer, *p, *loc; | |
300 | String_Template temp, temp_loc; | |
f92da234 | 301 | String_Pointer sp, sp_loc; |
302 | expanded_location xloc; | |
27becfc8 | 303 | |
1f63d337 | 304 | /* Warn if plugins present. */ |
305 | warn_if_plugins (); | |
306 | ||
27becfc8 | 307 | /* Reset the pretty-printer. */ |
1f63d337 | 308 | pp_clear_output_area (context->printer); |
27becfc8 | 309 | |
310 | /* Format the message into the pretty-printer. */ | |
311 | tinfo.format_spec = msgid; | |
312 | tinfo.args_ptr = ap; | |
313 | tinfo.err_no = errno; | |
1f63d337 | 314 | pp_format_verbatim (context->printer, &tinfo); |
27becfc8 | 315 | |
316 | /* Extract a (writable) pointer to the formatted text. */ | |
1f63d337 | 317 | buffer = xstrdup (pp_formatted_text (context->printer)); |
27becfc8 | 318 | |
319 | /* Go up to the first newline. */ | |
320 | for (p = buffer; *p; p++) | |
321 | if (*p == '\n') | |
322 | { | |
323 | *p = '\0'; | |
324 | break; | |
325 | } | |
326 | ||
327 | temp.Low_Bound = 1; | |
328 | temp.High_Bound = p - buffer; | |
f92da234 | 329 | sp.Bounds = &temp; |
330 | sp.Array = buffer; | |
27becfc8 | 331 | |
f92da234 | 332 | xloc = expand_location (input_location); |
333 | if (context->show_column && xloc.column != 0) | |
4baf631c | 334 | loc = xasprintf ("%s:%d:%d", xloc.file, xloc.line, xloc.column); |
27becfc8 | 335 | else |
4baf631c | 336 | loc = xasprintf ("%s:%d", xloc.file, xloc.line); |
27becfc8 | 337 | temp_loc.Low_Bound = 1; |
338 | temp_loc.High_Bound = strlen (loc); | |
f92da234 | 339 | sp_loc.Bounds = &temp_loc; |
340 | sp_loc.Array = loc; | |
27becfc8 | 341 | |
342 | Current_Error_Node = error_gnat_node; | |
f92da234 | 343 | Compiler_Abort (sp, sp_loc, true); |
27becfc8 | 344 | } |
345 | ||
1bc58db4 | 346 | /* lang_hooks.tree_size: Determine the size of a tree with code C, |
347 | which is a language-specific tree code in category tcc_constant, | |
348 | tcc_exceptional or tcc_type. The default expects never to be called. */ | |
349 | ||
350 | static size_t | |
351 | gnat_tree_size (enum tree_code code) | |
352 | { | |
353 | gcc_checking_assert (code >= NUM_TREE_CODES); | |
354 | switch (code) | |
355 | { | |
356 | case UNCONSTRAINED_ARRAY_TYPE: | |
357 | return sizeof (tree_type_non_common); | |
358 | default: | |
359 | gcc_unreachable (); | |
360 | } | |
361 | } | |
362 | ||
27becfc8 | 363 | /* Perform all the initialization steps that are language-specific. */ |
364 | ||
365 | static bool | |
366 | gnat_init (void) | |
367 | { | |
22582d86 | 368 | /* Do little here, most of the standard declarations are set up after the |
96536a9d | 369 | front-end has been run. Use the same `char' as C for Interfaces.C. */ |
600695e0 | 370 | build_common_tree_nodes (flag_signed_char); |
3e70070e | 371 | |
22582d86 | 372 | /* In Ada, we use an unsigned 8-bit type for the default boolean type. */ |
373 | boolean_type_node = make_unsigned_type (8); | |
374 | TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE); | |
375 | SET_TYPE_RM_MAX_VALUE (boolean_type_node, | |
376 | build_int_cst (boolean_type_node, 1)); | |
377 | SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1)); | |
eca04deb | 378 | boolean_true_node = TYPE_MAX_VALUE (boolean_type_node); |
379 | boolean_false_node = TYPE_MIN_VALUE (boolean_type_node); | |
22582d86 | 380 | |
3fa661c4 | 381 | sbitsize_one_node = sbitsize_int (1); |
382 | sbitsize_unit_node = sbitsize_int (BITS_PER_UNIT); | |
22582d86 | 383 | |
22582d86 | 384 | /* Register our internal error function. */ |
27becfc8 | 385 | global_dc->internal_error = &internal_error_function; |
386 | ||
27becfc8 | 387 | return true; |
388 | } | |
389 | ||
0ba78e57 | 390 | /* Initialize the GCC support for exception handling. */ |
27becfc8 | 391 | |
392 | void | |
393 | gnat_init_gcc_eh (void) | |
394 | { | |
27becfc8 | 395 | /* We shouldn't do anything if the No_Exceptions_Handler pragma is set, |
396 | though. This could for instance lead to the emission of tables with | |
397 | references to symbols (such as the Ada eh personality routine) within | |
398 | libraries we won't link against. */ | |
399 | if (No_Exception_Handlers_Set ()) | |
400 | return; | |
401 | ||
402 | /* Tell GCC we are handling cleanup actions through exception propagation. | |
403 | This opens possibilities that we don't take advantage of yet, but is | |
404 | nonetheless necessary to ensure that fixup code gets assigned to the | |
405 | right exception regions. */ | |
406 | using_eh_for_cleanups (); | |
407 | ||
30488079 | 408 | /* Turn on -fexceptions, -fnon-call-exceptions and -fdelete-dead-exceptions. |
409 | The first one triggers the generation of the necessary exception tables. | |
410 | The second one is useful for two reasons: 1/ we map some asynchronous | |
411 | signals like SEGV to exceptions, so we need to ensure that the insns | |
412 | which can lead to such signals are correctly attached to the exception | |
413 | region they pertain to, 2/ some calls to pure subprograms are handled as | |
414 | libcall blocks and then marked as "cannot trap" if the flag is not set | |
415 | (see emit_libcall_block). We should not let this be since it is possible | |
416 | for such calls to actually raise in Ada. | |
417 | The third one is an optimization that makes it possible to delete dead | |
418 | instructions that may throw exceptions, most notably loads and stores, | |
419 | as permitted in Ada. */ | |
27becfc8 | 420 | flag_exceptions = 1; |
421 | flag_non_call_exceptions = 1; | |
30488079 | 422 | flag_delete_dead_exceptions = 1; |
27becfc8 | 423 | |
424 | init_eh (); | |
27becfc8 | 425 | } |
426 | ||
0ba78e57 | 427 | /* Initialize the GCC support for floating-point operations. */ |
428 | ||
429 | void | |
430 | gnat_init_gcc_fp (void) | |
431 | { | |
432 | /* Disable FP optimizations that ignore the signedness of zero if | |
c6ac288c | 433 | S'Signed_Zeros is true, but don't override the user if not. */ |
0ba78e57 | 434 | if (Signed_Zeros_On_Target) |
435 | flag_signed_zeros = 1; | |
436 | else if (!global_options_set.x_flag_signed_zeros) | |
437 | flag_signed_zeros = 0; | |
438 | ||
c6ac288c | 439 | /* Assume that FP operations can trap if S'Machine_Overflow is true, |
6fa4bf38 | 440 | but don't override the user if not. */ |
441 | if (Machine_Overflows_On_Target) | |
0ba78e57 | 442 | flag_trapping_math = 1; |
443 | else if (!global_options_set.x_flag_trapping_math) | |
444 | flag_trapping_math = 0; | |
445 | } | |
446 | ||
4880a940 | 447 | /* Print language-specific items in declaration NODE. */ |
27becfc8 | 448 | |
449 | static void | |
450 | gnat_print_decl (FILE *file, tree node, int indent) | |
451 | { | |
452 | switch (TREE_CODE (node)) | |
453 | { | |
454 | case CONST_DECL: | |
91c756e6 | 455 | print_node (file, "corresponding var", |
27becfc8 | 456 | DECL_CONST_CORRESPONDING_VAR (node), indent + 4); |
457 | break; | |
458 | ||
459 | case FIELD_DECL: | |
91c756e6 | 460 | print_node (file, "original field", DECL_ORIGINAL_FIELD (node), |
27becfc8 | 461 | indent + 4); |
462 | break; | |
463 | ||
464 | case VAR_DECL: | |
1d957068 | 465 | if (DECL_LOOP_PARM_P (node)) |
466 | print_node (file, "induction var", DECL_INDUCTION_VAR (node), | |
467 | indent + 4); | |
468 | else | |
469 | print_node (file, "renamed object", DECL_RENAMED_OBJECT (node), | |
470 | indent + 4); | |
27becfc8 | 471 | break; |
472 | ||
473 | default: | |
474 | break; | |
475 | } | |
476 | } | |
477 | ||
4880a940 | 478 | /* Print language-specific items in type NODE. */ |
479 | ||
27becfc8 | 480 | static void |
481 | gnat_print_type (FILE *file, tree node, int indent) | |
482 | { | |
483 | switch (TREE_CODE (node)) | |
484 | { | |
485 | case FUNCTION_TYPE: | |
91c756e6 | 486 | print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4); |
27becfc8 | 487 | break; |
488 | ||
27becfc8 | 489 | case INTEGER_TYPE: |
490 | if (TYPE_MODULAR_P (node)) | |
211df513 | 491 | print_node_brief (file, "modulus", TYPE_MODULUS (node), indent + 4); |
6a3b696e | 492 | else if (TYPE_FIXED_POINT_P (node)) |
493 | print_node (file, "scale factor", TYPE_SCALE_FACTOR (node), | |
494 | indent + 4); | |
27becfc8 | 495 | else if (TYPE_HAS_ACTUAL_BOUNDS_P (node)) |
496 | print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node), | |
497 | indent + 4); | |
27becfc8 | 498 | else |
499 | print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4); | |
500 | ||
b7066486 | 501 | /* ... fall through ... */ |
4880a940 | 502 | |
503 | case ENUMERAL_TYPE: | |
504 | case BOOLEAN_TYPE: | |
211df513 | 505 | print_node_brief (file, "RM size", TYPE_RM_SIZE (node), indent + 4); |
a9538d68 | 506 | |
b7066486 | 507 | /* ... fall through ... */ |
a9538d68 | 508 | |
509 | case REAL_TYPE: | |
510 | print_node_brief (file, "RM min", TYPE_RM_MIN_VALUE (node), indent + 4); | |
511 | print_node_brief (file, "RM max", TYPE_RM_MAX_VALUE (node), indent + 4); | |
27becfc8 | 512 | break; |
513 | ||
514 | case ARRAY_TYPE: | |
515 | print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4); | |
516 | break; | |
517 | ||
52dd2567 | 518 | case VECTOR_TYPE: |
519 | print_node (file,"representative array", | |
520 | TYPE_REPRESENTATIVE_ARRAY (node), indent + 4); | |
521 | break; | |
522 | ||
27becfc8 | 523 | case RECORD_TYPE: |
a98f6bec | 524 | if (TYPE_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node)) |
27becfc8 | 525 | print_node (file, "unconstrained array", |
526 | TYPE_UNCONSTRAINED_ARRAY (node), indent + 4); | |
527 | else | |
528 | print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4); | |
529 | break; | |
530 | ||
531 | case UNION_TYPE: | |
532 | case QUAL_UNION_TYPE: | |
533 | print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4); | |
534 | break; | |
535 | ||
536 | default: | |
537 | break; | |
538 | } | |
db3c183a | 539 | |
ea780bd9 | 540 | if (TYPE_CAN_HAVE_DEBUG_TYPE_P (node) && TYPE_DEBUG_TYPE (node)) |
91f09771 | 541 | print_node_brief (file, "debug type", TYPE_DEBUG_TYPE (node), indent + 4); |
ea780bd9 | 542 | |
543 | if (TYPE_IMPL_PACKED_ARRAY_P (node) && TYPE_ORIGINAL_PACKED_ARRAY (node)) | |
91f09771 | 544 | print_node_brief (file, "original packed array", |
545 | TYPE_ORIGINAL_PACKED_ARRAY (node), indent + 4); | |
27becfc8 | 546 | } |
547 | ||
4880a940 | 548 | /* Return the name to be printed for DECL. */ |
27becfc8 | 549 | |
550 | static const char * | |
551 | gnat_printable_name (tree decl, int verbosity) | |
552 | { | |
553 | const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl)); | |
ba72912a | 554 | char *ada_name = (char *) ggc_alloc_atomic (strlen (coded_name) * 2 + 60); |
27becfc8 | 555 | |
556 | __gnat_decode (coded_name, ada_name, 0); | |
557 | ||
515c6c6c | 558 | if (verbosity == 2 && !DECL_IS_BUILTIN (decl)) |
27becfc8 | 559 | { |
b9837360 | 560 | Set_Identifier_Casing (ada_name, DECL_SOURCE_FILE (decl)); |
065c8a7b | 561 | return ggc_strdup (Name_Buffer); |
27becfc8 | 562 | } |
4880a940 | 563 | |
564 | return ada_name; | |
565 | } | |
566 | ||
567 | /* Return the name to be used in DWARF debug info for DECL. */ | |
568 | ||
569 | static const char * | |
570 | gnat_dwarf_name (tree decl, int verbosity ATTRIBUTE_UNUSED) | |
571 | { | |
572 | gcc_assert (DECL_P (decl)); | |
573 | return (const char *) IDENTIFIER_POINTER (DECL_NAME (decl)); | |
27becfc8 | 574 | } |
575 | ||
818dee1b | 576 | /* Return the descriptive type associated with TYPE, if any. */ |
577 | ||
578 | static tree | |
579 | gnat_descriptive_type (const_tree type) | |
580 | { | |
581 | if (TYPE_STUB_DECL (type)) | |
582 | return DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)); | |
583 | else | |
584 | return NULL_TREE; | |
585 | } | |
586 | ||
88ff21ff | 587 | /* Return the underlying base type of an enumeration type. */ |
588 | ||
589 | static tree | |
590 | gnat_enum_underlying_base_type (const_tree) | |
591 | { | |
592 | /* Enumeration types are base types in Ada. */ | |
593 | return void_type_node; | |
594 | } | |
595 | ||
ea780bd9 | 596 | /* Return the type to be used for debugging information instead of TYPE or |
db3c183a | 597 | NULL_TREE if TYPE is fine. */ |
598 | ||
599 | static tree | |
600 | gnat_get_debug_type (const_tree type) | |
601 | { | |
ea780bd9 | 602 | if (TYPE_CAN_HAVE_DEBUG_TYPE_P (type) && TYPE_DEBUG_TYPE (type)) |
91f09771 | 603 | { |
604 | type = TYPE_DEBUG_TYPE (type); | |
ea780bd9 | 605 | |
606 | /* ??? The get_debug_type language hook is processed after the array | |
607 | descriptor language hook, so if there is an array behind this type, | |
608 | the latter is supposed to handle it. Still, we can get here with | |
609 | a type we are not supposed to handle (e.g. when the DWARF back-end | |
91f09771 | 610 | processes the type of a variable), so keep this guard. */ |
ea780bd9 | 611 | if (type && TYPE_CAN_HAVE_DEBUG_TYPE_P (type)) |
91f09771 | 612 | return const_cast<tree> (type); |
613 | } | |
ea780bd9 | 614 | |
91f09771 | 615 | return NULL_TREE; |
db3c183a | 616 | } |
617 | ||
6a3b696e | 618 | /* Provide information in INFO for debugging output about the TYPE fixed-point |
619 | type. Return whether TYPE is handled. */ | |
620 | ||
621 | static bool | |
622 | gnat_get_fixed_point_type_info (const_tree type, | |
623 | struct fixed_point_type_info *info) | |
624 | { | |
625 | tree scale_factor; | |
626 | ||
627 | /* GDB cannot handle fixed-point types yet, so rely on GNAT encodings | |
628 | instead for it. */ | |
ea780bd9 | 629 | if (!TYPE_IS_FIXED_POINT_P (type) |
630 | || gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) | |
6a3b696e | 631 | return false; |
632 | ||
633 | scale_factor = TYPE_SCALE_FACTOR (type); | |
634 | ||
635 | /* We expect here only a finite set of pattern. See fixed-point types | |
636 | handling in gnat_to_gnu_entity. */ | |
637 | ||
638 | /* Put invalid values when compiler internals cannot represent the scale | |
639 | factor. */ | |
640 | if (scale_factor == integer_zero_node) | |
641 | { | |
642 | info->scale_factor_kind = fixed_point_scale_factor_arbitrary; | |
643 | info->scale_factor.arbitrary.numerator = 0; | |
644 | info->scale_factor.arbitrary.denominator = 0; | |
645 | return true; | |
646 | } | |
647 | ||
648 | if (TREE_CODE (scale_factor) == RDIV_EXPR) | |
649 | { | |
650 | const tree num = TREE_OPERAND (scale_factor, 0); | |
651 | const tree den = TREE_OPERAND (scale_factor, 1); | |
652 | ||
653 | /* See if we have a binary or decimal scale. */ | |
654 | if (TREE_CODE (den) == POWER_EXPR) | |
655 | { | |
656 | const tree base = TREE_OPERAND (den, 0); | |
657 | const tree exponent = TREE_OPERAND (den, 1); | |
658 | ||
659 | /* We expect the scale factor to be 1 / 2 ** N or 1 / 10 ** N. */ | |
660 | gcc_assert (num == integer_one_node | |
661 | && TREE_CODE (base) == INTEGER_CST | |
662 | && TREE_CODE (exponent) == INTEGER_CST); | |
ea780bd9 | 663 | |
6a3b696e | 664 | switch (tree_to_shwi (base)) |
665 | { | |
666 | case 2: | |
667 | info->scale_factor_kind = fixed_point_scale_factor_binary; | |
668 | info->scale_factor.binary = -tree_to_shwi (exponent); | |
669 | return true; | |
670 | ||
671 | case 10: | |
672 | info->scale_factor_kind = fixed_point_scale_factor_decimal; | |
673 | info->scale_factor.decimal = -tree_to_shwi (exponent); | |
674 | return true; | |
675 | ||
676 | default: | |
677 | gcc_unreachable (); | |
678 | } | |
679 | } | |
680 | ||
681 | /* If we reach this point, we are handling an arbitrary scale factor. We | |
682 | expect N / D with constant operands. */ | |
683 | gcc_assert (TREE_CODE (num) == INTEGER_CST | |
684 | && TREE_CODE (den) == INTEGER_CST); | |
ea780bd9 | 685 | |
6a3b696e | 686 | info->scale_factor_kind = fixed_point_scale_factor_arbitrary; |
687 | info->scale_factor.arbitrary.numerator = tree_to_uhwi (num); | |
688 | info->scale_factor.arbitrary.denominator = tree_to_shwi (den); | |
689 | return true; | |
690 | } | |
691 | ||
692 | gcc_unreachable (); | |
693 | } | |
694 | ||
47c154d9 | 695 | /* Return true if types T1 and T2 are identical for type hashing purposes. |
696 | Called only after doing all language independent checks. At present, | |
697 | this function is only called when both types are FUNCTION_TYPE. */ | |
698 | ||
699 | static bool | |
700 | gnat_type_hash_eq (const_tree t1, const_tree t2) | |
701 | { | |
702 | gcc_assert (TREE_CODE (t1) == FUNCTION_TYPE); | |
703 | return fntype_same_flags_p (t1, TYPE_CI_CO_LIST (t2), | |
704 | TYPE_RETURN_UNCONSTRAINED_P (t2), | |
705 | TYPE_RETURN_BY_DIRECT_REF_P (t2), | |
706 | TREE_ADDRESSABLE (t2)); | |
707 | } | |
708 | ||
27becfc8 | 709 | /* Do nothing (return the tree node passed). */ |
710 | ||
711 | static tree | |
712 | gnat_return_tree (tree t) | |
713 | { | |
714 | return t; | |
715 | } | |
716 | ||
27becfc8 | 717 | /* Get the alias set corresponding to a type or expression. */ |
718 | ||
719 | static alias_set_type | |
720 | gnat_get_alias_set (tree type) | |
721 | { | |
722 | /* If this is a padding type, use the type of the first field. */ | |
a98f6bec | 723 | if (TYPE_IS_PADDING_P (type)) |
27becfc8 | 724 | return get_alias_set (TREE_TYPE (TYPE_FIELDS (type))); |
725 | ||
726 | /* If the type is an unconstrained array, use the type of the | |
727 | self-referential array we make. */ | |
728 | else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) | |
729 | return | |
730 | get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type))))); | |
731 | ||
732 | /* If the type can alias any other types, return the alias set 0. */ | |
6a1231a5 | 733 | else if (TYPE_P (type) |
734 | && !TYPE_IS_DUMMY_P (type) | |
735 | && TYPE_UNIVERSAL_ALIASING_P (type)) | |
27becfc8 | 736 | return 0; |
737 | ||
738 | return -1; | |
739 | } | |
740 | ||
741 | /* GNU_TYPE is a type. Return its maximum size in bytes, if known, | |
742 | as a constant when possible. */ | |
743 | ||
744 | static tree | |
745 | gnat_type_max_size (const_tree gnu_type) | |
746 | { | |
747 | /* First see what we can get from TYPE_SIZE_UNIT, which might not | |
748 | be constant even for simple expressions if it has already been | |
749 | elaborated and possibly replaced by a VAR_DECL. */ | |
750 | tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true); | |
751 | ||
17b7eb98 | 752 | /* If we don't have a constant, try to look at attributes which should have |
753 | stayed untouched. */ | |
754 | if (!tree_fits_uhwi_p (max_unitsize)) | |
27becfc8 | 755 | { |
17b7eb98 | 756 | /* For record types, see what we can get from TYPE_ADA_SIZE. */ |
757 | if (RECORD_OR_UNION_TYPE_P (gnu_type) | |
758 | && !TYPE_FAT_POINTER_P (gnu_type) | |
759 | && TYPE_ADA_SIZE (gnu_type)) | |
760 | { | |
761 | tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true); | |
762 | ||
763 | /* If we have succeeded in finding a constant, round it up to the | |
764 | type's alignment and return the result in units. */ | |
765 | if (tree_fits_uhwi_p (max_adasize)) | |
766 | max_unitsize | |
767 | = size_binop (CEIL_DIV_EXPR, | |
768 | round_up (max_adasize, TYPE_ALIGN (gnu_type)), | |
769 | bitsize_unit_node); | |
770 | } | |
771 | ||
772 | /* For array types, see what we can get from TYPE_INDEX_TYPE. */ | |
773 | else if (TREE_CODE (gnu_type) == ARRAY_TYPE | |
774 | && TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)) | |
775 | && tree_fits_uhwi_p (TYPE_SIZE_UNIT (TREE_TYPE (gnu_type)))) | |
776 | { | |
777 | tree lb = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))); | |
778 | tree hb = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))); | |
779 | if (TREE_CODE (lb) != INTEGER_CST | |
780 | && TYPE_RM_SIZE (TREE_TYPE (lb)) | |
781 | && compare_tree_int (TYPE_RM_SIZE (TREE_TYPE (lb)), 16) <= 0) | |
782 | lb = TYPE_MIN_VALUE (TREE_TYPE (lb)); | |
783 | if (TREE_CODE (hb) != INTEGER_CST | |
784 | && TYPE_RM_SIZE (TREE_TYPE (hb)) | |
785 | && compare_tree_int (TYPE_RM_SIZE (TREE_TYPE (hb)), 16) <= 0) | |
786 | hb = TYPE_MAX_VALUE (TREE_TYPE (hb)); | |
787 | if (TREE_CODE (lb) == INTEGER_CST && TREE_CODE (hb) == INTEGER_CST) | |
788 | { | |
789 | tree ctype = get_base_type (TREE_TYPE (lb)); | |
790 | lb = fold_convert (ctype, lb); | |
791 | hb = fold_convert (ctype, hb); | |
792 | if (tree_int_cst_le (lb, hb)) | |
793 | { | |
794 | tree length | |
795 | = fold_build2 (PLUS_EXPR, ctype, | |
796 | fold_build2 (MINUS_EXPR, ctype, hb, lb), | |
797 | build_int_cst (ctype, 1)); | |
798 | max_unitsize | |
799 | = fold_build2 (MULT_EXPR, sizetype, | |
800 | fold_convert (sizetype, length), | |
801 | TYPE_SIZE_UNIT (TREE_TYPE (gnu_type))); | |
802 | } | |
803 | } | |
804 | } | |
27becfc8 | 805 | } |
806 | ||
807 | return max_unitsize; | |
808 | } | |
809 | ||
ea780bd9 | 810 | static tree get_array_bit_stride (tree); |
91f09771 | 811 | |
2c3209cd | 812 | /* Provide information in INFO for debug output about the TYPE array type. |
813 | Return whether TYPE is handled. */ | |
814 | ||
815 | static bool | |
91f09771 | 816 | gnat_get_array_descr_info (const_tree const_type, |
817 | struct array_descr_info *info) | |
2c3209cd | 818 | { |
819 | bool convention_fortran_p; | |
4b4c9654 | 820 | bool is_array = false; |
821 | bool is_fat_ptr = false; | |
91f09771 | 822 | bool is_packed_array = false; |
91f09771 | 823 | tree type = const_cast<tree> (const_type); |
4b4c9654 | 824 | const_tree first_dimen = NULL_TREE; |
2c3209cd | 825 | const_tree last_dimen = NULL_TREE; |
4b4c9654 | 826 | const_tree dimen; |
2c3209cd | 827 | int i; |
828 | ||
4b4c9654 | 829 | /* Temporaries created in the first pass and used in the second one for thin |
830 | pointers. The first one is an expression that yields the template record | |
831 | from the base address (i.e. the PLACEHOLDER_EXPR). The second one is just | |
832 | a cursor through this record's fields. */ | |
833 | tree thinptr_template_expr = NULL_TREE; | |
834 | tree thinptr_bound_field = NULL_TREE; | |
835 | ||
ea780bd9 | 836 | /* ??? See gnat_get_debug_type. */ |
ffc23920 | 837 | type = maybe_debug_type (type); |
91f09771 | 838 | |
839 | /* If we have an implementation type for a packed array, get the orignial | |
840 | array type. */ | |
ea780bd9 | 841 | if (TYPE_IMPL_PACKED_ARRAY_P (type) && TYPE_ORIGINAL_PACKED_ARRAY (type)) |
91f09771 | 842 | { |
91f09771 | 843 | type = TYPE_ORIGINAL_PACKED_ARRAY (type); |
ea780bd9 | 844 | is_packed_array = true; |
91f09771 | 845 | } |
846 | ||
4b4c9654 | 847 | /* First pass: gather all information about this array except everything |
848 | related to dimensions. */ | |
849 | ||
850 | /* Only handle ARRAY_TYPE nodes that come from GNAT. */ | |
851 | if (TREE_CODE (type) == ARRAY_TYPE | |
852 | && TYPE_DOMAIN (type) | |
853 | && TYPE_INDEX_TYPE (TYPE_DOMAIN (type))) | |
854 | { | |
855 | is_array = true; | |
856 | first_dimen = type; | |
857 | info->data_location = NULL_TREE; | |
858 | } | |
859 | ||
ea780bd9 | 860 | else if (TYPE_IS_FAT_POINTER_P (type) |
861 | && gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) | |
4b4c9654 | 862 | { |
91f09771 | 863 | const tree ua_type = TYPE_UNCONSTRAINED_ARRAY (type); |
4b4c9654 | 864 | |
865 | /* This will be our base object address. */ | |
91f09771 | 866 | const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type); |
4b4c9654 | 867 | |
868 | /* We assume below that maybe_unconstrained_array returns an INDIRECT_REF | |
869 | node. */ | |
870 | const tree ua_val | |
871 | = maybe_unconstrained_array (build_unary_op (INDIRECT_REF, | |
872 | ua_type, | |
873 | placeholder_expr)); | |
874 | ||
875 | is_fat_ptr = true; | |
876 | first_dimen = TREE_TYPE (ua_val); | |
877 | ||
878 | /* Get the *address* of the array, not the array itself. */ | |
879 | info->data_location = TREE_OPERAND (ua_val, 0); | |
880 | } | |
881 | ||
882 | /* Unlike fat pointers (which appear for unconstrained arrays passed in | |
883 | argument), thin pointers are used only for array access types, so we want | |
884 | them to appear in the debug info as pointers to an array type. That's why | |
885 | we match only the RECORD_TYPE here instead of the POINTER_TYPE with the | |
886 | TYPE_IS_THIN_POINTER_P predicate. */ | |
ea780bd9 | 887 | else if (TREE_CODE (type) == RECORD_TYPE |
888 | && TYPE_CONTAINS_TEMPLATE_P (type) | |
889 | && gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) | |
4b4c9654 | 890 | { |
891 | /* This will be our base object address. Note that we assume that | |
892 | pointers to these will actually point to the array field (thin | |
893 | pointers are shifted). */ | |
91f09771 | 894 | const tree placeholder_expr = build0 (PLACEHOLDER_EXPR, type); |
4b4c9654 | 895 | const tree placeholder_addr |
896 | = build_unary_op (ADDR_EXPR, NULL_TREE, placeholder_expr); | |
897 | ||
898 | const tree bounds_field = TYPE_FIELDS (type); | |
899 | const tree bounds_type = TREE_TYPE (bounds_field); | |
900 | const tree array_field = DECL_CHAIN (bounds_field); | |
901 | const tree array_type = TREE_TYPE (array_field); | |
902 | ||
903 | /* Shift the thin pointer address to get the address of the template. */ | |
904 | const tree shift_amount | |
905 | = fold_build1 (NEGATE_EXPR, sizetype, byte_position (array_field)); | |
906 | tree template_addr | |
907 | = build_binary_op (POINTER_PLUS_EXPR, TREE_TYPE (placeholder_addr), | |
908 | placeholder_addr, shift_amount); | |
909 | template_addr | |
910 | = fold_convert (TYPE_POINTER_TO (bounds_type), template_addr); | |
911 | ||
912 | first_dimen = array_type; | |
913 | ||
914 | /* The thin pointer is already the pointer to the array data, so there's | |
915 | no need for a specific "data location" expression. */ | |
916 | info->data_location = NULL_TREE; | |
917 | ||
918 | thinptr_template_expr = build_unary_op (INDIRECT_REF, | |
919 | bounds_type, | |
920 | template_addr); | |
921 | thinptr_bound_field = TYPE_FIELDS (bounds_type); | |
922 | } | |
923 | else | |
2c3209cd | 924 | return false; |
925 | ||
4b4c9654 | 926 | /* Second pass: compute the remaining information: dimensions and |
927 | corresponding bounds. */ | |
2c3209cd | 928 | |
91f09771 | 929 | if (TYPE_PACKED (first_dimen)) |
930 | is_packed_array = true; | |
4b4c9654 | 931 | /* If this array has fortran convention, it's arranged in column-major |
932 | order, so our view here has reversed dimensions. */ | |
933 | convention_fortran_p = TYPE_CONVENTION_FORTRAN_P (first_dimen); | |
934 | /* ??? For row major ordering, we probably want to emit nothing and | |
2c3209cd | 935 | instead specify it as the default in Dw_TAG_compile_unit. */ |
936 | info->ordering = (convention_fortran_p | |
937 | ? array_descr_ordering_column_major | |
938 | : array_descr_ordering_row_major); | |
2c3209cd | 939 | |
4b4c9654 | 940 | /* Count how many dimensions this array has. */ |
941 | for (i = 0, dimen = first_dimen; ; ++i, dimen = TREE_TYPE (dimen)) | |
942 | { | |
943 | if (i > 0 | |
944 | && (TREE_CODE (dimen) != ARRAY_TYPE | |
945 | || !TYPE_MULTI_ARRAY_P (dimen))) | |
946 | break; | |
947 | last_dimen = dimen; | |
948 | } | |
584cdd4f | 949 | |
4b4c9654 | 950 | info->ndimensions = i; |
e5336da8 | 951 | info->rank = NULL_TREE; |
584cdd4f | 952 | |
953 | /* Too many dimensions? Give up generating proper description: yield instead | |
954 | nested arrays. Note that in this case, this hook is invoked once on each | |
955 | intermediate array type: be consistent and output nested arrays for all | |
956 | dimensions. */ | |
957 | if (info->ndimensions > DWARF2OUT_ARRAY_DESCR_INFO_MAX_DIMEN | |
958 | || TYPE_MULTI_ARRAY_P (first_dimen)) | |
959 | { | |
960 | info->ndimensions = 1; | |
961 | last_dimen = first_dimen; | |
962 | } | |
963 | ||
4b4c9654 | 964 | info->element_type = TREE_TYPE (last_dimen); |
965 | ||
966 | /* Now iterate over all dimensions in source-order and fill the info | |
967 | structure. */ | |
2c3209cd | 968 | for (i = (convention_fortran_p ? info->ndimensions - 1 : 0), |
4b4c9654 | 969 | dimen = first_dimen; |
2c3209cd | 970 | 0 <= i && i < info->ndimensions; |
2c3209cd | 971 | i += (convention_fortran_p ? -1 : 1), |
972 | dimen = TREE_TYPE (dimen)) | |
973 | { | |
974 | /* We are interested in the stored bounds for the debug info. */ | |
4b4c9654 | 975 | tree index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (dimen)); |
2c3209cd | 976 | |
4b4c9654 | 977 | if (is_array || is_fat_ptr) |
978 | { | |
979 | /* GDB does not handle very well the self-referencial bound | |
980 | expressions we are able to generate here for XUA types (they are | |
981 | used only by XUP encodings) so avoid them in this case. Note that | |
982 | there are two cases where we generate self-referencial bound | |
983 | expressions: arrays that are constrained by record discriminants | |
984 | and XUA types. */ | |
ea780bd9 | 985 | if (TYPE_CONTEXT (first_dimen) |
986 | && TREE_CODE (TYPE_CONTEXT (first_dimen)) != RECORD_TYPE | |
6a1231a5 | 987 | && CONTAINS_PLACEHOLDER_P (TYPE_MIN_VALUE (index_type)) |
ea780bd9 | 988 | && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL) |
4b4c9654 | 989 | { |
990 | info->dimen[i].lower_bound = NULL_TREE; | |
991 | info->dimen[i].upper_bound = NULL_TREE; | |
992 | } | |
993 | else | |
994 | { | |
ffc23920 | 995 | info->dimen[i].lower_bound |
996 | = maybe_character_value (TYPE_MIN_VALUE (index_type)); | |
997 | info->dimen[i].upper_bound | |
998 | = maybe_character_value (TYPE_MAX_VALUE (index_type)); | |
4b4c9654 | 999 | } |
1000 | } | |
1001 | ||
1002 | /* This is a thin pointer. */ | |
1003 | else | |
1004 | { | |
1005 | info->dimen[i].lower_bound | |
1006 | = build_component_ref (thinptr_template_expr, thinptr_bound_field, | |
1007 | false); | |
1008 | thinptr_bound_field = DECL_CHAIN (thinptr_bound_field); | |
1009 | ||
1010 | info->dimen[i].upper_bound | |
1011 | = build_component_ref (thinptr_template_expr, thinptr_bound_field, | |
1012 | false); | |
1013 | thinptr_bound_field = DECL_CHAIN (thinptr_bound_field); | |
1014 | } | |
1015 | ||
ffc23920 | 1016 | /* The DWARF back-end will output BOUNDS_TYPE as the base type of |
1017 | the array index, so get to the base type of INDEX_TYPE. */ | |
1018 | while (TREE_TYPE (index_type)) | |
4b4c9654 | 1019 | index_type = TREE_TYPE (index_type); |
ea780bd9 | 1020 | |
ffc23920 | 1021 | info->dimen[i].bounds_type = maybe_debug_type (index_type); |
4b4c9654 | 1022 | info->dimen[i].stride = NULL_TREE; |
2c3209cd | 1023 | } |
1024 | ||
4b4c9654 | 1025 | /* These are Fortran-specific fields. They make no sense here. */ |
1026 | info->allocated = NULL_TREE; | |
1027 | info->associated = NULL_TREE; | |
2c3209cd | 1028 | |
db3c183a | 1029 | if (gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) |
1030 | { | |
91f09771 | 1031 | /* When arrays contain dynamically-sized elements, we usually wrap them |
1032 | in padding types, or we create constrained types for them. Then, if | |
1033 | such types are stripped in the debugging information output, the | |
1034 | debugger needs a way to know the size that is reserved for each | |
1035 | element. This is why we emit a stride in such situations. */ | |
db3c183a | 1036 | tree source_element_type = info->element_type; |
1037 | ||
ea780bd9 | 1038 | while (true) |
db3c183a | 1039 | { |
ea780bd9 | 1040 | if (TYPE_DEBUG_TYPE (source_element_type)) |
db3c183a | 1041 | source_element_type = TYPE_DEBUG_TYPE (source_element_type); |
1042 | else if (TYPE_IS_PADDING_P (source_element_type)) | |
1043 | source_element_type | |
1044 | = TREE_TYPE (TYPE_FIELDS (source_element_type)); | |
1045 | else | |
1046 | break; | |
1047 | } | |
1048 | ||
1049 | if (TREE_CODE (TYPE_SIZE_UNIT (source_element_type)) != INTEGER_CST) | |
1050 | { | |
1051 | info->stride = TYPE_SIZE_UNIT (info->element_type); | |
1052 | info->stride_in_bits = false; | |
1053 | } | |
91f09771 | 1054 | |
1055 | /* We need to specify a bit stride when it does not correspond to the | |
1056 | natural size of the contained elements. ??? Note that we do not | |
1057 | support packed records and nested packed arrays. */ | |
1058 | else if (is_packed_array) | |
1059 | { | |
1060 | info->stride = get_array_bit_stride (info->element_type); | |
1061 | info->stride_in_bits = true; | |
1062 | } | |
db3c183a | 1063 | } |
1064 | ||
2c3209cd | 1065 | return true; |
1066 | } | |
1067 | ||
91f09771 | 1068 | /* Given the component type COMP_TYPE of a packed array, return an expression |
1069 | that computes the bit stride of this packed array. Return NULL_TREE when | |
1070 | unsuccessful. */ | |
1071 | ||
1072 | static tree | |
1073 | get_array_bit_stride (tree comp_type) | |
1074 | { | |
1075 | struct array_descr_info info; | |
1076 | tree stride; | |
1077 | ||
1078 | /* Simple case: the array contains an integral type: return its RM size. */ | |
1079 | if (INTEGRAL_TYPE_P (comp_type)) | |
1080 | return TYPE_RM_SIZE (comp_type); | |
1081 | ||
ea780bd9 | 1082 | /* Otherwise, see if this is an array we can analyze; if it's not, punt. */ |
91f09771 | 1083 | memset (&info, 0, sizeof (info)); |
ea780bd9 | 1084 | if (!gnat_get_array_descr_info (comp_type, &info) || !info.stride) |
91f09771 | 1085 | return NULL_TREE; |
1086 | ||
1087 | /* Otherwise, the array stride is the inner array's stride multiplied by the | |
1088 | number of elements it contains. Note that if the inner array is not | |
1089 | packed, then the stride is "natural" and thus does not deserve an | |
1090 | attribute. */ | |
1091 | stride = info.stride; | |
1092 | if (!info.stride_in_bits) | |
1093 | { | |
1094 | stride = fold_convert (bitsizetype, stride); | |
1095 | stride = build_binary_op (MULT_EXPR, bitsizetype, | |
0353d27b | 1096 | stride, build_int_cst (bitsizetype, 8)); |
91f09771 | 1097 | } |
1098 | ||
1099 | for (int i = 0; i < info.ndimensions; ++i) | |
1100 | { | |
1101 | tree count; | |
1102 | ||
ea780bd9 | 1103 | if (!info.dimen[i].lower_bound || !info.dimen[i].upper_bound) |
91f09771 | 1104 | return NULL_TREE; |
1105 | ||
1106 | /* Put in count an expression that computes the length of this | |
1107 | dimension. */ | |
1108 | count = build_binary_op (MINUS_EXPR, sbitsizetype, | |
1109 | fold_convert (sbitsizetype, | |
1110 | info.dimen[i].upper_bound), | |
1111 | fold_convert (sbitsizetype, | |
1112 | info.dimen[i].lower_bound)), | |
1113 | count = build_binary_op (PLUS_EXPR, sbitsizetype, | |
0353d27b | 1114 | count, build_int_cst (sbitsizetype, 1)); |
91f09771 | 1115 | count = build_binary_op (MAX_EXPR, sbitsizetype, |
1116 | count, | |
0353d27b | 1117 | build_int_cst (sbitsizetype, 0)); |
91f09771 | 1118 | count = fold_convert (bitsizetype, count); |
1119 | stride = build_binary_op (MULT_EXPR, bitsizetype, stride, count); | |
1120 | } | |
1121 | ||
1122 | return stride; | |
1123 | } | |
1124 | ||
a9538d68 | 1125 | /* GNU_TYPE is a subtype of an integral type. Set LOWVAL to the low bound |
1126 | and HIGHVAL to the high bound, respectively. */ | |
1127 | ||
1128 | static void | |
1129 | gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval) | |
1130 | { | |
7cdef07d | 1131 | *lowval = TYPE_MIN_VALUE (gnu_type); |
1132 | *highval = TYPE_MAX_VALUE (gnu_type); | |
a9538d68 | 1133 | } |
1134 | ||
ea780bd9 | 1135 | /* Return the bias of GNU_TYPE, if any. */ |
1136 | ||
e0501e5f | 1137 | static tree |
1138 | gnat_get_type_bias (const_tree gnu_type) | |
1139 | { | |
1140 | if (TREE_CODE (gnu_type) == INTEGER_TYPE | |
1141 | && TYPE_BIASED_REPRESENTATION_P (gnu_type) | |
1142 | && gnat_encodings == DWARF_GNAT_ENCODINGS_MINIMAL) | |
ea780bd9 | 1143 | return TYPE_RM_MIN_VALUE (gnu_type); |
1144 | ||
e0501e5f | 1145 | return NULL_TREE; |
1146 | } | |
1147 | ||
aacd5a58 | 1148 | /* GNU_TYPE is the type of a subprogram parameter. Determine if it should be |
1149 | passed by reference by default. */ | |
27becfc8 | 1150 | |
1151 | bool | |
1152 | default_pass_by_ref (tree gnu_type) | |
1153 | { | |
97658fc9 | 1154 | /* We pass aggregates by reference if they are sufficiently large for |
1155 | their alignment. The ratio is somewhat arbitrary. We also pass by | |
27becfc8 | 1156 | reference if the target machine would either pass or return by |
1157 | reference. Strictly speaking, we need only check the return if this | |
1158 | is an In Out parameter, but it's probably best to err on the side of | |
1159 | passing more things by reference. */ | |
1160 | ||
aacd5a58 | 1161 | if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true)) |
27becfc8 | 1162 | return true; |
1163 | ||
1164 | if (targetm.calls.return_in_memory (gnu_type, NULL_TREE)) | |
1165 | return true; | |
1166 | ||
1167 | if (AGGREGATE_TYPE_P (gnu_type) | |
97658fc9 | 1168 | && (!valid_constant_size_p (TYPE_SIZE_UNIT (gnu_type)) |
1169 | || 0 < compare_tree_int (TYPE_SIZE_UNIT (gnu_type), | |
1170 | TYPE_ALIGN (gnu_type)))) | |
27becfc8 | 1171 | return true; |
1172 | ||
1173 | return false; | |
1174 | } | |
1175 | ||
aacd5a58 | 1176 | /* GNU_TYPE is the type of a subprogram parameter. Determine if it must be |
1177 | passed by reference. */ | |
27becfc8 | 1178 | |
1179 | bool | |
1180 | must_pass_by_ref (tree gnu_type) | |
1181 | { | |
1182 | /* We pass only unconstrained objects, those required by the language | |
1183 | to be passed by reference, and objects of variable size. The latter | |
1184 | is more efficient, avoids problems with variable size temporaries, | |
1185 | and does not produce compatibility problems with C, since C does | |
1186 | not have such objects. */ | |
1187 | return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE | |
a3b35344 | 1188 | || TYPE_IS_BY_REFERENCE_P (gnu_type) |
97658fc9 | 1189 | || (TYPE_SIZE_UNIT (gnu_type) |
1190 | && TREE_CODE (TYPE_SIZE_UNIT (gnu_type)) != INTEGER_CST)); | |
27becfc8 | 1191 | } |
1192 | ||
547350f1 | 1193 | /* This function is called by the front-end to enumerate all the supported |
1194 | modes for the machine, as well as some predefined C types. F is a function | |
1195 | which is called back with the parameters as listed below, first a string, | |
7b91b384 | 1196 | then seven ints. The name is any arbitrary null-terminated string and has |
547350f1 | 1197 | no particular significance, except for the case of predefined C types, where |
1198 | it should be the name of the C type. For integer types, only signed types | |
1199 | should be listed, unsigned versions are assumed. The order of types should | |
1200 | be in order of preference, with the smallest/cheapest types first. | |
1201 | ||
1202 | In particular, C predefined types should be listed before other types, | |
1203 | binary floating point types before decimal ones, and narrower/cheaper | |
1204 | type versions before more expensive ones. In type selection the first | |
1205 | matching variant will be used. | |
1206 | ||
1207 | NAME pointer to first char of type name | |
1208 | DIGS number of decimal digits for floating-point modes, else 0 | |
1209 | COMPLEX_P nonzero is this represents a complex mode | |
1210 | COUNT count of number of items, nonzero for vector mode | |
1211 | FLOAT_REP Float_Rep_Kind for FP, otherwise undefined | |
7b91b384 | 1212 | PRECISION number of bits used to store data |
1213 | SIZE number of bits occupied by the mode | |
547350f1 | 1214 | ALIGN number of bits to which mode is aligned. */ |
1215 | ||
1216 | void | |
7b91b384 | 1217 | enumerate_modes (void (*f) (const char *, int, int, int, int, int, int, int)) |
547350f1 | 1218 | { |
1219 | const tree c_types[] | |
1220 | = { float_type_node, double_type_node, long_double_type_node }; | |
1221 | const char *const c_names[] | |
1222 | = { "float", "double", "long double" }; | |
1223 | int iloop; | |
1224 | ||
b6f6bb02 | 1225 | /* We are going to compute it below. */ |
1226 | fp_arith_may_widen = false; | |
1227 | ||
547350f1 | 1228 | for (iloop = 0; iloop < NUM_MACHINE_MODES; iloop++) |
1229 | { | |
3754d046 | 1230 | machine_mode i = (machine_mode) iloop; |
1231 | machine_mode inner_mode = i; | |
547350f1 | 1232 | bool float_p = false; |
1233 | bool complex_p = false; | |
1234 | bool vector_p = false; | |
1235 | bool skip_p = false; | |
1236 | int digs = 0; | |
1237 | unsigned int nameloop; | |
1238 | Float_Rep_Kind float_rep = IEEE_Binary; /* Until proven otherwise */ | |
1239 | ||
1240 | switch (GET_MODE_CLASS (i)) | |
1241 | { | |
1242 | case MODE_INT: | |
1243 | break; | |
1244 | case MODE_FLOAT: | |
1245 | float_p = true; | |
1246 | break; | |
1247 | case MODE_COMPLEX_INT: | |
1248 | complex_p = true; | |
1249 | inner_mode = GET_MODE_INNER (i); | |
1250 | break; | |
1251 | case MODE_COMPLEX_FLOAT: | |
1252 | float_p = true; | |
1253 | complex_p = true; | |
1254 | inner_mode = GET_MODE_INNER (i); | |
1255 | break; | |
1256 | case MODE_VECTOR_INT: | |
1257 | vector_p = true; | |
1258 | inner_mode = GET_MODE_INNER (i); | |
1259 | break; | |
1260 | case MODE_VECTOR_FLOAT: | |
1261 | float_p = true; | |
1262 | vector_p = true; | |
1263 | inner_mode = GET_MODE_INNER (i); | |
1264 | break; | |
1265 | default: | |
1266 | skip_p = true; | |
1267 | } | |
1268 | ||
1269 | if (float_p) | |
1270 | { | |
1271 | const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode); | |
1272 | ||
23255a5b | 1273 | /* ??? Cope with the ghost XFmode of the ARM port. */ |
1274 | if (!fmt) | |
1275 | continue; | |
1276 | ||
b6f6bb02 | 1277 | /* Be conservative and consider that floating-point arithmetics may |
1278 | use wider intermediate results as soon as there is an extended | |
1279 | Motorola or Intel mode supported by the machine. */ | |
1280 | if (fmt == &ieee_extended_motorola_format | |
1281 | || fmt == &ieee_extended_intel_96_format | |
1282 | || fmt == &ieee_extended_intel_96_round_53_format | |
1283 | || fmt == &ieee_extended_intel_128_format) | |
1cfce405 | 1284 | { |
1285 | #ifdef TARGET_FPMATH_DEFAULT | |
1286 | if (TARGET_FPMATH_DEFAULT == FPMATH_387) | |
1287 | #endif | |
1288 | fp_arith_may_widen = true; | |
1289 | } | |
b6f6bb02 | 1290 | |
547350f1 | 1291 | if (fmt->b == 2) |
1292 | digs = (fmt->p - 1) * 1233 / 4096; /* scale by log (2) */ | |
1293 | ||
1294 | else if (fmt->b == 10) | |
1295 | digs = fmt->p; | |
1296 | ||
1297 | else | |
ea780bd9 | 1298 | gcc_unreachable (); |
547350f1 | 1299 | } |
1300 | ||
1301 | /* First register any C types for this mode that the front end | |
1302 | may need to know about, unless the mode should be skipped. */ | |
7b91b384 | 1303 | if (!skip_p && !vector_p) |
547350f1 | 1304 | for (nameloop = 0; nameloop < ARRAY_SIZE (c_types); nameloop++) |
1305 | { | |
7b91b384 | 1306 | tree type = c_types[nameloop]; |
1307 | const char *name = c_names[nameloop]; | |
547350f1 | 1308 | |
7b91b384 | 1309 | if (TYPE_MODE (type) == i) |
547350f1 | 1310 | { |
7b91b384 | 1311 | f (name, digs, complex_p, 0, float_rep, TYPE_PRECISION (type), |
1312 | TREE_INT_CST_LOW (TYPE_SIZE (type)), TYPE_ALIGN (type)); | |
547350f1 | 1313 | skip_p = true; |
1314 | } | |
1315 | } | |
1316 | ||
1317 | /* If no predefined C types were found, register the mode itself. */ | |
547350f1 | 1318 | if (!skip_p) |
1319 | f (GET_MODE_NAME (i), digs, complex_p, | |
1320 | vector_p ? GET_MODE_NUNITS (i) : 0, float_rep, | |
7b91b384 | 1321 | GET_MODE_PRECISION (i), GET_MODE_BITSIZE (i), |
1322 | GET_MODE_ALIGNMENT (i)); | |
547350f1 | 1323 | } |
1324 | } | |
1325 | ||
4880a940 | 1326 | /* Return the size of the FP mode with precision PREC. */ |
1327 | ||
27becfc8 | 1328 | int |
1329 | fp_prec_to_size (int prec) | |
1330 | { | |
2b8f2d97 | 1331 | opt_scalar_float_mode opt_mode; |
27becfc8 | 1332 | |
2b8f2d97 | 1333 | FOR_EACH_MODE_IN_CLASS (opt_mode, MODE_FLOAT) |
1334 | { | |
1335 | scalar_float_mode mode = opt_mode.require (); | |
1336 | if (GET_MODE_PRECISION (mode) == prec) | |
1337 | return GET_MODE_BITSIZE (mode); | |
1338 | } | |
27becfc8 | 1339 | |
1340 | gcc_unreachable (); | |
1341 | } | |
1342 | ||
4880a940 | 1343 | /* Return the precision of the FP mode with size SIZE. */ |
1344 | ||
27becfc8 | 1345 | int |
1346 | fp_size_to_prec (int size) | |
1347 | { | |
2b8f2d97 | 1348 | opt_scalar_float_mode opt_mode; |
27becfc8 | 1349 | |
2b8f2d97 | 1350 | FOR_EACH_MODE_IN_CLASS (opt_mode, MODE_FLOAT) |
1351 | { | |
1352 | scalar_mode mode = opt_mode.require (); | |
1353 | if (GET_MODE_BITSIZE (mode) == size) | |
1354 | return GET_MODE_PRECISION (mode); | |
1355 | } | |
27becfc8 | 1356 | |
1357 | gcc_unreachable (); | |
1358 | } | |
58d82cd0 | 1359 | |
1360 | static GTY(()) tree gnat_eh_personality_decl; | |
1361 | ||
e61798eb | 1362 | /* Return the GNAT personality function decl. */ |
1363 | ||
58d82cd0 | 1364 | static tree |
1365 | gnat_eh_personality (void) | |
1366 | { | |
1367 | if (!gnat_eh_personality_decl) | |
382597e4 | 1368 | gnat_eh_personality_decl = build_personality_function ("gnat"); |
58d82cd0 | 1369 | return gnat_eh_personality_decl; |
1370 | } | |
1371 | ||
9b88d08d | 1372 | /* Initialize language-specific bits of tree_contains_struct. */ |
1373 | ||
1374 | static void | |
1375 | gnat_init_ts (void) | |
1376 | { | |
1377 | MARK_TS_COMMON (UNCONSTRAINED_ARRAY_TYPE); | |
1378 | ||
1379 | MARK_TS_TYPED (UNCONSTRAINED_ARRAY_REF); | |
1380 | MARK_TS_TYPED (NULL_EXPR); | |
1381 | MARK_TS_TYPED (PLUS_NOMOD_EXPR); | |
1382 | MARK_TS_TYPED (MINUS_NOMOD_EXPR); | |
6a3b696e | 1383 | MARK_TS_TYPED (POWER_EXPR); |
9b88d08d | 1384 | MARK_TS_TYPED (ATTR_ADDR_EXPR); |
1385 | MARK_TS_TYPED (STMT_STMT); | |
1386 | MARK_TS_TYPED (LOOP_STMT); | |
1387 | MARK_TS_TYPED (EXIT_STMT); | |
1388 | } | |
1389 | ||
db3c183a | 1390 | /* Return the lang specific structure attached to NODE. Allocate it (cleared) |
1391 | if needed. */ | |
1392 | ||
1393 | struct lang_type * | |
1394 | get_lang_specific (tree node) | |
1395 | { | |
1396 | if (!TYPE_LANG_SPECIFIC (node)) | |
1397 | TYPE_LANG_SPECIFIC (node) = ggc_cleared_alloc<struct lang_type> (); | |
1398 | return TYPE_LANG_SPECIFIC (node); | |
1399 | } | |
1400 | ||
e61798eb | 1401 | /* Definitions for our language-specific hooks. */ |
1402 | ||
1403 | #undef LANG_HOOKS_NAME | |
1404 | #define LANG_HOOKS_NAME "GNU Ada" | |
1405 | #undef LANG_HOOKS_IDENTIFIER_SIZE | |
1406 | #define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier) | |
1bc58db4 | 1407 | #undef LANG_HOOKS_TREE_SIZE |
1408 | #define LANG_HOOKS_TREE_SIZE gnat_tree_size | |
e61798eb | 1409 | #undef LANG_HOOKS_INIT |
1410 | #define LANG_HOOKS_INIT gnat_init | |
1411 | #undef LANG_HOOKS_OPTION_LANG_MASK | |
1412 | #define LANG_HOOKS_OPTION_LANG_MASK gnat_option_lang_mask | |
1413 | #undef LANG_HOOKS_INIT_OPTIONS_STRUCT | |
1414 | #define LANG_HOOKS_INIT_OPTIONS_STRUCT gnat_init_options_struct | |
1415 | #undef LANG_HOOKS_INIT_OPTIONS | |
1416 | #define LANG_HOOKS_INIT_OPTIONS gnat_init_options | |
1417 | #undef LANG_HOOKS_HANDLE_OPTION | |
1418 | #define LANG_HOOKS_HANDLE_OPTION gnat_handle_option | |
1419 | #undef LANG_HOOKS_POST_OPTIONS | |
1420 | #define LANG_HOOKS_POST_OPTIONS gnat_post_options | |
1421 | #undef LANG_HOOKS_PARSE_FILE | |
1422 | #define LANG_HOOKS_PARSE_FILE gnat_parse_file | |
1423 | #undef LANG_HOOKS_TYPE_HASH_EQ | |
1424 | #define LANG_HOOKS_TYPE_HASH_EQ gnat_type_hash_eq | |
1425 | #undef LANG_HOOKS_GETDECLS | |
8a23256f | 1426 | #define LANG_HOOKS_GETDECLS hook_tree_void_null |
e61798eb | 1427 | #undef LANG_HOOKS_PUSHDECL |
1428 | #define LANG_HOOKS_PUSHDECL gnat_return_tree | |
0bee934e | 1429 | #undef LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL |
1430 | #define LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL hook_bool_const_tree_false | |
e61798eb | 1431 | #undef LANG_HOOKS_GET_ALIAS_SET |
1432 | #define LANG_HOOKS_GET_ALIAS_SET gnat_get_alias_set | |
1433 | #undef LANG_HOOKS_PRINT_DECL | |
1434 | #define LANG_HOOKS_PRINT_DECL gnat_print_decl | |
1435 | #undef LANG_HOOKS_PRINT_TYPE | |
1436 | #define LANG_HOOKS_PRINT_TYPE gnat_print_type | |
1437 | #undef LANG_HOOKS_TYPE_MAX_SIZE | |
1438 | #define LANG_HOOKS_TYPE_MAX_SIZE gnat_type_max_size | |
1439 | #undef LANG_HOOKS_DECL_PRINTABLE_NAME | |
1440 | #define LANG_HOOKS_DECL_PRINTABLE_NAME gnat_printable_name | |
1441 | #undef LANG_HOOKS_DWARF_NAME | |
1442 | #define LANG_HOOKS_DWARF_NAME gnat_dwarf_name | |
1443 | #undef LANG_HOOKS_GIMPLIFY_EXPR | |
1444 | #define LANG_HOOKS_GIMPLIFY_EXPR gnat_gimplify_expr | |
1445 | #undef LANG_HOOKS_TYPE_FOR_MODE | |
1446 | #define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode | |
1447 | #undef LANG_HOOKS_TYPE_FOR_SIZE | |
1448 | #define LANG_HOOKS_TYPE_FOR_SIZE gnat_type_for_size | |
1449 | #undef LANG_HOOKS_TYPES_COMPATIBLE_P | |
1450 | #define LANG_HOOKS_TYPES_COMPATIBLE_P gnat_types_compatible_p | |
2c3209cd | 1451 | #undef LANG_HOOKS_GET_ARRAY_DESCR_INFO |
1452 | #define LANG_HOOKS_GET_ARRAY_DESCR_INFO gnat_get_array_descr_info | |
e61798eb | 1453 | #undef LANG_HOOKS_GET_SUBRANGE_BOUNDS |
1454 | #define LANG_HOOKS_GET_SUBRANGE_BOUNDS gnat_get_subrange_bounds | |
e0501e5f | 1455 | #undef LANG_HOOKS_GET_TYPE_BIAS |
1456 | #define LANG_HOOKS_GET_TYPE_BIAS gnat_get_type_bias | |
818dee1b | 1457 | #undef LANG_HOOKS_DESCRIPTIVE_TYPE |
1458 | #define LANG_HOOKS_DESCRIPTIVE_TYPE gnat_descriptive_type | |
88ff21ff | 1459 | #undef LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE |
1460 | #define LANG_HOOKS_ENUM_UNDERLYING_BASE_TYPE gnat_enum_underlying_base_type | |
db3c183a | 1461 | #undef LANG_HOOKS_GET_DEBUG_TYPE |
1462 | #define LANG_HOOKS_GET_DEBUG_TYPE gnat_get_debug_type | |
6a3b696e | 1463 | #undef LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO |
0bee934e | 1464 | #define LANG_HOOKS_GET_FIXED_POINT_TYPE_INFO gnat_get_fixed_point_type_info |
e61798eb | 1465 | #undef LANG_HOOKS_ATTRIBUTE_TABLE |
1466 | #define LANG_HOOKS_ATTRIBUTE_TABLE gnat_internal_attribute_table | |
1467 | #undef LANG_HOOKS_BUILTIN_FUNCTION | |
1468 | #define LANG_HOOKS_BUILTIN_FUNCTION gnat_builtin_function | |
0bee934e | 1469 | #undef LANG_HOOKS_INIT_TS |
1470 | #define LANG_HOOKS_INIT_TS gnat_init_ts | |
e61798eb | 1471 | #undef LANG_HOOKS_EH_PERSONALITY |
1472 | #define LANG_HOOKS_EH_PERSONALITY gnat_eh_personality | |
1473 | #undef LANG_HOOKS_DEEP_UNSHARING | |
1474 | #define LANG_HOOKS_DEEP_UNSHARING true | |
a27e3913 | 1475 | #undef LANG_HOOKS_CUSTOM_FUNCTION_DESCRIPTORS |
1476 | #define LANG_HOOKS_CUSTOM_FUNCTION_DESCRIPTORS true | |
e61798eb | 1477 | |
1478 | struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; | |
1479 | ||
58d82cd0 | 1480 | #include "gt-ada-misc.h" |