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