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