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