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 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 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 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 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 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 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 1008