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