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