OSDN Git Service

* misc.c (enumerate_modes): Consider log2_b to always be one.
[pf3gnuchains/gcc-fork.git] / gcc / ada / misc.c
1 /****************************************************************************
2  *                                                                          *
3  *                         GNAT COMPILER COMPONENTS                         *
4  *                                                                          *
5  *                                 M I S C                                  *
6  *                                                                          *
7  *                           C Implementation File                          *
8  *                                                                          *
9  *          Copyright (C) 1992-2006, Free Software Foundation, Inc.         *
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,  51  Franklin  Street,  Fifth  Floor, *
20  * Boston, MA 02110-1301, 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. *
29  * Extensive contributions were provided by Ada Core Technologies Inc.      *
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"
39 #include "coretypes.h"
40 #include "tm.h"
41 #include "tree.h"
42 #include "real.h"
43 #include "rtl.h"
44 #include "diagnostic.h"
45 #include "expr.h"
46 #include "libfuncs.h"
47 #include "ggc.h"
48 #include "flags.h"
49 #include "debug.h"
50 #include "cgraph.h"
51 #include "tree-inline.h"
52 #include "insn-codes.h"
53 #include "insn-flags.h"
54 #include "insn-config.h"
55 #include "optabs.h"
56 #include "recog.h"
57 #include "toplev.h"
58 #include "output.h"
59 #include "except.h"
60 #include "tm_p.h"
61 #include "langhooks.h"
62 #include "langhooks-def.h"
63 #include "target.h"
64
65 #include "ada.h"
66 #include "types.h"
67 #include "atree.h"
68 #include "elists.h"
69 #include "namet.h"
70 #include "nlists.h"
71 #include "stringt.h"
72 #include "uintp.h"
73 #include "fe.h"
74 #include "sinfo.h"
75 #include "einfo.h"
76 #include "ada-tree.h"
77 #include "gigi.h"
78 #include "adadecode.h"
79 #include "opts.h"
80 #include "options.h"
81
82 extern FILE *asm_out_file;
83
84 /* The largest alignment, in bits, that is needed for using the widest
85    move instruction.  */
86 unsigned int largest_move_alignment;
87
88 static bool gnat_init                   (void);
89 static void gnat_finish_incomplete_decl (tree);
90 static unsigned int gnat_init_options   (unsigned int, const char **);
91 static int gnat_handle_option           (size_t, const char *, int);
92 static bool gnat_post_options           (const char **);
93 static HOST_WIDE_INT gnat_get_alias_set (tree);
94 static void gnat_print_decl             (FILE *, tree, int);
95 static void gnat_print_type             (FILE *, tree, int);
96 static const char *gnat_printable_name  (tree, int);
97 static const char *gnat_dwarf_name      (tree, int);
98 static tree gnat_eh_runtime_type        (tree);
99 static int gnat_eh_type_covers          (tree, tree);
100 static void gnat_parse_file             (int);
101 static rtx gnat_expand_expr             (tree, rtx, enum machine_mode, int,
102                                          rtx *);
103 static void gnat_expand_body            (tree);
104 static void internal_error_function     (const char *, va_list *);
105 static void gnat_adjust_rli             (record_layout_info);
106 static tree gnat_type_max_size          (tree);
107
108 /* Definitions for our language-specific hooks.  */
109
110 #undef  LANG_HOOKS_NAME
111 #define LANG_HOOKS_NAME                 "GNU Ada"
112 #undef  LANG_HOOKS_IDENTIFIER_SIZE
113 #define LANG_HOOKS_IDENTIFIER_SIZE      sizeof (struct tree_identifier)
114 #undef  LANG_HOOKS_INIT
115 #define LANG_HOOKS_INIT                 gnat_init
116 #undef  LANG_HOOKS_INIT_OPTIONS
117 #define LANG_HOOKS_INIT_OPTIONS         gnat_init_options
118 #undef  LANG_HOOKS_HANDLE_OPTION
119 #define LANG_HOOKS_HANDLE_OPTION        gnat_handle_option
120 #undef  LANG_HOOKS_POST_OPTIONS
121 #define LANG_HOOKS_POST_OPTIONS         gnat_post_options
122 #undef  LANG_HOOKS_PARSE_FILE
123 #define LANG_HOOKS_PARSE_FILE           gnat_parse_file
124 #undef  LANG_HOOKS_HASH_TYPES
125 #define LANG_HOOKS_HASH_TYPES           false
126 #undef  LANG_HOOKS_GETDECLS
127 #define LANG_HOOKS_GETDECLS             lhd_return_null_tree_v
128 #undef  LANG_HOOKS_PUSHDECL
129 #define LANG_HOOKS_PUSHDECL             lhd_return_tree
130 #undef  LANG_HOOKS_WRITE_GLOBALS
131 #define LANG_HOOKS_WRITE_GLOBALS      gnat_write_global_declarations
132 #undef  LANG_HOOKS_FINISH_INCOMPLETE_DECL
133 #define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl
134 #undef  LANG_HOOKS_REDUCE_BIT_FIELD_OPERATIONS
135 #define LANG_HOOKS_REDUCE_BIT_FIELD_OPERATIONS true
136 #undef  LANG_HOOKS_GET_ALIAS_SET
137 #define LANG_HOOKS_GET_ALIAS_SET        gnat_get_alias_set
138 #undef  LANG_HOOKS_EXPAND_EXPR
139 #define LANG_HOOKS_EXPAND_EXPR          gnat_expand_expr
140 #undef  LANG_HOOKS_MARK_ADDRESSABLE
141 #define LANG_HOOKS_MARK_ADDRESSABLE     gnat_mark_addressable
142 #undef  LANG_HOOKS_PRINT_DECL
143 #define LANG_HOOKS_PRINT_DECL           gnat_print_decl
144 #undef  LANG_HOOKS_PRINT_TYPE
145 #define LANG_HOOKS_PRINT_TYPE           gnat_print_type
146 #undef  LANG_HOOKS_TYPE_MAX_SIZE
147 #define LANG_HOOKS_TYPE_MAX_SIZE        gnat_type_max_size
148 #undef  LANG_HOOKS_DECL_PRINTABLE_NAME
149 #define LANG_HOOKS_DECL_PRINTABLE_NAME  gnat_printable_name
150 #undef  LANG_HOOKS_DWARF_NAME
151 #define LANG_HOOKS_DWARF_NAME           gnat_dwarf_name
152 #undef  LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
153 #define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gnat_expand_body
154 #undef  LANG_HOOKS_GIMPLIFY_EXPR
155 #define LANG_HOOKS_GIMPLIFY_EXPR        gnat_gimplify_expr
156 #undef  LANG_HOOKS_TYPE_FOR_MODE
157 #define LANG_HOOKS_TYPE_FOR_MODE        gnat_type_for_mode
158 #undef  LANG_HOOKS_TYPE_FOR_SIZE
159 #define LANG_HOOKS_TYPE_FOR_SIZE        gnat_type_for_size
160 #undef  LANG_HOOKS_SIGNED_TYPE
161 #define LANG_HOOKS_SIGNED_TYPE          gnat_signed_type
162 #undef  LANG_HOOKS_ATTRIBUTE_TABLE
163 #define LANG_HOOKS_ATTRIBUTE_TABLE      gnat_internal_attribute_table
164 #undef  LANG_HOOKS_BUILTIN_FUNCTION
165 #define LANG_HOOKS_BUILTIN_FUNCTION        gnat_builtin_function
166
167 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
168
169 /* Tables describing GCC tree codes used only by GNAT.
170
171    Table indexed by tree code giving a string containing a character
172    classifying the tree code.  Possibilities are
173    t, d, s, c, r, <, 1 and 2.  See cp-tree.def for details.  */
174
175 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
176
177 const enum tree_code_class tree_code_type[] = {
178 #include "tree.def"
179   tcc_exceptional,
180 #include "ada-tree.def"
181 };
182 #undef DEFTREECODE
183
184 /* Table indexed by tree code giving number of expression
185    operands beyond the fixed part of the node structure.
186    Not used for types or decls.  */
187
188 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
189
190 const unsigned char tree_code_length[] = {
191 #include "tree.def"
192   0,
193 #include "ada-tree.def"
194 };
195 #undef DEFTREECODE
196
197 /* Names of tree components.
198    Used for printing out the tree and error messages.  */
199 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
200
201 const char *const tree_code_name[] = {
202 #include "tree.def"
203   "@@dummy",
204 #include "ada-tree.def"
205 };
206 #undef DEFTREECODE
207
208 /* Command-line argc and argv.
209    These variables are global, since they are imported and used in
210    back_end.adb  */
211
212 unsigned int save_argc;
213 const char **save_argv;
214
215 /* gnat standard argc argv */
216
217 extern int gnat_argc;
218 extern char **gnat_argv;
219
220 \f
221 /* Declare functions we use as part of startup.  */
222 extern void __gnat_initialize           (void *);
223 extern void __gnat_install_SEH_handler  (void *);
224 extern void adainit                     (void);
225 extern void _ada_gnat1drv               (void);
226
227 /* The parser for the language.  For us, we process the GNAT tree.  */
228
229 static void
230 gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
231 {
232   int seh[2];
233
234   /* Call the target specific initializations.  */
235   __gnat_initialize (NULL);
236
237   /* ??? Call the SEH initialization routine.  This is to workaround
238   a bootstrap path problem.  The call below should be removed at some
239   point and the SEH pointer passed to __gnat_initialize() above.  */
240   __gnat_install_SEH_handler((void *)seh);
241
242   /* Call the front-end elaboration procedures.  */
243   adainit ();
244
245   /* Call the front end.  */
246   _ada_gnat1drv ();
247
248   /* We always have a single compilation unit in Ada.  */
249   cgraph_finalize_compilation_unit ();
250 }
251
252 /* Decode all the language specific options that cannot be decoded by GCC.
253    The option decoding phase of GCC calls this routine on the flags that
254    it cannot decode.  This routine returns the number of consecutive arguments
255    from ARGV that it successfully decoded; 0 indicates failure.  */
256
257 static int
258 gnat_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED)
259 {
260   const struct cl_option *option = &cl_options[scode];
261   enum opt_code code = (enum opt_code) scode;
262   char *q;
263
264   if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE)))
265     {
266       error ("missing argument to \"-%s\"", option->opt_text);
267       return 1;
268     }
269
270   switch (code)
271     {
272     default:
273       abort ();
274
275     case OPT_I:
276       q = xmalloc (sizeof("-I") + strlen (arg));
277       strcpy (q, "-I");
278       strcat (q, arg);
279       gnat_argv[gnat_argc] = q;
280       gnat_argc++;
281       break;
282
283       /* All front ends are expected to accept this.  */
284     case OPT_Wall:
285       /* These are used in the GCC Makefile.  */
286     case OPT_Wmissing_prototypes:
287     case OPT_Wstrict_prototypes:
288     case OPT_Wwrite_strings:
289     case OPT_Wlong_long:
290     case OPT_Wvariadic_macros:
291     case OPT_Wold_style_definition:
292     case OPT_Wmissing_format_attribute:
293     case OPT_Woverlength_strings:
294       break;
295
296       /* This is handled by the front-end.  */
297     case OPT_nostdinc:
298       break;
299
300     case OPT_nostdlib:
301       gnat_argv[gnat_argc] = xstrdup ("-nostdlib");
302       gnat_argc++;
303       break;
304
305     case OPT_fRTS_:
306       gnat_argv[gnat_argc] = xstrdup ("-fRTS");
307       gnat_argc++;
308       break;
309
310     case OPT_gant:
311       warning (0, "%<-gnat%> misspelled as %<-gant%>");
312
313       /* ... fall through ... */
314
315     case OPT_gnat:
316       /* Recopy the switches without the 'gnat' prefix.  */
317       gnat_argv[gnat_argc] = xmalloc (strlen (arg) + 2);
318       gnat_argv[gnat_argc][0] = '-';
319       strcpy (gnat_argv[gnat_argc] + 1, arg);
320       gnat_argc++;
321       break;
322
323     case OPT_gnatO:
324       gnat_argv[gnat_argc] = xstrdup ("-O");
325       gnat_argc++;
326       gnat_argv[gnat_argc] = xstrdup (arg);
327       gnat_argc++;
328       break;
329     }
330
331   return 1;
332 }
333
334 /* Initialize for option processing.  */
335
336 static unsigned int
337 gnat_init_options (unsigned int argc, const char **argv)
338 {
339   /* Initialize gnat_argv with save_argv size.  */
340   gnat_argv = (char **) xmalloc ((argc + 1) * sizeof (argv[0]));
341   gnat_argv[0] = xstrdup (argv[0]);     /* name of the command */
342   gnat_argc = 1;
343
344   save_argc = argc;
345   save_argv = argv;
346
347   /* Uninitialized really means uninitialized in Ada.  */
348   flag_zero_initialized_in_bss = 0;
349
350   return CL_Ada;
351 }
352
353 /* Post-switch processing.  */
354
355 bool
356 gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
357 {
358   flag_inline_trees = 1;
359
360   if (!flag_no_inline)
361     flag_no_inline = 1;
362   if (flag_inline_functions)
363     flag_inline_trees = 2;
364
365   /* The structural alias analysis machinery essentially assumes that
366      everything is addressable (modulo bit-fields) by disregarding
367      the TYPE_NONALIASED_COMPONENT and DECL_NONADDRESSABLE_P macros.  */
368   flag_tree_salias = 0;
369
370   return false;
371 }
372
373 /* Here is the function to handle the compiler error processing in GCC.  */
374
375 static void
376 internal_error_function (const char *msgid, va_list *ap)
377 {
378   text_info tinfo;
379   char *buffer, *p, *loc;
380   String_Template temp, temp_loc;
381   Fat_Pointer fp, fp_loc;
382   expanded_location s;
383
384   /* Reset the pretty-printer.  */
385   pp_clear_output_area (global_dc->printer);
386
387   /* Format the message into the pretty-printer.  */
388   tinfo.format_spec = msgid;
389   tinfo.args_ptr = ap;
390   tinfo.err_no = errno;
391   pp_format_verbatim (global_dc->printer, &tinfo);
392
393   /* Extract a (writable) pointer to the formatted text.  */
394   buffer = (char*) pp_formatted_text (global_dc->printer);
395
396   /* Go up to the first newline.  */
397   for (p = buffer; *p; p++)
398     if (*p == '\n')
399       {
400         *p = '\0';
401         break;
402       }
403
404   temp.Low_Bound = 1;
405   temp.High_Bound = p - buffer;
406   fp.Bounds = &temp;
407   fp.Array = buffer;
408
409   s = expand_location (input_location);
410 #ifdef USE_MAPPED_LOCATION
411   if (flag_show_column && s.column != 0)
412     asprintf (&loc, "%s:%d:%d", s.file, s.line, s.column);
413   else
414 #endif
415     asprintf (&loc, "%s:%d", s.file, s.line);
416   temp_loc.Low_Bound = 1;
417   temp_loc.High_Bound = strlen (loc);
418   fp_loc.Bounds = &temp_loc;
419   fp_loc.Array = loc;
420
421   Current_Error_Node = error_gnat_node;
422   Compiler_Abort (fp, -1, fp_loc);
423 }
424
425 /* Perform all the initialization steps that are language-specific.  */
426
427 static bool
428 gnat_init (void)
429 {
430   /* Initialize translations and the outer statement group.  */
431   gnat_init_stmt_group ();
432
433   /* Performs whatever initialization steps needed by the language-dependent
434      lexical analyzer.  */
435   gnat_init_decl_processing ();
436
437   /* Add the input filename as the last argument.  */
438   gnat_argv[gnat_argc] = (char *) main_input_filename;
439   gnat_argc++;
440   gnat_argv[gnat_argc] = 0;
441
442   global_dc->internal_error = &internal_error_function;
443
444   /* Show that REFERENCE_TYPEs are internal and should be Pmode.  */
445   internal_reference_types ();
446
447   set_lang_adjust_rli (gnat_adjust_rli);
448
449   return true;
450 }
451
452 /* This function is called indirectly from toplev.c to handle incomplete
453    declarations, i.e. VAR_DECL nodes whose DECL_SIZE is zero.  To be precise,
454    compile_file in toplev.c makes an indirect call through the function pointer
455    incomplete_decl_finalize_hook which is initialized to this routine in
456    init_decl_processing.  */
457
458 static void
459 gnat_finish_incomplete_decl (tree dont_care ATTRIBUTE_UNUSED)
460 {
461   abort ();
462 }
463 \f
464 /* Compute the alignment of the largest mode that can be used for copying
465    objects.  */
466
467 void
468 gnat_compute_largest_alignment (void)
469 {
470   enum machine_mode mode;
471
472   for (mode = GET_CLASS_NARROWEST_MODE (MODE_INT); mode != VOIDmode;
473        mode = GET_MODE_WIDER_MODE (mode))
474     if (mov_optab->handlers[(int) mode].insn_code != CODE_FOR_nothing)
475       largest_move_alignment = MIN (BIGGEST_ALIGNMENT,
476                                     MAX (largest_move_alignment,
477                                          GET_MODE_ALIGNMENT (mode)));
478 }
479
480 /* If we are using the GCC mechanism to process exception handling, we
481    have to register the personality routine for Ada and to initialize
482    various language dependent hooks.  */
483
484 void
485 gnat_init_gcc_eh (void)
486 {
487   /* We shouldn't do anything if the No_Exceptions_Handler pragma is set,
488      though. This could for instance lead to the emission of tables with
489      references to symbols (such as the Ada eh personality routine) within
490      libraries we won't link against.  */
491   if (No_Exception_Handlers_Set ())
492     return;
493
494   /* Tell GCC we are handling cleanup actions through exception propagation.
495      This opens possibilities that we don't take advantage of yet, but is
496      nonetheless necessary to ensure that fixup code gets assigned to the
497      right exception regions.  */
498   using_eh_for_cleanups ();
499
500   eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality");
501   lang_eh_type_covers = gnat_eh_type_covers;
502   lang_eh_runtime_type = gnat_eh_runtime_type;
503   default_init_unwind_resume_libfunc ();
504
505   /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers
506      the generation of the necessary exception runtime tables. The second one
507      is useful for two reasons: 1/ we map some asynchronous signals like SEGV
508      to exceptions, so we need to ensure that the insns which can lead to such
509      signals are correctly attached to the exception region they pertain to,
510      2/ Some calls to pure subprograms are handled as libcall blocks and then
511      marked as "cannot trap" if the flag is not set (see emit_libcall_block).
512      We should not let this be since it is possible for such calls to actually
513      raise in Ada.  */
514
515   flag_exceptions = 1;
516   flag_non_call_exceptions = 1;
517
518   init_eh ();
519 #ifdef DWARF2_UNWIND_INFO
520   if (dwarf2out_do_frame ())
521     dwarf2out_frame_init ();
522 #endif
523 }
524
525 /* Language hooks, first one to print language-specific items in a DECL.  */
526
527 static void
528 gnat_print_decl (FILE *file, tree node, int indent)
529 {
530   switch (TREE_CODE (node))
531     {
532     case CONST_DECL:
533       print_node (file, "const_corresponding_var",
534                   DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
535       break;
536
537     case FIELD_DECL:
538       print_node (file, "original_field", DECL_ORIGINAL_FIELD (node),
539                   indent + 4);
540       break;
541
542     case VAR_DECL:
543       print_node (file, "renamed_object", DECL_RENAMED_OBJECT (node),
544                   indent + 4);
545       break;
546
547     default:
548       break;
549     }
550 }
551
552 static void
553 gnat_print_type (FILE *file, tree node, int indent)
554 {
555   switch (TREE_CODE (node))
556     {
557     case FUNCTION_TYPE:
558       print_node (file, "ci_co_list", TYPE_CI_CO_LIST (node), indent + 4);
559       break;
560
561     case ENUMERAL_TYPE:
562       print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
563       break;
564
565     case INTEGER_TYPE:
566       if (TYPE_MODULAR_P (node))
567         print_node (file, "modulus", TYPE_MODULUS (node), indent + 4);
568       else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
569         print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
570                     indent + 4);
571       else if (TYPE_VAX_FLOATING_POINT_P (node))
572         ;
573       else
574         print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
575
576       print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
577       break;
578
579     case ARRAY_TYPE:
580       print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
581       break;
582
583     case RECORD_TYPE:
584       if (TYPE_IS_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
585         print_node (file, "unconstrained array",
586                     TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
587       else
588         print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
589       break;
590
591     case UNION_TYPE:
592     case QUAL_UNION_TYPE:
593       print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
594       break;
595
596     default:
597       break;
598     }
599 }
600
601 static const char *
602 gnat_printable_name (tree decl, int verbosity)
603 {
604   const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
605   char *ada_name = (char *) ggc_alloc (strlen (coded_name) * 2 + 60);
606
607   __gnat_decode (coded_name, ada_name, 0);
608
609   if (verbosity == 2)
610     {
611       Set_Identifier_Casing (ada_name, (char *) DECL_SOURCE_FILE (decl));
612       ada_name = Name_Buffer;
613     }
614
615   return (const char *) ada_name;
616 }
617
618 static const char *
619 gnat_dwarf_name (tree t, int verbosity ATTRIBUTE_UNUSED)
620 {
621   gcc_assert (DECL_P (t));
622
623   return (const char *) IDENTIFIER_POINTER (DECL_NAME (t));
624 }
625
626 /* Expands GNAT-specific GCC tree nodes.  The only ones we support
627    here are  and NULL_EXPR.  */
628
629 static rtx
630 gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode,
631                   int modifier, rtx *alt_rtl)
632 {
633   tree type = TREE_TYPE (exp);
634   tree new;
635
636   /* If this is a statement, call the expansion routine for statements.  */
637   if (IS_STMT (exp))
638     {
639       gnat_expand_stmt (exp);
640       return const0_rtx;
641     }
642
643   /* Update EXP to be the new expression to expand.  */
644   switch (TREE_CODE (exp))
645     {
646 #if 0
647     case ALLOCATE_EXPR:
648       return
649         allocate_dynamic_stack_space
650           (expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype),
651                         EXPAND_NORMAL),
652            NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1));
653 #endif
654
655     case UNCONSTRAINED_ARRAY_REF:
656       /* If we are evaluating just for side-effects, just evaluate our
657          operand.  Otherwise, abort since this code should never appear
658          in a tree to be evaluated (objects aren't unconstrained).  */
659       if (target == const0_rtx || TREE_CODE (type) == VOID_TYPE)
660         return expand_expr (TREE_OPERAND (exp, 0), const0_rtx,
661                             VOIDmode, modifier);
662
663       /* ... fall through ... */
664
665     default:
666       abort ();
667     }
668
669   return expand_expr_real (new, target, tmode, modifier, alt_rtl);
670 }
671
672 /* Generate the RTL for the body of GNU_DECL.  */
673
674 static void
675 gnat_expand_body (tree gnu_decl)
676 {
677   tree_rest_of_compilation (gnu_decl);
678 }
679
680 /* Adjusts the RLI used to layout a record after all the fields have been
681    added.  We only handle the packed case and cause it to use the alignment
682    that will pad the record at the end.  */
683
684 static void
685 gnat_adjust_rli (record_layout_info rli ATTRIBUTE_UNUSED)
686 {
687 #if 0
688   /* ??? This code seems to have no actual effect; record_align should already
689      reflect the largest alignment desired by a field.  jason 2003-04-01  */
690   unsigned int record_align = rli->unpadded_align;
691   tree field;
692
693   /* If an alignment has been specified, don't use anything larger unless we
694      have to.  */
695   if (TYPE_ALIGN (rli->t) != 0 && TYPE_ALIGN (rli->t) < record_align)
696     record_align = MAX (rli->record_align, TYPE_ALIGN (rli->t));
697
698   /* If any fields have variable size, we need to force the record to be at
699      least as aligned as the alignment of that type.  */
700   for (field = TYPE_FIELDS (rli->t); field; field = TREE_CHAIN (field))
701     if (TREE_CODE (DECL_SIZE_UNIT (field)) != INTEGER_CST)
702       record_align = MAX (record_align, DECL_ALIGN (field));
703
704   if (TYPE_PACKED (rli->t))
705     rli->record_align = record_align;
706 #endif
707 }
708 \f
709 /* These routines are used in conjunction with GCC exception handling.  */
710
711 /* Map compile-time to run-time tree for GCC exception handling scheme.  */
712
713 static tree
714 gnat_eh_runtime_type (tree type)
715 {
716   return type;
717 }
718
719 /* Return true if type A catches type B. Callback for flow analysis from
720    the exception handling part of the back-end.  */
721
722 static int
723 gnat_eh_type_covers (tree a, tree b)
724 {
725   /* a catches b if they represent the same exception id or if a
726      is an "others".
727
728      ??? integer_zero_node for "others" is hardwired in too many places
729      currently.  */
730   return (a == b || a == integer_zero_node);
731 }
732 \f
733 /* Get the alias set corresponding to a type or expression.  */
734
735 static HOST_WIDE_INT
736 gnat_get_alias_set (tree type)
737 {
738   /* If this is a padding type, use the type of the first field.  */
739   if (TREE_CODE (type) == RECORD_TYPE
740       && TYPE_IS_PADDING_P (type))
741     return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
742
743   /* If the type is an unconstrained array, use the type of the
744      self-referential array we make.  */
745   else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
746     return
747       get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
748
749
750   return -1;
751 }
752
753 /* GNU_TYPE is a type.  Return its maximum size in bytes, if known,
754    as a constant when possible.  */
755
756 static tree
757 gnat_type_max_size (tree gnu_type)
758 {
759   /* First see what we can get from TYPE_SIZE_UNIT, which might not
760      be constant even for simple expressions if it has already been
761      elaborated and possibly replaced by a VAR_DECL.  */
762   tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true);
763
764   /* If we don't have a constant, see what we can get from TYPE_ADA_SIZE,
765      which should stay untouched.  */
766   if (!host_integerp (max_unitsize, 1)
767       && (TREE_CODE (gnu_type) == RECORD_TYPE
768           || TREE_CODE (gnu_type) == UNION_TYPE
769           || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
770       && TYPE_ADA_SIZE (gnu_type))
771     {
772       tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
773
774       /* If we have succeeded in finding a constant, round it up to the
775          type's alignment and return the result in units.  */
776       if (host_integerp (max_adasize, 1))
777         max_unitsize
778           = size_binop (CEIL_DIV_EXPR,
779                         round_up (max_adasize, TYPE_ALIGN (gnu_type)),
780                         bitsize_unit_node);
781     }
782
783   return max_unitsize;
784 }
785
786 /* GNU_TYPE is a type. Determine if it should be passed by reference by
787    default.  */
788
789 bool
790 default_pass_by_ref (tree gnu_type)
791 {
792   /* We pass aggregates by reference if they are sufficiently large.  The
793      choice of constant here is somewhat arbitrary.  We also pass by
794      reference if the target machine would either pass or return by
795      reference.  Strictly speaking, we need only check the return if this
796      is an In Out parameter, but it's probably best to err on the side of
797      passing more things by reference.  */
798
799   if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, 1))
800     return true;
801
802   if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
803     return true;
804
805   if (AGGREGATE_TYPE_P (gnu_type)
806       && (!host_integerp (TYPE_SIZE (gnu_type), 1)
807           || 0 < compare_tree_int (TYPE_SIZE (gnu_type),
808                                    8 * TYPE_ALIGN (gnu_type))))
809     return true;
810
811   return false;
812 }
813
814 /* GNU_TYPE is the type of a subprogram parameter.  Determine from the type if
815    it should be passed by reference. */
816
817 bool
818 must_pass_by_ref (tree gnu_type)
819 {
820   /* We pass only unconstrained objects, those required by the language
821      to be passed by reference, and objects of variable size.  The latter
822      is more efficient, avoids problems with variable size temporaries,
823      and does not produce compatibility problems with C, since C does
824      not have such objects.  */
825   return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
826           || (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
827           || (TYPE_SIZE (gnu_type)
828               && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
829 }
830
831 /* This function is called by the front end to enumerate all the supported
832    modes for the machine.  We pass a function which is called back with
833    the following integer parameters:
834
835    FLOAT_P      nonzero if this represents a floating-point mode
836    COMPLEX_P    nonzero is this represents a complex mode
837    COUNT        count of number of items, nonzero for vector mode
838    PRECISION    number of bits in data representation
839    MANTISSA     number of bits in mantissa, if FP and known, else zero.
840    SIZE         number of bits used to store data
841    ALIGN        number of bits to which mode is aligned.  */
842
843 void
844 enumerate_modes (void (*f) (int, int, int, int, int, int, unsigned int))
845 {
846   enum machine_mode i;
847
848   for (i = 0; i < NUM_MACHINE_MODES; i++)
849     {
850       enum machine_mode j;
851       bool float_p = 0;
852       bool complex_p = 0;
853       bool vector_p = 0;
854       bool skip_p = 0;
855       int mantissa = 0;
856       enum machine_mode inner_mode = i;
857
858       switch (GET_MODE_CLASS (i))
859         {
860         case MODE_INT:
861           break;
862         case MODE_FLOAT:
863           float_p = 1;
864           break;
865         case MODE_COMPLEX_INT:
866           complex_p = 1;
867           inner_mode = GET_MODE_INNER (i);
868           break;
869         case MODE_COMPLEX_FLOAT:
870           float_p = 1;
871           complex_p = 1;
872           inner_mode = GET_MODE_INNER (i);
873           break;
874         case MODE_VECTOR_INT:
875           vector_p = 1;
876           inner_mode = GET_MODE_INNER (i);
877           break;
878         case MODE_VECTOR_FLOAT:
879           float_p = 1;
880           vector_p = 1;
881           inner_mode = GET_MODE_INNER (i);
882           break;
883         default:
884           skip_p = 1;
885         }
886
887       /* Skip this mode if it's one the front end doesn't need to know about
888          (e.g., the CC modes) or if there is no add insn for that mode (or
889          any wider mode), meaning it is not supported by the hardware.  If
890          this a complex or vector mode, we care about the inner mode.  */
891       for (j = inner_mode; j != VOIDmode; j = GET_MODE_WIDER_MODE (j))
892         if (add_optab->handlers[j].insn_code != CODE_FOR_nothing)
893           break;
894
895       if (float_p)
896         {
897           const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode);
898
899           mantissa = fmt->p;
900         }
901
902       if (!skip_p && j != VOIDmode)
903         (*f) (float_p, complex_p, vector_p ? GET_MODE_NUNITS (i) : 0,
904               GET_MODE_BITSIZE (i), mantissa,
905               GET_MODE_SIZE (i) * BITS_PER_UNIT, GET_MODE_ALIGNMENT (i));
906     }
907 }
908
909 int
910 fp_prec_to_size (int prec)
911 {
912   enum machine_mode mode;
913
914   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
915        mode = GET_MODE_WIDER_MODE (mode))
916     if (GET_MODE_PRECISION (mode) == prec)
917       return GET_MODE_BITSIZE (mode);
918
919   abort ();
920 }
921
922 int
923 fp_size_to_prec (int size)
924 {
925   enum machine_mode mode;
926
927   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
928        mode = GET_MODE_WIDER_MODE (mode))
929     if (GET_MODE_BITSIZE (mode) == size)
930       return GET_MODE_PRECISION (mode);
931
932   abort ();
933 }