]>
Commit | Line | Data |
---|---|---|
84481f76 RK |
1 | /**************************************************************************** |
2 | * * | |
3 | * GNAT COMPILER COMPONENTS * | |
4 | * * | |
5 | * M I S C * | |
6 | * * | |
7 | * C Implementation File * | |
8 | * * | |
61f71b34 | 9 | * Copyright (C) 1992-2003 Free Software Foundation, Inc. * |
84481f76 RK |
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 2, 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 COPYING. If not, write * | |
19 | * to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, * | |
20 | * MA 02111-1307, USA. * | |
21 | * * | |
22 | * As a special exception, if you link this file with other files to * | |
23 | * produce an executable, this file does not by itself cause the resulting * | |
24 | * executable to be covered by the GNU General Public License. This except- * | |
25 | * ion does not however invalidate any other reasons why the executable * | |
26 | * file might be covered by the GNU Public License. * | |
27 | * * | |
28 | * GNAT was originally developed by the GNAT team at New York University. * | |
71ff80dc | 29 | * Extensive contributions were provided by Ada Core Technologies Inc. * |
84481f76 RK |
30 | * * |
31 | ****************************************************************************/ | |
32 | ||
33 | /* This file contains parts of the compiler that are required for interfacing | |
34 | with GCC but otherwise do nothing and parts of Gigi that need to know | |
35 | about RTL. */ | |
36 | ||
37 | #include "config.h" | |
38 | #include "system.h" | |
4977bab6 ZW |
39 | #include "coretypes.h" |
40 | #include "tm.h" | |
84481f76 RK |
41 | #include "tree.h" |
42 | #include "rtl.h" | |
43 | #include "errors.h" | |
44 | #include "diagnostic.h" | |
45 | #include "expr.h" | |
07fc65c4 | 46 | #include "libfuncs.h" |
84481f76 RK |
47 | #include "ggc.h" |
48 | #include "flags.h" | |
07fc65c4 | 49 | #include "debug.h" |
6510f4c9 | 50 | #include "insn-codes.h" |
84481f76 RK |
51 | #include "insn-flags.h" |
52 | #include "insn-config.h" | |
1c4048ca | 53 | #include "optabs.h" |
84481f76 RK |
54 | #include "recog.h" |
55 | #include "toplev.h" | |
56 | #include "output.h" | |
57 | #include "except.h" | |
58 | #include "tm_p.h" | |
17ed6335 | 59 | #include "langhooks.h" |
d23c55c2 | 60 | #include "langhooks-def.h" |
5f1e32fa | 61 | #include "target.h" |
84481f76 RK |
62 | |
63 | #include "ada.h" | |
64 | #include "types.h" | |
65 | #include "atree.h" | |
66 | #include "elists.h" | |
67 | #include "namet.h" | |
68 | #include "nlists.h" | |
69 | #include "stringt.h" | |
70 | #include "uintp.h" | |
71 | #include "fe.h" | |
72 | #include "sinfo.h" | |
73 | #include "einfo.h" | |
74 | #include "ada-tree.h" | |
75 | #include "gigi.h" | |
07fc65c4 | 76 | #include "adadecode.h" |
a165c302 | 77 | #include "opts.h" |
d7b42618 | 78 | #include "options.h" |
84481f76 RK |
79 | |
80 | extern FILE *asm_out_file; | |
84481f76 | 81 | |
fbf5a39b AC |
82 | /* The largest alignment, in bits, that is needed for using the widest |
83 | move instruction. */ | |
84 | unsigned int largest_move_alignment; | |
85 | ||
86 | static size_t gnat_tree_size (enum tree_code); | |
87 | static bool gnat_init (void); | |
88 | static void gnat_finish_incomplete_decl (tree); | |
b86f6cd9 | 89 | static unsigned int gnat_init_options (unsigned int, const char **); |
fbf5a39b AC |
90 | static int gnat_handle_option (size_t, const char *, int); |
91 | static HOST_WIDE_INT gnat_get_alias_set (tree); | |
92 | static void gnat_print_decl (FILE *, tree, int); | |
93 | static void gnat_print_type (FILE *, tree, int); | |
94 | static const char *gnat_printable_name (tree, int); | |
95 | static tree gnat_eh_runtime_type (tree); | |
96 | static int gnat_eh_type_covers (tree, tree); | |
97 | static void gnat_parse_file (int); | |
98 | static rtx gnat_expand_expr (tree, rtx, enum machine_mode, int); | |
99 | static void internal_error_function (const char *, va_list *); | |
100 | static void gnat_adjust_rli (record_layout_info); | |
75c09e7d | 101 | |
84481f76 | 102 | /* Structure giving our language-specific hooks. */ |
17ed6335 | 103 | |
3ac88239 NB |
104 | #undef LANG_HOOKS_NAME |
105 | #define LANG_HOOKS_NAME "GNU Ada" | |
106 | #undef LANG_HOOKS_IDENTIFIER_SIZE | |
107 | #define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier) | |
d78e771d ZW |
108 | #undef LANG_HOOKS_TREE_SIZE |
109 | #define LANG_HOOKS_TREE_SIZE gnat_tree_size | |
17ed6335 RH |
110 | #undef LANG_HOOKS_INIT |
111 | #define LANG_HOOKS_INIT gnat_init | |
112 | #undef LANG_HOOKS_INIT_OPTIONS | |
113 | #define LANG_HOOKS_INIT_OPTIONS gnat_init_options | |
3c900cb5 NB |
114 | #undef LANG_HOOKS_HANDLE_OPTION |
115 | #define LANG_HOOKS_HANDLE_OPTION gnat_handle_option | |
52dabb6c NB |
116 | #undef LANG_HOOKS_PARSE_FILE |
117 | #define LANG_HOOKS_PARSE_FILE gnat_parse_file | |
75c09e7d RK |
118 | #undef LANG_HOOKS_HONOR_READONLY |
119 | #define LANG_HOOKS_HONOR_READONLY 1 | |
48a7a235 NB |
120 | #undef LANG_HOOKS_FINISH_INCOMPLETE_DECL |
121 | #define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl | |
75c09e7d RK |
122 | #undef LANG_HOOKS_GET_ALIAS_SET |
123 | #define LANG_HOOKS_GET_ALIAS_SET gnat_get_alias_set | |
c9d892a8 NB |
124 | #undef LANG_HOOKS_EXPAND_EXPR |
125 | #define LANG_HOOKS_EXPAND_EXPR gnat_expand_expr | |
dffd7eb6 NB |
126 | #undef LANG_HOOKS_MARK_ADDRESSABLE |
127 | #define LANG_HOOKS_MARK_ADDRESSABLE gnat_mark_addressable | |
78ef5b89 NB |
128 | #undef LANG_HOOKS_TRUTHVALUE_CONVERSION |
129 | #define LANG_HOOKS_TRUTHVALUE_CONVERSION gnat_truthvalue_conversion | |
5d69f816 NB |
130 | #undef LANG_HOOKS_PRINT_DECL |
131 | #define LANG_HOOKS_PRINT_DECL gnat_print_decl | |
132 | #undef LANG_HOOKS_PRINT_TYPE | |
133 | #define LANG_HOOKS_PRINT_TYPE gnat_print_type | |
7afff7cf NB |
134 | #undef LANG_HOOKS_DECL_PRINTABLE_NAME |
135 | #define LANG_HOOKS_DECL_PRINTABLE_NAME gnat_printable_name | |
b0c48229 NB |
136 | #undef LANG_HOOKS_TYPE_FOR_MODE |
137 | #define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode | |
138 | #undef LANG_HOOKS_TYPE_FOR_SIZE | |
139 | #define LANG_HOOKS_TYPE_FOR_SIZE gnat_type_for_size | |
ceef8ce4 NB |
140 | #undef LANG_HOOKS_SIGNED_TYPE |
141 | #define LANG_HOOKS_SIGNED_TYPE gnat_signed_type | |
142 | #undef LANG_HOOKS_UNSIGNED_TYPE | |
143 | #define LANG_HOOKS_UNSIGNED_TYPE gnat_unsigned_type | |
144 | #undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE | |
145 | #define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gnat_signed_or_unsigned_type | |
17ed6335 | 146 | |
3ac88239 | 147 | const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; |
84481f76 | 148 | |
2f9834e8 KG |
149 | /* Tables describing GCC tree codes used only by GNAT. |
150 | ||
151 | Table indexed by tree code giving a string containing a character | |
152 | classifying the tree code. Possibilities are | |
153 | t, d, s, c, r, <, 1 and 2. See cp-tree.def for details. */ | |
154 | ||
155 | #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE, | |
156 | ||
157 | const char tree_code_type[] = { | |
158 | #include "tree.def" | |
159 | 'x', | |
160 | #include "ada-tree.def" | |
161 | }; | |
162 | #undef DEFTREECODE | |
163 | ||
164 | /* Table indexed by tree code giving number of expression | |
165 | operands beyond the fixed part of the node structure. | |
166 | Not used for types or decls. */ | |
167 | ||
168 | #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH, | |
169 | ||
170 | const unsigned char tree_code_length[] = { | |
171 | #include "tree.def" | |
172 | 0, | |
173 | #include "ada-tree.def" | |
174 | }; | |
175 | #undef DEFTREECODE | |
176 | ||
177 | /* Names of tree components. | |
178 | Used for printing out the tree and error messages. */ | |
179 | #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME, | |
180 | ||
181 | const char *const tree_code_name[] = { | |
182 | #include "tree.def" | |
183 | "@@dummy", | |
184 | #include "ada-tree.def" | |
185 | }; | |
186 | #undef DEFTREECODE | |
187 | ||
fbf5a39b AC |
188 | /* Command-line argc and argv. |
189 | These variables are global, since they are imported and used in | |
190 | back_end.adb */ | |
191 | ||
836d77a9 NB |
192 | unsigned int save_argc; |
193 | const char **save_argv; | |
b86f6cd9 | 194 | |
84481f76 RK |
195 | /* gnat standard argc argv */ |
196 | ||
197 | extern int gnat_argc; | |
9c286213 | 198 | extern char **gnat_argv; |
84481f76 | 199 | |
84481f76 | 200 | \f |
84481f76 | 201 | /* Declare functions we use as part of startup. */ |
fbf5a39b AC |
202 | extern void __gnat_initialize (void); |
203 | extern void adainit (void); | |
204 | extern void _ada_gnat1drv (void); | |
84481f76 | 205 | |
52dabb6c | 206 | /* The parser for the language. For us, we process the GNAT tree. */ |
07fc65c4 | 207 | |
52dabb6c | 208 | static void |
fbf5a39b | 209 | gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED) |
84481f76 | 210 | { |
84481f76 RK |
211 | /* call the target specific initializations */ |
212 | __gnat_initialize(); | |
213 | ||
214 | /* Call the front-end elaboration procedures */ | |
215 | adainit (); | |
216 | ||
84481f76 RK |
217 | immediate_size_expand = 1; |
218 | ||
219 | /* Call the front end */ | |
220 | _ada_gnat1drv (); | |
84481f76 RK |
221 | } |
222 | ||
223 | /* Decode all the language specific options that cannot be decoded by GCC. | |
224 | The option decoding phase of GCC calls this routine on the flags that | |
4977bab6 ZW |
225 | it cannot decode. This routine returns the number of consecutive arguments |
226 | from ARGV that it successfully decoded; 0 indicates failure. */ | |
84481f76 | 227 | |
a7512dec | 228 | static int |
3c900cb5 | 229 | gnat_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED) |
84481f76 | 230 | { |
fbf5a39b | 231 | const struct cl_option *option = &cl_options[scode]; |
3c900cb5 NB |
232 | enum opt_code code = (enum opt_code) scode; |
233 | char *q; | |
b86f6cd9 | 234 | unsigned int i; |
84481f76 | 235 | |
fbf5a39b AC |
236 | if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE))) |
237 | { | |
238 | error ("missing argument to \"-%s\"", option->opt_text); | |
239 | return 1; | |
240 | } | |
241 | ||
3c900cb5 | 242 | switch (code) |
84481f76 | 243 | { |
70fd6569 | 244 | default: |
fbf5a39b | 245 | abort (); |
70fd6569 | 246 | |
3c900cb5 NB |
247 | case OPT_I: |
248 | q = xmalloc (sizeof("-I") + strlen (arg)); | |
249 | strcpy (q, "-I"); | |
250 | strcat (q, arg); | |
251 | gnat_argv[gnat_argc] = q; | |
252 | gnat_argc++; | |
253 | break; | |
254 | ||
57eb6503 | 255 | /* All front ends are expected to accept this. */ |
fbf5a39b AC |
256 | case OPT_Wall: |
257 | /* These are used in the GCC Makefile. */ | |
258 | case OPT_Wmissing_prototypes: | |
259 | case OPT_Wstrict_prototypes: | |
260 | case OPT_Wwrite_strings: | |
261 | case OPT_Wno_long_long: | |
262 | break; | |
263 | ||
264 | /* This is handled by the front-end. */ | |
265 | case OPT_nostdinc: | |
57eb6503 NB |
266 | break; |
267 | ||
3c900cb5 | 268 | case OPT_fRTS: |
70fd6569 | 269 | gnat_argv[gnat_argc] = xstrdup ("-fRTS"); |
3c900cb5 NB |
270 | gnat_argc++; |
271 | break; | |
272 | ||
273 | case OPT_gant: | |
274 | warning ("`-gnat' misspelled as `-gant'"); | |
fbf5a39b AC |
275 | |
276 | /* ... fall through ... */ | |
84481f76 | 277 | |
3c900cb5 | 278 | case OPT_gnat: |
fbf5a39b | 279 | /* Recopy the switches without the 'gnat' prefix. */ |
3c900cb5 | 280 | gnat_argv[gnat_argc] = xmalloc (strlen (arg) + 2); |
84481f76 | 281 | gnat_argv[gnat_argc][0] = '-'; |
3c900cb5 NB |
282 | strcpy (gnat_argv[gnat_argc] + 1, arg); |
283 | gnat_argc++; | |
284 | ||
285 | if (arg[0] == 'O') | |
84481f76 RK |
286 | for (i = 1; i < save_argc - 1; i++) |
287 | if (!strncmp (save_argv[i], "-gnatO", 6)) | |
288 | if (save_argv[++i][0] != '-') | |
289 | { | |
290 | /* Preserve output filename as GCC doesn't save it for GNAT. */ | |
9c286213 | 291 | gnat_argv[gnat_argc] = xstrdup (save_argv[i]); |
84481f76 RK |
292 | gnat_argc++; |
293 | break; | |
294 | } | |
3c900cb5 | 295 | break; |
07fc65c4 GB |
296 | } |
297 | ||
3c900cb5 | 298 | return 1; |
84481f76 RK |
299 | } |
300 | ||
301 | /* Initialize for option processing. */ | |
302 | ||
b86f6cd9 NB |
303 | static unsigned int |
304 | gnat_init_options (unsigned int argc, const char **argv) | |
84481f76 | 305 | { |
b86f6cd9 NB |
306 | /* Initialize gnat_argv with save_argv size. */ |
307 | gnat_argv = (char **) xmalloc ((argc + 1) * sizeof (argv[0])); | |
9c286213 | 308 | gnat_argv[0] = xstrdup (argv[0]); /* name of the command */ |
84481f76 | 309 | gnat_argc = 1; |
2772ef3e | 310 | |
b86f6cd9 NB |
311 | save_argc = argc; |
312 | save_argv = argv; | |
313 | ||
be43ab4e | 314 | return CL_Ada; |
84481f76 RK |
315 | } |
316 | ||
07fc65c4 | 317 | /* Here is the function to handle the compiler error processing in GCC. */ |
84481f76 RK |
318 | |
319 | static void | |
fbf5a39b | 320 | internal_error_function (const char *msgid, va_list *ap) |
84481f76 RK |
321 | { |
322 | char buffer[1000]; /* Assume this is big enough. */ | |
323 | char *p; | |
324 | String_Template temp; | |
325 | Fat_Pointer fp; | |
326 | ||
327 | vsprintf (buffer, msgid, *ap); | |
328 | ||
329 | /* Go up to the first newline. */ | |
330 | for (p = buffer; *p != 0; p++) | |
331 | if (*p == '\n') | |
332 | { | |
333 | *p = '\0'; | |
334 | break; | |
335 | } | |
336 | ||
337 | temp.Low_Bound = 1, temp.High_Bound = strlen (buffer); | |
338 | fp.Array = buffer, fp.Bounds = &temp; | |
339 | ||
340 | Current_Error_Node = error_gnat_node; | |
341 | Compiler_Abort (fp, -1); | |
342 | } | |
84481f76 | 343 | |
fbf5a39b AC |
344 | /* Langhook for tree_size: Determine size of our 'x' and 'c' nodes. */ |
345 | ||
d78e771d ZW |
346 | static size_t |
347 | gnat_tree_size (enum tree_code code) | |
348 | { | |
349 | switch (code) | |
350 | { | |
fbf5a39b AC |
351 | case GNAT_LOOP_ID: |
352 | return sizeof (struct tree_loop_id); | |
d78e771d ZW |
353 | default: |
354 | abort (); | |
355 | } | |
356 | /* NOTREACHED */ | |
357 | } | |
358 | ||
84481f76 RK |
359 | /* Perform all the initialization steps that are language-specific. */ |
360 | ||
4bfec483 NB |
361 | static bool |
362 | gnat_init () | |
84481f76 | 363 | { |
07fc65c4 | 364 | /* Performs whatever initialization steps needed by the language-dependent |
fbf5a39b | 365 | lexical analyzer. */ |
f5e99456 NB |
366 | gnat_init_decl_processing (); |
367 | ||
84481f76 | 368 | /* Add the input filename as the last argument. */ |
4bfec483 | 369 | gnat_argv[gnat_argc] = (char *) main_input_filename; |
84481f76 | 370 | gnat_argc++; |
07fc65c4 | 371 | gnat_argv[gnat_argc] = 0; |
84481f76 | 372 | |
27e511e0 | 373 | global_dc->internal_error = &internal_error_function; |
84481f76 RK |
374 | |
375 | /* Show that REFERENCE_TYPEs are internal and should be Pmode. */ | |
376 | internal_reference_types (); | |
377 | ||
84481f76 | 378 | set_lang_adjust_rli (gnat_adjust_rli); |
a7512dec | 379 | |
4bfec483 | 380 | return true; |
07fc65c4 | 381 | } |
84481f76 | 382 | |
fbf5a39b AC |
383 | /* This function is called indirectly from toplev.c to handle incomplete |
384 | declarations, i.e. VAR_DECL nodes whose DECL_SIZE is zero. To be precise, | |
385 | compile_file in toplev.c makes an indirect call through the function pointer | |
386 | incomplete_decl_finalize_hook which is initialized to this routine in | |
387 | init_decl_processing. */ | |
388 | ||
389 | static void | |
390 | gnat_finish_incomplete_decl (tree dont_care ATTRIBUTE_UNUSED) | |
391 | { | |
392 | gigi_abort (202); | |
393 | } | |
394 | \f | |
395 | /* Compute the alignment of the largest mode that can be used for copying | |
396 | objects. */ | |
397 | ||
398 | void | |
399 | gnat_compute_largest_alignment () | |
400 | { | |
401 | enum machine_mode mode; | |
402 | ||
403 | for (mode = GET_CLASS_NARROWEST_MODE (MODE_INT); mode != VOIDmode; | |
404 | mode = GET_MODE_WIDER_MODE (mode)) | |
405 | if (mov_optab->handlers[(int) mode].insn_code != CODE_FOR_nothing) | |
406 | largest_move_alignment = MIN (BIGGEST_ALIGNMENT, | |
407 | MAX (largest_move_alignment, | |
408 | GET_MODE_ALIGNMENT (mode))); | |
409 | } | |
410 | ||
411 | /* If we are using the GCC mechanism to process exception handling, we | |
07fc65c4 GB |
412 | have to register the personality routine for Ada and to initialize |
413 | various language dependent hooks. */ | |
22703ccc | 414 | |
07fc65c4 GB |
415 | void |
416 | gnat_init_gcc_eh () | |
417 | { | |
418 | /* We shouldn't do anything if the No_Exceptions_Handler pragma is set, | |
419 | though. This could for instance lead to the emission of tables with | |
420 | references to symbols (such as the Ada eh personality routine) within | |
421 | libraries we won't link against. */ | |
422 | if (No_Exception_Handlers_Set ()) | |
423 | return; | |
424 | ||
fbf5a39b AC |
425 | /* Tell GCC we are handling cleanup actions through exception propagation. |
426 | This opens possibilities that we don't take advantage of yet, but is | |
427 | nonetheless necessary to ensure that fixup code gets assigned to the | |
428 | right exception regions. */ | |
429 | using_eh_for_cleanups (); | |
430 | ||
07fc65c4 GB |
431 | eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality"); |
432 | lang_eh_type_covers = gnat_eh_type_covers; | |
433 | lang_eh_runtime_type = gnat_eh_runtime_type; | |
fbf5a39b AC |
434 | |
435 | /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers | |
436 | the generation of the necessary exception runtime tables. The second one | |
437 | is useful for two reasons: 1/ we map some asynchronous signals like SEGV | |
438 | to exceptions, so we need to ensure that the insns which can lead to such | |
439 | signals are correctly attached to the exception region they pertain to, | |
440 | 2/ Some calls to pure subprograms are handled as libcall blocks and then | |
441 | marked as "cannot trap" if the flag is not set (see emit_libcall_block). | |
442 | We should not let this be since it is possible for such calls to actually | |
443 | raise in Ada. */ | |
444 | ||
07fc65c4 | 445 | flag_exceptions = 1; |
fbf5a39b | 446 | flag_non_call_exceptions = 1; |
07fc65c4 GB |
447 | |
448 | init_eh (); | |
449 | #ifdef DWARF2_UNWIND_INFO | |
450 | if (dwarf2out_do_frame ()) | |
451 | dwarf2out_frame_init (); | |
452 | #endif | |
84481f76 RK |
453 | } |
454 | ||
fbf5a39b | 455 | /* Language hooks, first one to print language-specific items in a DECL. */ |
84481f76 | 456 | |
5d69f816 | 457 | static void |
fbf5a39b | 458 | gnat_print_decl (FILE *file, tree node, int indent) |
84481f76 RK |
459 | { |
460 | switch (TREE_CODE (node)) | |
461 | { | |
462 | case CONST_DECL: | |
463 | print_node (file, "const_corresponding_var", | |
464 | DECL_CONST_CORRESPONDING_VAR (node), indent + 4); | |
465 | break; | |
466 | ||
467 | case FIELD_DECL: | |
468 | print_node (file, "original field", DECL_ORIGINAL_FIELD (node), | |
469 | indent + 4); | |
470 | break; | |
471 | ||
472 | default: | |
473 | break; | |
474 | } | |
475 | } | |
476 | ||
5d69f816 | 477 | static void |
fbf5a39b | 478 | gnat_print_type (FILE *file, tree node, int indent) |
84481f76 RK |
479 | { |
480 | switch (TREE_CODE (node)) | |
481 | { | |
482 | case FUNCTION_TYPE: | |
483 | print_node (file, "ci_co_list", TYPE_CI_CO_LIST (node), indent + 4); | |
484 | break; | |
485 | ||
486 | case ENUMERAL_TYPE: | |
487 | print_node (file, "RM size", TYPE_RM_SIZE_ENUM (node), indent + 4); | |
488 | break; | |
489 | ||
490 | case INTEGER_TYPE: | |
491 | if (TYPE_MODULAR_P (node)) | |
492 | print_node (file, "modulus", TYPE_MODULUS (node), indent + 4); | |
493 | else if (TYPE_HAS_ACTUAL_BOUNDS_P (node)) | |
494 | print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node), | |
495 | indent + 4); | |
496 | else if (TYPE_VAX_FLOATING_POINT_P (node)) | |
497 | ; | |
498 | else | |
499 | print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4); | |
500 | ||
501 | print_node (file, "RM size", TYPE_RM_SIZE_INT (node), indent + 4); | |
502 | break; | |
503 | ||
504 | case ARRAY_TYPE: | |
505 | print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4); | |
506 | break; | |
507 | ||
508 | case RECORD_TYPE: | |
509 | if (TYPE_IS_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node)) | |
510 | print_node (file, "unconstrained array", | |
511 | TYPE_UNCONSTRAINED_ARRAY (node), indent + 4); | |
512 | else | |
513 | print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4); | |
514 | break; | |
515 | ||
516 | case UNION_TYPE: | |
517 | case QUAL_UNION_TYPE: | |
518 | print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4); | |
519 | break; | |
520 | ||
521 | default: | |
522 | break; | |
523 | } | |
524 | } | |
525 | ||
07fc65c4 | 526 | static const char * |
fbf5a39b | 527 | gnat_printable_name (tree decl, int verbosity ATTRIBUTE_UNUSED) |
07fc65c4 GB |
528 | { |
529 | const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl)); | |
530 | char *ada_name = (char *) ggc_alloc (strlen (coded_name) * 2 + 60); | |
531 | ||
532 | __gnat_decode (coded_name, ada_name, 0); | |
533 | ||
534 | return (const char *) ada_name; | |
535 | } | |
536 | ||
84481f76 | 537 | /* Expands GNAT-specific GCC tree nodes. The only ones we support |
07fc65c4 | 538 | here are TRANSFORM_EXPR, ALLOCATE_EXPR, USE_EXPR and NULL_EXPR. */ |
84481f76 RK |
539 | |
540 | static rtx | |
fbf5a39b | 541 | gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode, int modifier) |
84481f76 RK |
542 | { |
543 | tree type = TREE_TYPE (exp); | |
84481f76 RK |
544 | tree new; |
545 | rtx result; | |
84481f76 RK |
546 | |
547 | /* Update EXP to be the new expression to expand. */ | |
84481f76 RK |
548 | switch (TREE_CODE (exp)) |
549 | { | |
550 | case TRANSFORM_EXPR: | |
551 | gnat_to_code (TREE_COMPLEXITY (exp)); | |
552 | return const0_rtx; | |
553 | break; | |
554 | ||
84481f76 RK |
555 | case NULL_EXPR: |
556 | expand_expr (TREE_OPERAND (exp, 0), const0_rtx, VOIDmode, 0); | |
557 | ||
558 | /* We aren't going to be doing anything with this memory, but allocate | |
559 | it anyway. If it's variable size, make a bogus address. */ | |
560 | if (! host_integerp (TYPE_SIZE_UNIT (type), 1)) | |
75c09e7d | 561 | result = gen_rtx_MEM (BLKmode, virtual_stack_vars_rtx); |
84481f76 | 562 | else |
75c09e7d RK |
563 | result = assign_temp (type, 0, TREE_ADDRESSABLE (exp), 1); |
564 | ||
75c09e7d | 565 | return result; |
84481f76 RK |
566 | |
567 | case ALLOCATE_EXPR: | |
568 | return | |
569 | allocate_dynamic_stack_space | |
570 | (expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype), | |
571 | EXPAND_NORMAL), | |
572 | NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1)); | |
573 | ||
574 | case USE_EXPR: | |
575 | if (target != const0_rtx) | |
576 | gigi_abort (203); | |
577 | ||
578 | /* First write a volatile ASM_INPUT to prevent anything from being | |
579 | moved. */ | |
580 | result = gen_rtx_ASM_INPUT (VOIDmode, ""); | |
581 | MEM_VOLATILE_P (result) = 1; | |
582 | emit_insn (result); | |
583 | ||
584 | result = expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, VOIDmode, | |
585 | modifier); | |
586 | emit_insn (gen_rtx_USE (VOIDmode, result)); | |
587 | return target; | |
588 | ||
589 | case GNAT_NOP_EXPR: | |
590 | return expand_expr (build1 (NOP_EXPR, type, TREE_OPERAND (exp, 0)), | |
591 | target, tmode, modifier); | |
592 | ||
593 | case UNCONSTRAINED_ARRAY_REF: | |
594 | /* If we are evaluating just for side-effects, just evaluate our | |
595 | operand. Otherwise, abort since this code should never appear | |
596 | in a tree to be evaluated (objects aren't unconstrained). */ | |
597 | if (target == const0_rtx || TREE_CODE (type) == VOID_TYPE) | |
598 | return expand_expr (TREE_OPERAND (exp, 0), const0_rtx, | |
599 | VOIDmode, modifier); | |
600 | ||
601 | /* ... fall through ... */ | |
602 | ||
603 | default: | |
604 | gigi_abort (201); | |
605 | } | |
606 | ||
607 | return expand_expr (new, target, tmode, modifier); | |
608 | } | |
609 | ||
84481f76 RK |
610 | /* Adjusts the RLI used to layout a record after all the fields have been |
611 | added. We only handle the packed case and cause it to use the alignment | |
612 | that will pad the record at the end. */ | |
613 | ||
614 | static void | |
fbf5a39b | 615 | gnat_adjust_rli (record_layout_info rli ATTRIBUTE_UNUSED) |
84481f76 | 616 | { |
fbf5a39b AC |
617 | #if 0 |
618 | /* ??? This code seems to have no actual effect; record_align should already | |
78d55cc8 | 619 | reflect the largest alignment desired by a field. jason 2003-04-01 */ |
fbf5a39b AC |
620 | unsigned int record_align = rli->unpadded_align; |
621 | tree field; | |
622 | ||
623 | /* If an alignment has been specified, don't use anything larger unless we | |
624 | have to. */ | |
625 | if (TYPE_ALIGN (rli->t) != 0 && TYPE_ALIGN (rli->t) < record_align) | |
626 | record_align = MAX (rli->record_align, TYPE_ALIGN (rli->t)); | |
627 | ||
628 | /* If any fields have variable size, we need to force the record to be at | |
629 | least as aligned as the alignment of that type. */ | |
630 | for (field = TYPE_FIELDS (rli->t); field; field = TREE_CHAIN (field)) | |
631 | if (TREE_CODE (DECL_SIZE_UNIT (field)) != INTEGER_CST) | |
632 | record_align = MAX (record_align, DECL_ALIGN (field)); | |
633 | ||
634 | if (TYPE_PACKED (rli->t)) | |
635 | rli->record_align = record_align; | |
636 | #endif | |
84481f76 RK |
637 | } |
638 | ||
639 | /* Make a TRANSFORM_EXPR to later expand GNAT_NODE into code. */ | |
640 | ||
641 | tree | |
fbf5a39b | 642 | make_transform_expr (Node_Id gnat_node) |
84481f76 RK |
643 | { |
644 | tree gnu_result = build (TRANSFORM_EXPR, void_type_node); | |
645 | ||
646 | TREE_SIDE_EFFECTS (gnu_result) = 1; | |
647 | TREE_COMPLEXITY (gnu_result) = gnat_node; | |
648 | return gnu_result; | |
649 | } | |
650 | \f | |
651 | /* Update the setjmp buffer BUF with the current stack pointer. We assume | |
652 | here that a __builtin_setjmp was done to BUF. */ | |
653 | ||
654 | void | |
fbf5a39b | 655 | update_setjmp_buf (tree buf) |
84481f76 RK |
656 | { |
657 | enum machine_mode sa_mode = Pmode; | |
658 | rtx stack_save; | |
659 | ||
660 | #ifdef HAVE_save_stack_nonlocal | |
661 | if (HAVE_save_stack_nonlocal) | |
07fc65c4 | 662 | sa_mode = insn_data[(int) CODE_FOR_save_stack_nonlocal].operand[0].mode; |
84481f76 RK |
663 | #endif |
664 | #ifdef STACK_SAVEAREA_MODE | |
665 | sa_mode = STACK_SAVEAREA_MODE (SAVE_NONLOCAL); | |
666 | #endif | |
667 | ||
668 | stack_save | |
669 | = gen_rtx_MEM (sa_mode, | |
670 | memory_address | |
671 | (sa_mode, | |
672 | plus_constant (expand_expr | |
673 | (build_unary_op (ADDR_EXPR, NULL_TREE, buf), | |
674 | NULL_RTX, VOIDmode, 0), | |
675 | 2 * GET_MODE_SIZE (Pmode)))); | |
676 | ||
677 | #ifdef HAVE_setjmp | |
678 | if (HAVE_setjmp) | |
679 | emit_insn (gen_setjmp ()); | |
680 | #endif | |
681 | ||
682 | emit_stack_save (SAVE_NONLOCAL, &stack_save, NULL_RTX); | |
683 | } | |
684 | \f | |
07fc65c4 GB |
685 | /* These routines are used in conjunction with GCC exception handling. */ |
686 | ||
687 | /* Map compile-time to run-time tree for GCC exception handling scheme. */ | |
688 | ||
689 | static tree | |
fbf5a39b | 690 | gnat_eh_runtime_type (tree type) |
07fc65c4 GB |
691 | { |
692 | return type; | |
693 | } | |
694 | ||
695 | /* Return true if type A catches type B. Callback for flow analysis from | |
696 | the exception handling part of the back-end. */ | |
697 | ||
698 | static int | |
fbf5a39b | 699 | gnat_eh_type_covers (tree a, tree b) |
07fc65c4 GB |
700 | { |
701 | /* a catches b if they represent the same exception id or if a | |
702 | is an "others". | |
703 | ||
704 | ??? integer_zero_node for "others" is hardwired in too many places | |
705 | currently. */ | |
706 | return (a == b || a == integer_zero_node); | |
707 | } | |
708 | \f | |
84481f76 RK |
709 | /* See if DECL has an RTL that is indirect via a pseudo-register or a |
710 | memory location and replace it with an indirect reference if so. | |
711 | This improves the debugger's ability to display the value. */ | |
712 | ||
713 | void | |
fbf5a39b | 714 | adjust_decl_rtl (tree decl) |
84481f76 RK |
715 | { |
716 | tree new_type; | |
717 | ||
718 | /* If this decl is already indirect, don't do anything. This should | |
719 | mean that the decl cannot be indirect, but there's no point in | |
720 | adding an abort to check that. */ | |
721 | if (TREE_CODE (decl) != CONST_DECL | |
722 | && ! DECL_BY_REF_P (decl) | |
723 | && (GET_CODE (DECL_RTL (decl)) == MEM | |
724 | && (GET_CODE (XEXP (DECL_RTL (decl), 0)) == MEM | |
725 | || (GET_CODE (XEXP (DECL_RTL (decl), 0)) == REG | |
726 | && (REGNO (XEXP (DECL_RTL (decl), 0)) | |
727 | > LAST_VIRTUAL_REGISTER)))) | |
728 | /* We can't do this if the reference type's mode is not the same | |
729 | as the current mode, which means this may not work on mixed 32/64 | |
730 | bit systems. */ | |
731 | && (new_type = build_reference_type (TREE_TYPE (decl))) != 0 | |
732 | && TYPE_MODE (new_type) == GET_MODE (XEXP (DECL_RTL (decl), 0)) | |
733 | /* If this is a PARM_DECL, we can only do it if DECL_INCOMING_RTL | |
734 | is also an indirect and of the same mode and if the object is | |
735 | readonly, the latter condition because we don't want to upset the | |
736 | handling of CICO_LIST. */ | |
737 | && (TREE_CODE (decl) != PARM_DECL | |
738 | || (GET_CODE (DECL_INCOMING_RTL (decl)) == MEM | |
739 | && (TYPE_MODE (new_type) | |
740 | == GET_MODE (XEXP (DECL_INCOMING_RTL (decl), 0))) | |
741 | && TREE_READONLY (decl)))) | |
742 | { | |
743 | new_type | |
744 | = build_qualified_type (new_type, | |
745 | (TYPE_QUALS (new_type) | TYPE_QUAL_CONST)); | |
746 | ||
747 | DECL_POINTS_TO_READONLY_P (decl) = TREE_READONLY (decl); | |
748 | DECL_BY_REF_P (decl) = 1; | |
749 | SET_DECL_RTL (decl, XEXP (DECL_RTL (decl), 0)); | |
750 | TREE_TYPE (decl) = new_type; | |
751 | DECL_MODE (decl) = TYPE_MODE (new_type); | |
752 | DECL_ALIGN (decl) = TYPE_ALIGN (new_type); | |
753 | DECL_SIZE (decl) = TYPE_SIZE (new_type); | |
754 | ||
755 | if (TREE_CODE (decl) == PARM_DECL) | |
756 | DECL_INCOMING_RTL (decl) = XEXP (DECL_INCOMING_RTL (decl), 0); | |
757 | ||
758 | /* If DECL_INITIAL was set, it should be updated to show that | |
759 | the decl is initialized to the address of that thing. | |
760 | Otherwise, just set it to the address of this decl. | |
761 | It needs to be set so that GCC does not think the decl is | |
762 | unused. */ | |
763 | DECL_INITIAL (decl) | |
764 | = build1 (ADDR_EXPR, new_type, | |
765 | DECL_INITIAL (decl) != 0 ? DECL_INITIAL (decl) : decl); | |
766 | } | |
767 | } | |
768 | \f | |
769 | /* Record the current code position in GNAT_NODE. */ | |
770 | ||
771 | void | |
fbf5a39b | 772 | record_code_position (Node_Id gnat_node) |
84481f76 RK |
773 | { |
774 | if (global_bindings_p ()) | |
775 | { | |
776 | /* Make a dummy entry so multiple things at the same location don't | |
777 | end up in the same place. */ | |
778 | add_pending_elaborations (NULL_TREE, NULL_TREE); | |
779 | save_gnu_tree (gnat_node, get_elaboration_location (), 1); | |
780 | } | |
781 | else | |
782 | /* Always emit another insn in case marking the last insn | |
783 | addressable needs some fixups and also for above reason. */ | |
784 | save_gnu_tree (gnat_node, | |
785 | build (RTL_EXPR, void_type_node, NULL_TREE, | |
2e040219 | 786 | (tree) emit_note (NOTE_INSN_DELETED)), |
84481f76 RK |
787 | 1); |
788 | } | |
789 | ||
790 | /* Insert the code for GNAT_NODE at the position saved for that node. */ | |
791 | ||
792 | void | |
fbf5a39b | 793 | insert_code_for (Node_Id gnat_node) |
84481f76 RK |
794 | { |
795 | if (global_bindings_p ()) | |
796 | { | |
797 | push_pending_elaborations (); | |
798 | gnat_to_code (gnat_node); | |
799 | Check_Elaboration_Code_Allowed (gnat_node); | |
800 | insert_elaboration_list (get_gnu_tree (gnat_node)); | |
801 | pop_pending_elaborations (); | |
802 | } | |
803 | else | |
804 | { | |
805 | rtx insns; | |
806 | ||
07fc65c4 | 807 | do_pending_stack_adjust (); |
84481f76 RK |
808 | start_sequence (); |
809 | mark_all_temps_used (); | |
810 | gnat_to_code (gnat_node); | |
07fc65c4 | 811 | do_pending_stack_adjust (); |
84481f76 RK |
812 | insns = get_insns (); |
813 | end_sequence (); | |
2f937369 | 814 | emit_insn_after (insns, RTL_EXPR_RTL (get_gnu_tree (gnat_node))); |
84481f76 RK |
815 | } |
816 | } | |
817 | ||
84481f76 RK |
818 | /* Get the alias set corresponding to a type or expression. */ |
819 | ||
75c09e7d | 820 | static HOST_WIDE_INT |
fbf5a39b | 821 | gnat_get_alias_set (tree type) |
84481f76 RK |
822 | { |
823 | /* If this is a padding type, use the type of the first field. */ | |
824 | if (TREE_CODE (type) == RECORD_TYPE | |
825 | && TYPE_IS_PADDING_P (type)) | |
826 | return get_alias_set (TREE_TYPE (TYPE_FIELDS (type))); | |
827 | ||
07fc65c4 GB |
828 | /* If the type is an unconstrained array, use the type of the |
829 | self-referential array we make. */ | |
830 | else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) | |
831 | return | |
832 | get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type))))); | |
833 | ||
834 | ||
84481f76 RK |
835 | return -1; |
836 | } | |
837 | ||
838 | /* GNU_TYPE is a type. Determine if it should be passed by reference by | |
839 | default. */ | |
840 | ||
841 | int | |
fbf5a39b | 842 | default_pass_by_ref (tree gnu_type) |
84481f76 RK |
843 | { |
844 | CUMULATIVE_ARGS cum; | |
845 | ||
846 | INIT_CUMULATIVE_ARGS (cum, NULL_TREE, NULL_RTX, 0); | |
847 | ||
848 | /* We pass aggregates by reference if they are sufficiently large. The | |
849 | choice of constant here is somewhat arbitrary. We also pass by | |
850 | reference if the target machine would either pass or return by | |
851 | reference. Strictly speaking, we need only check the return if this | |
852 | is an In Out parameter, but it's probably best to err on the side of | |
853 | passing more things by reference. */ | |
854 | return (0 | |
855 | #ifdef FUNCTION_ARG_PASS_BY_REFERENCE | |
856 | || FUNCTION_ARG_PASS_BY_REFERENCE (cum, TYPE_MODE (gnu_type), | |
857 | gnu_type, 1) | |
858 | #endif | |
61f71b34 | 859 | || targetm.calls.return_in_memory (gnu_type, NULL_TREE) |
84481f76 RK |
860 | || (AGGREGATE_TYPE_P (gnu_type) |
861 | && (! host_integerp (TYPE_SIZE (gnu_type), 1) | |
862 | || 0 < compare_tree_int (TYPE_SIZE (gnu_type), | |
863 | 8 * TYPE_ALIGN (gnu_type))))); | |
864 | } | |
865 | ||
866 | /* GNU_TYPE is the type of a subprogram parameter. Determine from the type if | |
867 | it should be passed by reference. */ | |
868 | ||
869 | int | |
fbf5a39b | 870 | must_pass_by_ref (tree gnu_type) |
84481f76 RK |
871 | { |
872 | /* We pass only unconstrained objects, those required by the language | |
873 | to be passed by reference, and objects of variable size. The latter | |
874 | is more efficient, avoids problems with variable size temporaries, | |
875 | and does not produce compatibility problems with C, since C does | |
876 | not have such objects. */ | |
877 | return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE | |
878 | || (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type)) | |
879 | || (TYPE_SIZE (gnu_type) != 0 | |
880 | && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST)); | |
881 | } |