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 "insn-codes.h"
  52 #include "insn-flags.h"
  53 #include "insn-config.h"
  54 #include "optabs.h"
  55 #include "recog.h"
  56 #include "toplev.h"
  57 #include "output.h"
  58 #include "except.h"
  59 #include "tm_p.h"
  60 #include "langhooks.h"
  61 #include "langhooks-def.h"
  62 #include "target.h"
  63
  64 #include "ada.h"
  65 #include "types.h"
  66 #include "atree.h"
  67 #include "elists.h"
  68 #include "namet.h"
  69 #include "nlists.h"
  70 #include "stringt.h"
  71 #include "uintp.h"
  72 #include "fe.h"
  73 #include "sinfo.h"
  74 #include "einfo.h"
  75 #include "ada-tree.h"
  76 #include "gigi.h"
  77 #include "adadecode.h"
  78 #include "opts.h"
  79 #include "options.h"
  80
  81 extern FILE *asm_out_file;
  82
  83 /* The largest alignment, in bits, that is needed for using the widest
  84    move instruction.  */
  85 unsigned int largest_move_alignment;
  86
  87 static size_t gnat_tree_size            (enum tree_code);
  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 HOST_WIDE_INT gnat_get_alias_set (tree);
  93 static void gnat_print_decl             (FILE *, tree, int);
  94 static void gnat_print_type             (FILE *, tree, int);
  95 static const char *gnat_printable_name  (tree, int);
  96 static tree gnat_eh_runtime_type        (tree);
  97 static int gnat_eh_type_covers          (tree, tree);
  98 static void gnat_parse_file             (int);
  99 static rtx gnat_expand_expr             (tree, rtx, enum machine_mode, int,
 100                                          rtx *);
 101 static void internal_error_function     (const char *, va_list *);
 102 static void gnat_adjust_rli             (record_layout_info);
 103
 104 /* Definitions for our language-specific hooks.  */
 105
 106 #undef  LANG_HOOKS_NAME
 107 #define LANG_HOOKS_NAME                 "GNU Ada"
 108 #undef  LANG_HOOKS_IDENTIFIER_SIZE
 109 #define LANG_HOOKS_IDENTIFIER_SIZE      sizeof (struct tree_identifier)
 110 #undef  LANG_HOOKS_TREE_SIZE
 111 #define LANG_HOOKS_TREE_SIZE            gnat_tree_size
 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_PARSE_FILE
 119 #define LANG_HOOKS_PARSE_FILE           gnat_parse_file
 120 #undef LANG_HOOKS_HONOR_READONLY
 121 #define LANG_HOOKS_HONOR_READONLY       true
 122 #undef LANG_HOOKS_HASH_TYPES
 123 #define LANG_HOOKS_HASH_TYPES           false
 124 #undef LANG_HOOKS_FINISH_INCOMPLETE_DECL
 125 #define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl
 126 #undef LANG_HOOKS_GET_ALIAS_SET
 127 #define LANG_HOOKS_GET_ALIAS_SET        gnat_get_alias_set
 128 #undef LANG_HOOKS_EXPAND_EXPR
 129 #define LANG_HOOKS_EXPAND_EXPR          gnat_expand_expr
 130 #undef LANG_HOOKS_MARK_ADDRESSABLE
 131 #define LANG_HOOKS_MARK_ADDRESSABLE     gnat_mark_addressable
 132 #undef LANG_HOOKS_TRUTHVALUE_CONVERSION
 133 #define LANG_HOOKS_TRUTHVALUE_CONVERSION gnat_truthvalue_conversion
 134 #undef LANG_HOOKS_PRINT_DECL
 135 #define LANG_HOOKS_PRINT_DECL           gnat_print_decl
 136 #undef LANG_HOOKS_PRINT_TYPE
 137 #define LANG_HOOKS_PRINT_TYPE           gnat_print_type
 138 #undef LANG_HOOKS_DECL_PRINTABLE_NAME
 139 #define LANG_HOOKS_DECL_PRINTABLE_NAME  gnat_printable_name
 140 #undef LANG_HOOKS_TYPE_FOR_MODE
 141 #define LANG_HOOKS_TYPE_FOR_MODE        gnat_type_for_mode
 142 #undef LANG_HOOKS_TYPE_FOR_SIZE
 143 #define LANG_HOOKS_TYPE_FOR_SIZE        gnat_type_for_size
 144 #undef LANG_HOOKS_SIGNED_TYPE
 145 #define LANG_HOOKS_SIGNED_TYPE          gnat_signed_type
 146 #undef LANG_HOOKS_UNSIGNED_TYPE
 147 #define LANG_HOOKS_UNSIGNED_TYPE        gnat_unsigned_type
 148 #undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
 149 #define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gnat_signed_or_unsigned_type
 150
 151 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 152
 153 /* Tables describing GCC tree codes used only by GNAT.
 154
 155    Table indexed by tree code giving a string containing a character
 156    classifying the tree code.  Possibilities are
 157    t, d, s, c, r, <, 1 and 2.  See cp-tree.def for details.  */
 158
 159 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
 160
 161 const char tree_code_type[] = {
 162 #include "tree.def"
 163   'x',
 164 #include "ada-tree.def"
 165 };
 166 #undef DEFTREECODE
 167
 168 /* Table indexed by tree code giving number of expression
 169    operands beyond the fixed part of the node structure.
 170    Not used for types or decls.  */
 171
 172 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
 173
 174 const unsigned char tree_code_length[] = {
 175 #include "tree.def"
 176   0,
 177 #include "ada-tree.def"
 178 };
 179 #undef DEFTREECODE
 180
 181 /* Names of tree components.
 182    Used for printing out the tree and error messages.  */
 183 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
 184
 185 const char *const tree_code_name[] = {
 186 #include "tree.def"
 187   "@@dummy",
 188 #include "ada-tree.def"
 189 };
 190 #undef DEFTREECODE
 191
 192 /* Command-line argc and argv.
 193    These variables are global, since they are imported and used in
 194    back_end.adb  */
 195
 196 unsigned int save_argc;
 197 const char **save_argv;
 198
 199 /* gnat standard argc argv */
 200
 201 extern int gnat_argc;
 202 extern char **gnat_argv;
 203
 204 \f
 205 /* Declare functions we use as part of startup.  */
 206 extern void __gnat_initialize   (void);
 207 extern void adainit             (void);
 208 extern void _ada_gnat1drv       (void);
 209
 210 /* The parser for the language.  For us, we process the GNAT tree.  */
 211
 212 static void
 213 gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
 214 {
 215   /* call the target specific initializations */
 216   __gnat_initialize();
 217
 218   /* Call the front-end elaboration procedures */
 219   adainit ();
 220
 221   immediate_size_expand = 1;
 222
 223   /* Call the front end */
 224   _ada_gnat1drv ();
 225 }
 226
 227 /* Decode all the language specific options that cannot be decoded by GCC.
 228    The option decoding phase of GCC calls this routine on the flags that
 229    it cannot decode.  This routine returns the number of consecutive arguments
 230    from ARGV that it successfully decoded; 0 indicates failure.  */
 231
 232 static int
 233 gnat_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED)
 234 {
 235   const struct cl_option *option = &cl_options[scode];
 236   enum opt_code code = (enum opt_code) scode;
 237   char *q;
 238   unsigned int i;
 239
 240   if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE)))
 241     {
 242       error ("missing argument to \"-%s\"", option->opt_text);
 243       return 1;
 244     }
 245
 246   switch (code)
 247     {
 248     default:
 249       abort ();
 250
 251     case OPT_I:
 252       q = xmalloc (sizeof("-I") + strlen (arg));
 253       strcpy (q, "-I");
 254       strcat (q, arg);
 255       gnat_argv[gnat_argc] = q;
 256       gnat_argc++;
 257       break;
 258
 259       /* All front ends are expected to accept this.  */
 260     case OPT_Wall:
 261       /* These are used in the GCC Makefile.  */
 262     case OPT_Wmissing_prototypes:
 263     case OPT_Wstrict_prototypes:
 264     case OPT_Wwrite_strings:
 265     case OPT_Wlong_long:
 266       break;
 267
 268       /* This is handled by the front-end.  */
 269     case OPT_nostdinc:
 270       break;
 271
 272     case OPT_nostdlib:
 273       gnat_argv[gnat_argc] = xstrdup ("-nostdlib");
 274       gnat_argc++;
 275       break;
 276
 277     case OPT_fRTS:
 278       gnat_argv[gnat_argc] = xstrdup ("-fRTS");
 279       gnat_argc++;
 280       break;
 281
 282     case OPT_gant:
 283       warning ("`-gnat' misspelled as `-gant'");
 284
 285       /* ... fall through ... */
 286
 287     case OPT_gnat:
 288       /* Recopy the switches without the 'gnat' prefix.  */
 289       gnat_argv[gnat_argc] = xmalloc (strlen (arg) + 2);
 290       gnat_argv[gnat_argc][0] = '-';
 291       strcpy (gnat_argv[gnat_argc] + 1, arg);
 292       gnat_argc++;
 293
 294       if (arg[0] == 'O')
 295         for (i = 1; i < save_argc - 1; i++)
 296           if (!strncmp (save_argv[i], "-gnatO", 6))
 297             if (save_argv[++i][0] != '-')
 298               {
 299                 /* Preserve output filename as GCC doesn't save it for GNAT. */
 300                 gnat_argv[gnat_argc] = xstrdup (save_argv[i]);
 301                 gnat_argc++;
 302                 break;
 303               }
 304       break;
 305     }
 306
 307   return 1;
 308 }
 309
 310 /* Initialize for option processing.  */
 311
 312 static unsigned int
 313 gnat_init_options (unsigned int argc, const char **argv)
 314 {
 315   /* Initialize gnat_argv with save_argv size.  */
 316   gnat_argv = (char **) xmalloc ((argc + 1) * sizeof (argv[0]));
 317   gnat_argv[0] = xstrdup (argv[0]);     /* name of the command */
 318   gnat_argc = 1;
 319
 320   save_argc = argc;
 321   save_argv = argv;
 322
 323   return CL_Ada;
 324 }
 325
 326 /* Here is the function to handle the compiler error processing in GCC.  */
 327
 328 static void
 329 internal_error_function (const char *msgid, va_list *ap)
 330 {
 331   char buffer[1000];            /* Assume this is big enough.  */
 332   char *p;
 333   String_Template temp;
 334   Fat_Pointer fp;
 335
 336   vsprintf (buffer, msgid, *ap);
 337
 338   /* Go up to the first newline.  */
 339   for (p = buffer; *p != 0; p++)
 340     if (*p == '\n')
 341       {
 342         *p = '\0';
 343         break;
 344       }
 345
 346   temp.Low_Bound = 1, temp.High_Bound = strlen (buffer);
 347   fp.Array = buffer, fp.Bounds = &temp;
 348
 349   Current_Error_Node = error_gnat_node;
 350   Compiler_Abort (fp, -1);
 351 }
 352
 353 /* Langhook for tree_size: Determine size of our 'x' and 'c' nodes.  */
 354
 355 static size_t
 356 gnat_tree_size (enum tree_code code)
 357 {
 358   switch (code)
 359     {
 360     case GNAT_LOOP_ID:
 361       return sizeof (struct tree_loop_id);
 362     default:
 363       abort ();
 364     }
 365   /* NOTREACHED */
 366 }
 367
 368 /* Perform all the initialization steps that are language-specific.  */
 369
 370 static bool
 371 gnat_init (void)
 372 {
 373   /* Performs whatever initialization steps needed by the language-dependent
 374      lexical analyzer.  */
 375   gnat_init_decl_processing ();
 376
 377   /* Add the input filename as the last argument.  */
 378   gnat_argv[gnat_argc] = (char *) main_input_filename;
 379   gnat_argc++;
 380   gnat_argv[gnat_argc] = 0;
 381
 382   global_dc->internal_error = &internal_error_function;
 383
 384   /* Show that REFERENCE_TYPEs are internal and should be Pmode.  */
 385   internal_reference_types ();
 386
 387   set_lang_adjust_rli (gnat_adjust_rli);
 388
 389   return true;
 390 }
 391
 392 /* This function is called indirectly from toplev.c to handle incomplete
 393    declarations, i.e. VAR_DECL nodes whose DECL_SIZE is zero.  To be precise,
 394    compile_file in toplev.c makes an indirect call through the function pointer
 395    incomplete_decl_finalize_hook which is initialized to this routine in
 396    init_decl_processing.  */
 397
 398 static void
 399 gnat_finish_incomplete_decl (tree dont_care ATTRIBUTE_UNUSED)
 400 {
 401   gigi_abort (202);
 402 }
 403 \f
 404 /* Compute the alignment of the largest mode that can be used for copying
 405    objects.  */
 406
 407 void
 408 gnat_compute_largest_alignment (void)
 409 {
 410   enum machine_mode mode;
 411
 412   for (mode = GET_CLASS_NARROWEST_MODE (MODE_INT); mode != VOIDmode;
 413        mode = GET_MODE_WIDER_MODE (mode))
 414     if (mov_optab->handlers[(int) mode].insn_code != CODE_FOR_nothing)
 415       largest_move_alignment = MIN (BIGGEST_ALIGNMENT,
 416                                     MAX (largest_move_alignment,
 417                                          GET_MODE_ALIGNMENT (mode)));
 418 }
 419
 420 /* If we are using the GCC mechanism to process exception handling, we
 421    have to register the personality routine for Ada and to initialize
 422    various language dependent hooks.  */
 423
 424 void
 425 gnat_init_gcc_eh (void)
 426 {
 427   /* We shouldn't do anything if the No_Exceptions_Handler pragma is set,
 428      though. This could for instance lead to the emission of tables with
 429      references to symbols (such as the Ada eh personality routine) within
 430      libraries we won't link against.  */
 431   if (No_Exception_Handlers_Set ())
 432     return;
 433
 434   /* Tell GCC we are handling cleanup actions through exception propagation.
 435      This opens possibilities that we don't take advantage of yet, but is
 436      nonetheless necessary to ensure that fixup code gets assigned to the
 437      right exception regions.  */
 438   using_eh_for_cleanups ();
 439
 440   eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality");
 441   lang_eh_type_covers = gnat_eh_type_covers;
 442   lang_eh_runtime_type = gnat_eh_runtime_type;
 443
 444   /* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers
 445      the generation of the necessary exception runtime tables. The second one
 446      is useful for two reasons: 1/ we map some asynchronous signals like SEGV
 447      to exceptions, so we need to ensure that the insns which can lead to such
 448      signals are correctly attached to the exception region they pertain to,
 449      2/ Some calls to pure subprograms are handled as libcall blocks and then
 450      marked as "cannot trap" if the flag is not set (see emit_libcall_block).
 451      We should not let this be since it is possible for such calls to actually
 452      raise in Ada.  */
 453
 454   flag_exceptions = 1;
 455   flag_non_call_exceptions = 1;
 456
 457   init_eh ();
 458 #ifdef DWARF2_UNWIND_INFO
 459   if (dwarf2out_do_frame ())
 460     dwarf2out_frame_init ();
 461 #endif
 462 }
 463
 464 /* Language hooks, first one to print language-specific items in a DECL.  */
 465
 466 static void
 467 gnat_print_decl (FILE *file, tree node, int indent)
 468 {
 469   switch (TREE_CODE (node))
 470     {
 471     case CONST_DECL:
 472       print_node (file, "const_corresponding_var",
 473                   DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
 474       break;
 475
 476     case FIELD_DECL:
 477       print_node (file, "original field", DECL_ORIGINAL_FIELD (node),
 478                   indent + 4);
 479       break;
 480
 481     default:
 482       break;
 483     }
 484 }
 485
 486 static void
 487 gnat_print_type (FILE *file, tree node, int indent)
 488 {
 489   switch (TREE_CODE (node))
 490     {
 491     case FUNCTION_TYPE:
 492       print_node (file, "ci_co_list", TYPE_CI_CO_LIST (node), indent + 4);
 493       break;
 494
 495     case ENUMERAL_TYPE:
 496       print_node (file, "RM size", TYPE_RM_SIZE_ENUM (node), indent + 4);
 497       break;
 498
 499     case INTEGER_TYPE:
 500       if (TYPE_MODULAR_P (node))
 501         print_node (file, "modulus", TYPE_MODULUS (node), indent + 4);
 502       else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
 503         print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
 504                     indent + 4);
 505       else if (TYPE_VAX_FLOATING_POINT_P (node))
 506         ;
 507       else
 508         print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
 509
 510       print_node (file, "RM size", TYPE_RM_SIZE_INT (node), indent + 4);
 511       break;
 512
 513     case ARRAY_TYPE:
 514       print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
 515       break;
 516
 517     case RECORD_TYPE:
 518       if (TYPE_IS_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
 519         print_node (file, "unconstrained array",
 520                     TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
 521       else
 522         print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
 523       break;
 524
 525     case UNION_TYPE:
 526     case QUAL_UNION_TYPE:
 527       print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
 528       break;
 529
 530     default:
 531       break;
 532     }
 533 }
 534
 535 static const char *
 536 gnat_printable_name (tree decl, int verbosity)
 537 {
 538   const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
 539   char *ada_name = (char *) ggc_alloc (strlen (coded_name) * 2 + 60);
 540
 541   __gnat_decode (coded_name, ada_name, 0);
 542
 543   if (verbosity == 2)
 544     {
 545       Set_Identifier_Casing (ada_name, (char *) DECL_SOURCE_FILE (decl));
 546       ada_name = Name_Buffer;
 547     }
 548
 549   return (const char *) ada_name;
 550 }
 551
 552 /* Expands GNAT-specific GCC tree nodes.  The only ones we support
 553    here are TRANSFORM_EXPR, ALLOCATE_EXPR, USE_EXPR and NULL_EXPR.  */
 554
 555 static rtx
 556 gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode,
 557                   int modifier, rtx *alt_rtl)
 558 {
 559   tree type = TREE_TYPE (exp);
 560   tree new;
 561   rtx result;
 562
 563   /* If this is a statement, call the expansion routine for statements.  */
 564   if (IS_STMT (exp))
 565     {
 566       gnat_expand_stmt (exp);
 567       return const0_rtx;
 568     }
 569
 570   /* Update EXP to be the new expression to expand.  */
 571   switch (TREE_CODE (exp))
 572     {
 573     case TRANSFORM_EXPR:
 574       gnat_to_code (TREE_COMPLEXITY (exp));
 575       return const0_rtx;
 576       break;
 577
 578     case NULL_EXPR:
 579       expand_expr (TREE_OPERAND (exp, 0), const0_rtx, VOIDmode, 0);
 580
 581       /* We aren't going to be doing anything with this memory, but allocate
 582          it anyway.  If it's variable size, make a bogus address.  */
 583       if (! host_integerp (TYPE_SIZE_UNIT (type), 1))
 584         result = gen_rtx_MEM (BLKmode, virtual_stack_vars_rtx);
 585       else
 586         result = assign_temp (type, 0, TREE_ADDRESSABLE (exp), 1);
 587
 588       return result;
 589
 590     case ALLOCATE_EXPR:
 591       return
 592         allocate_dynamic_stack_space
 593           (expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype),
 594                         EXPAND_NORMAL),
 595            NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1));
 596
 597     case USE_EXPR:
 598       if (target != const0_rtx)
 599         gigi_abort (203);
 600
 601       /* First write a volatile ASM_INPUT to prevent anything from being
 602          moved.  */
 603       result = gen_rtx_ASM_INPUT (VOIDmode, "");
 604       MEM_VOLATILE_P (result) = 1;
 605       emit_insn (result);
 606
 607       result = expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, VOIDmode,
 608                             modifier);
 609       emit_insn (gen_rtx_USE (VOIDmode, result));
 610       return target;
 611
 612     case GNAT_NOP_EXPR:
 613       return expand_expr_real (build1 (NOP_EXPR, type, TREE_OPERAND (exp, 0)),
 614                                target, tmode, modifier, alt_rtl);
 615
 616     case UNCONSTRAINED_ARRAY_REF:
 617       /* If we are evaluating just for side-effects, just evaluate our
 618          operand.  Otherwise, abort since this code should never appear
 619          in a tree to be evaluated (objects aren't unconstrained).  */
 620       if (target == const0_rtx || TREE_CODE (type) == VOID_TYPE)
 621         return expand_expr (TREE_OPERAND (exp, 0), const0_rtx,
 622                             VOIDmode, modifier);
 623
 624       /* ... fall through ... */
 625
 626     default:
 627       gigi_abort (201);
 628     }
 629
 630   return expand_expr_real (new, target, tmode, modifier, alt_rtl);
 631 }
 632
 633 /* Adjusts the RLI used to layout a record after all the fields have been
 634    added.  We only handle the packed case and cause it to use the alignment
 635    that will pad the record at the end.  */
 636
 637 static void
 638 gnat_adjust_rli (record_layout_info rli ATTRIBUTE_UNUSED)
 639 {
 640 #if 0
 641   /* ??? This code seems to have no actual effect; record_align should already
 642      reflect the largest alignment desired by a field.  jason 2003-04-01  */
 643   unsigned int record_align = rli->unpadded_align;
 644   tree field;
 645
 646   /* If an alignment has been specified, don't use anything larger unless we
 647      have to.  */
 648   if (TYPE_ALIGN (rli->t) != 0 && TYPE_ALIGN (rli->t) < record_align)
 649     record_align = MAX (rli->record_align, TYPE_ALIGN (rli->t));
 650
 651   /* If any fields have variable size, we need to force the record to be at
 652      least as aligned as the alignment of that type.  */
 653   for (field = TYPE_FIELDS (rli->t); field; field = TREE_CHAIN (field))
 654     if (TREE_CODE (DECL_SIZE_UNIT (field)) != INTEGER_CST)
 655       record_align = MAX (record_align, DECL_ALIGN (field));
 656
 657   if (TYPE_PACKED (rli->t))
 658     rli->record_align = record_align;
 659 #endif
 660 }
 661
 662 /* Make a TRANSFORM_EXPR to later expand GNAT_NODE into code.  */
 663
 664 tree
 665 make_transform_expr (Node_Id gnat_node)
 666 {
 667   tree gnu_result = build (TRANSFORM_EXPR, void_type_node);
 668
 669   TREE_SIDE_EFFECTS (gnu_result) = 1;
 670   TREE_COMPLEXITY (gnu_result) = gnat_node;
 671   return gnu_result;
 672 }
 673 \f
 674 /* Update the setjmp buffer BUF with the current stack pointer.  We assume
 675    here that a __builtin_setjmp was done to BUF.  */
 676
 677 void
 678 update_setjmp_buf (tree buf)
 679 {
 680   enum machine_mode sa_mode = Pmode;
 681   rtx stack_save;
 682
 683 #ifdef HAVE_save_stack_nonlocal
 684   if (HAVE_save_stack_nonlocal)
 685     sa_mode = insn_data[(int) CODE_FOR_save_stack_nonlocal].operand[0].mode;
 686 #endif
 687 #ifdef STACK_SAVEAREA_MODE
 688   sa_mode = STACK_SAVEAREA_MODE (SAVE_NONLOCAL);
 689 #endif
 690
 691   stack_save
 692     = gen_rtx_MEM (sa_mode,
 693                    memory_address
 694                    (sa_mode,
 695                     plus_constant (expand_expr
 696                                    (build_unary_op (ADDR_EXPR, NULL_TREE, buf),
 697                                     NULL_RTX, VOIDmode, 0),
 698                                    2 * GET_MODE_SIZE (Pmode))));
 699
 700 #ifdef HAVE_setjmp
 701   if (HAVE_setjmp)
 702     emit_insn (gen_setjmp ());
 703 #endif
 704
 705   emit_stack_save (SAVE_NONLOCAL, &stack_save, NULL_RTX);
 706 }
 707 \f
 708 /* These routines are used in conjunction with GCC exception handling.  */
 709
 710 /* Map compile-time to run-time tree for GCC exception handling scheme.  */
 711
 712 static tree
 713 gnat_eh_runtime_type (tree type)
 714 {
 715   return type;
 716 }
 717
 718 /* Return true if type A catches type B. Callback for flow analysis from
 719    the exception handling part of the back-end.  */
 720
 721 static int
 722 gnat_eh_type_covers (tree a, tree b)
 723 {
 724   /* a catches b if they represent the same exception id or if a
 725      is an "others".
 726
 727      ??? integer_zero_node for "others" is hardwired in too many places
 728      currently.  */
 729   return (a == b || a == integer_zero_node);
 730 }
 731 \f
 732 /* See if DECL has an RTL that is indirect via a pseudo-register or a
 733    memory location and replace it with an indirect reference if so.
 734    This improves the debugger's ability to display the value.  */
 735
 736 void
 737 adjust_decl_rtl (tree decl)
 738 {
 739   tree new_type;
 740
 741   /* If this decl is already indirect, don't do anything.  This should
 742      mean that the decl cannot be indirect, but there's no point in
 743      adding an abort to check that.  */
 744   if (TREE_CODE (decl) != CONST_DECL
 745       && ! DECL_BY_REF_P (decl)
 746       && (GET_CODE (DECL_RTL (decl)) == MEM
 747           && (GET_CODE (XEXP (DECL_RTL (decl), 0)) == MEM
 748               || (GET_CODE (XEXP (DECL_RTL (decl), 0)) == REG
 749                   && (REGNO (XEXP (DECL_RTL (decl), 0))
 750                       > LAST_VIRTUAL_REGISTER))))
 751       /* We can't do this if the reference type's mode is not the same
 752          as the current mode, which means this may not work on mixed 32/64
 753          bit systems.  */
 754       && (new_type = build_reference_type (TREE_TYPE (decl))) != 0
 755       && TYPE_MODE (new_type) == GET_MODE (XEXP (DECL_RTL (decl), 0))
 756       /* If this is a PARM_DECL, we can only do it if DECL_INCOMING_RTL
 757          is also an indirect and of the same mode and if the object is
 758          readonly, the latter condition because we don't want to upset the
 759          handling of CICO_LIST.  */
 760       && (TREE_CODE (decl) != PARM_DECL
 761           || (GET_CODE (DECL_INCOMING_RTL (decl)) == MEM
 762               && (TYPE_MODE (new_type)
 763                   == GET_MODE (XEXP (DECL_INCOMING_RTL (decl), 0)))
 764               && TREE_READONLY (decl))))
 765     {
 766       new_type
 767         = build_qualified_type (new_type,
 768                                 (TYPE_QUALS (new_type) | TYPE_QUAL_CONST));
 769
 770       DECL_POINTS_TO_READONLY_P (decl) = TREE_READONLY (decl);
 771       DECL_BY_REF_P (decl) = 1;
 772       SET_DECL_RTL (decl, XEXP (DECL_RTL (decl), 0));
 773       TREE_TYPE (decl) = new_type;
 774       DECL_MODE (decl) = TYPE_MODE (new_type);
 775       DECL_ALIGN (decl) = TYPE_ALIGN (new_type);
 776       DECL_SIZE (decl) = TYPE_SIZE (new_type);
 777
 778       if (TREE_CODE (decl) == PARM_DECL)
 779         set_decl_incoming_rtl (decl, XEXP (DECL_INCOMING_RTL (decl), 0));
 780
 781       /* If DECL_INITIAL was set, it should be updated to show that
 782          the decl is initialized to the address of that thing.
 783          Otherwise, just set it to the address of this decl.
 784          It needs to be set so that GCC does not think the decl is
 785          unused.  */
 786       DECL_INITIAL (decl)
 787         = build1 (ADDR_EXPR, new_type,
 788                   DECL_INITIAL (decl) != 0 ? DECL_INITIAL (decl) : decl);
 789     }
 790 }
 791 \f
 792 /* Record the current code position in GNAT_NODE.  */
 793
 794 void
 795 record_code_position (Node_Id gnat_node)
 796 {
 797   if (global_bindings_p ())
 798     {
 799       /* Make a dummy entry so multiple things at the same location don't
 800          end up in the same place.  */
 801       add_pending_elaborations (NULL_TREE, NULL_TREE);
 802       save_gnu_tree (gnat_node, get_elaboration_location (), 1);
 803     }
 804   else
 805     /* Always emit another insn in case marking the last insn
 806        addressable needs some fixups and also for above reason.  */
 807     save_gnu_tree (gnat_node,
 808                    build (RTL_EXPR, void_type_node, NULL_TREE,
 809                           (tree) emit_note (NOTE_INSN_DELETED), NULL_TREE),
 810                    1);
 811 }
 812
 813 /* Insert the code for GNAT_NODE at the position saved for that node.  */
 814
 815 void
 816 insert_code_for (Node_Id gnat_node)
 817 {
 818   if (global_bindings_p ())
 819     {
 820       push_pending_elaborations ();
 821       gnat_to_code (gnat_node);
 822       Check_Elaboration_Code_Allowed (gnat_node);
 823       insert_elaboration_list (get_gnu_tree (gnat_node));
 824       pop_pending_elaborations ();
 825     }
 826   else
 827     {
 828       rtx insns;
 829
 830       do_pending_stack_adjust ();
 831       start_sequence ();
 832       mark_all_temps_used ();
 833       gnat_to_code (gnat_node);
 834       do_pending_stack_adjust ();
 835       insns = get_insns ();
 836       end_sequence ();
 837       emit_insn_after (insns, RTL_EXPR_RTL (get_gnu_tree (gnat_node)));
 838     }
 839 }
 840
 841 /* Get the alias set corresponding to a type or expression.  */
 842
 843 static HOST_WIDE_INT
 844 gnat_get_alias_set (tree type)
 845 {
 846   /* If this is a padding type, use the type of the first field.  */
 847   if (TREE_CODE (type) == RECORD_TYPE
 848       && TYPE_IS_PADDING_P (type))
 849     return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
 850
 851   /* If the type is an unconstrained array, use the type of the
 852      self-referential array we make.  */
 853   else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
 854     return
 855       get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
 856
 857
 858   return -1;
 859 }
 860
 861 /* GNU_TYPE is a type. Determine if it should be passed by reference by
 862    default.  */
 863
 864 int
 865 default_pass_by_ref (tree gnu_type)
 866 {
 867   CUMULATIVE_ARGS cum;
 868
 869   INIT_CUMULATIVE_ARGS (cum, NULL_TREE, NULL_RTX, 0, 2);
 870
 871   /* We pass aggregates by reference if they are sufficiently large.  The
 872      choice of constant here is somewhat arbitrary.  We also pass by
 873      reference if the target machine would either pass or return by
 874      reference.  Strictly speaking, we need only check the return if this
 875      is an In Out parameter, but it's probably best to err on the side of
 876      passing more things by reference.  */
 877   return (0
 878 #ifdef FUNCTION_ARG_PASS_BY_REFERENCE
 879           || FUNCTION_ARG_PASS_BY_REFERENCE (cum, TYPE_MODE (gnu_type),
 880                                              gnu_type, 1)
 881 #endif
 882           || targetm.calls.return_in_memory (gnu_type, NULL_TREE)
 883           || (AGGREGATE_TYPE_P (gnu_type)
 884               && (! host_integerp (TYPE_SIZE (gnu_type), 1)
 885                   || 0 < compare_tree_int (TYPE_SIZE (gnu_type),
 886                                            8 * TYPE_ALIGN (gnu_type)))));
 887 }
 888
 889 /* GNU_TYPE is the type of a subprogram parameter.  Determine from the type if
 890    it should be passed by reference. */
 891
 892 int
 893 must_pass_by_ref (tree gnu_type)
 894 {
 895   /* We pass only unconstrained objects, those required by the language
 896      to be passed by reference, and objects of variable size.  The latter
 897      is more efficient, avoids problems with variable size temporaries,
 898      and does not produce compatibility problems with C, since C does
 899      not have such objects.  */
 900   return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
 901           || (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
 902           || (TYPE_SIZE (gnu_type) != 0
 903               && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
 904 }
 905
 906 /* This function is called by the front end to enumerate all the supported
 907    modes for the machine.  We pass a function which is called back with
 908    the following integer parameters:
 909
 910    FLOAT_P      nonzero if this represents a floating-point mode
 911    COMPLEX_P    nonzero is this represents a complex mode
 912    COUNT        count of number of items, nonzero for vector mode
 913    PRECISION    number of bits in data representation
 914    MANTISSA     number of bits in mantissa, if FP and known, else zero.
 915    SIZE         number of bits used to store data
 916    ALIGN        number of bits to which mode is aligned.  */
 917
 918 void
 919 enumerate_modes (void (*f) (int, int, int, int, int, int, unsigned int))
 920 {
 921   enum machine_mode i;
 922
 923   for (i = 0; i < NUM_MACHINE_MODES; i++)
 924     {
 925       enum machine_mode j;
 926       bool float_p = 0;
 927       bool complex_p = 0;
 928       bool vector_p = 0;
 929       bool skip_p = 0;
 930       int mantissa = 0;
 931       enum machine_mode inner_mode = i;
 932
 933       switch (GET_MODE_CLASS (i))
 934         {
 935         case MODE_INT:
 936           break;
 937         case MODE_FLOAT:
 938           float_p = 1;
 939           break;
 940         case MODE_COMPLEX_INT:
 941           complex_p = 1;
 942           inner_mode = GET_MODE_INNER (i);
 943           break;
 944         case MODE_COMPLEX_FLOAT:
 945           float_p = 1;
 946           complex_p = 1;
 947           inner_mode = GET_MODE_INNER (i);
 948           break;
 949         case MODE_VECTOR_INT:
 950           vector_p = 1;
 951           inner_mode = GET_MODE_INNER (i);
 952           break;
 953         case MODE_VECTOR_FLOAT:
 954           float_p = 1;
 955           vector_p = 1;
 956           inner_mode = GET_MODE_INNER (i);
 957           break;
 958         default:
 959           skip_p = 1;
 960         }
 961
 962       /* Skip this mode if it's one the front end doesn't need to know about
 963          (e.g., the CC modes) or if there is no add insn for that mode (or
 964          any wider mode), meaning it is not supported by the hardware.  If
 965          this a complex or vector mode, we care about the inner mode.  */
 966       for (j = inner_mode; j != VOIDmode; j = GET_MODE_WIDER_MODE (j))
 967         if (add_optab->handlers[j].insn_code != CODE_FOR_nothing)
 968           break;
 969
 970       if (float_p)
 971         {
 972           const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode);
 973
 974           mantissa = fmt->p * fmt->log2_b;
 975         }
 976
 977       if (!skip_p && j != VOIDmode)
 978         (*f) (float_p, complex_p, vector_p ? GET_MODE_NUNITS (i) : 0,
 979               GET_MODE_BITSIZE (i), mantissa,
 980               GET_MODE_SIZE (i) * BITS_PER_UNIT, GET_MODE_ALIGNMENT (i));
 981     }
 982 }
 983
 984 int
 985 fp_prec_to_size (int prec)
 986 {
 987   enum machine_mode mode;
 988
 989   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
 990        mode = GET_MODE_WIDER_MODE (mode))
 991     if (GET_MODE_PRECISION (mode) == prec)
 992       return GET_MODE_BITSIZE (mode);
 993
 994   abort ();
 995 }
 996
 997 int
 998 fp_size_to_prec (int size)
 999 {
1000   enum machine_mode mode;
1001
1002   for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
1003        mode = GET_MODE_WIDER_MODE (mode))
1004     if (GET_MODE_BITSIZE (mode) == size)
1005       return GET_MODE_PRECISION (mode);
1006
1007   abort ();
1008 }
1009