1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
10 * Copyright (C) 1992-2002 Free Software Foundation, Inc. *
12 * GNAT is free software; you can redistribute it and/or modify it under *
13 * terms of the GNU General Public License as published by the Free Soft- *
14 * ware Foundation; either version 2, or (at your option) any later ver- *
15 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
16 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
17 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
18 * for more details. You should have received a copy of the GNU General *
19 * Public License distributed with GNAT; see file COPYING. If not, write *
20 * to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
21 * MA 02111-1307, USA. *
23 * As a special exception, if you link this file with other files to *
24 * produce an executable, this file does not by itself cause the resulting *
25 * executable to be covered by the GNU General Public License. This except- *
26 * ion does not however invalidate any other reasons why the executable *
27 * file might be covered by the GNU Public License. *
29 * GNAT was originally developed by the GNAT team at New York University. *
30 * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
32 ****************************************************************************/
34 /* This file contains parts of the compiler that are required for interfacing
35 with GCC but otherwise do nothing and parts of Gigi that need to know
43 #include "diagnostic.h"
49 #include "insn-codes.h"
50 #include "insn-flags.h"
51 #include "insn-config.h"
57 #include "langhooks.h"
58 #include "langhooks-def.h"
73 #include "adadecode.h"
75 extern FILE *asm_out_file;
77 extern char **save_argv;
79 static const char *gnat_init PARAMS ((const char *));
80 static void gnat_init_options PARAMS ((void));
81 static int gnat_decode_option PARAMS ((int, char **));
82 static HOST_WIDE_INT gnat_get_alias_set PARAMS ((tree));
83 static void gnat_print_decl PARAMS ((FILE *, tree, int));
84 static void gnat_print_type PARAMS ((FILE *, tree, int));
85 static const char *gnat_printable_name PARAMS ((tree, int));
86 static tree gnat_eh_runtime_type PARAMS ((tree));
87 static int gnat_eh_type_covers PARAMS ((tree, tree));
88 static void gnat_parse_file PARAMS ((int));
89 static rtx gnat_expand_expr PARAMS ((tree, rtx, enum machine_mode,
92 /* Structure giving our language-specific hooks. */
94 #undef LANG_HOOKS_NAME
95 #define LANG_HOOKS_NAME "GNU Ada"
96 #undef LANG_HOOKS_IDENTIFIER_SIZE
97 #define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
98 #undef LANG_HOOKS_INIT
99 #define LANG_HOOKS_INIT gnat_init
100 #undef LANG_HOOKS_INIT_OPTIONS
101 #define LANG_HOOKS_INIT_OPTIONS gnat_init_options
102 #undef LANG_HOOKS_DECODE_OPTION
103 #define LANG_HOOKS_DECODE_OPTION gnat_decode_option
104 #undef LANG_HOOKS_PARSE_FILE
105 #define LANG_HOOKS_PARSE_FILE gnat_parse_file
106 #undef LANG_HOOKS_HONOR_READONLY
107 #define LANG_HOOKS_HONOR_READONLY 1
108 #undef LANG_HOOKS_FINISH_INCOMPLETE_DECL
109 #define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl
110 #undef LANG_HOOKS_GET_ALIAS_SET
111 #define LANG_HOOKS_GET_ALIAS_SET gnat_get_alias_set
112 #undef LANG_HOOKS_EXPAND_EXPR
113 #define LANG_HOOKS_EXPAND_EXPR gnat_expand_expr
114 #undef LANG_HOOKS_MARK_ADDRESSABLE
115 #define LANG_HOOKS_MARK_ADDRESSABLE gnat_mark_addressable
116 #undef LANG_HOOKS_TRUTHVALUE_CONVERSION
117 #define LANG_HOOKS_TRUTHVALUE_CONVERSION gnat_truthvalue_conversion
118 #undef LANG_HOOKS_PRINT_DECL
119 #define LANG_HOOKS_PRINT_DECL gnat_print_decl
120 #undef LANG_HOOKS_PRINT_TYPE
121 #define LANG_HOOKS_PRINT_TYPE gnat_print_type
122 #undef LANG_HOOKS_DECL_PRINTABLE_NAME
123 #define LANG_HOOKS_DECL_PRINTABLE_NAME gnat_printable_name
124 #undef LANG_HOOKS_TYPE_FOR_MODE
125 #define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode
126 #undef LANG_HOOKS_TYPE_FOR_SIZE
127 #define LANG_HOOKS_TYPE_FOR_SIZE gnat_type_for_size
128 #undef LANG_HOOKS_SIGNED_TYPE
129 #define LANG_HOOKS_SIGNED_TYPE gnat_signed_type
130 #undef LANG_HOOKS_UNSIGNED_TYPE
131 #define LANG_HOOKS_UNSIGNED_TYPE gnat_unsigned_type
132 #undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
133 #define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gnat_signed_or_unsigned_type
135 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
137 /* Tables describing GCC tree codes used only by GNAT.
139 Table indexed by tree code giving a string containing a character
140 classifying the tree code. Possibilities are
141 t, d, s, c, r, <, 1 and 2. See cp-tree.def for details. */
143 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
145 const char tree_code_type[] = {
148 #include "ada-tree.def"
152 /* Table indexed by tree code giving number of expression
153 operands beyond the fixed part of the node structure.
154 Not used for types or decls. */
156 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
158 const unsigned char tree_code_length[] = {
161 #include "ada-tree.def"
165 /* Names of tree components.
166 Used for printing out the tree and error messages. */
167 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
169 const char *const tree_code_name[] = {
172 #include "ada-tree.def"
176 /* gnat standard argc argv */
178 extern int gnat_argc;
179 extern char **gnat_argv;
181 static void internal_error_function PARAMS ((const char *, va_list *));
182 static void gnat_adjust_rli PARAMS ((record_layout_info));
184 /* Declare functions we use as part of startup. */
185 extern void __gnat_initialize PARAMS((void));
186 extern void adainit PARAMS((void));
187 extern void _ada_gnat1drv PARAMS((void));
189 /* The parser for the language. For us, we process the GNAT tree. */
192 gnat_parse_file (set_yydebug)
193 int set_yydebug ATTRIBUTE_UNUSED;
195 /* call the target specific initializations */
198 /* Call the front-end elaboration procedures */
201 immediate_size_expand = 1;
203 /* Call the front end */
207 /* Decode all the language specific options that cannot be decoded by GCC.
208 The option decoding phase of GCC calls this routine on the flags that
209 it cannot decode. This routine returns 1 if it is successful, otherwise
213 gnat_decode_option (argc, argv)
214 int argc ATTRIBUTE_UNUSED;
220 if (!strncmp (p, "-I", 2))
222 /* Pass the -I switches as-is. */
223 gnat_argv[gnat_argc] = p;
228 else if (!strncmp (p, "-gant", 5))
230 char *q = (char *) xmalloc (strlen (p) + 1);
232 warning ("`-gnat' misspelled as `-gant'");
234 q[2] = 'n', q[3] = 'a';
239 else if (!strncmp (p, "-gnat", 5))
241 /* Recopy the switches without the 'gnat' prefix */
243 gnat_argv[gnat_argc] = (char *) xmalloc (strlen (p) - 3);
244 gnat_argv[gnat_argc][0] = '-';
245 strcpy (gnat_argv[gnat_argc] + 1, p + 5);
248 for (i = 1; i < save_argc - 1; i++)
249 if (!strncmp (save_argv[i], "-gnatO", 6))
250 if (save_argv[++i][0] != '-')
252 /* Preserve output filename as GCC doesn't save it for GNAT. */
253 gnat_argv[gnat_argc] = save_argv[i];
261 /* Handle the --RTS switch. The real option we get is -fRTS. This
262 modification is done by the driver program. */
263 if (!strncmp (p, "-fRTS", 5))
265 gnat_argv[gnat_argc] = p;
270 /* Ignore -W flags since people may want to use the same flags for all
272 else if (p[0] == '-' && p[1] == 'W' && p[2] != 0)
278 /* Initialize for option processing. */
283 /* Initialize gnat_argv with save_argv size */
284 gnat_argv = (char **) xmalloc ((save_argc + 1) * sizeof (gnat_argv[0]));
285 gnat_argv[0] = save_argv[0]; /* name of the command */
289 /* Here is the function to handle the compiler error processing in GCC. */
292 internal_error_function (msgid, ap)
296 char buffer[1000]; /* Assume this is big enough. */
298 String_Template temp;
301 vsprintf (buffer, msgid, *ap);
303 /* Go up to the first newline. */
304 for (p = buffer; *p != 0; p++)
311 temp.Low_Bound = 1, temp.High_Bound = strlen (buffer);
312 fp.Array = buffer, fp.Bounds = &temp;
314 Current_Error_Node = error_gnat_node;
315 Compiler_Abort (fp, -1);
318 /* Perform all the initialization steps that are language-specific. */
322 const char *filename;
324 /* Performs whatever initialization steps needed by the language-dependent
327 Define the additional tree codes here. This isn't the best place to put
328 it, but it's where g++ does it. */
330 gnat_init_decl_processing ();
332 /* Add the input filename as the last argument. */
333 gnat_argv[gnat_argc] = (char *) filename;
335 gnat_argv[gnat_argc] = 0;
337 global_dc->internal_error = &internal_error_function;
339 /* Show that REFERENCE_TYPEs are internal and should be Pmode. */
340 internal_reference_types ();
342 set_lang_adjust_rli (gnat_adjust_rli);
346 /* If we are using the GCC mechanism for to process exception handling, we
347 have to register the personality routine for Ada and to initialize
348 various language dependent hooks. */
353 /* We shouldn't do anything if the No_Exceptions_Handler pragma is set,
354 though. This could for instance lead to the emission of tables with
355 references to symbols (such as the Ada eh personality routine) within
356 libraries we won't link against. */
357 if (No_Exception_Handlers_Set ())
360 eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality");
361 lang_eh_type_covers = gnat_eh_type_covers;
362 lang_eh_runtime_type = gnat_eh_runtime_type;
366 #ifdef DWARF2_UNWIND_INFO
367 if (dwarf2out_do_frame ())
368 dwarf2out_frame_init ();
372 /* Hooks for print-tree.c: */
375 gnat_print_decl (file, node, indent)
380 switch (TREE_CODE (node))
383 print_node (file, "const_corresponding_var",
384 DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
388 print_node (file, "original field", DECL_ORIGINAL_FIELD (node),
398 gnat_print_type (file, node, indent)
403 switch (TREE_CODE (node))
406 print_node (file, "ci_co_list", TYPE_CI_CO_LIST (node), indent + 4);
410 print_node (file, "RM size", TYPE_RM_SIZE_ENUM (node), indent + 4);
414 if (TYPE_MODULAR_P (node))
415 print_node (file, "modulus", TYPE_MODULUS (node), indent + 4);
416 else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
417 print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
419 else if (TYPE_VAX_FLOATING_POINT_P (node))
422 print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
424 print_node (file, "RM size", TYPE_RM_SIZE_INT (node), indent + 4);
428 print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
432 if (TYPE_IS_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
433 print_node (file, "unconstrained array",
434 TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
436 print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
440 case QUAL_UNION_TYPE:
441 print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
450 gnat_printable_name (decl, verbosity)
452 int verbosity ATTRIBUTE_UNUSED;
454 const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
455 char *ada_name = (char *) ggc_alloc (strlen (coded_name) * 2 + 60);
457 __gnat_decode (coded_name, ada_name, 0);
459 return (const char *) ada_name;
462 /* Expands GNAT-specific GCC tree nodes. The only ones we support
463 here are TRANSFORM_EXPR, ALLOCATE_EXPR, USE_EXPR and NULL_EXPR. */
466 gnat_expand_expr (exp, target, tmode, modifier)
469 enum machine_mode tmode;
470 int modifier; /* Actually an enum expand_modifier. */
472 tree type = TREE_TYPE (exp);
476 /* Update EXP to be the new expression to expand. */
478 switch (TREE_CODE (exp))
481 gnat_to_code (TREE_COMPLEXITY (exp));
486 expand_expr (TREE_OPERAND (exp, 0), const0_rtx, VOIDmode, 0);
488 /* We aren't going to be doing anything with this memory, but allocate
489 it anyway. If it's variable size, make a bogus address. */
490 if (! host_integerp (TYPE_SIZE_UNIT (type), 1))
491 result = gen_rtx_MEM (BLKmode, virtual_stack_vars_rtx);
493 result = assign_temp (type, 0, TREE_ADDRESSABLE (exp), 1);
499 allocate_dynamic_stack_space
500 (expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype),
502 NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1));
505 if (target != const0_rtx)
508 /* First write a volatile ASM_INPUT to prevent anything from being
510 result = gen_rtx_ASM_INPUT (VOIDmode, "");
511 MEM_VOLATILE_P (result) = 1;
514 result = expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, VOIDmode,
516 emit_insn (gen_rtx_USE (VOIDmode, result));
520 return expand_expr (build1 (NOP_EXPR, type, TREE_OPERAND (exp, 0)),
521 target, tmode, modifier);
523 case UNCONSTRAINED_ARRAY_REF:
524 /* If we are evaluating just for side-effects, just evaluate our
525 operand. Otherwise, abort since this code should never appear
526 in a tree to be evaluated (objects aren't unconstrained). */
527 if (target == const0_rtx || TREE_CODE (type) == VOID_TYPE)
528 return expand_expr (TREE_OPERAND (exp, 0), const0_rtx,
531 /* ... fall through ... */
537 return expand_expr (new, target, tmode, modifier);
540 /* Adjusts the RLI used to layout a record after all the fields have been
541 added. We only handle the packed case and cause it to use the alignment
542 that will pad the record at the end. */
545 gnat_adjust_rli (rli)
546 record_layout_info rli;
548 unsigned int record_align = rli->unpadded_align;
551 /* If any fields have variable size, we need to force the record to be at
552 least as aligned as the alignment of that type. */
553 for (field = TYPE_FIELDS (rli->t); field; field = TREE_CHAIN (field))
554 if (TREE_CODE (DECL_SIZE_UNIT (field)) != INTEGER_CST)
555 record_align = MAX (record_align, DECL_ALIGN (field));
557 if (TYPE_PACKED (rli->t))
558 rli->record_align = record_align;
561 /* Make a TRANSFORM_EXPR to later expand GNAT_NODE into code. */
564 make_transform_expr (gnat_node)
567 tree gnu_result = build (TRANSFORM_EXPR, void_type_node);
569 TREE_SIDE_EFFECTS (gnu_result) = 1;
570 TREE_COMPLEXITY (gnu_result) = gnat_node;
574 /* Update the setjmp buffer BUF with the current stack pointer. We assume
575 here that a __builtin_setjmp was done to BUF. */
578 update_setjmp_buf (buf)
581 enum machine_mode sa_mode = Pmode;
584 #ifdef HAVE_save_stack_nonlocal
585 if (HAVE_save_stack_nonlocal)
586 sa_mode = insn_data[(int) CODE_FOR_save_stack_nonlocal].operand[0].mode;
588 #ifdef STACK_SAVEAREA_MODE
589 sa_mode = STACK_SAVEAREA_MODE (SAVE_NONLOCAL);
593 = gen_rtx_MEM (sa_mode,
596 plus_constant (expand_expr
597 (build_unary_op (ADDR_EXPR, NULL_TREE, buf),
598 NULL_RTX, VOIDmode, 0),
599 2 * GET_MODE_SIZE (Pmode))));
603 emit_insn (gen_setjmp ());
606 emit_stack_save (SAVE_NONLOCAL, &stack_save, NULL_RTX);
609 /* These routines are used in conjunction with GCC exception handling. */
611 /* Map compile-time to run-time tree for GCC exception handling scheme. */
614 gnat_eh_runtime_type (type)
620 /* Return true if type A catches type B. Callback for flow analysis from
621 the exception handling part of the back-end. */
624 gnat_eh_type_covers (a, b)
627 /* a catches b if they represent the same exception id or if a
630 ??? integer_zero_node for "others" is hardwired in too many places
632 return (a == b || a == integer_zero_node);
635 /* See if DECL has an RTL that is indirect via a pseudo-register or a
636 memory location and replace it with an indirect reference if so.
637 This improves the debugger's ability to display the value. */
640 adjust_decl_rtl (decl)
645 /* If this decl is already indirect, don't do anything. This should
646 mean that the decl cannot be indirect, but there's no point in
647 adding an abort to check that. */
648 if (TREE_CODE (decl) != CONST_DECL
649 && ! DECL_BY_REF_P (decl)
650 && (GET_CODE (DECL_RTL (decl)) == MEM
651 && (GET_CODE (XEXP (DECL_RTL (decl), 0)) == MEM
652 || (GET_CODE (XEXP (DECL_RTL (decl), 0)) == REG
653 && (REGNO (XEXP (DECL_RTL (decl), 0))
654 > LAST_VIRTUAL_REGISTER))))
655 /* We can't do this if the reference type's mode is not the same
656 as the current mode, which means this may not work on mixed 32/64
658 && (new_type = build_reference_type (TREE_TYPE (decl))) != 0
659 && TYPE_MODE (new_type) == GET_MODE (XEXP (DECL_RTL (decl), 0))
660 /* If this is a PARM_DECL, we can only do it if DECL_INCOMING_RTL
661 is also an indirect and of the same mode and if the object is
662 readonly, the latter condition because we don't want to upset the
663 handling of CICO_LIST. */
664 && (TREE_CODE (decl) != PARM_DECL
665 || (GET_CODE (DECL_INCOMING_RTL (decl)) == MEM
666 && (TYPE_MODE (new_type)
667 == GET_MODE (XEXP (DECL_INCOMING_RTL (decl), 0)))
668 && TREE_READONLY (decl))))
671 = build_qualified_type (new_type,
672 (TYPE_QUALS (new_type) | TYPE_QUAL_CONST));
674 DECL_POINTS_TO_READONLY_P (decl) = TREE_READONLY (decl);
675 DECL_BY_REF_P (decl) = 1;
676 SET_DECL_RTL (decl, XEXP (DECL_RTL (decl), 0));
677 TREE_TYPE (decl) = new_type;
678 DECL_MODE (decl) = TYPE_MODE (new_type);
679 DECL_ALIGN (decl) = TYPE_ALIGN (new_type);
680 DECL_SIZE (decl) = TYPE_SIZE (new_type);
682 if (TREE_CODE (decl) == PARM_DECL)
683 DECL_INCOMING_RTL (decl) = XEXP (DECL_INCOMING_RTL (decl), 0);
685 /* If DECL_INITIAL was set, it should be updated to show that
686 the decl is initialized to the address of that thing.
687 Otherwise, just set it to the address of this decl.
688 It needs to be set so that GCC does not think the decl is
691 = build1 (ADDR_EXPR, new_type,
692 DECL_INITIAL (decl) != 0 ? DECL_INITIAL (decl) : decl);
696 /* Record the current code position in GNAT_NODE. */
699 record_code_position (gnat_node)
702 if (global_bindings_p ())
704 /* Make a dummy entry so multiple things at the same location don't
705 end up in the same place. */
706 add_pending_elaborations (NULL_TREE, NULL_TREE);
707 save_gnu_tree (gnat_node, get_elaboration_location (), 1);
710 /* Always emit another insn in case marking the last insn
711 addressable needs some fixups and also for above reason. */
712 save_gnu_tree (gnat_node,
713 build (RTL_EXPR, void_type_node, NULL_TREE,
714 (tree) emit_note (0, NOTE_INSN_DELETED)),
718 /* Insert the code for GNAT_NODE at the position saved for that node. */
721 insert_code_for (gnat_node)
724 if (global_bindings_p ())
726 push_pending_elaborations ();
727 gnat_to_code (gnat_node);
728 Check_Elaboration_Code_Allowed (gnat_node);
729 insert_elaboration_list (get_gnu_tree (gnat_node));
730 pop_pending_elaborations ();
736 do_pending_stack_adjust ();
738 mark_all_temps_used ();
739 gnat_to_code (gnat_node);
740 do_pending_stack_adjust ();
741 insns = get_insns ();
743 emit_insn_after (insns, RTL_EXPR_RTL (get_gnu_tree (gnat_node)));
747 /* Get the alias set corresponding to a type or expression. */
750 gnat_get_alias_set (type)
753 /* If this is a padding type, use the type of the first field. */
754 if (TREE_CODE (type) == RECORD_TYPE
755 && TYPE_IS_PADDING_P (type))
756 return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
758 /* If the type is an unconstrained array, use the type of the
759 self-referential array we make. */
760 else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
762 get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
768 /* GNU_TYPE is a type. Determine if it should be passed by reference by
772 default_pass_by_ref (gnu_type)
777 INIT_CUMULATIVE_ARGS (cum, NULL_TREE, NULL_RTX, 0);
779 /* We pass aggregates by reference if they are sufficiently large. The
780 choice of constant here is somewhat arbitrary. We also pass by
781 reference if the target machine would either pass or return by
782 reference. Strictly speaking, we need only check the return if this
783 is an In Out parameter, but it's probably best to err on the side of
784 passing more things by reference. */
786 #ifdef FUNCTION_ARG_PASS_BY_REFERENCE
787 || FUNCTION_ARG_PASS_BY_REFERENCE (cum, TYPE_MODE (gnu_type),
790 || RETURN_IN_MEMORY (gnu_type)
791 || (AGGREGATE_TYPE_P (gnu_type)
792 && (! host_integerp (TYPE_SIZE (gnu_type), 1)
793 || 0 < compare_tree_int (TYPE_SIZE (gnu_type),
794 8 * TYPE_ALIGN (gnu_type)))));
797 /* GNU_TYPE is the type of a subprogram parameter. Determine from the type if
798 it should be passed by reference. */
801 must_pass_by_ref (gnu_type)
804 /* We pass only unconstrained objects, those required by the language
805 to be passed by reference, and objects of variable size. The latter
806 is more efficient, avoids problems with variable size temporaries,
807 and does not produce compatibility problems with C, since C does
808 not have such objects. */
809 return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
810 || (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
811 || (TYPE_SIZE (gnu_type) != 0
812 && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
815 /* This function returns the version of GCC being used. Here it's GCC 3. */