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