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-2006, 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     case OPT_Wvariadic_macros:
 287     case OPT_Wold_style_definition:
 288     case OPT_Wmissing_format_attribute:
 289     case OPT_Woverlength_strings:
 290       break;
 291
 292       /* This is handled by the front-end.  */
 293     case OPT_nostdinc:
 294       break;
 295
 296     case OPT_nostdlib:
 297       gnat_argv[gnat_argc] = xstrdup ("-nostdlib");
 298       gnat_argc++;
 299       break;
 300
 301     case OPT_fRTS_:
 302       gnat_argv[gnat_argc] = xstrdup ("-fRTS");
 303       gnat_argc++;
 304       break;
 305
 306     case OPT_gant:
 307       warning (0, "%<-gnat%> misspelled as %<-gant%>");
 308
 309       /* ... fall through ... */
 310
 311     case OPT_gnat:
 312       /* Recopy the switches without the 'gnat' prefix.  */
 313       gnat_argv[gnat_argc] = xmalloc (strlen (arg) + 2);
 314       gnat_argv[gnat_argc][0] = '-';
 315       strcpy (gnat_argv[gnat_argc] + 1, arg);
 316       gnat_argc++;
 317       break;
 318
 319     case OPT_gnatO:
 320       gnat_argv[gnat_argc] = xstrdup ("-O");
 321       gnat_argc++;
 322       gnat_argv[gnat_argc] = xstrdup (arg);
 323       gnat_argc++;
 324       break;
 325     }
 326
 327   return 1;
 328 }
 329
 330 /* Initialize for option processing.  */
 331
 332 static unsigned int
 333 gnat_init_options (unsigned int argc, const char **argv)
 334 {
 335   /* Initialize gnat_argv with save_argv size.  */
 336   gnat_argv = (char **) xmalloc ((argc + 1) * sizeof (argv[0]));
 337   gnat_argv[0] = xstrdup (argv[0]);     /* name of the command */
 338   gnat_argc = 1;
 339
 340   save_argc = argc;
 341   save_argv = argv;
 342
 343   /* Uninitialized really means uninitialized in Ada.  */
 344   flag_zero_initialized_in_bss = 0;
 345
 346   return CL_Ada;
 347 }
 348
 349 /* Post-switch processing.  */
 350
 351 bool
 352 gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
 353 {
 354   flag_inline_trees = 1;
 355
 356   if (!flag_no_inline)
 357     flag_no_inline = 1;
 358   if (flag_inline_functions)
 359     flag_inline_trees = 2;
 360
 361   flag_tree_salias = 0;
 362
 363   return false;
 364 }
 365
 366 /* Here is the function to handle the compiler error processing in GCC.  */
 367
 368 static void
 369 internal_error_function (const char *msgid, va_list *ap)
 370 {
 371   text_info tinfo;
 372   char *buffer;
 373   char *p;
 374   String_Template temp;
 375   Fat_Pointer fp;
 376
 377   /* Reset the pretty-printer.  */
 378   pp_clear_output_area (global_dc->printer);
 379
 380   /* Format the message into the pretty-printer.  */
 381   tinfo.format_spec = msgid;
 382   tinfo.args_ptr = ap;
 383   tinfo.err_no = errno;
 384   pp_format_verbatim (global_dc->printer, &tinfo);
 385
 386   /* Extract a (writable) pointer to the formatted text.  */
 387   buffer = (char*) pp_formatted_text (global_dc->printer);
 388
 389   /* Go up to the first newline.  */
 390   for (p = buffer; *p; p++)
 391     if (*p == '\n')
 392       {
 393         *p = '\0';
 394         break;
 395       }
 396
 397   temp.Low_Bound = 1;
 398   temp.High_Bound = p - buffer;
 399   fp.Bounds = &temp;
 400   fp.Array = buffer;
 401
 402   Current_Error_Node = error_gnat_node;
 403   Compiler_Abort (fp, -1);
 404 }
 405
 406 /* Perform all the initialization steps that are language-specific.  */
 407
 408 static bool
 409 gnat_init (void)
 410 {
 411   /* Initialize translations and the outer statement group.  */
 412   gnat_init_stmt_group ();
 413
 414   /* Performs whatever initialization steps needed by the language-dependent
 415      lexical analyzer.  */
 416   gnat_init_decl_processing ();
 417
 418   /* Add the input filename as the last argument.  */
 419   gnat_argv[gnat_argc] = (char *) main_input_filename;
 420   gnat_argc++;
 421   gnat_argv[gnat_argc] = 0;
 422
 423   global_dc->internal_error = &internal_error_function;
 424
 425   /* Show that REFERENCE_TYPEs are internal and should be Pmode.  */
 426   internal_reference_types ();
 427
 428   set_lang_adjust_rli (gnat_adjust_rli);
 429
 430   return true;
 431 }
 432
 433 /* This function is called indirectly from toplev.c to handle incomplete
 434    declarations, i.e. VAR_DECL nodes whose DECL_SIZE is zero.  To be precise,
 435    compile_file in toplev.c makes an indirect call through the function pointer
 436    incomplete_decl_finalize_hook which is initialized to this routine in
 437    init_decl_processing.  */
 438
 439 static void
 440 gnat_finish_incomplete_decl (tree dont_care ATTRIBUTE_UNUSED)
 441 {
 442   abort ();
 443 }
 444 \f
 445 /* Compute the alignment of the largest mode that can be used for copying
 446    objects.  */
 447
 448 void
 449 gnat_compute_largest_alignment (void)
 450 {
 451   enum machine_mode mode;
 452
 453   for (mode = GET_CLASS_NARROWEST_MODE (MODE_INT); mode != VOIDmode;
 454        mode = GET_MODE_WIDER_MODE (mode))
 455     if (mov_optab->handlers[(int) mode].insn_code != CODE_FOR_nothing)
 456       largest_move_alignment = MIN (BIGGEST_ALIGNMENT,
 457                                     MAX (largest_move_alignment,
 458                                          GET_MODE_ALIGNMENT (mode)));
 459 }
 460
 461 /* If we are using the GCC mechanism to process exception handling, we
 462    have to register the personality routine for Ada and to initialize
 463    various language dependent hooks.  */
 464
 465 void
 466 gnat_init_gcc_eh (void)
 467 {
 468   /* We shouldn't do anything if the No_Exceptions_Handler pragma is set,
 469      though. This could for instance lead to the emission of tables with
 470      references to symbols (such as the Ada eh personality routine) within
 471      libraries we won't link against.  */
 472   if (No_Exception_Handlers_Set ())
 473     return;
 474
 475   /* Tell GCC we are handling cleanup actions through exception propagation.
 476      This opens possibilities that we don't take advantage of yet, but is
 477      nonetheless necessary to ensure that fixup code gets assigned to the
 478      right exception regions.  */
 479   using_eh_for_cleanups ();
 480
 481   eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality");
 482   lang_eh_type_covers = gnat_eh_type_covers;
 483   lang_eh_runtime_type = gnat_eh_runtime_type;
 484   default_init_unwind_resume_libfunc ();
 485
 486   /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers
 487      the generation of the necessary exception runtime tables. The second one
 488      is useful for two reasons: 1/ we map some asynchronous signals like SEGV
 489      to exceptions, so we need to ensure that the insns which can lead to such
 490      signals are correctly attached to the exception region they pertain to,
 491      2/ Some calls to pure subprograms are handled as libcall blocks and then
 492      marked as "cannot trap" if the flag is not set (see emit_libcall_block).
 493      We should not let this be since it is possible for such calls to actually
 494      raise in Ada.  */
 495
 496   flag_exceptions = 1;
 497   flag_non_call_exceptions = 1;
 498
 499   init_eh ();
 500 #ifdef DWARF2_UNWIND_INFO
 501   if (dwarf2out_do_frame ())
 502     dwarf2out_frame_init ();
 503 #endif
 504 }
 505
 506 /* Language hooks, first one to print language-specific items in a DECL.  */
 507
 508 static void
 509 gnat_print_decl (FILE *file, tree node, int indent)
 510 {
 511   switch (TREE_CODE (node))
 512     {
 513     case CONST_DECL:
 514       print_node (file, "const_corresponding_var",
 515                   DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
 516       break;
 517
 518     case FIELD_DECL:
 519       print_node (file, "original_field", DECL_ORIGINAL_FIELD (node),
 520                   indent + 4);
 521       break;
 522
 523     case VAR_DECL:
 524       print_node (file, "renamed_object", DECL_RENAMED_OBJECT (node),
 525                   indent + 4);
 526       break;
 527
 528     default:
 529       break;
 530     }
 531 }
 532
 533 static void
 534 gnat_print_type (FILE *file, tree node, int indent)
 535 {
 536   switch (TREE_CODE (node))
 537     {
 538     case FUNCTION_TYPE:
 539       print_node (file, "ci_co_list", TYPE_CI_CO_LIST (node), indent + 4);
 540       break;
 541
 542     case ENUMERAL_TYPE:
 543       print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
 544       break;
 545
 546     case INTEGER_TYPE:
 547       if (TYPE_MODULAR_P (node))
 548         print_node (file, "modulus", TYPE_MODULUS (node), indent + 4);
 549       else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
 550         print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
 551                     indent + 4);
 552       else if (TYPE_VAX_FLOATING_POINT_P (node))
 553         ;
 554       else
 555         print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
 556
 557       print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
 558       break;
 559
 560     case ARRAY_TYPE:
 561       print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
 562       break;
 563
 564     case RECORD_TYPE:
 565       if (TYPE_IS_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
 566         print_node (file, "unconstrained array",
 567                     TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
 568       else
 569         print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
 570       break;
 571
 572     case UNION_TYPE:
 573     case QUAL_UNION_TYPE:
 574       print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
 575       break;
 576
 577     default:
 578       break;
 579     }
 580 }
 581
 582 static const char *
 583 gnat_printable_name (tree decl, int verbosity)
 584 {
 585   const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
 586   char *ada_name = (char *) ggc_alloc (strlen (coded_name) * 2 + 60);
 587
 588   __gnat_decode (coded_name, ada_name, 0);
 589
 590   if (verbosity == 2)
 591     {
 592       Set_Identifier_Casing (ada_name, (char *) DECL_SOURCE_FILE (decl));
 593       ada_name = Name_Buffer;
 594     }
 595
 596   return (const char *) ada_name;
 597 }
 598
 599 /* Expands GNAT-specific GCC tree nodes.  The only ones we support
 600    here are  and NULL_EXPR.  */
 601
 602 static rtx
 603 gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode,
 604                   int modifier, rtx *alt_rtl)
 605 {
 606   tree type = TREE_TYPE (exp);
 607   tree new;
 608
 609   /* If this is a statement, call the expansion routine for statements.  */
 610   if (IS_STMT (exp))
 611     {
 612       gnat_expand_stmt (exp);
 613       return const0_rtx;
 614     }
 615
 616   /* Update EXP to be the new expression to expand.  */
 617   switch (TREE_CODE (exp))
 618     {
 619 #if 0
 620     case ALLOCATE_EXPR:
 621       return
 622         allocate_dynamic_stack_space
 623           (expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype),
 624                         EXPAND_NORMAL),
 625            NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1));
 626 #endif
 627
 628     case UNCONSTRAINED_ARRAY_REF:
 629       /* If we are evaluating just for side-effects, just evaluate our
 630          operand.  Otherwise, abort since this code should never appear
 631          in a tree to be evaluated (objects aren't unconstrained).  */
 632       if (target == const0_rtx || TREE_CODE (type) == VOID_TYPE)
 633         return expand_expr (TREE_OPERAND (exp, 0), const0_rtx,
 634                             VOIDmode, modifier);
 635
 636       /* ... fall through ... */
 637
 638     default:
 639       abort ();
 640     }
 641
 642   return expand_expr_real (new, target, tmode, modifier, alt_rtl);
 643 }
 644
 645 /* Generate the RTL for the body of GNU_DECL.  */
 646
 647 static void
 648 gnat_expand_body (tree gnu_decl)
 649 {
 650   if (!DECL_INITIAL (gnu_decl) || DECL_INITIAL (gnu_decl) == error_mark_node)
 651     return;
 652
 653   tree_rest_of_compilation (gnu_decl);
 654
 655   if (DECL_STATIC_CONSTRUCTOR (gnu_decl) && targetm.have_ctors_dtors)
 656     targetm.asm_out.constructor (XEXP (DECL_RTL (gnu_decl), 0),
 657                                  DEFAULT_INIT_PRIORITY);
 658
 659   if (DECL_STATIC_DESTRUCTOR (gnu_decl) && targetm.have_ctors_dtors)
 660     targetm.asm_out.destructor (XEXP (DECL_RTL (gnu_decl), 0),
 661                                 DEFAULT_INIT_PRIORITY);
 662 }
 663
 664 /* Adjusts the RLI used to layout a record after all the fields have been
 665    added.  We only handle the packed case and cause it to use the alignment
 666    that will pad the record at the end.  */
 667
 668 static void
 669 gnat_adjust_rli (record_layout_info rli ATTRIBUTE_UNUSED)
 670 {
 671 #if 0
 672   /* ??? This code seems to have no actual effect; record_align should already
 673      reflect the largest alignment desired by a field.  jason 2003-04-01  */
 674   unsigned int record_align = rli->unpadded_align;
 675   tree field;
 676
 677   /* If an alignment has been specified, don't use anything larger unless we
 678      have to.  */
 679   if (TYPE_ALIGN (rli->t) != 0 && TYPE_ALIGN (rli->t) < record_align)
 680     record_align = MAX (rli->record_align, TYPE_ALIGN (rli->t));
 681
 682   /* If any fields have variable size, we need to force the record to be at
 683      least as aligned as the alignment of that type.  */
 684   for (field = TYPE_FIELDS (rli->t); field; field = TREE_CHAIN (field))
 685     if (TREE_CODE (DECL_SIZE_UNIT (field)) != INTEGER_CST)
 686       record_align = MAX (record_align, DECL_ALIGN (field));
 687
 688   if (TYPE_PACKED (rli->t))
 689     rli->record_align = record_align;
 690 #endif
 691 }
 692 \f
 693 /* These routines are used in conjunction with GCC exception handling.  */
 694
 695 /* Map compile-time to run-time tree for GCC exception handling scheme.  */
 696
 697 static tree
 698 gnat_eh_runtime_type (tree type)
 699 {
 700   return type;
 701 }
 702
 703 /* Return true if type A catches type B. Callback for flow analysis from
 704    the exception handling part of the back-end.  */
 705
 706 static int
 707 gnat_eh_type_covers (tree a, tree b)
 708 {
 709   /* a catches b if they represent the same exception id or if a
 710      is an "others".
 711
 712      ??? integer_zero_node for "others" is hardwired in too many places
 713      currently.  */
 714   return (a == b || a == integer_zero_node);
 715 }
 716 \f
 717 /* Get the alias set corresponding to a type or expression.  */
 718
 719 static HOST_WIDE_INT
 720 gnat_get_alias_set (tree type)
 721 {
 722   /* If this is a padding type, use the type of the first field.  */
 723   if (TREE_CODE (type) == RECORD_TYPE
 724       && TYPE_IS_PADDING_P (type))
 725     return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
 726
 727   /* If the type is an unconstrained array, use the type of the
 728      self-referential array we make.  */
 729   else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
 730     return
 731       get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
 732
 733
 734   return -1;
 735 }
 736
 737 /* GNU_TYPE is a type.  Return its maxium size in bytes, if known.  */
 738
 739 static tree
 740 gnat_type_max_size (gnu_type)
 741      tree gnu_type;
 742 {
 743   return max_size (TYPE_SIZE_UNIT (gnu_type), true);
 744 }
 745
 746 /* GNU_TYPE is a type. Determine if it should be passed by reference by
 747    default.  */
 748
 749 bool
 750 default_pass_by_ref (tree gnu_type)
 751 {
 752   /* We pass aggregates by reference if they are sufficiently large.  The
 753      choice of constant here is somewhat arbitrary.  We also pass by
 754      reference if the target machine would either pass or return by
 755      reference.  Strictly speaking, we need only check the return if this
 756      is an In Out parameter, but it's probably best to err on the side of
 757      passing more things by reference.  */
 758
 759   if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, 1))
 760     return true;
 761
 762   if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
 763     return true;
 764
 765   if (AGGREGATE_TYPE_P (gnu_type)
 766       && (!host_integerp (TYPE_SIZE (gnu_type), 1)
 767           || 0 < compare_tree_int (TYPE_SIZE (gnu_type),
 768                                    8 * TYPE_ALIGN (gnu_type))))
 769     return true;
 770
 771   return false;
 772 }
 773
 774 /* GNU_TYPE is the type of a subprogram parameter.  Determine from the type if
 775    it should be passed by reference. */
 776
 777 bool
 778 must_pass_by_ref (tree gnu_type)
 779 {
 780   /* We pass only unconstrained objects, those required by the language
 781      to be passed by reference, and objects of variable size.  The latter
 782      is more efficient, avoids problems with variable size temporaries,
 783      and does not produce compatibility problems with C, since C does
 784      not have such objects.  */
 785   return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
 786           || (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
 787           || (TYPE_SIZE (gnu_type)
 788               && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
 789 }
 790
 791 /* This function is called by the front end to enumerate all the supported
 792    modes for the machine.  We pass a function which is called back with
 793    the following integer parameters:
 794
 795    FLOAT_P      nonzero if this represents a floating-point mode
 796    COMPLEX_P    nonzero is this represents a complex mode
 797    COUNT        count of number of items, nonzero for vector mode
 798    PRECISION    number of bits in data representation
 799    MANTISSA     number of bits in mantissa, if FP and known, else zero.
 800    SIZE         number of bits used to store data
 801    ALIGN        number of bits to which mode is aligned.  */
 802
 803 void
 804 enumerate_modes (void (*f) (int, int, int, int, int, int, unsigned int))
 805 {
 806   enum machine_mode i;
 807
 808   for (i = 0; i < NUM_MACHINE_MODES; i++)
 809     {
 810       enum machine_mode j;
 811       bool float_p = 0;
 812       bool complex_p = 0;
 813       bool vector_p = 0;
 814       bool skip_p = 0;
 815       int mantissa = 0;
 816       enum machine_mode inner_mode = i;
 817
 818       switch (GET_MODE_CLASS (i))
 819         {
 820         case MODE_INT:
 821           break;
 822         case MODE_FLOAT:
 823           float_p = 1;
 824           break;
 825         case MODE_COMPLEX_INT:
 826           complex_p = 1;
 827           inner_mode = GET_MODE_INNER (i);
 828           break;
 829         case MODE_COMPLEX_FLOAT:
 830           float_p = 1;
 831           complex_p = 1;
 832           inner_mode = GET_MODE_INNER (i);
 833           break;
 834         case MODE_VECTOR_INT:
 835           vector_p = 1;
 836           inner_mode = GET_MODE_INNER (i);
 837           break;
 838         case MODE_VECTOR_FLOAT:
 839           float_p = 1;
 840           vector_p = 1;
 841           inner_mode = GET_MODE_INNER (i);
 842           break;
 843         default:
 844           skip_p = 1;
 845         }
 846
 847       /* Skip this mode if it's one the front end doesn't need to know about
 848          (e.g., the CC modes) or if there is no add insn for that mode (or
 849          any wider mode), meaning it is not supported by the hardware.  If
 850          this a complex or vector mode, we care about the inner mode.  */
 851       for (j = inner_mode; j != VOIDmode; j = GET_MODE_WIDER_MODE (j))
 852         if (add_optab->handlers[j].insn_code != CODE_FOR_nothing)
 853           break;
 854
 855       if (float_p)
 856         {
 857           const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode);
 858
 859           mantissa = fmt->p * fmt->log2_b;
 860         }
 861
 862       if (!skip_p && j != VOIDmode)
 863         (*f) (float_p, complex_p, vector_p ? GET_MODE_NUNITS (i) : 0,
 864               GET_MODE_BITSIZE (i), mantissa,
 865               GET_MODE_SIZE (i) * BITS_PER_UNIT, GET_MODE_ALIGNMENT (i));
 866     }
 867 }
 868
 869 int
 870 fp_prec_to_size (int prec)
 871 {
 872   enum machine_mode mode;
 873
 874   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
 875        mode = GET_MODE_WIDER_MODE (mode))
 876     if (GET_MODE_PRECISION (mode) == prec)
 877       return GET_MODE_BITSIZE (mode);
 878
 879   abort ();
 880 }
 881
 882 int
 883 fp_size_to_prec (int size)
 884 {
 885   enum machine_mode mode;
 886
 887   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
 888        mode = GET_MODE_WIDER_MODE (mode))
 889     if (GET_MODE_BITSIZE (mode) == size)
 890       return GET_MODE_PRECISION (mode);
 891
 892   abort ();
 893 }