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