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