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-2007, 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 alias_set_type 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_return_tree            (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 internal_error_function     (const char *, va_list *);
 104 static tree gnat_type_max_size          (const_tree);
 105
 106 /* Definitions for our language-specific hooks.  */
 107
 108 #undef  LANG_HOOKS_NAME
 109 #define LANG_HOOKS_NAME                 "GNU Ada"
 110 #undef  LANG_HOOKS_IDENTIFIER_SIZE
 111 #define LANG_HOOKS_IDENTIFIER_SIZE      sizeof (struct tree_identifier)
 112 #undef  LANG_HOOKS_INIT
 113 #define LANG_HOOKS_INIT                 gnat_init
 114 #undef  LANG_HOOKS_INIT_OPTIONS
 115 #define LANG_HOOKS_INIT_OPTIONS         gnat_init_options
 116 #undef  LANG_HOOKS_HANDLE_OPTION
 117 #define LANG_HOOKS_HANDLE_OPTION        gnat_handle_option
 118 #undef  LANG_HOOKS_POST_OPTIONS
 119 #define LANG_HOOKS_POST_OPTIONS         gnat_post_options
 120 #undef  LANG_HOOKS_PARSE_FILE
 121 #define LANG_HOOKS_PARSE_FILE           gnat_parse_file
 122 #undef  LANG_HOOKS_HASH_TYPES
 123 #define LANG_HOOKS_HASH_TYPES           false
 124 #undef  LANG_HOOKS_GETDECLS
 125 #define LANG_HOOKS_GETDECLS             lhd_return_null_tree_v
 126 #undef  LANG_HOOKS_PUSHDECL
 127 #define LANG_HOOKS_PUSHDECL             gnat_return_tree
 128 #undef  LANG_HOOKS_WRITE_GLOBALS
 129 #define LANG_HOOKS_WRITE_GLOBALS      gnat_write_global_declarations
 130 #undef  LANG_HOOKS_FINISH_INCOMPLETE_DECL
 131 #define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl
 132 #undef  LANG_HOOKS_REDUCE_BIT_FIELD_OPERATIONS
 133 #define LANG_HOOKS_REDUCE_BIT_FIELD_OPERATIONS true
 134 #undef  LANG_HOOKS_GET_ALIAS_SET
 135 #define LANG_HOOKS_GET_ALIAS_SET        gnat_get_alias_set
 136 #undef  LANG_HOOKS_EXPAND_EXPR
 137 #define LANG_HOOKS_EXPAND_EXPR          gnat_expand_expr
 138 #undef  LANG_HOOKS_MARK_ADDRESSABLE
 139 #define LANG_HOOKS_MARK_ADDRESSABLE     gnat_mark_addressable
 140 #undef  LANG_HOOKS_PRINT_DECL
 141 #define LANG_HOOKS_PRINT_DECL           gnat_print_decl
 142 #undef  LANG_HOOKS_PRINT_TYPE
 143 #define LANG_HOOKS_PRINT_TYPE           gnat_print_type
 144 #undef  LANG_HOOKS_TYPE_MAX_SIZE
 145 #define LANG_HOOKS_TYPE_MAX_SIZE        gnat_type_max_size
 146 #undef  LANG_HOOKS_DECL_PRINTABLE_NAME
 147 #define LANG_HOOKS_DECL_PRINTABLE_NAME  gnat_printable_name
 148 #undef  LANG_HOOKS_DWARF_NAME
 149 #define LANG_HOOKS_DWARF_NAME           gnat_dwarf_name
 150 #undef  LANG_HOOKS_GIMPLIFY_EXPR
 151 #define LANG_HOOKS_GIMPLIFY_EXPR        gnat_gimplify_expr
 152 #undef  LANG_HOOKS_TYPE_FOR_MODE
 153 #define LANG_HOOKS_TYPE_FOR_MODE        gnat_type_for_mode
 154 #undef  LANG_HOOKS_TYPE_FOR_SIZE
 155 #define LANG_HOOKS_TYPE_FOR_SIZE        gnat_type_for_size
 156 #undef  LANG_HOOKS_ATTRIBUTE_TABLE
 157 #define LANG_HOOKS_ATTRIBUTE_TABLE      gnat_internal_attribute_table
 158 #undef  LANG_HOOKS_BUILTIN_FUNCTION
 159 #define LANG_HOOKS_BUILTIN_FUNCTION        gnat_builtin_function
 160
 161 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 162
 163 /* Tables describing GCC tree codes used only by GNAT.
 164
 165    Table indexed by tree code giving a string containing a character
 166    classifying the tree code.  Possibilities are
 167    t, d, s, c, r, <, 1 and 2.  See cp-tree.def for details.  */
 168
 169 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
 170
 171 const enum tree_code_class tree_code_type[] = {
 172 #include "tree.def"
 173   tcc_exceptional,
 174 #include "ada-tree.def"
 175 };
 176 #undef DEFTREECODE
 177
 178 /* Table indexed by tree code giving number of expression
 179    operands beyond the fixed part of the node structure.
 180    Not used for types or decls.  */
 181
 182 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
 183
 184 const unsigned char tree_code_length[] = {
 185 #include "tree.def"
 186   0,
 187 #include "ada-tree.def"
 188 };
 189 #undef DEFTREECODE
 190
 191 /* Names of tree components.
 192    Used for printing out the tree and error messages.  */
 193 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
 194
 195 const char *const tree_code_name[] = {
 196 #include "tree.def"
 197   "@@dummy",
 198 #include "ada-tree.def"
 199 };
 200 #undef DEFTREECODE
 201
 202 /* Command-line argc and argv.
 203    These variables are global, since they are imported and used in
 204    back_end.adb  */
 205
 206 unsigned int save_argc;
 207 const char **save_argv;
 208
 209 /* gnat standard argc argv */
 210
 211 extern int gnat_argc;
 212 extern char **gnat_argv;
 213
 214 \f
 215 /* Declare functions we use as part of startup.  */
 216 extern void __gnat_initialize           (void *);
 217 extern void __gnat_install_SEH_handler  (void *);
 218 extern void adainit                     (void);
 219 extern void _ada_gnat1drv               (void);
 220
 221 /* The parser for the language.  For us, we process the GNAT tree.  */
 222
 223 static void
 224 gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
 225 {
 226   int seh[2];
 227
 228   /* Call the target specific initializations.  */
 229   __gnat_initialize (NULL);
 230
 231   /* ??? Call the SEH initialization routine.  This is to workaround
 232   a bootstrap path problem.  The call below should be removed at some
 233   point and the SEH pointer passed to __gnat_initialize() above.  */
 234   __gnat_install_SEH_handler((void *)seh);
 235
 236   /* Call the front-end elaboration procedures.  */
 237   adainit ();
 238
 239   /* Call the front end.  */
 240   _ada_gnat1drv ();
 241
 242   /* We always have a single compilation unit in Ada.  */
 243   cgraph_finalize_compilation_unit ();
 244 }
 245
 246 /* Decode all the language specific options that cannot be decoded by GCC.
 247    The option decoding phase of GCC calls this routine on the flags that
 248    it cannot decode.  This routine returns the number of consecutive arguments
 249    from ARGV that it successfully decoded; 0 indicates failure.  */
 250
 251 static int
 252 gnat_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED)
 253 {
 254   const struct cl_option *option = &cl_options[scode];
 255   enum opt_code code = (enum opt_code) scode;
 256   char *q;
 257
 258   if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE)))
 259     {
 260       error ("missing argument to \"-%s\"", option->opt_text);
 261       return 1;
 262     }
 263
 264   switch (code)
 265     {
 266     case OPT_I:
 267       q = xmalloc (sizeof("-I") + strlen (arg));
 268       strcpy (q, "-I");
 269       strcat (q, arg);
 270       gnat_argv[gnat_argc] = q;
 271       gnat_argc++;
 272       break;
 273
 274       /* All front ends are expected to accept this.  */
 275     case OPT_Wall:
 276       /* These are used in the GCC Makefile.  */
 277     case OPT_Wmissing_prototypes:
 278     case OPT_Wstrict_prototypes:
 279     case OPT_Wwrite_strings:
 280     case OPT_Wlong_long:
 281     case OPT_Wvariadic_macros:
 282     case OPT_Wold_style_definition:
 283     case OPT_Wmissing_format_attribute:
 284     case OPT_Woverlength_strings:
 285       break;
 286
 287       /* This is handled by the front-end.  */
 288     case OPT_nostdinc:
 289       break;
 290
 291     case OPT_nostdlib:
 292       gnat_argv[gnat_argc] = xstrdup ("-nostdlib");
 293       gnat_argc++;
 294       break;
 295
 296     case OPT_feliminate_unused_debug_types:
 297       /* We arrange for post_option to be able to only set the corresponding
 298          flag to 1 when explicitely requested by the user.  We expect the
 299          default flag value to be either 0 or positive, and expose a positive
 300          -f as a negative value to post_option.  */
 301       flag_eliminate_unused_debug_types = -value;
 302       break;
 303
 304     case OPT_fRTS_:
 305       gnat_argv[gnat_argc] = xstrdup ("-fRTS");
 306       gnat_argc++;
 307       break;
 308
 309     case OPT_gant:
 310       warning (0, "%<-gnat%> misspelled as %<-gant%>");
 311
 312       /* ... fall through ... */
 313
 314     case OPT_gnat:
 315       /* Recopy the switches without the 'gnat' prefix.  */
 316       gnat_argv[gnat_argc] = xmalloc (strlen (arg) + 2);
 317       gnat_argv[gnat_argc][0] = '-';
 318       strcpy (gnat_argv[gnat_argc] + 1, arg);
 319       gnat_argc++;
 320       break;
 321
 322     case OPT_gnatO:
 323       gnat_argv[gnat_argc] = xstrdup ("-O");
 324       gnat_argc++;
 325       gnat_argv[gnat_argc] = xstrdup (arg);
 326       gnat_argc++;
 327       break;
 328
 329     default:
 330       gcc_unreachable ();
 331     }
 332
 333   return 1;
 334 }
 335
 336 /* Initialize for option processing.  */
 337
 338 static unsigned int
 339 gnat_init_options (unsigned int argc, const char **argv)
 340 {
 341   /* Initialize gnat_argv with save_argv size.  */
 342   gnat_argv = (char **) xmalloc ((argc + 1) * sizeof (argv[0]));
 343   gnat_argv[0] = xstrdup (argv[0]);     /* name of the command */
 344   gnat_argc = 1;
 345
 346   save_argc = argc;
 347   save_argv = argv;
 348
 349   /* Uninitialized really means uninitialized in Ada.  */
 350   flag_zero_initialized_in_bss = 0;
 351
 352   return CL_Ada;
 353 }
 354
 355 /* Post-switch processing.  */
 356
 357 bool
 358 gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
 359 {
 360   flag_inline_trees = 1;
 361
 362   if (!flag_no_inline)
 363     flag_no_inline = 1;
 364   if (flag_inline_functions)
 365     flag_inline_trees = 2;
 366
 367   /* Force eliminate_unused_debug_types to 0 unless an explicit positive
 368      -f has been passed.  This forces the default to 0 for Ada, which might
 369      differ from the common default.  */
 370   if (flag_eliminate_unused_debug_types < 0)
 371     flag_eliminate_unused_debug_types = 1;
 372   else
 373     flag_eliminate_unused_debug_types = 0;
 374
 375   return false;
 376 }
 377
 378 /* Here is the function to handle the compiler error processing in GCC.  */
 379
 380 static void
 381 internal_error_function (const char *msgid, va_list *ap)
 382 {
 383   text_info tinfo;
 384   char *buffer, *p, *loc;
 385   String_Template temp, temp_loc;
 386   Fat_Pointer fp, fp_loc;
 387   expanded_location s;
 388
 389   /* Reset the pretty-printer.  */
 390   pp_clear_output_area (global_dc->printer);
 391
 392   /* Format the message into the pretty-printer.  */
 393   tinfo.format_spec = msgid;
 394   tinfo.args_ptr = ap;
 395   tinfo.err_no = errno;
 396   pp_format_verbatim (global_dc->printer, &tinfo);
 397
 398   /* Extract a (writable) pointer to the formatted text.  */
 399   buffer = (char*) pp_formatted_text (global_dc->printer);
 400
 401   /* Go up to the first newline.  */
 402   for (p = buffer; *p; p++)
 403     if (*p == '\n')
 404       {
 405         *p = '\0';
 406         break;
 407       }
 408
 409   temp.Low_Bound = 1;
 410   temp.High_Bound = p - buffer;
 411   fp.Bounds = &temp;
 412   fp.Array = buffer;
 413
 414   s = expand_location (input_location);
 415 #ifdef USE_MAPPED_LOCATION
 416   if (flag_show_column && s.column != 0)
 417     asprintf (&loc, "%s:%d:%d", s.file, s.line, s.column);
 418   else
 419 #endif
 420     asprintf (&loc, "%s:%d", s.file, s.line);
 421   temp_loc.Low_Bound = 1;
 422   temp_loc.High_Bound = strlen (loc);
 423   fp_loc.Bounds = &temp_loc;
 424   fp_loc.Array = loc;
 425
 426   Current_Error_Node = error_gnat_node;
 427   Compiler_Abort (fp, -1, fp_loc);
 428 }
 429
 430 /* Perform all the initialization steps that are language-specific.  */
 431
 432 static bool
 433 gnat_init (void)
 434 {
 435   /* Performs whatever initialization steps needed by the language-dependent
 436      lexical analyzer.  */
 437   gnat_init_decl_processing ();
 438
 439   /* Add the input filename as the last argument.  */
 440   gnat_argv[gnat_argc] = (char *) main_input_filename;
 441   gnat_argc++;
 442   gnat_argv[gnat_argc] = 0;
 443
 444   global_dc->internal_error = &internal_error_function;
 445
 446   /* Show that REFERENCE_TYPEs are internal and should be Pmode.  */
 447   internal_reference_types ();
 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   gcc_unreachable ();
 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 (optab_handler (mov_optab, 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 #ifdef DWARF2_UNWIND_INFO
 488   /* lang_dependent_init already called dwarf2out_frame_init if true.  */
 489   int dwarf2out_frame_initialized = dwarf2out_do_frame ();
 490 #endif
 491
 492   /* We shouldn't do anything if the No_Exceptions_Handler pragma is set,
 493      though. This could for instance lead to the emission of tables with
 494      references to symbols (such as the Ada eh personality routine) within
 495      libraries we won't link against.  */
 496   if (No_Exception_Handlers_Set ())
 497     return;
 498
 499   /* Tell GCC we are handling cleanup actions through exception propagation.
 500      This opens possibilities that we don't take advantage of yet, but is
 501      nonetheless necessary to ensure that fixup code gets assigned to the
 502      right exception regions.  */
 503   using_eh_for_cleanups ();
 504
 505   eh_personality_libfunc = init_one_libfunc (USING_SJLJ_EXCEPTIONS
 506                                              ? "__gnat_eh_personality_sj"
 507                                              : "__gnat_eh_personality");
 508   lang_eh_type_covers = gnat_eh_type_covers;
 509   lang_eh_runtime_type = gnat_return_tree;
 510   default_init_unwind_resume_libfunc ();
 511
 512   /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers
 513      the generation of the necessary exception runtime tables. The second one
 514      is useful for two reasons: 1/ we map some asynchronous signals like SEGV
 515      to exceptions, so we need to ensure that the insns which can lead to such
 516      signals are correctly attached to the exception region they pertain to,
 517      2/ Some calls to pure subprograms are handled as libcall blocks and then
 518      marked as "cannot trap" if the flag is not set (see emit_libcall_block).
 519      We should not let this be since it is possible for such calls to actually
 520      raise in Ada.  */
 521
 522   flag_exceptions = 1;
 523   flag_non_call_exceptions = 1;
 524
 525   init_eh ();
 526 #ifdef DWARF2_UNWIND_INFO
 527   if (!dwarf2out_frame_initialized && dwarf2out_do_frame ())
 528     dwarf2out_frame_init ();
 529 #endif
 530 }
 531
 532 /* Language hooks, first one to print language-specific items in a DECL.  */
 533
 534 static void
 535 gnat_print_decl (FILE *file, tree node, int indent)
 536 {
 537   switch (TREE_CODE (node))
 538     {
 539     case CONST_DECL:
 540       print_node (file, "const_corresponding_var",
 541                   DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
 542       break;
 543
 544     case FIELD_DECL:
 545       print_node (file, "original_field", DECL_ORIGINAL_FIELD (node),
 546                   indent + 4);
 547       break;
 548
 549     case VAR_DECL:
 550       print_node (file, "renamed_object", DECL_RENAMED_OBJECT (node),
 551                   indent + 4);
 552       break;
 553
 554     default:
 555       break;
 556     }
 557 }
 558
 559 static void
 560 gnat_print_type (FILE *file, tree node, int indent)
 561 {
 562   switch (TREE_CODE (node))
 563     {
 564     case FUNCTION_TYPE:
 565       print_node (file, "ci_co_list", TYPE_CI_CO_LIST (node), indent + 4);
 566       break;
 567
 568     case ENUMERAL_TYPE:
 569       print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
 570       break;
 571
 572     case INTEGER_TYPE:
 573       if (TYPE_MODULAR_P (node))
 574         print_node (file, "modulus", TYPE_MODULUS (node), indent + 4);
 575       else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
 576         print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
 577                     indent + 4);
 578       else if (TYPE_VAX_FLOATING_POINT_P (node))
 579         ;
 580       else
 581         print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
 582
 583       print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
 584       break;
 585
 586     case ARRAY_TYPE:
 587       print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
 588       break;
 589
 590     case RECORD_TYPE:
 591       if (TYPE_IS_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
 592         print_node (file, "unconstrained array",
 593                     TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
 594       else
 595         print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
 596       break;
 597
 598     case UNION_TYPE:
 599     case QUAL_UNION_TYPE:
 600       print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
 601       break;
 602
 603     default:
 604       break;
 605     }
 606 }
 607
 608 static const char *
 609 gnat_printable_name (tree decl, int verbosity)
 610 {
 611   const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
 612   char *ada_name = (char *) ggc_alloc (strlen (coded_name) * 2 + 60);
 613
 614   __gnat_decode (coded_name, ada_name, 0);
 615
 616   if (verbosity == 2)
 617     {
 618       Set_Identifier_Casing (ada_name, (char *) DECL_SOURCE_FILE (decl));
 619       ada_name = Name_Buffer;
 620     }
 621
 622   return (const char *) ada_name;
 623 }
 624
 625 static const char *
 626 gnat_dwarf_name (tree t, int verbosity ATTRIBUTE_UNUSED)
 627 {
 628   gcc_assert (DECL_P (t));
 629
 630   return (const char *) IDENTIFIER_POINTER (DECL_NAME (t));
 631 }
 632
 633 /* Expands GNAT-specific GCC tree nodes.  The only ones we support
 634    here are  and NULL_EXPR.  */
 635
 636 static rtx
 637 gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode,
 638                   int modifier, rtx *alt_rtl)
 639 {
 640   tree type = TREE_TYPE (exp);
 641   tree new;
 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       gcc_unreachable ();
 667     }
 668
 669   return expand_expr_real (new, target, tmode, modifier, alt_rtl);
 670 }
 671
 672 /* Do nothing (return the tree node passed).  */
 673
 674 static tree
 675 gnat_return_tree (tree t)
 676 {
 677   return t;
 678 }
 679
 680 /* Return true if type A catches type B. Callback for flow analysis from
 681    the exception handling part of the back-end.  */
 682
 683 static int
 684 gnat_eh_type_covers (tree a, tree b)
 685 {
 686   /* a catches b if they represent the same exception id or if a
 687      is an "others".
 688
 689      ??? integer_zero_node for "others" is hardwired in too many places
 690      currently.  */
 691   return (a == b || a == integer_zero_node);
 692 }
 693 \f
 694 /* Get the alias set corresponding to a type or expression.  */
 695
 696 static alias_set_type
 697 gnat_get_alias_set (tree type)
 698 {
 699   /* If this is a padding type, use the type of the first field.  */
 700   if (TREE_CODE (type) == RECORD_TYPE
 701       && TYPE_IS_PADDING_P (type))
 702     return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
 703
 704   /* If the type is an unconstrained array, use the type of the
 705      self-referential array we make.  */
 706   else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
 707     return
 708       get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
 709
 710   /* If the type can alias any other types, return the alias set 0.  */
 711   else if (TYPE_P (type)
 712            && TYPE_UNIVERSAL_ALIASING_P (TYPE_MAIN_VARIANT (type)))
 713     return 0;
 714
 715   return -1;
 716 }
 717
 718 /* GNU_TYPE is a type.  Return its maximum size in bytes, if known,
 719    as a constant when possible.  */
 720
 721 static tree
 722 gnat_type_max_size (const_tree gnu_type)
 723 {
 724   /* First see what we can get from TYPE_SIZE_UNIT, which might not
 725      be constant even for simple expressions if it has already been
 726      elaborated and possibly replaced by a VAR_DECL.  */
 727   tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true);
 728
 729   /* If we don't have a constant, see what we can get from TYPE_ADA_SIZE,
 730      which should stay untouched.  */
 731   if (!host_integerp (max_unitsize, 1)
 732       && (TREE_CODE (gnu_type) == RECORD_TYPE
 733           || TREE_CODE (gnu_type) == UNION_TYPE
 734           || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
 735       && TYPE_ADA_SIZE (gnu_type))
 736     {
 737       tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
 738
 739       /* If we have succeeded in finding a constant, round it up to the
 740          type's alignment and return the result in units.  */
 741       if (host_integerp (max_adasize, 1))
 742         max_unitsize
 743           = size_binop (CEIL_DIV_EXPR,
 744                         round_up (max_adasize, TYPE_ALIGN (gnu_type)),
 745                         bitsize_unit_node);
 746     }
 747
 748   return max_unitsize;
 749 }
 750
 751 /* GNU_TYPE is a type. Determine if it should be passed by reference by
 752    default.  */
 753
 754 bool
 755 default_pass_by_ref (tree gnu_type)
 756 {
 757   /* We pass aggregates by reference if they are sufficiently large.  The
 758      choice of constant here is somewhat arbitrary.  We also pass by
 759      reference if the target machine would either pass or return by
 760      reference.  Strictly speaking, we need only check the return if this
 761      is an In Out parameter, but it's probably best to err on the side of
 762      passing more things by reference.  */
 763
 764   if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, 1))
 765     return true;
 766
 767   if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
 768     return true;
 769
 770   if (AGGREGATE_TYPE_P (gnu_type)
 771       && (!host_integerp (TYPE_SIZE (gnu_type), 1)
 772           || 0 < compare_tree_int (TYPE_SIZE (gnu_type),
 773                                    8 * TYPE_ALIGN (gnu_type))))
 774     return true;
 775
 776   return false;
 777 }
 778
 779 /* GNU_TYPE is the type of a subprogram parameter.  Determine from the type if
 780    it should be passed by reference. */
 781
 782 bool
 783 must_pass_by_ref (tree gnu_type)
 784 {
 785   /* We pass only unconstrained objects, those required by the language
 786      to be passed by reference, and objects of variable size.  The latter
 787      is more efficient, avoids problems with variable size temporaries,
 788      and does not produce compatibility problems with C, since C does
 789      not have such objects.  */
 790   return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
 791           || (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
 792           || (TYPE_SIZE (gnu_type)
 793               && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
 794 }
 795
 796 /* This function is called by the front end to enumerate all the supported
 797    modes for the machine.  We pass a function which is called back with
 798    the following integer parameters:
 799
 800    FLOAT_P      nonzero if this represents a floating-point mode
 801    COMPLEX_P    nonzero is this represents a complex mode
 802    COUNT        count of number of items, nonzero for vector mode
 803    PRECISION    number of bits in data representation
 804    MANTISSA     number of bits in mantissa, if FP and known, else zero.
 805    SIZE         number of bits used to store data
 806    ALIGN        number of bits to which mode is aligned.  */
 807
 808 void
 809 enumerate_modes (void (*f) (int, int, int, int, int, int, unsigned int))
 810 {
 811   enum machine_mode i;
 812
 813   for (i = 0; i < NUM_MACHINE_MODES; i++)
 814     {
 815       enum machine_mode j;
 816       bool float_p = 0;
 817       bool complex_p = 0;
 818       bool vector_p = 0;
 819       bool skip_p = 0;
 820       int mantissa = 0;
 821       enum machine_mode inner_mode = i;
 822
 823       switch (GET_MODE_CLASS (i))
 824         {
 825         case MODE_INT:
 826           break;
 827         case MODE_FLOAT:
 828           float_p = 1;
 829           break;
 830         case MODE_COMPLEX_INT:
 831           complex_p = 1;
 832           inner_mode = GET_MODE_INNER (i);
 833           break;
 834         case MODE_COMPLEX_FLOAT:
 835           float_p = 1;
 836           complex_p = 1;
 837           inner_mode = GET_MODE_INNER (i);
 838           break;
 839         case MODE_VECTOR_INT:
 840           vector_p = 1;
 841           inner_mode = GET_MODE_INNER (i);
 842           break;
 843         case MODE_VECTOR_FLOAT:
 844           float_p = 1;
 845           vector_p = 1;
 846           inner_mode = GET_MODE_INNER (i);
 847           break;
 848         default:
 849           skip_p = 1;
 850         }
 851
 852       /* Skip this mode if it's one the front end doesn't need to know about
 853          (e.g., the CC modes) or if there is no add insn for that mode (or
 854          any wider mode), meaning it is not supported by the hardware.  If
 855          this a complex or vector mode, we care about the inner mode.  */
 856       for (j = inner_mode; j != VOIDmode; j = GET_MODE_WIDER_MODE (j))
 857         if (optab_handler (add_optab, j)->insn_code != CODE_FOR_nothing)
 858           break;
 859
 860       if (float_p)
 861         {
 862           const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode);
 863
 864           mantissa = fmt->p;
 865         }
 866
 867       if (!skip_p && j != VOIDmode)
 868         (*f) (float_p, complex_p, vector_p ? GET_MODE_NUNITS (i) : 0,
 869               GET_MODE_BITSIZE (i), mantissa,
 870               GET_MODE_SIZE (i) * BITS_PER_UNIT, GET_MODE_ALIGNMENT (i));
 871     }
 872 }
 873
 874 int
 875 fp_prec_to_size (int prec)
 876 {
 877   enum machine_mode mode;
 878
 879   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
 880        mode = GET_MODE_WIDER_MODE (mode))
 881     if (GET_MODE_PRECISION (mode) == prec)
 882       return GET_MODE_BITSIZE (mode);
 883
 884   gcc_unreachable ();
 885 }
 886
 887 int
 888 fp_size_to_prec (int size)
 889 {
 890   enum machine_mode mode;
 891
 892   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
 893        mode = GET_MODE_WIDER_MODE (mode))
 894     if (GET_MODE_BITSIZE (mode) == size)
 895       return GET_MODE_PRECISION (mode);
 896
 897   gcc_unreachable ();
 898 }