gcc/ada/gcc-interface/misc.c

   1 /****************************************************************************
   2  *                                                                          *
   3  *                         GNAT COMPILER COMPONENTS                         *
   4  *                                                                          *
   5  *                                 M I S C                                  *
   6  *                                                                          *
   7  *                           C Implementation File                          *
   8  *                                                                          *
   9  *          Copyright (C) 1992-2011, 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 3,  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  COPYING3.  If not see *
  19  * <http://www.gnu.org/licenses/>.                                          *
  20  *                                                                          *
  21  * GNAT was originally developed  by the GNAT team at  New York University. *
  22  * Extensive contributions were provided by Ada Core Technologies Inc.      *
  23  *                                                                          *
  24  ****************************************************************************/
  25
  26 #include "config.h"
  27 #include "system.h"
  28 #include "coretypes.h"
  29 #include "tm.h"
  30 #include "tree.h"
  31 #include "diagnostic.h"
  32 #include "target.h"
  33 #include "ggc.h"
  34 #include "flags.h"
  35 #include "debug.h"
  36 #include "toplev.h"
  37 #include "langhooks.h"
  38 #include "langhooks-def.h"
  39 #include "opts.h"
  40 #include "options.h"
  41 #include "plugin.h"
  42 #include "function.h"   /* For pass_by_reference.  */
  43
  44 #include "ada.h"
  45 #include "adadecode.h"
  46 #include "types.h"
  47 #include "atree.h"
  48 #include "elists.h"
  49 #include "namet.h"
  50 #include "nlists.h"
  51 #include "stringt.h"
  52 #include "uintp.h"
  53 #include "fe.h"
  54 #include "sinfo.h"
  55 #include "einfo.h"
  56 #include "ada-tree.h"
  57 #include "gigi.h"
  58
  59 /* This symbol needs to be defined for the front-end.  */
  60 void *callgraph_info_file = NULL;
  61
  62 /* Command-line argc and argv.  These variables are global since they are
  63    imported in back_end.adb.  */
  64 unsigned int save_argc;
  65 const char **save_argv;
  66
  67 /* GNAT argc and argv.  */
  68 extern int gnat_argc;
  69 extern char **gnat_argv;
  70
  71 /* Declare functions we use as part of startup.  */
  72 extern void __gnat_initialize (void *);
  73 extern void __gnat_install_SEH_handler (void *);
  74 extern void adainit (void);
  75 extern void _ada_gnat1drv (void);
  76
  77 /* The parser for the language.  For us, we process the GNAT tree.  */
  78
  79 static void
  80 gnat_parse_file (void)
  81 {
  82   int seh[2];
  83
  84   /* Call the target specific initializations.  */
  85   __gnat_initialize (NULL);
  86
  87   /* ??? Call the SEH initialization routine.  This is to workaround
  88   a bootstrap path problem.  The call below should be removed at some
  89   point and the SEH pointer passed to __gnat_initialize() above.  */
  90   __gnat_install_SEH_handler((void *)seh);
  91
  92   /* Call the front-end elaboration procedures.  */
  93   adainit ();
  94
  95   /* Call the front end.  */
  96   _ada_gnat1drv ();
  97 }
  98
  99 /* Decode all the language specific options that cannot be decoded by GCC.
 100    The option decoding phase of GCC calls this routine on the flags that
 101    are marked as Ada-specific.  Return true on success or false on failure.  */
 102
 103 static bool
 104 gnat_handle_option (size_t scode, const char *arg ATTRIBUTE_UNUSED, int value,
 105                     int kind ATTRIBUTE_UNUSED, location_t loc ATTRIBUTE_UNUSED,
 106                     const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
 107 {
 108   enum opt_code code = (enum opt_code) scode;
 109
 110   switch (code)
 111     {
 112     case OPT_Wall:
 113       warn_unused = value;
 114       warn_uninitialized = value;
 115       warn_maybe_uninitialized = value;
 116       break;
 117
 118     case OPT_Wmissing_prototypes:
 119     case OPT_Wstrict_prototypes:
 120     case OPT_Wwrite_strings:
 121     case OPT_Wlong_long:
 122     case OPT_Wvariadic_macros:
 123     case OPT_Wold_style_definition:
 124     case OPT_Wmissing_format_attribute:
 125     case OPT_Woverlength_strings:
 126       /* These are used in the GCC Makefile.  */
 127       break;
 128
 129     case OPT_gant:
 130       warning (0, "%<-gnat%> misspelled as %<-gant%>");
 131
 132       /* ... fall through ... */
 133
 134     case OPT_gnat:
 135     case OPT_gnatO:
 136     case OPT_fRTS_:
 137     case OPT_I:
 138     case OPT_nostdinc:
 139     case OPT_nostdlib:
 140       /* These are handled by the front-end.  */
 141       break;
 142
 143     default:
 144       gcc_unreachable ();
 145     }
 146
 147   return true;
 148 }
 149
 150 /* Return language mask for option processing.  */
 151
 152 static unsigned int
 153 gnat_option_lang_mask (void)
 154 {
 155   return CL_Ada;
 156 }
 157
 158 /* Initialize options structure OPTS.  */
 159
 160 static void
 161 gnat_init_options_struct (struct gcc_options *opts)
 162 {
 163   /* Uninitialized really means uninitialized in Ada.  */
 164   opts->x_flag_zero_initialized_in_bss = 0;
 165 }
 166
 167 /* Initialize for option processing.  */
 168
 169 static void
 170 gnat_init_options (unsigned int decoded_options_count,
 171                    struct cl_decoded_option *decoded_options)
 172 {
 173   /* Reconstruct an argv array for use of back_end.adb.
 174
 175      ??? back_end.adb should not rely on this; instead, it should work with
 176      decoded options without such reparsing, to ensure consistency in how
 177      options are decoded.  */
 178   unsigned int i;
 179
 180   save_argv = XNEWVEC (const char *, 2 * decoded_options_count + 1);
 181   save_argc = 0;
 182   for (i = 0; i < decoded_options_count; i++)
 183     {
 184       size_t num_elements = decoded_options[i].canonical_option_num_elements;
 185
 186       if (decoded_options[i].errors
 187           || decoded_options[i].opt_index == OPT_SPECIAL_unknown
 188           || num_elements == 0)
 189         continue;
 190
 191       /* Deal with -I- specially since it must be a single switch.  */
 192       if (decoded_options[i].opt_index == OPT_I
 193           && num_elements == 2
 194           && decoded_options[i].canonical_option[1][0] == '-'
 195           && decoded_options[i].canonical_option[1][1] == '\0')
 196         save_argv[save_argc++] = "-I-";
 197       else
 198         {
 199           gcc_assert (num_elements >= 1 && num_elements <= 2);
 200           save_argv[save_argc++] = decoded_options[i].canonical_option[0];
 201           if (num_elements >= 2)
 202             save_argv[save_argc++] = decoded_options[i].canonical_option[1];
 203         }
 204     }
 205   save_argv[save_argc] = NULL;
 206
 207   gnat_argv = (char **) xmalloc (sizeof (save_argv[0]));
 208   gnat_argv[0] = xstrdup (save_argv[0]);     /* name of the command */
 209   gnat_argc = 1;
 210 }
 211
 212 /* Ada code requires variables for these settings rather than elements
 213    of the global_options structure.  */
 214 #undef optimize
 215 #undef optimize_size
 216 #undef flag_compare_debug
 217 #undef flag_stack_check
 218 int optimize;
 219 int optimize_size;
 220 int flag_compare_debug;
 221 enum stack_check_type flag_stack_check = NO_STACK_CHECK;
 222
 223 /* Post-switch processing.  */
 224
 225 static bool
 226 gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
 227 {
 228   /* Excess precision other than "fast" requires front-end support.  */
 229   if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD
 230       && TARGET_FLT_EVAL_METHOD_NON_DEFAULT)
 231     sorry ("-fexcess-precision=standard for Ada");
 232   flag_excess_precision_cmdline = EXCESS_PRECISION_FAST;
 233
 234   /* ??? The warning machinery is outsmarted by Ada.  */
 235   warn_unused_parameter = 0;
 236
 237   /* No psABI change warnings for Ada.  */
 238   warn_psabi = 0;
 239
 240   optimize = global_options.x_optimize;
 241   optimize_size = global_options.x_optimize_size;
 242   flag_compare_debug = global_options.x_flag_compare_debug;
 243   flag_stack_check = global_options.x_flag_stack_check;
 244
 245   return false;
 246 }
 247
 248 /* Here is the function to handle the compiler error processing in GCC.  */
 249
 250 static void
 251 internal_error_function (diagnostic_context *context,
 252                          const char *msgid, va_list *ap)
 253 {
 254   text_info tinfo;
 255   char *buffer, *p, *loc;
 256   String_Template temp, temp_loc;
 257   Fat_Pointer fp, fp_loc;
 258   expanded_location s;
 259
 260   /* Warn if plugins present.  */
 261   warn_if_plugins ();
 262
 263   /* Reset the pretty-printer.  */
 264   pp_clear_output_area (context->printer);
 265
 266   /* Format the message into the pretty-printer.  */
 267   tinfo.format_spec = msgid;
 268   tinfo.args_ptr = ap;
 269   tinfo.err_no = errno;
 270   pp_format_verbatim (context->printer, &tinfo);
 271
 272   /* Extract a (writable) pointer to the formatted text.  */
 273   buffer = xstrdup (pp_formatted_text (context->printer));
 274
 275   /* Go up to the first newline.  */
 276   for (p = buffer; *p; p++)
 277     if (*p == '\n')
 278       {
 279         *p = '\0';
 280         break;
 281       }
 282
 283   temp.Low_Bound = 1;
 284   temp.High_Bound = p - buffer;
 285   fp.Bounds = &temp;
 286   fp.Array = buffer;
 287
 288   s = expand_location (input_location);
 289   if (context->show_column && s.column != 0)
 290     asprintf (&loc, "%s:%d:%d", s.file, s.line, s.column);
 291   else
 292     asprintf (&loc, "%s:%d", s.file, s.line);
 293   temp_loc.Low_Bound = 1;
 294   temp_loc.High_Bound = strlen (loc);
 295   fp_loc.Bounds = &temp_loc;
 296   fp_loc.Array = loc;
 297
 298   Current_Error_Node = error_gnat_node;
 299   Compiler_Abort (fp, -1, fp_loc);
 300 }
 301
 302 /* Perform all the initialization steps that are language-specific.  */
 303
 304 static bool
 305 gnat_init (void)
 306 {
 307   /* Do little here, most of the standard declarations are set up after the
 308      front-end has been run.  Use the same `char' as C, this doesn't really
 309      matter since we'll use the explicit `unsigned char' for Character.  */
 310   build_common_tree_nodes (flag_signed_char, false);
 311
 312   /* In Ada, we use an unsigned 8-bit type for the default boolean type.  */
 313   boolean_type_node = make_unsigned_type (8);
 314   TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE);
 315   SET_TYPE_RM_MAX_VALUE (boolean_type_node,
 316                          build_int_cst (boolean_type_node, 1));
 317   SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1));
 318   boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
 319   boolean_false_node = TYPE_MIN_VALUE (boolean_type_node);
 320
 321   sbitsize_one_node = sbitsize_int (1);
 322   sbitsize_unit_node = sbitsize_int (BITS_PER_UNIT);
 323
 324   ptr_void_type_node = build_pointer_type (void_type_node);
 325
 326   /* Show that REFERENCE_TYPEs are internal and should be Pmode.  */
 327   internal_reference_types ();
 328
 329   /* Register our internal error function.  */
 330   global_dc->internal_error = &internal_error_function;
 331
 332   return true;
 333 }
 334
 335 /* If we are using the GCC mechanism to process exception handling, we
 336    have to register the personality routine for Ada and to initialize
 337    various language dependent hooks.  */
 338
 339 void
 340 gnat_init_gcc_eh (void)
 341 {
 342   /* We shouldn't do anything if the No_Exceptions_Handler pragma is set,
 343      though. This could for instance lead to the emission of tables with
 344      references to symbols (such as the Ada eh personality routine) within
 345      libraries we won't link against.  */
 346   if (No_Exception_Handlers_Set ())
 347     return;
 348
 349   /* Tell GCC we are handling cleanup actions through exception propagation.
 350      This opens possibilities that we don't take advantage of yet, but is
 351      nonetheless necessary to ensure that fixup code gets assigned to the
 352      right exception regions.  */
 353   using_eh_for_cleanups ();
 354
 355   /* Turn on -fexceptions and -fnon-call-exceptions.  The first one triggers
 356      the generation of the necessary exception tables.  The second one is
 357      useful for two reasons: 1/ we map some asynchronous signals like SEGV to
 358      exceptions, so we need to ensure that the insns which can lead to such
 359      signals are correctly attached to the exception region they pertain to,
 360      2/ Some calls to pure subprograms are handled as libcall blocks and then
 361      marked as "cannot trap" if the flag is not set (see emit_libcall_block).
 362      We should not let this be since it is possible for such calls to actually
 363      raise in Ada.  */
 364   flag_exceptions = 1;
 365   flag_non_call_exceptions = 1;
 366
 367   init_eh ();
 368 }
 369
 370 /* Print language-specific items in declaration NODE.  */
 371
 372 static void
 373 gnat_print_decl (FILE *file, tree node, int indent)
 374 {
 375   switch (TREE_CODE (node))
 376     {
 377     case CONST_DECL:
 378       print_node (file, "corresponding var",
 379                   DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
 380       break;
 381
 382     case FIELD_DECL:
 383       print_node (file, "original field", DECL_ORIGINAL_FIELD (node),
 384                   indent + 4);
 385       break;
 386
 387     case VAR_DECL:
 388       print_node (file, "renamed object", DECL_RENAMED_OBJECT (node),
 389                   indent + 4);
 390       break;
 391
 392     default:
 393       break;
 394     }
 395 }
 396
 397 /* Print language-specific items in type NODE.  */
 398
 399 static void
 400 gnat_print_type (FILE *file, tree node, int indent)
 401 {
 402   switch (TREE_CODE (node))
 403     {
 404     case FUNCTION_TYPE:
 405       print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4);
 406       break;
 407
 408     case INTEGER_TYPE:
 409       if (TYPE_MODULAR_P (node))
 410         print_node_brief (file, "modulus", TYPE_MODULUS (node), indent + 4);
 411       else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
 412         print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
 413                     indent + 4);
 414       else if (TYPE_VAX_FLOATING_POINT_P (node))
 415         ;
 416       else
 417         print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
 418
 419       /* ... fall through ... */
 420
 421     case ENUMERAL_TYPE:
 422     case BOOLEAN_TYPE:
 423       print_node_brief (file, "RM size", TYPE_RM_SIZE (node), indent + 4);
 424
 425       /* ... fall through ... */
 426
 427     case REAL_TYPE:
 428       print_node_brief (file, "RM min", TYPE_RM_MIN_VALUE (node), indent + 4);
 429       print_node_brief (file, "RM max", TYPE_RM_MAX_VALUE (node), indent + 4);
 430       break;
 431
 432     case ARRAY_TYPE:
 433       print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
 434       break;
 435
 436     case VECTOR_TYPE:
 437       print_node (file,"representative array",
 438                   TYPE_REPRESENTATIVE_ARRAY (node), indent + 4);
 439       break;
 440
 441     case RECORD_TYPE:
 442       if (TYPE_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
 443         print_node (file, "unconstrained array",
 444                     TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
 445       else
 446         print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
 447       break;
 448
 449     case UNION_TYPE:
 450     case QUAL_UNION_TYPE:
 451       print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
 452       break;
 453
 454     default:
 455       break;
 456     }
 457 }
 458
 459 /* Return the name to be printed for DECL.  */
 460
 461 static const char *
 462 gnat_printable_name (tree decl, int verbosity)
 463 {
 464   const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
 465   char *ada_name = (char *) ggc_alloc_atomic (strlen (coded_name) * 2 + 60);
 466
 467   __gnat_decode (coded_name, ada_name, 0);
 468
 469   if (verbosity == 2 && !DECL_IS_BUILTIN (decl))
 470     {
 471       Set_Identifier_Casing (ada_name, DECL_SOURCE_FILE (decl));
 472       return ggc_strdup (Name_Buffer);
 473     }
 474
 475   return ada_name;
 476 }
 477
 478 /* Return the name to be used in DWARF debug info for DECL.  */
 479
 480 static const char *
 481 gnat_dwarf_name (tree decl, int verbosity ATTRIBUTE_UNUSED)
 482 {
 483   gcc_assert (DECL_P (decl));
 484   return (const char *) IDENTIFIER_POINTER (DECL_NAME (decl));
 485 }
 486
 487 /* Return the descriptive type associated with TYPE, if any.  */
 488
 489 static tree
 490 gnat_descriptive_type (const_tree type)
 491 {
 492   if (TYPE_STUB_DECL (type))
 493     return DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type));
 494   else
 495     return NULL_TREE;
 496 }
 497
 498 /* Return true if types T1 and T2 are identical for type hashing purposes.
 499    Called only after doing all language independent checks.  At present,
 500    this function is only called when both types are FUNCTION_TYPE.  */
 501
 502 static bool
 503 gnat_type_hash_eq (const_tree t1, const_tree t2)
 504 {
 505   gcc_assert (TREE_CODE (t1) == FUNCTION_TYPE);
 506   return fntype_same_flags_p (t1, TYPE_CI_CO_LIST (t2),
 507                               TYPE_RETURN_UNCONSTRAINED_P (t2),
 508                               TYPE_RETURN_BY_DIRECT_REF_P (t2),
 509                               TREE_ADDRESSABLE (t2));
 510 }
 511
 512 /* Do nothing (return the tree node passed).  */
 513
 514 static tree
 515 gnat_return_tree (tree t)
 516 {
 517   return t;
 518 }
 519
 520 /* Get the alias set corresponding to a type or expression.  */
 521
 522 static alias_set_type
 523 gnat_get_alias_set (tree type)
 524 {
 525   /* If this is a padding type, use the type of the first field.  */
 526   if (TYPE_IS_PADDING_P (type))
 527     return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
 528
 529   /* If the type is an unconstrained array, use the type of the
 530      self-referential array we make.  */
 531   else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
 532     return
 533       get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
 534
 535   /* If the type can alias any other types, return the alias set 0.  */
 536   else if (TYPE_P (type)
 537            && TYPE_UNIVERSAL_ALIASING_P (TYPE_MAIN_VARIANT (type)))
 538     return 0;
 539
 540   return -1;
 541 }
 542
 543 /* GNU_TYPE is a type.  Return its maximum size in bytes, if known,
 544    as a constant when possible.  */
 545
 546 static tree
 547 gnat_type_max_size (const_tree gnu_type)
 548 {
 549   /* First see what we can get from TYPE_SIZE_UNIT, which might not
 550      be constant even for simple expressions if it has already been
 551      elaborated and possibly replaced by a VAR_DECL.  */
 552   tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true);
 553
 554   /* If we don't have a constant, see what we can get from TYPE_ADA_SIZE,
 555      which should stay untouched.  */
 556   if (!host_integerp (max_unitsize, 1)
 557       && (TREE_CODE (gnu_type) == RECORD_TYPE
 558           || TREE_CODE (gnu_type) == UNION_TYPE
 559           || TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
 560       && TYPE_ADA_SIZE (gnu_type))
 561     {
 562       tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
 563
 564       /* If we have succeeded in finding a constant, round it up to the
 565          type's alignment and return the result in units.  */
 566       if (host_integerp (max_adasize, 1))
 567         max_unitsize
 568           = size_binop (CEIL_DIV_EXPR,
 569                         round_up (max_adasize, TYPE_ALIGN (gnu_type)),
 570                         bitsize_unit_node);
 571     }
 572
 573   return max_unitsize;
 574 }
 575
 576 /* GNU_TYPE is a subtype of an integral type.  Set LOWVAL to the low bound
 577    and HIGHVAL to the high bound, respectively.  */
 578
 579 static void
 580 gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval)
 581 {
 582   *lowval = TYPE_MIN_VALUE (gnu_type);
 583   *highval = TYPE_MAX_VALUE (gnu_type);
 584 }
 585
 586 /* GNU_TYPE is the type of a subprogram parameter.  Determine if it should be
 587    passed by reference by default.  */
 588
 589 bool
 590 default_pass_by_ref (tree gnu_type)
 591 {
 592   /* We pass aggregates by reference if they are sufficiently large.  The
 593      choice of constant here is somewhat arbitrary.  We also pass by
 594      reference if the target machine would either pass or return by
 595      reference.  Strictly speaking, we need only check the return if this
 596      is an In Out parameter, but it's probably best to err on the side of
 597      passing more things by reference.  */
 598
 599   if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, true))
 600     return true;
 601
 602   if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
 603     return true;
 604
 605   if (AGGREGATE_TYPE_P (gnu_type)
 606       && (!host_integerp (TYPE_SIZE (gnu_type), 1)
 607           || 0 < compare_tree_int (TYPE_SIZE (gnu_type),
 608                                    8 * TYPE_ALIGN (gnu_type))))
 609     return true;
 610
 611   return false;
 612 }
 613
 614 /* GNU_TYPE is the type of a subprogram parameter.  Determine if it must be
 615    passed by reference.  */
 616
 617 bool
 618 must_pass_by_ref (tree gnu_type)
 619 {
 620   /* We pass only unconstrained objects, those required by the language
 621      to be passed by reference, and objects of variable size.  The latter
 622      is more efficient, avoids problems with variable size temporaries,
 623      and does not produce compatibility problems with C, since C does
 624      not have such objects.  */
 625   return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
 626           || TREE_ADDRESSABLE (gnu_type)
 627           || (TYPE_SIZE (gnu_type)
 628               && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
 629 }
 630
 631 /* Return the size of the FP mode with precision PREC.  */
 632
 633 int
 634 fp_prec_to_size (int prec)
 635 {
 636   enum machine_mode mode;
 637
 638   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
 639        mode = GET_MODE_WIDER_MODE (mode))
 640     if (GET_MODE_PRECISION (mode) == prec)
 641       return GET_MODE_BITSIZE (mode);
 642
 643   gcc_unreachable ();
 644 }
 645
 646 /* Return the precision of the FP mode with size SIZE.  */
 647
 648 int
 649 fp_size_to_prec (int size)
 650 {
 651   enum machine_mode mode;
 652
 653   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
 654        mode = GET_MODE_WIDER_MODE (mode))
 655     if (GET_MODE_BITSIZE (mode) == size)
 656       return GET_MODE_PRECISION (mode);
 657
 658   gcc_unreachable ();
 659 }
 660
 661 static GTY(()) tree gnat_eh_personality_decl;
 662
 663 /* Return the GNAT personality function decl.  */
 664
 665 static tree
 666 gnat_eh_personality (void)
 667 {
 668   if (!gnat_eh_personality_decl)
 669     gnat_eh_personality_decl = build_personality_function ("gnat");
 670   return gnat_eh_personality_decl;
 671 }
 672
 673 /* Initialize language-specific bits of tree_contains_struct.  */
 674
 675 static void
 676 gnat_init_ts (void)
 677 {
 678   MARK_TS_COMMON (UNCONSTRAINED_ARRAY_TYPE);
 679
 680   MARK_TS_TYPED (UNCONSTRAINED_ARRAY_REF);
 681   MARK_TS_TYPED (NULL_EXPR);
 682   MARK_TS_TYPED (PLUS_NOMOD_EXPR);
 683   MARK_TS_TYPED (MINUS_NOMOD_EXPR);
 684   MARK_TS_TYPED (ATTR_ADDR_EXPR);
 685   MARK_TS_TYPED (STMT_STMT);
 686   MARK_TS_TYPED (LOOP_STMT);
 687   MARK_TS_TYPED (EXIT_STMT);
 688 }
 689
 690 /* Definitions for our language-specific hooks.  */
 691
 692 #undef  LANG_HOOKS_NAME
 693 #define LANG_HOOKS_NAME                 "GNU Ada"
 694 #undef  LANG_HOOKS_IDENTIFIER_SIZE
 695 #define LANG_HOOKS_IDENTIFIER_SIZE      sizeof (struct tree_identifier)
 696 #undef  LANG_HOOKS_INIT
 697 #define LANG_HOOKS_INIT                 gnat_init
 698 #undef  LANG_HOOKS_OPTION_LANG_MASK
 699 #define LANG_HOOKS_OPTION_LANG_MASK     gnat_option_lang_mask
 700 #undef  LANG_HOOKS_INIT_OPTIONS_STRUCT
 701 #define LANG_HOOKS_INIT_OPTIONS_STRUCT  gnat_init_options_struct
 702 #undef  LANG_HOOKS_INIT_OPTIONS
 703 #define LANG_HOOKS_INIT_OPTIONS         gnat_init_options
 704 #undef  LANG_HOOKS_HANDLE_OPTION
 705 #define LANG_HOOKS_HANDLE_OPTION        gnat_handle_option
 706 #undef  LANG_HOOKS_POST_OPTIONS
 707 #define LANG_HOOKS_POST_OPTIONS         gnat_post_options
 708 #undef  LANG_HOOKS_PARSE_FILE
 709 #define LANG_HOOKS_PARSE_FILE           gnat_parse_file
 710 #undef  LANG_HOOKS_TYPE_HASH_EQ
 711 #define LANG_HOOKS_TYPE_HASH_EQ         gnat_type_hash_eq
 712 #undef  LANG_HOOKS_GETDECLS
 713 #define LANG_HOOKS_GETDECLS             lhd_return_null_tree_v
 714 #undef  LANG_HOOKS_PUSHDECL
 715 #define LANG_HOOKS_PUSHDECL             gnat_return_tree
 716 #undef  LANG_HOOKS_WRITE_GLOBALS
 717 #define LANG_HOOKS_WRITE_GLOBALS        gnat_write_global_declarations
 718 #undef  LANG_HOOKS_GET_ALIAS_SET
 719 #define LANG_HOOKS_GET_ALIAS_SET        gnat_get_alias_set
 720 #undef  LANG_HOOKS_PRINT_DECL
 721 #define LANG_HOOKS_PRINT_DECL           gnat_print_decl
 722 #undef  LANG_HOOKS_PRINT_TYPE
 723 #define LANG_HOOKS_PRINT_TYPE           gnat_print_type
 724 #undef  LANG_HOOKS_TYPE_MAX_SIZE
 725 #define LANG_HOOKS_TYPE_MAX_SIZE        gnat_type_max_size
 726 #undef  LANG_HOOKS_DECL_PRINTABLE_NAME
 727 #define LANG_HOOKS_DECL_PRINTABLE_NAME  gnat_printable_name
 728 #undef  LANG_HOOKS_DWARF_NAME
 729 #define LANG_HOOKS_DWARF_NAME           gnat_dwarf_name
 730 #undef  LANG_HOOKS_GIMPLIFY_EXPR
 731 #define LANG_HOOKS_GIMPLIFY_EXPR        gnat_gimplify_expr
 732 #undef  LANG_HOOKS_TYPE_FOR_MODE
 733 #define LANG_HOOKS_TYPE_FOR_MODE        gnat_type_for_mode
 734 #undef  LANG_HOOKS_TYPE_FOR_SIZE
 735 #define LANG_HOOKS_TYPE_FOR_SIZE        gnat_type_for_size
 736 #undef  LANG_HOOKS_TYPES_COMPATIBLE_P
 737 #define LANG_HOOKS_TYPES_COMPATIBLE_P   gnat_types_compatible_p
 738 #undef  LANG_HOOKS_GET_SUBRANGE_BOUNDS
 739 #define LANG_HOOKS_GET_SUBRANGE_BOUNDS  gnat_get_subrange_bounds
 740 #undef  LANG_HOOKS_DESCRIPTIVE_TYPE
 741 #define LANG_HOOKS_DESCRIPTIVE_TYPE     gnat_descriptive_type
 742 #undef  LANG_HOOKS_ATTRIBUTE_TABLE
 743 #define LANG_HOOKS_ATTRIBUTE_TABLE      gnat_internal_attribute_table
 744 #undef  LANG_HOOKS_BUILTIN_FUNCTION
 745 #define LANG_HOOKS_BUILTIN_FUNCTION     gnat_builtin_function
 746 #undef  LANG_HOOKS_EH_PERSONALITY
 747 #define LANG_HOOKS_EH_PERSONALITY       gnat_eh_personality
 748 #undef  LANG_HOOKS_DEEP_UNSHARING
 749 #define LANG_HOOKS_DEEP_UNSHARING       true
 750 #undef  LANG_HOOKS_INIT_TS
 751 #define LANG_HOOKS_INIT_TS              gnat_init_ts
 752
 753 struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 754
 755 #include "gt-ada-misc.h"