]> git.ipfire.org Git - thirdparty/gcc.git/blobdiff - gcc/ada/gcc-interface/decl.c
Merge from trunk.
[thirdparty/gcc.git] / gcc / ada / gcc-interface / decl.c
index 26e3944df3787052b5759df6f7385c2e376bf449..61b2239132bd3ede26b478bae7fb3752d722c7df 100644 (file)
@@ -28,6 +28,8 @@
 #include "coretypes.h"
 #include "tm.h"
 #include "tree.h"
+#include "stringpool.h"
+#include "stor-layout.h"
 #include "flags.h"
 #include "toplev.h"
 #include "ggc.h"
@@ -98,7 +100,7 @@ struct incomplete
 static int defer_incomplete_level = 0;
 static struct incomplete *defer_incomplete_list;
 
-/* This variable is used to delay expanding From_With_Type types until the
+/* This variable is used to delay expanding From_Limited_With types until the
    end of the spec.  */
 static struct incomplete *defer_limited_with;
 
@@ -311,8 +313,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       return gnu_decl;
     }
 
-  /* If this is a numeric or enumeral type, or an access type, a nonzero
-     Esize must be specified unless it was specified by the programmer.  */
+  /* If this is a numeric or enumeral type, or an access type, a nonzero Esize
+     must be specified unless it was specified by the programmer.  Exceptions
+     are for access-to-protected-subprogram types and all access subtypes, as
+     another GNAT type is used to lay out the GCC type for them.  */
   gcc_assert (!Unknown_Esize (gnat_entity)
              || Has_Size_Clause (gnat_entity)
              || (!IN (kind, Numeric_Kind)
@@ -320,7 +324,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                  && (!IN (kind, Access_Kind)
                      || kind == E_Access_Protected_Subprogram_Type
                      || kind == E_Anonymous_Access_Protected_Subprogram_Type
-                     || kind == E_Access_Subtype)));
+                     || kind == E_Access_Subtype
+                     || type_annotate_only)));
 
   /* The RM size must be specified for all discrete and fixed-point types.  */
   gcc_assert (!(IN (kind, Discrete_Or_Fixed_Point_Kind)
@@ -834,13 +839,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                align_cap = get_mode_alignment (ptr_mode);
              }
 
-           if (!host_integerp (TYPE_SIZE (gnu_type), 1)
+           if (!tree_fits_uhwi_p (TYPE_SIZE (gnu_type))
                || compare_tree_int (TYPE_SIZE (gnu_type), size_cap) > 0)
              align = 0;
            else if (compare_tree_int (TYPE_SIZE (gnu_type), align_cap) > 0)
              align = align_cap;
            else
-             align = ceil_pow2 (tree_low_cst (TYPE_SIZE (gnu_type), 1));
+             align = ceil_pow2 (tree_to_uhwi (TYPE_SIZE (gnu_type)));
 
            /* But make sure not to under-align the object.  */
            if (align <= TYPE_ALIGN (gnu_type))
@@ -1022,7 +1027,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                        save_gnu_tree (gnat_entity, gnu_decl, true);
                        saved = true;
                        annotate_object (gnat_entity, gnu_type, NULL_TREE,
-                                        false, false);
+                                        false);
                        /* This assertion will fail if the renamed object
                           isn't aligned enough as to make it possible to
                           honor the alignment set on the renaming.  */
@@ -1114,8 +1119,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                           as we have a VAR_DECL for the pointer we make.  */
                      }
 
-                   gnu_expr = build_unary_op (ADDR_EXPR, gnu_type,
-                                              maybe_stable_expr);
+                   if (type_annotate_only
+                       && TREE_CODE (maybe_stable_expr) == ERROR_MARK)
+                     gnu_expr = NULL_TREE;
+                   else
+                     gnu_expr = build_unary_op (ADDR_EXPR, gnu_type,
+                                                maybe_stable_expr);
 
                    gnu_size = NULL_TREE;
                    used_by_ref = true;
@@ -1475,10 +1484,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            && const_flag
            && gnu_expr && TREE_CONSTANT (gnu_expr)
            && AGGREGATE_TYPE_P (gnu_type)
-           && host_integerp (TYPE_SIZE_UNIT (gnu_type), 1)
+           && tree_fits_uhwi_p (TYPE_SIZE_UNIT (gnu_type))
            && !(TYPE_IS_PADDING_P (gnu_type)
-                && !host_integerp (TYPE_SIZE_UNIT
-                                   (TREE_TYPE (TYPE_FIELDS (gnu_type))), 1)))
+                && !tree_fits_uhwi_p (TYPE_SIZE_UNIT
+                                      (TREE_TYPE (TYPE_FIELDS (gnu_type))))))
          static_p = true;
 
        /* Now create the variable or the constant and set various flags.  */
@@ -1494,7 +1503,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        /* If we are defining an Out parameter and optimization isn't enabled,
           create a fake PARM_DECL for debugging purposes and make it point to
           the VAR_DECL.  Suppress debug info for the latter but make sure it
-          will live on the stack so that it can be accessed from within the
+          will live in memory so that it can be accessed from within the
           debugger through the PARM_DECL.  */
        if (kind == E_Out_Parameter
            && definition
@@ -1517,7 +1526,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        /* If this is a renaming pointer, attach the renamed object to it and
           register it if we are at the global level.  Note that an external
           constant is at the global level.  */
-       else if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
+       if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
          {
            SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
            if ((!definition && kind == E_Constant) || global_bindings_p ())
@@ -1576,6 +1585,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            && Has_Nested_Block_With_Handler (Scope (gnat_entity)))
          TREE_ADDRESSABLE (gnu_decl) = 1;
 
+       /* If this is a local variable with non-BLKmode and aggregate type,
+          and optimization isn't enabled, then force it in memory so that
+          a register won't be allocated to it with possible subparts left
+          uninitialized and reaching the register allocator.  */
+       else if (TREE_CODE (gnu_decl) == VAR_DECL
+                && !DECL_EXTERNAL (gnu_decl)
+                && !TREE_STATIC (gnu_decl)
+                && DECL_MODE (gnu_decl) != BLKmode
+                && AGGREGATE_TYPE_P (TREE_TYPE (gnu_decl))
+                && !TYPE_IS_FAT_POINTER_P (TREE_TYPE (gnu_decl))
+                && !optimize)
+         TREE_ADDRESSABLE (gnu_decl) = 1;
+
        /* If we are defining an object with variable size or an object with
           fixed size that will be dynamically allocated, and we are using the
           setjmp/longjmp exception mechanism, update the setjmp buffer.  */
@@ -1601,7 +1623,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
           type of the object and not on the object directly, and makes it
           possible to support all confirming representation clauses.  */
        annotate_object (gnat_entity, TREE_TYPE (gnu_decl), gnu_object_size,
-                        used_by_ref, false);
+                        used_by_ref);
       }
       break;
 
@@ -1642,7 +1664,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          TYPE_PRECISION (gnu_type) = esize;
          TYPE_UNSIGNED (gnu_type) = is_unsigned;
          set_min_and_max_values_for_integral_type (gnu_type, esize,
-                                                   is_unsigned);
+                                                   TYPE_SIGN (gnu_type));
          process_attributes (&gnu_type, &attr_list, true, gnat_entity);
          layout_type (gnu_type);
 
@@ -3477,7 +3499,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                        gnu_size = DECL_SIZE (gnu_old_field);
                        if (RECORD_OR_UNION_TYPE_P (gnu_field_type)
                            && !TYPE_FAT_POINTER_P (gnu_field_type)
-                           && host_integerp (TYPE_SIZE (gnu_field_type), 1))
+                           && tree_fits_uhwi_p (TYPE_SIZE (gnu_field_type)))
                          gnu_field_type
                            = make_packable_type (gnu_field_type, true);
                      }
@@ -3722,7 +3744,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        /* Whether it comes from a limited with.  */
        bool is_from_limited_with
          = (IN (Ekind (gnat_desig_equiv), Incomplete_Kind)
-            && From_With_Type (gnat_desig_equiv));
+            && From_Limited_With (gnat_desig_equiv));
        /* The "full view" of the designated type.  If this is an incomplete
           entity from a limited with, treat its non-limited view as the full
           view.  Otherwise, if this is an incomplete or private type, use the
@@ -4214,7 +4236,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
               we are only annotating types, break circularities here.  */
            if (type_annotate_only
                && IN (Ekind (gnat_return_type), Incomplete_Kind)
-               && From_With_Type (gnat_return_type)
+               && From_Limited_With (gnat_return_type)
                && In_Extended_Main_Code_Unit
                   (Non_Limited_View (gnat_return_type))
                && !present_gnu_tree (Non_Limited_View (gnat_return_type)))
@@ -4327,7 +4349,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
               we are only annotating types, break circularities here.  */
            if (type_annotate_only
                && IN (Ekind (gnat_param_type), Incomplete_Kind)
-               && From_With_Type (Etype (gnat_param_type))
+               && From_Limited_With (Etype (gnat_param_type))
                && In_Extended_Main_Code_Unit
                   (Non_Limited_View (gnat_param_type))
                && !present_gnu_tree (Non_Limited_View (gnat_param_type)))
@@ -4722,7 +4744,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
           full view, whichever is present.  This is used in all the tests
           below.  */
        Entity_Id full_view
-         = (IN (kind, Incomplete_Kind) && From_With_Type (gnat_entity))
+         = (IN (kind, Incomplete_Kind) && From_Limited_With (gnat_entity))
            ? Non_Limited_View (gnat_entity)
            : Present (Full_View (gnat_entity))
              ? Full_View (gnat_entity)
@@ -4809,6 +4831,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       saved = true;
       break;
 
+    case E_Abstract_State:
+      /* This is a SPARK annotation that only reaches here when compiling in
+        ASIS mode and has no characteristics to annotate.  */
+      gcc_assert (type_annotate_only);
+      return error_mark_node;
+
     default:
       gcc_unreachable ();
     }
@@ -4827,7 +4855,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
   if (is_type && (!gnu_decl || this_made_decl))
     {
       /* Process the attributes, if not already done.  Note that the type is
-        already defined so we cannot pass True for IN_PLACE here.  */
+        already defined so we cannot pass true for IN_PLACE here.  */
       process_attributes (&gnu_type, &attr_list, false, gnat_entity);
 
       /* Tell the middle-end that objects of tagged types are guaranteed to
@@ -4896,22 +4924,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
              /* Consider an alignment as suspicious if the alignment/size
                 ratio is greater or equal to the byte/bit ratio.  */
-             if (host_integerp (size, 1)
-                 && align >= TREE_INT_CST_LOW (size) * BITS_PER_UNIT)
+             if (tree_fits_uhwi_p (size)
+                 && align >= tree_to_uhwi (size) * BITS_PER_UNIT)
                post_error_ne ("?suspiciously large alignment specified for&",
                               Expression (Alignment_Clause (gnat_entity)),
                               gnat_entity);
            }
        }
       else if (Is_Atomic (gnat_entity) && !gnu_size
-              && host_integerp (TYPE_SIZE (gnu_type), 1)
+              && tree_fits_uhwi_p (TYPE_SIZE (gnu_type))
               && integer_pow2p (TYPE_SIZE (gnu_type)))
        align = MIN (BIGGEST_ALIGNMENT,
-                    tree_low_cst (TYPE_SIZE (gnu_type), 1));
+                    tree_to_uhwi (TYPE_SIZE (gnu_type)));
       else if (Is_Atomic (gnat_entity) && gnu_size
-              && host_integerp (gnu_size, 1)
+              && tree_fits_uhwi_p (gnu_size)
               && integer_pow2p (gnu_size))
-       align = MIN (BIGGEST_ALIGNMENT, tree_low_cst (gnu_size, 1));
+       align = MIN (BIGGEST_ALIGNMENT, tree_to_uhwi (gnu_size));
 
       /* See if we need to pad the type.  If we did, and made a record,
         the name of the new type may be changed.  So get it back for
@@ -5150,7 +5178,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
         to conflict with Comp2 and an alias set copy is required.
 
         The language rules ensure the parent type is already frozen here.  */
-      if (Is_Derived_Type (gnat_entity))
+      if (Is_Derived_Type (gnat_entity) && !type_annotate_only)
        {
          tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_entity));
          relate_alias_sets (gnu_type, gnu_parent_type,
@@ -5446,32 +5474,32 @@ bool
 is_cplusplus_method (Entity_Id gnat_entity)
 {
   if (Convention (gnat_entity) != Convention_CPP)
-    return False;
+    return false;
 
   /* This is the main case: C++ method imported as a primitive operation.  */
   if (Is_Dispatching_Operation (gnat_entity))
-    return True;
+    return true;
 
   /* A thunk needs to be handled like its associated primitive operation.  */
   if (Is_Subprogram (gnat_entity) && Is_Thunk (gnat_entity))
-    return True;
+    return true;
 
   /* C++ classes with no virtual functions can be imported as limited
      record types, but we need to return true for the constructors.  */
   if (Is_Constructor (gnat_entity))
-    return True;
+    return true;
 
   /* This is set on the E_Subprogram_Type built for a dispatching call.  */
   if (Is_Dispatch_Table_Entity (gnat_entity))
-    return True;
+    return true;
 
-  return False;
+  return false;
 }
 
-/* Finalize the processing of From_With_Type incomplete types.  */
+/* Finalize the processing of From_Limited_With incomplete types.  */
 
 void
-finalize_from_with_types (void)
+finalize_from_limited_with (void)
 {
   struct incomplete *p, *next;
 
@@ -5557,7 +5585,7 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
       && !Strict_Alignment (gnat_type)
       && RECORD_OR_UNION_TYPE_P (gnu_type)
       && !TYPE_FAT_POINTER_P (gnu_type)
-      && host_integerp (TYPE_SIZE (gnu_type), 1))
+      && tree_fits_uhwi_p (TYPE_SIZE (gnu_type)))
     gnu_type = make_packable_type (gnu_type, false);
 
   if (Has_Atomic_Components (gnat_array))
@@ -5647,7 +5675,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
   /* The parameter can be indirectly modified if its address is taken.  */
   bool ro_param = in_param && !Address_Taken (gnat_param);
   bool by_return = false, by_component_ptr = false;
-  bool by_ref = false, by_double_ref = false;
+  bool by_ref = false;
   tree gnu_param;
 
   /* Copy-return is used only for the first parameter of a valued procedure.
@@ -5772,19 +5800,6 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
        gnu_param_type
          = build_qualified_type (gnu_param_type, TYPE_QUAL_RESTRICT);
       by_ref = true;
-
-      /* In some ABIs, e.g. SPARC 32-bit, fat pointer types are themselves
-        passed by reference.  Pass them by explicit reference, this will
-        generate more debuggable code at -O0.  */
-      if (TYPE_IS_FAT_POINTER_P (gnu_param_type)
-         && targetm.calls.pass_by_reference (pack_cumulative_args (NULL),
-                                             TYPE_MODE (gnu_param_type),
-                                             gnu_param_type,
-                                             true))
-       {
-          gnu_param_type = build_reference_type (gnu_param_type);
-          by_double_ref = true;
-       }
     }
 
   /* Pass In Out or Out parameters using copy-in copy-out mechanism.  */
@@ -5827,14 +5842,9 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
   gnu_param = create_param_decl (gnu_param_name, gnu_param_type,
                                 ro_param || by_ref || by_component_ptr);
   DECL_BY_REF_P (gnu_param) = by_ref;
-  DECL_BY_DOUBLE_REF_P (gnu_param) = by_double_ref;
   DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
-  DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor ||
-                                      mech == By_Short_Descriptor);
-  /* Note that, in case of a parameter passed by double reference, the
-     DECL_POINTS_TO_READONLY_P flag is meant for the second reference.
-     The first reference always points to read-only, as it points to
-     the second reference, i.e. the reference to the actual parameter.  */
+  DECL_BY_DESCRIPTOR_P (gnu_param)
+    = (mech == By_Descriptor || mech == By_Short_Descriptor);
   DECL_POINTS_TO_READONLY_P (gnu_param)
     = (ro_param && (by_ref || by_component_ptr));
   DECL_CAN_NEVER_BE_NULL_P (gnu_param) = Can_Never_Be_Null (gnat_param);
@@ -6499,7 +6509,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
   if (!needs_strict_alignment
       && RECORD_OR_UNION_TYPE_P (gnu_field_type)
       && !TYPE_FAT_POINTER_P (gnu_field_type)
-      && host_integerp (TYPE_SIZE (gnu_field_type), 1)
+      && tree_fits_uhwi_p (TYPE_SIZE (gnu_field_type))
       && (packed == 1
          || (gnu_size
              && (tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type))
@@ -6738,13 +6748,13 @@ components_need_strict_alignment (Node_Id component_list)
       Entity_Id gnat_field = Defining_Entity (component_decl);
 
       if (Is_Aliased (gnat_field))
-       return True;
+       return true;
 
       if (Strict_Alignment (Etype (gnat_field)))
-       return True;
+       return true;
     }
 
-  return False;
+  return false;
 }
 
 /* Return true if TYPE is a type with variable size or a padding type with a
@@ -6999,13 +7009,11 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
       tree gnu_union_type, gnu_union_name;
       tree this_first_free_pos, gnu_variant_list = NULL_TREE;
       bool union_field_needs_strict_alignment = false;
-      vec <vinfo_t, va_stack> variant_types;
+      stack_vec <vinfo_t, 16> variant_types;
       vinfo_t *gnu_variant;
       unsigned int variants_align = 0;
       unsigned int i;
 
-      vec_stack_alloc (vinfo_t, variant_types, 16);
-
       if (TREE_CODE (gnu_name) == TYPE_DECL)
        gnu_name = DECL_NAME (gnu_name);
 
@@ -7201,9 +7209,6 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
          gnu_variant_list = gnu_field;
        }
 
-      /* We are done with the variants.  */
-      variant_types.release ();
-
       /* Only make the QUAL_UNION_TYPE if there are non-empty variants.  */
       if (gnu_variant_list)
        {
@@ -7488,11 +7493,9 @@ annotate_value (tree gnu_size)
       if (TREE_CODE (TREE_OPERAND (gnu_size, 1)) == INTEGER_CST)
        {
          tree op1 = TREE_OPERAND (gnu_size, 1);
-         double_int signed_op1
-           = tree_to_double_int (op1).sext (TYPE_PRECISION (sizetype));
-         if (signed_op1.is_negative ())
+         if (wi::neg_p (op1))
            {
-             op1 = double_int_to_tree (sizetype, -signed_op1);
+             op1 = wide_int_to_tree (sizetype, wi::neg (op1));
              pre_op1 = annotate_value (build1 (NEGATE_EXPR, sizetype, op1));
            }
        }
@@ -7551,18 +7554,13 @@ annotate_value (tree gnu_size)
 /* Given GNAT_ENTITY, an object (constant, variable, parameter, exception)
    and GNU_TYPE, its corresponding GCC type, set Esize and Alignment to the
    size and alignment used by Gigi.  Prefer SIZE over TYPE_SIZE if non-null.
-   BY_REF is true if the object is used by reference and BY_DOUBLE_REF is
-   true if the object is used by double reference.  */
+   BY_REF is true if the object is used by reference.  */
 
 void
-annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref,
-                bool by_double_ref)
+annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref)
 {
   if (by_ref)
     {
-      if (by_double_ref)
-       gnu_type = TREE_TYPE (gnu_type);
-
       if (TYPE_IS_FAT_POINTER_P (gnu_type))
        gnu_type = TYPE_UNCONSTRAINED_ARRAY (gnu_type);
       else
@@ -8364,7 +8362,7 @@ create_field_decl_from (tree old_field, tree field_type, tree record_type,
 {
   tree t = TREE_VALUE (purpose_member (old_field, pos_list));
   tree pos = TREE_VEC_ELT (t, 0), bitpos = TREE_VEC_ELT (t, 2);
-  unsigned int offset_align = tree_low_cst (TREE_VEC_ELT (t, 1), 1);
+  unsigned int offset_align = tree_to_uhwi (TREE_VEC_ELT (t, 1));
   tree new_pos, new_field;
   unsigned int i;
   subst_pair *s;