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