1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2003 Free Software Foundation, Inc. *
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. *
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. *
28 * GNAT was originally developed by the GNAT team at New York University. *
29 * Extensive contributions were provided by Ada Core Technologies Inc. *
31 ****************************************************************************/
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
39 #include "coretypes.h"
45 #include "diagnostic.h"
51 #include "insn-codes.h"
52 #include "insn-flags.h"
53 #include "insn-config.h"
60 #include "langhooks.h"
61 #include "langhooks-def.h"
77 #include "adadecode.h"
81 extern FILE *asm_out_file;
83 /* The largest alignment, in bits, that is needed for using the widest
85 unsigned int largest_move_alignment;
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,
101 static void internal_error_function (const char *, va_list *);
102 static void gnat_adjust_rli (record_layout_info);
104 /* Structure giving our language-specific hooks. */
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
149 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
151 /* Tables describing GCC tree codes used only by GNAT.
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. */
157 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
159 const char tree_code_type[] = {
162 #include "ada-tree.def"
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. */
170 #define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
172 const unsigned char tree_code_length[] = {
175 #include "ada-tree.def"
179 /* Names of tree components.
180 Used for printing out the tree and error messages. */
181 #define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
183 const char *const tree_code_name[] = {
186 #include "ada-tree.def"
190 /* Command-line argc and argv.
191 These variables are global, since they are imported and used in
194 unsigned int save_argc;
195 const char **save_argv;
197 /* gnat standard argc argv */
199 extern int gnat_argc;
200 extern char **gnat_argv;
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);
208 /* The parser for the language. For us, we process the GNAT tree. */
211 gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
213 /* call the target specific initializations */
216 /* Call the front-end elaboration procedures */
219 immediate_size_expand = 1;
221 /* Call the front end */
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. */
231 gnat_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED)
233 const struct cl_option *option = &cl_options[scode];
234 enum opt_code code = (enum opt_code) scode;
238 if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE)))
240 error ("missing argument to \"-%s\"", option->opt_text);
250 q = xmalloc (sizeof("-I") + strlen (arg));
253 gnat_argv[gnat_argc] = q;
257 /* All front ends are expected to accept this. */
259 /* These are used in the GCC Makefile. */
260 case OPT_Wmissing_prototypes:
261 case OPT_Wstrict_prototypes:
262 case OPT_Wwrite_strings:
266 /* This is handled by the front-end. */
271 gnat_argv[gnat_argc] = xstrdup ("-nostdlib");
276 gnat_argv[gnat_argc] = xstrdup ("-fRTS");
281 warning ("`-gnat' misspelled as `-gant'");
283 /* ... fall through ... */
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);
293 for (i = 1; i < save_argc - 1; i++)
294 if (!strncmp (save_argv[i], "-gnatO", 6))
295 if (save_argv[++i][0] != '-')
297 /* Preserve output filename as GCC doesn't save it for GNAT. */
298 gnat_argv[gnat_argc] = xstrdup (save_argv[i]);
308 /* Initialize for option processing. */
311 gnat_init_options (unsigned int argc, const char **argv)
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 */
324 /* Here is the function to handle the compiler error processing in GCC. */
327 internal_error_function (const char *msgid, va_list *ap)
329 char buffer[1000]; /* Assume this is big enough. */
331 String_Template temp;
334 vsprintf (buffer, msgid, *ap);
336 /* Go up to the first newline. */
337 for (p = buffer; *p != 0; p++)
344 temp.Low_Bound = 1, temp.High_Bound = strlen (buffer);
345 fp.Array = buffer, fp.Bounds = &temp;
347 Current_Error_Node = error_gnat_node;
348 Compiler_Abort (fp, -1);
351 /* Langhook for tree_size: Determine size of our 'x' and 'c' nodes. */
354 gnat_tree_size (enum tree_code code)
359 return sizeof (struct tree_loop_id);
366 /* Perform all the initialization steps that are language-specific. */
371 /* Performs whatever initialization steps needed by the language-dependent
373 gnat_init_decl_processing ();
375 /* Add the input filename as the last argument. */
376 gnat_argv[gnat_argc] = (char *) main_input_filename;
378 gnat_argv[gnat_argc] = 0;
380 global_dc->internal_error = &internal_error_function;
382 /* Show that REFERENCE_TYPEs are internal and should be Pmode. */
383 internal_reference_types ();
385 set_lang_adjust_rli (gnat_adjust_rli);
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. */
397 gnat_finish_incomplete_decl (tree dont_care ATTRIBUTE_UNUSED)
402 /* Compute the alignment of the largest mode that can be used for copying
406 gnat_compute_largest_alignment (void)
408 enum machine_mode mode;
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)));
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. */
423 gnat_init_gcc_eh (void)
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 ())
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 ();
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;
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
453 flag_non_call_exceptions = 1;
456 #ifdef DWARF2_UNWIND_INFO
457 if (dwarf2out_do_frame ())
458 dwarf2out_frame_init ();
462 /* Language hooks, first one to print language-specific items in a DECL. */
465 gnat_print_decl (FILE *file, tree node, int indent)
467 switch (TREE_CODE (node))
470 print_node (file, "const_corresponding_var",
471 DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
475 print_node (file, "original field", DECL_ORIGINAL_FIELD (node),
485 gnat_print_type (FILE *file, tree node, int indent)
487 switch (TREE_CODE (node))
490 print_node (file, "ci_co_list", TYPE_CI_CO_LIST (node), indent + 4);
494 print_node (file, "RM size", TYPE_RM_SIZE_ENUM (node), indent + 4);
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),
503 else if (TYPE_VAX_FLOATING_POINT_P (node))
506 print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
508 print_node (file, "RM size", TYPE_RM_SIZE_INT (node), indent + 4);
512 print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
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);
520 print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
524 case QUAL_UNION_TYPE:
525 print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
534 gnat_printable_name (tree decl, int verbosity)
536 const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
537 char *ada_name = (char *) ggc_alloc (strlen (coded_name) * 2 + 60);
539 __gnat_decode (coded_name, ada_name, 0);
543 Set_Identifier_Casing (ada_name, (char *) DECL_SOURCE_FILE (decl));
544 ada_name = Name_Buffer;
547 return (const char *) ada_name;
550 /* Expands GNAT-specific GCC tree nodes. The only ones we support
551 here are TRANSFORM_EXPR, ALLOCATE_EXPR, USE_EXPR and NULL_EXPR. */
554 gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode,
555 int modifier, rtx *alt_rtl)
557 tree type = TREE_TYPE (exp);
561 /* If this is a statement, call the expansion routine for statements. */
564 gnat_expand_stmt (exp);
568 /* Update EXP to be the new expression to expand. */
569 switch (TREE_CODE (exp))
572 gnat_to_code (TREE_COMPLEXITY (exp));
577 expand_expr (TREE_OPERAND (exp, 0), const0_rtx, VOIDmode, 0);
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);
584 result = assign_temp (type, 0, TREE_ADDRESSABLE (exp), 1);
590 allocate_dynamic_stack_space
591 (expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype),
593 NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1));
596 if (target != const0_rtx)
599 /* First write a volatile ASM_INPUT to prevent anything from being
601 result = gen_rtx_ASM_INPUT (VOIDmode, "");
602 MEM_VOLATILE_P (result) = 1;
605 result = expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, VOIDmode,
607 emit_insn (gen_rtx_USE (VOIDmode, result));
611 return expand_expr_real (build1 (NOP_EXPR, type, TREE_OPERAND (exp, 0)),
612 target, tmode, modifier, alt_rtl);
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,
622 /* ... fall through ... */
628 return expand_expr_real (new, target, tmode, modifier, alt_rtl);
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. */
636 gnat_adjust_rli (record_layout_info rli ATTRIBUTE_UNUSED)
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;
644 /* If an alignment has been specified, don't use anything larger unless we
646 if (TYPE_ALIGN (rli->t) != 0 && TYPE_ALIGN (rli->t) < record_align)
647 record_align = MAX (rli->record_align, TYPE_ALIGN (rli->t));
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));
655 if (TYPE_PACKED (rli->t))
656 rli->record_align = record_align;
660 /* Make a TRANSFORM_EXPR to later expand GNAT_NODE into code. */
663 make_transform_expr (Node_Id gnat_node)
665 tree gnu_result = build (TRANSFORM_EXPR, void_type_node);
667 TREE_SIDE_EFFECTS (gnu_result) = 1;
668 TREE_COMPLEXITY (gnu_result) = gnat_node;
672 /* Update the setjmp buffer BUF with the current stack pointer. We assume
673 here that a __builtin_setjmp was done to BUF. */
676 update_setjmp_buf (tree buf)
678 enum machine_mode sa_mode = Pmode;
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;
685 #ifdef STACK_SAVEAREA_MODE
686 sa_mode = STACK_SAVEAREA_MODE (SAVE_NONLOCAL);
690 = gen_rtx_MEM (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))));
700 emit_insn (gen_setjmp ());
703 emit_stack_save (SAVE_NONLOCAL, &stack_save, NULL_RTX);
706 /* These routines are used in conjunction with GCC exception handling. */
708 /* Map compile-time to run-time tree for GCC exception handling scheme. */
711 gnat_eh_runtime_type (tree type)
716 /* Return true if type A catches type B. Callback for flow analysis from
717 the exception handling part of the back-end. */
720 gnat_eh_type_covers (tree a, tree b)
722 /* a catches b if they represent the same exception id or if a
725 ??? integer_zero_node for "others" is hardwired in too many places
727 return (a == b || a == integer_zero_node);
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. */
735 adjust_decl_rtl (tree decl)
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
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))))
765 = build_qualified_type (new_type,
766 (TYPE_QUALS (new_type) | TYPE_QUAL_CONST));
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);
776 if (TREE_CODE (decl) == PARM_DECL)
777 DECL_INCOMING_RTL (decl) = XEXP (DECL_INCOMING_RTL (decl), 0);
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
785 = build1 (ADDR_EXPR, new_type,
786 DECL_INITIAL (decl) != 0 ? DECL_INITIAL (decl) : decl);
790 /* Record the current code position in GNAT_NODE. */
793 record_code_position (Node_Id gnat_node)
795 if (global_bindings_p ())
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);
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)),
811 /* Insert the code for GNAT_NODE at the position saved for that node. */
814 insert_code_for (Node_Id gnat_node)
816 if (global_bindings_p ())
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 ();
828 do_pending_stack_adjust ();
830 mark_all_temps_used ();
831 gnat_to_code (gnat_node);
832 do_pending_stack_adjust ();
833 insns = get_insns ();
835 emit_insn_after (insns, RTL_EXPR_RTL (get_gnu_tree (gnat_node)));
839 /* Get the alias set corresponding to a type or expression. */
842 gnat_get_alias_set (tree type)
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)));
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)
853 get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
859 /* GNU_TYPE is a type. Determine if it should be passed by reference by
863 default_pass_by_ref (tree gnu_type)
867 INIT_CUMULATIVE_ARGS (cum, NULL_TREE, NULL_RTX, 0);
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. */
876 #ifdef FUNCTION_ARG_PASS_BY_REFERENCE
877 || FUNCTION_ARG_PASS_BY_REFERENCE (cum, TYPE_MODE (gnu_type),
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)))));
887 /* GNU_TYPE is the type of a subprogram parameter. Determine from the type if
888 it should be passed by reference. */
891 must_pass_by_ref (tree gnu_type)
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));
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:
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. */
917 enumerate_modes (void (*f) (int, int, int, int, int, int, unsigned int))
921 for (i = 0; i < NUM_MACHINE_MODES; i++)
929 enum machine_mode inner_mode = i;
931 switch (GET_MODE_CLASS (i))
938 case MODE_COMPLEX_INT:
940 inner_mode = GET_MODE_INNER (i);
942 case MODE_COMPLEX_FLOAT:
945 inner_mode = GET_MODE_INNER (i);
947 case MODE_VECTOR_INT:
949 inner_mode = GET_MODE_INNER (i);
951 case MODE_VECTOR_FLOAT:
954 inner_mode = GET_MODE_INNER (i);
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)
970 const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode);
972 mantissa = fmt->p * fmt->log2_b;
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));
983 fp_prec_to_size (int prec)
985 enum machine_mode mode;
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);
996 fp_size_to_prec (int size)
998 enum machine_mode mode;
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);