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