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