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