gcc/ada/misc.c

   1 /****************************************************************************
   2  *                                                                          *
   3  *                         GNAT COMPILER COMPONENTS                         *
   4  *                                                                          *
   5  *                                 M I S C                                  *
   6  *                                                                          *
   7  *                           C Implementation File                          *
   8  *                                                                          *
   9  *          Copyright (C) 1992-2004 Free Software Foundation, Inc.          *
  10  *                                                                          *
  11  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  12  * terms of the  GNU General Public License as published  by the Free Soft- *
  13  * ware  Foundation;  either version 2,  or (at your option) any later ver- *
  14  * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
  15  * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
  16  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
  17  * for  more details.  You should have  received  a copy of the GNU General *
  18  * Public License  distributed with GNAT;  see file COPYING.  If not, write *
  19  * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
  20  * MA 02111-1307, USA.                                                      *
  21  *                                                                          *
  22  * As a  special  exception,  if you  link  this file  with other  files to *
  23  * produce an executable,  this file does not by itself cause the resulting *
  24  * executable to be covered by the GNU General Public License. This except- *
  25  * ion does not  however invalidate  any other reasons  why the  executable *
  26  * file might be covered by the  GNU Public License.                        *
  27  *                                                                          *
  28  * GNAT was originally developed  by the GNAT team at  New York University. *
  29  * Extensive contributions were provided by Ada Core Technologies Inc.      *
  30  *                                                                          *
  31  ****************************************************************************/
  32
  33 /* This file contains parts of the compiler that are required for interfacing
  34    with GCC but otherwise do nothing and parts of Gigi that need to know
  35    about RTL.  */
  36
  37 #include "config.h"
  38 #include "system.h"
  39 #include "coretypes.h"
  40 #include "tm.h"
  41 #include "tree.h"
  42 #include "real.h"
  43 #include "rtl.h"
  44 #include "errors.h"
  45 #include "diagnostic.h"
  46 #include "expr.h"
  47 #include "libfuncs.h"
  48 #include "ggc.h"
  49 #include "flags.h"
  50 #include "debug.h"
  51 #include "cgraph.h"
  52 #include "tree-inline.h"
  53 #include "insn-codes.h"
  54 #include "insn-flags.h"
  55 #include "insn-config.h"
  56 #include "optabs.h"
  57 #include "recog.h"
  58 #include "toplev.h"
  59 #include "output.h"
  60 #include "except.h"
  61 #include "tm_p.h"
  62 #include "langhooks.h"
  63 #include "langhooks-def.h"
  64 #include "target.h"
  65
  66 #include "ada.h"
  67 #include "types.h"
  68 #include "atree.h"
  69 #include "elists.h"
  70 #include "namet.h"
  71 #include "nlists.h"
  72 #include "stringt.h"
  73 #include "uintp.h"
  74 #include "fe.h"
  75 #include "sinfo.h"
  76 #include "einfo.h"
  77 #include "ada-tree.h"
  78 #include "gigi.h"
  79 #include "adadecode.h"
  80 #include "opts.h"
  81 #include "options.h"
  82
  83 extern FILE *asm_out_file;
  84
  85 /* The largest alignment, in bits, that is needed for using the widest
  86    move instruction.  */
  87 unsigned int largest_move_alignment;
  88
  89 static bool gnat_init                   (void);
  90 static void gnat_finish_incomplete_decl (tree);
  91 static unsigned int gnat_init_options   (unsigned int, const char **);
  92 static int gnat_handle_option           (size_t, const char *, int);
  93 static bool gnat_post_options           (const char **);
  94 static HOST_WIDE_INT gnat_get_alias_set (tree);
  95 static void gnat_print_decl             (FILE *, tree, int);
  96 static void gnat_print_type             (FILE *, tree, int);
  97 static 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();
 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 /* Initialize for option processing.  */
 326
 327 static unsigned int
 328 gnat_init_options (unsigned int argc, const char **argv)
 329 {
 330   /* Initialize gnat_argv with save_argv size.  */
 331   gnat_argv = (char **) xmalloc ((argc + 1) * sizeof (argv[0]));
 332   gnat_argv[0] = xstrdup (argv[0]);     /* name of the command */
 333   gnat_argc = 1;
 334
 335   save_argc = argc;
 336   save_argv = argv;
 337
 338   /* Uninitialized really means uninitialized in Ada.  */
 339   flag_zero_initialized_in_bss = 0;
 340
 341   return CL_Ada;
 342 }
 343
 344 /* Post-switch processing.  */
 345
 346 bool
 347 gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
 348 {
 349   flag_inline_trees = 1;
 350
 351   if (!flag_no_inline)
 352     flag_no_inline = 1;
 353   if (flag_inline_functions)
 354     flag_inline_trees = 2;
 355
 356   return false;
 357 }
 358
 359 /* Here is the function to handle the compiler error processing in GCC.  */
 360
 361 static void
 362 internal_error_function (const char *msgid, va_list *ap)
 363 {
 364   char buffer[1000];            /* Assume this is big enough.  */
 365   char *p;
 366   String_Template temp;
 367   Fat_Pointer fp;
 368
 369   vsprintf (buffer, msgid, *ap);
 370
 371   /* Go up to the first newline.  */
 372   for (p = buffer; *p; p++)
 373     if (*p == '\n')
 374       {
 375         *p = '\0';
 376         break;
 377       }
 378
 379   temp.Low_Bound = 1, temp.High_Bound = strlen (buffer);
 380   fp.Array = buffer, fp.Bounds = &temp;
 381
 382   Current_Error_Node = error_gnat_node;
 383   Compiler_Abort (fp, -1);
 384 }
 385
 386 /* Perform all the initialization steps that are language-specific.  */
 387
 388 static bool
 389 gnat_init (void)
 390 {
 391   /* Initialize translations and the outer statement group.  */
 392   gnat_init_stmt_group ();
 393
 394   /* Performs whatever initialization steps needed by the language-dependent
 395      lexical analyzer.  */
 396   gnat_init_decl_processing ();
 397
 398   /* Add the input filename as the last argument.  */
 399   gnat_argv[gnat_argc] = (char *) main_input_filename;
 400   gnat_argc++;
 401   gnat_argv[gnat_argc] = 0;
 402
 403   global_dc->internal_error = &internal_error_function;
 404
 405   /* Show that REFERENCE_TYPEs are internal and should be Pmode.  */
 406   internal_reference_types ();
 407
 408   set_lang_adjust_rli (gnat_adjust_rli);
 409
 410   return true;
 411 }
 412
 413 /* This function is called indirectly from toplev.c to handle incomplete
 414    declarations, i.e. VAR_DECL nodes whose DECL_SIZE is zero.  To be precise,
 415    compile_file in toplev.c makes an indirect call through the function pointer
 416    incomplete_decl_finalize_hook which is initialized to this routine in
 417    init_decl_processing.  */
 418
 419 static void
 420 gnat_finish_incomplete_decl (tree dont_care ATTRIBUTE_UNUSED)
 421 {
 422   abort ();
 423 }
 424 \f
 425 /* Compute the alignment of the largest mode that can be used for copying
 426    objects.  */
 427
 428 void
 429 gnat_compute_largest_alignment (void)
 430 {
 431   enum machine_mode mode;
 432
 433   for (mode = GET_CLASS_NARROWEST_MODE (MODE_INT); mode != VOIDmode;
 434        mode = GET_MODE_WIDER_MODE (mode))
 435     if (mov_optab->handlers[(int) mode].insn_code != CODE_FOR_nothing)
 436       largest_move_alignment = MIN (BIGGEST_ALIGNMENT,
 437                                     MAX (largest_move_alignment,
 438                                          GET_MODE_ALIGNMENT (mode)));
 439 }
 440
 441 /* If we are using the GCC mechanism to process exception handling, we
 442    have to register the personality routine for Ada and to initialize
 443    various language dependent hooks.  */
 444
 445 void
 446 gnat_init_gcc_eh (void)
 447 {
 448   /* We shouldn't do anything if the No_Exceptions_Handler pragma is set,
 449      though. This could for instance lead to the emission of tables with
 450      references to symbols (such as the Ada eh personality routine) within
 451      libraries we won't link against.  */
 452   if (No_Exception_Handlers_Set ())
 453     return;
 454
 455   /* Tell GCC we are handling cleanup actions through exception propagation.
 456      This opens possibilities that we don't take advantage of yet, but is
 457      nonetheless necessary to ensure that fixup code gets assigned to the
 458      right exception regions.  */
 459   using_eh_for_cleanups ();
 460
 461   eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality");
 462   lang_eh_type_covers = gnat_eh_type_covers;
 463   lang_eh_runtime_type = gnat_eh_runtime_type;
 464
 465   /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers
 466      the generation of the necessary exception runtime tables. The second one
 467      is useful for two reasons: 1/ we map some asynchronous signals like SEGV
 468      to exceptions, so we need to ensure that the insns which can lead to such
 469      signals are correctly attached to the exception region they pertain to,
 470      2/ Some calls to pure subprograms are handled as libcall blocks and then
 471      marked as "cannot trap" if the flag is not set (see emit_libcall_block).
 472      We should not let this be since it is possible for such calls to actually
 473      raise in Ada.  */
 474
 475   flag_exceptions = 1;
 476   flag_non_call_exceptions = 1;
 477
 478   init_eh ();
 479 #ifdef DWARF2_UNWIND_INFO
 480   if (dwarf2out_do_frame ())
 481     dwarf2out_frame_init ();
 482 #endif
 483 }
 484
 485 /* Language hooks, first one to print language-specific items in a DECL.  */
 486
 487 static void
 488 gnat_print_decl (FILE *file, tree node, int indent)
 489 {
 490   switch (TREE_CODE (node))
 491     {
 492     case CONST_DECL:
 493       print_node (file, "const_corresponding_var",
 494                   DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
 495       break;
 496
 497     case FIELD_DECL:
 498       print_node (file, "original field", DECL_ORIGINAL_FIELD (node),
 499                   indent + 4);
 500       break;
 501
 502     default:
 503       break;
 504     }
 505 }
 506
 507 static void
 508 gnat_print_type (FILE *file, tree node, int indent)
 509 {
 510   switch (TREE_CODE (node))
 511     {
 512     case FUNCTION_TYPE:
 513       print_node (file, "ci_co_list", TYPE_CI_CO_LIST (node), indent + 4);
 514       break;
 515
 516     case ENUMERAL_TYPE:
 517       print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
 518       break;
 519
 520     case INTEGER_TYPE:
 521       if (TYPE_MODULAR_P (node))
 522         print_node (file, "modulus", TYPE_MODULUS (node), indent + 4);
 523       else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
 524         print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
 525                     indent + 4);
 526       else if (TYPE_VAX_FLOATING_POINT_P (node))
 527         ;
 528       else
 529         print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
 530
 531       print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
 532       break;
 533
 534     case ARRAY_TYPE:
 535       print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
 536       break;
 537
 538     case RECORD_TYPE:
 539       if (TYPE_IS_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
 540         print_node (file, "unconstrained array",
 541                     TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
 542       else
 543         print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
 544       break;
 545
 546     case UNION_TYPE:
 547     case QUAL_UNION_TYPE:
 548       print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
 549       break;
 550
 551     default:
 552       break;
 553     }
 554 }
 555
 556 static const char *
 557 gnat_printable_name (tree decl, int verbosity)
 558 {
 559   const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
 560   char *ada_name = (char *) ggc_alloc (strlen (coded_name) * 2 + 60);
 561
 562   __gnat_decode (coded_name, ada_name, 0);
 563
 564   if (verbosity == 2)
 565     {
 566       Set_Identifier_Casing (ada_name, (char *) DECL_SOURCE_FILE (decl));
 567       ada_name = Name_Buffer;
 568     }
 569
 570   return (const char *) ada_name;
 571 }
 572
 573 /* Expands GNAT-specific GCC tree nodes.  The only ones we support
 574    here are  and NULL_EXPR.  */
 575
 576 static rtx
 577 gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode,
 578                   int modifier, rtx *alt_rtl)
 579 {
 580   tree type = TREE_TYPE (exp);
 581   tree new;
 582
 583   /* If this is a statement, call the expansion routine for statements.  */
 584   if (IS_STMT (exp))
 585     {
 586       gnat_expand_stmt (exp);
 587       return const0_rtx;
 588     }
 589
 590   /* Update EXP to be the new expression to expand.  */
 591   switch (TREE_CODE (exp))
 592     {
 593 #if 0
 594     case ALLOCATE_EXPR:
 595       return
 596         allocate_dynamic_stack_space
 597           (expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype),
 598                         EXPAND_NORMAL),
 599            NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1));
 600 #endif
 601
 602     case UNCONSTRAINED_ARRAY_REF:
 603       /* If we are evaluating just for side-effects, just evaluate our
 604          operand.  Otherwise, abort since this code should never appear
 605          in a tree to be evaluated (objects aren't unconstrained).  */
 606       if (target == const0_rtx || TREE_CODE (type) == VOID_TYPE)
 607         return expand_expr (TREE_OPERAND (exp, 0), const0_rtx,
 608                             VOIDmode, modifier);
 609
 610       /* ... fall through ... */
 611
 612     default:
 613       abort ();
 614     }
 615
 616   return expand_expr_real (new, target, tmode, modifier, alt_rtl);
 617 }
 618
 619 /* Generate the RTL for the body of GNU_DECL.  */
 620
 621 static void
 622 gnat_expand_body (tree gnu_decl)
 623 {
 624   if (!DECL_INITIAL (gnu_decl) || DECL_INITIAL (gnu_decl) == error_mark_node)
 625     return;
 626
 627   tree_rest_of_compilation (gnu_decl);
 628 }
 629
 630 /* Adjusts the RLI used to layout a record after all the fields have been
 631    added.  We only handle the packed case and cause it to use the alignment
 632    that will pad the record at the end.  */
 633
 634 static void
 635 gnat_adjust_rli (record_layout_info rli ATTRIBUTE_UNUSED)
 636 {
 637 #if 0
 638   /* ??? This code seems to have no actual effect; record_align should already
 639      reflect the largest alignment desired by a field.  jason 2003-04-01  */
 640   unsigned int record_align = rli->unpadded_align;
 641   tree field;
 642
 643   /* If an alignment has been specified, don't use anything larger unless we
 644      have to.  */
 645   if (TYPE_ALIGN (rli->t) != 0 && TYPE_ALIGN (rli->t) < record_align)
 646     record_align = MAX (rli->record_align, TYPE_ALIGN (rli->t));
 647
 648   /* If any fields have variable size, we need to force the record to be at
 649      least as aligned as the alignment of that type.  */
 650   for (field = TYPE_FIELDS (rli->t); field; field = TREE_CHAIN (field))
 651     if (TREE_CODE (DECL_SIZE_UNIT (field)) != INTEGER_CST)
 652       record_align = MAX (record_align, DECL_ALIGN (field));
 653
 654   if (TYPE_PACKED (rli->t))
 655     rli->record_align = record_align;
 656 #endif
 657 }
 658 \f
 659 /* These routines are used in conjunction with GCC exception handling.  */
 660
 661 /* Map compile-time to run-time tree for GCC exception handling scheme.  */
 662
 663 static tree
 664 gnat_eh_runtime_type (tree type)
 665 {
 666   return type;
 667 }
 668
 669 /* Return true if type A catches type B. Callback for flow analysis from
 670    the exception handling part of the back-end.  */
 671
 672 static int
 673 gnat_eh_type_covers (tree a, tree b)
 674 {
 675   /* a catches b if they represent the same exception id or if a
 676      is an "others".
 677
 678      ??? integer_zero_node for "others" is hardwired in too many places
 679      currently.  */
 680   return (a == b || a == integer_zero_node);
 681 }
 682 \f
 683 /* Get the alias set corresponding to a type or expression.  */
 684
 685 static HOST_WIDE_INT
 686 gnat_get_alias_set (tree type)
 687 {
 688   /* If this is a padding type, use the type of the first field.  */
 689   if (TREE_CODE (type) == RECORD_TYPE
 690       && TYPE_IS_PADDING_P (type))
 691     return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
 692
 693   /* If the type is an unconstrained array, use the type of the
 694      self-referential array we make.  */
 695   else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
 696     return
 697       get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
 698
 699
 700   return -1;
 701 }
 702
 703 /* GNU_TYPE is a type.  Return its maxium size in bytes, if known.  */
 704
 705 static tree
 706 gnat_type_max_size (gnu_type)
 707      tree gnu_type;
 708 {
 709   return max_size (TYPE_SIZE_UNIT (gnu_type), true);
 710 }
 711
 712 /* GNU_TYPE is a type. Determine if it should be passed by reference by
 713    default.  */
 714
 715 bool
 716 default_pass_by_ref (tree gnu_type)
 717 {
 718   /* We pass aggregates by reference if they are sufficiently large.  The
 719      choice of constant here is somewhat arbitrary.  We also pass by
 720      reference if the target machine would either pass or return by
 721      reference.  Strictly speaking, we need only check the return if this
 722      is an In Out parameter, but it's probably best to err on the side of
 723      passing more things by reference.  */
 724
 725   if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, 1))
 726     return true;
 727
 728   if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
 729     return true;
 730
 731   if (AGGREGATE_TYPE_P (gnu_type)
 732       && (!host_integerp (TYPE_SIZE (gnu_type), 1)
 733           || 0 < compare_tree_int (TYPE_SIZE (gnu_type),
 734                                    8 * TYPE_ALIGN (gnu_type))))
 735     return true;
 736
 737   return false;
 738 }
 739
 740 /* GNU_TYPE is the type of a subprogram parameter.  Determine from the type if
 741    it should be passed by reference. */
 742
 743 bool
 744 must_pass_by_ref (tree gnu_type)
 745 {
 746   /* We pass only unconstrained objects, those required by the language
 747      to be passed by reference, and objects of variable size.  The latter
 748      is more efficient, avoids problems with variable size temporaries,
 749      and does not produce compatibility problems with C, since C does
 750      not have such objects.  */
 751   return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
 752           || (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
 753           || (TYPE_SIZE (gnu_type)
 754               && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
 755 }
 756
 757 /* This function is called by the front end to enumerate all the supported
 758    modes for the machine.  We pass a function which is called back with
 759    the following integer parameters:
 760
 761    FLOAT_P      nonzero if this represents a floating-point mode
 762    COMPLEX_P    nonzero is this represents a complex mode
 763    COUNT        count of number of items, nonzero for vector mode
 764    PRECISION    number of bits in data representation
 765    MANTISSA     number of bits in mantissa, if FP and known, else zero.
 766    SIZE         number of bits used to store data
 767    ALIGN        number of bits to which mode is aligned.  */
 768
 769 void
 770 enumerate_modes (void (*f) (int, int, int, int, int, int, unsigned int))
 771 {
 772   enum machine_mode i;
 773
 774   for (i = 0; i < NUM_MACHINE_MODES; i++)
 775     {
 776       enum machine_mode j;
 777       bool float_p = 0;
 778       bool complex_p = 0;
 779       bool vector_p = 0;
 780       bool skip_p = 0;
 781       int mantissa = 0;
 782       enum machine_mode inner_mode = i;
 783
 784       switch (GET_MODE_CLASS (i))
 785         {
 786         case MODE_INT:
 787           break;
 788         case MODE_FLOAT:
 789           float_p = 1;
 790           break;
 791         case MODE_COMPLEX_INT:
 792           complex_p = 1;
 793           inner_mode = GET_MODE_INNER (i);
 794           break;
 795         case MODE_COMPLEX_FLOAT:
 796           float_p = 1;
 797           complex_p = 1;
 798           inner_mode = GET_MODE_INNER (i);
 799           break;
 800         case MODE_VECTOR_INT:
 801           vector_p = 1;
 802           inner_mode = GET_MODE_INNER (i);
 803           break;
 804         case MODE_VECTOR_FLOAT:
 805           float_p = 1;
 806           vector_p = 1;
 807           inner_mode = GET_MODE_INNER (i);
 808           break;
 809         default:
 810           skip_p = 1;
 811         }
 812
 813       /* Skip this mode if it's one the front end doesn't need to know about
 814          (e.g., the CC modes) or if there is no add insn for that mode (or
 815          any wider mode), meaning it is not supported by the hardware.  If
 816          this a complex or vector mode, we care about the inner mode.  */
 817       for (j = inner_mode; j != VOIDmode; j = GET_MODE_WIDER_MODE (j))
 818         if (add_optab->handlers[j].insn_code != CODE_FOR_nothing)
 819           break;
 820
 821       if (float_p)
 822         {
 823           const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode);
 824
 825           mantissa = fmt->p * fmt->log2_b;
 826         }
 827
 828       if (!skip_p && j != VOIDmode)
 829         (*f) (float_p, complex_p, vector_p ? GET_MODE_NUNITS (i) : 0,
 830               GET_MODE_BITSIZE (i), mantissa,
 831               GET_MODE_SIZE (i) * BITS_PER_UNIT, GET_MODE_ALIGNMENT (i));
 832     }
 833 }
 834
 835 int
 836 fp_prec_to_size (int prec)
 837 {
 838   enum machine_mode mode;
 839
 840   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
 841        mode = GET_MODE_WIDER_MODE (mode))
 842     if (GET_MODE_PRECISION (mode) == prec)
 843       return GET_MODE_BITSIZE (mode);
 844
 845   abort ();
 846 }
 847
 848 int
 849 fp_size_to_prec (int size)
 850 {
 851   enum machine_mode mode;
 852
 853   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
 854        mode = GET_MODE_WIDER_MODE (mode))
 855     if (GET_MODE_BITSIZE (mode) == size)
 856       return GET_MODE_PRECISION (mode);
 857
 858   abort ();
 859 }