OSDN Git Service

2007-08-14 Olivier Hainque <hainque@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 14 Aug 2007 08:40:11 +0000 (08:40 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 14 Aug 2007 08:40:11 +0000 (08:40 +0000)
    Eric Botcazou  <ebotcazou@adacore.com>

* targtyps.c (get_target_maximum_default_alignment): New function.
Maximum alignment
that the compiler might choose by default for a type or object.
(get_target_default_allocator_alignment): New function. Alignment known
to be honored by the target default allocator.
(get_target_maximum_allowed_alignment): New function. Maximum alignment
we might accept for any type or object on the target.
(get_target_maximum_alignment): Now synonym of maximum_default_alignment

* gigi.h (get_target_maximum_default_alignment): Declare new function.
(get_target_default_allocator_alignment): Likewise.
(get_target_maximum_allowed_alignment): Likewise.

PR ada/19037
* decl.c (gnat_to_gnu_entity) <object>: Except for the renaming of the
result of a function call, first try to use a stabilized reference for
a constant renaming too.
(validate_alignment): Use target_maximum_allowed_alignment instead of
MAX_OFILE_ALIGNMENT as the upper bound to what we accept.
(gnat_to_gnu_entity): Use common nodes directly.
(gnat_to_gnu_entity) <object>: Pick the values of the type to annotate
alignment and size for the object.
(lvalue_required_p): Handle N_Parameter_Association like N_Function_Call
and N_Procedure_Call_Statement.
(takes_address): Rename to lvalue_required_p, add third parameter
'aliased' and adjust recursive calls.
<N_Indexed_Component>: Update 'aliased' from the array type.
<N_Selected_Component>: New case.
<N_Object_Renaming_Declaration>: New Likewise.
(Identifier_to_gnu): Adjust for above changes.
(maybe_stabilize_reference) <CONST_DECL>: New case.

* utils2.c (build_binary_op) <ARRAY_RANGE_REF>: Look through conversion
between type variants.
(build_simple_component_ref): Likewise.
(build_call_alloc_dealloc): Use target_default_allocator_alignment
instead of BIGGEST_ALIGNMENT as the threshold to trigger the super
aligning type circuitry for allocations from the default storage pool.
(build_allocator): Likewise.
(build_simple_component_ref): Manually fold the reference for a
constructor if the record type contains a template.

* utils.c (value_zerop): Delete.
(gnat_init_decl_processing): Emit debug info for common types.
(rest_of_record_type_compilation): If a union contains a field
with a non-constant qualifier, treat it as variable-sized.
(finish_record_type): Give the stub TYPE_DECL a name.
(rest_of_record_type_compilation): Likewise.
(convert) <CONSTRUCTOR>: New case.  Build a new constructor if
types are equivalent array types.
(create_field_decl): Claim fields of any ARRAY_TYPE are addressable,
even if the type is not passed by reference.
(static_ctors, static_dtors): Delete.
(end_subprog_body): Do not record constructors and destructors.
(build_global_cdtor): Delete.
(gnat_write_global_declarations): Do not call build_global_cdtor.

* lang-specs.h: If TARGET_VXWORKS_RTP is defined, append -mrtp when
-fRTS=rtp is specified.
If CONFIG_DUAL_EXCEPTIONS is 1, append -fsjlj when -fRTS=sjlj is
specified.

* misc.c (gnat_init_gcc_eh): Use __gnat_eh_personality_sj for the name
of the personality function with SJLJ exceptions.

        * raise-gcc.c (PERSONALITY_FUNCTION): Use __gnat_eh_personality_sj for
the name of the personality function with SJLJ exceptions.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127422 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/decl.c
gcc/ada/gigi.h
gcc/ada/lang-specs.h
gcc/ada/misc.c
gcc/ada/raise-gcc.c
gcc/ada/targtyps.c
gcc/ada/utils.c
gcc/ada/utils2.c

index c82f3dc..0621ead 100644 (file)
@@ -89,10 +89,6 @@ static VEC (tree,heap) *defer_finalize_list;
 static GTY ((if_marked ("tree_int_map_marked_p"),
             param_is (struct tree_int_map))) htab_t annotate_value_cache;
 
-/* A hash table used as to cache the result of annotate_value.  */
-static GTY ((if_marked ("tree_int_map_marked_p"), param_is (struct tree_int_map)))
-  htab_t annotate_value_cache;
-
 static void copy_alias_set (tree, tree);
 static tree substitution_list (Entity_Id, Entity_Id, tree, bool);
 static bool allocatable_size_p (tree, bool);
@@ -743,65 +739,47 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                     (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_type)))))))
          gnu_expr = convert (gnu_type, gnu_expr);
 
-       /* See if this is a renaming and handle appropriately depending on
-          what is renamed and in which context.  There are three cases:
-
-          1/ This is a constant renaming and we can just make an object
-             with what is renamed as its initial value,
-
-          2/ We can reuse a stabilized version of what is renamed in place
-             of the renaming,
-
-          3/ If neither 1 nor 2 applies, we make the renaming entity a
-             constant pointer to what is being renamed.  */
+       /* If this is a renaming, avoid as much as possible to create a new
+          object.  However, in several cases, creating it is required.  */
        if (Present (Renamed_Object (gnat_entity)))
          {
            bool create_normal_object = false;
 
            /* If the renamed object had padding, strip off the reference
               to the inner object and reset our type.  */
-           if (TREE_CODE (gnu_expr) == COMPONENT_REF
-               && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))
-                   == RECORD_TYPE)
-               && (TYPE_IS_PADDING_P
-                   (TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))))
+           if ((TREE_CODE (gnu_expr) == COMPONENT_REF
+                && TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_expr, 0)))
+                   == RECORD_TYPE
+                && TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (gnu_expr, 0))))
+               /* Strip useless conversions around the object.  */
+               || TREE_CODE (gnu_expr) == NOP_EXPR)
              {
                gnu_expr = TREE_OPERAND (gnu_expr, 0);
                gnu_type = TREE_TYPE (gnu_expr);
              }
 
-           /* Case 1: If this is a constant renaming, treat it as a normal
-              object whose initial value is what is being renamed.  We cannot
-              do this if the type is unconstrained or class-wide.  */
-           if (const_flag
-               && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
-               && Ekind (Etype (gnat_entity)) != E_Class_Wide_Type)
+           /* Case 1: If this is a constant renaming stemming from a function
+              call, treat it as a normal object whose initial value is what
+              is being renamed.  RM 3.3 says that the result of evaluating a
+              function call is a constant object.  As a consequence, it can
+              be the inner object of a constant renaming.  In this case, the
+              renaming must be fully instantiated, i.e. it cannot be a mere
+              reference to (part of) an existing object.  */
+           if (const_flag)
              {
-               /* However avoid creating large objects...  */
-               if (TYPE_MODE (gnu_type) != BLKmode)
+               tree inner_object = gnu_expr;
+               while (handled_component_p (inner_object))
+                 inner_object = TREE_OPERAND (inner_object, 0);
+               if (TREE_CODE (inner_object) == CALL_EXPR)
                  create_normal_object = true;
-               else
-                 {
-                   /* ...unless we really need to do it.  RM 3.3 says that
-                      the result of evaluating a function call is a constant
-                      object.  As a consequence, it can be the inner object
-                      of a constant renaming.  In this case, the renaming
-                      must be fully instantiated, i.e. it cannot be a mere
-                      reference to (part of) an existing object.  */
-                   tree inner_object = gnu_expr;
-                   while (handled_component_p (inner_object))
-                     inner_object = TREE_OPERAND (inner_object, 0);
-                   if (TREE_CODE (inner_object) == CALL_EXPR)
-                     create_normal_object = true;
-                 }
              }
 
            /* Otherwise, see if we can proceed with a stabilized version of
-              the renamed entity or if we need to make a pointer.  */
+              the renamed entity or if we need to make a new object.  */
            if (!create_normal_object)
              {
-               bool stable = false;
                tree maybe_stable_expr = NULL_TREE;
+               bool stable = false;
 
                /* Case 2: If the renaming entity need not be materialized and
                   the renamed expression is something we can stabilize, use
@@ -835,7 +813,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                       about that failure.  */
                  }
 
-               /* Case 3: Make this into a constant pointer to the object we
+               /* Case 3: If this is a constant renaming and creating a
+                  new object is allowed and cheap, treat it as a normal
+                  object whose initial value is what is being renamed.  */
+               if (const_flag
+                   && Ekind (Etype (gnat_entity)) != E_Class_Wide_Type
+                   && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
+                   && TYPE_MODE (gnu_type) != BLKmode)
+                 ;
+
+               /* Case 4: Make this into a constant pointer to the object we
                   are to rename and attach the object to the pointer if it is
                   something we can stabilize.
 
@@ -849,53 +836,54 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                   In the rare cases where we cannot stabilize the renamed
                   object, we just make a "bare" pointer, and the renamed
                   entity is always accessed indirectly through it.  */
-               {
-                 inner_const_flag = TREE_READONLY (gnu_expr);
-                 const_flag = true;
-                 gnu_type = build_reference_type (gnu_type);
-
-                 /* If the previous attempt at stabilization failed, there is
-                    no point in trying again and we reuse the result without
-                    attaching it to the pointer.  In this case it will only
-                    be used as the initializing expression of the pointer
-                    and thus needs no special treatment with regard to
-                    multiple evaluations.  */
-                 if (maybe_stable_expr)
-                   ;
-
-                 /* Otherwise, try to stabilize now and attach the expression
-                    to the pointer if the stabilization succeeds.
-
-                    Note that this might introduce SAVE_EXPRs and we don't
-                    check whether we're at the global level or not.  This is
-                    fine since we are building a pointer initializer and
-                    neither the pointer nor the initializing expression can
-                    be accessed before the pointer elaboration has taken
-                    place in a correct program.
-
-                    SAVE_EXPRs will be evaluated at the right spots by either
-                    the evaluation of the initializer for the non-global case
-                    or the elaboration code for the global case, and will be
-                    attached to the elaboration procedure in the latter case.
-                    We have no need to force an early evaluation here.  */
-                 else
-                   {
-                     maybe_stable_expr
-                       = maybe_stabilize_reference (gnu_expr, true, &stable);
+               else
+                 {
+                   gnu_type = build_reference_type (gnu_type);
+                   inner_const_flag = TREE_READONLY (gnu_expr);
+                   const_flag = true;
+
+                   /* If the previous attempt at stabilizing failed, there
+                      is no point in trying again and we reuse the result
+                      without attaching it to the pointer.  In this case it
+                      will only be used as the initializing expression of
+                      the pointer and thus needs no special treatment with
+                      regard to multiple evaluations.  */
+                   if (maybe_stable_expr)
+                     ;
+
+                   /* Otherwise, try to stabilize and attach the expression
+                      to the pointer if the stabilization succeeds.
+
+                      Note that this might introduce SAVE_EXPRs and we don't
+                      check whether we're at the global level or not.  This
+                      is fine since we are building a pointer initializer and
+                      neither the pointer nor the initializing expression can
+                      be accessed before the pointer elaboration has taken
+                      place in a correct program.
+
+                      These SAVE_EXPRs will be evaluated at the right place
+                      by either the evaluation of the initializer for the
+                      non-global case or the elaboration code for the global
+                      case, and will be attached to the elaboration procedure
+                      in the latter case.  */
+                   else
+                    {
+                       maybe_stable_expr
+                         = maybe_stabilize_reference (gnu_expr, true, &stable);
 
-                     if (stable)
-                       renamed_obj = maybe_stable_expr;
+                       if (stable)
+                         renamed_obj = maybe_stable_expr;
 
-                     /* Attaching is actually performed downstream, as soon
-                        as we have a VAR_DECL for the pointer we make.  */
-                   }
+                       /* Attaching is actually performed downstream, as soon
+                          as we have a VAR_DECL for the pointer we make.  */
+                     }
 
-                 gnu_expr
-                   = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr);
+                   gnu_expr
+                     = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr);
 
-                 gnu_size = NULL_TREE;
-                 used_by_ref = true;
-               }
+                   gnu_size = NULL_TREE;
+                   used_by_ref = true;
+                 }
              }
          }
 
@@ -1063,7 +1051,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST
                    && TREE_OVERFLOW (TYPE_SIZE_UNIT (gnu_alloc_type))
                    && !Is_Imported (gnat_entity))
-                 post_error ("Storage_Error will be raised at run-time?",
+                 post_error ("?Storage_Error will be raised at run-time!",
                              gnat_entity);
 
                gnu_expr = build_allocator (gnu_alloc_type, gnu_expr, gnu_type,
@@ -1216,25 +1204,33 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            && Exception_Mechanism != Back_End_Exceptions)
          TREE_ADDRESSABLE (gnu_decl) = 1;
 
-       /* Back-annotate the Alignment of the object if not already in the
-          tree.  Likewise for Esize if the object is of a constant size.
-          But if the "object" is actually a pointer to an object, the
-          alignment and size are the same as the type, so don't back-annotate
-          the values for the pointer.  */
+       gnu_type = TREE_TYPE (gnu_decl);
+
+       /* Back-annotate Alignment and Esize of the object if not already
+          known, except for when the object is actually a pointer to the
+          real object, since alignment and size of a pointer don't have
+          anything to do with those of the designated object.  Note that
+          we pick the values of the type, not those of the object, to
+          shield ourselves from low-level platform-dependent adjustments
+          like alignment promotion.  This is both consistent with all the
+          treatment above, where alignment and size are set on the type of
+          the object and not on the object directly, and makes it possible
+          to support confirming representation clauses in all cases.  */
+
        if (!used_by_ref && Unknown_Alignment (gnat_entity))
          Set_Alignment (gnat_entity,
-                        UI_From_Int (DECL_ALIGN (gnu_decl) / BITS_PER_UNIT));
+                        UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT));
 
-       if (!used_by_ref && Unknown_Esize (gnat_entity)
-           && DECL_SIZE (gnu_decl))
+       if (!used_by_ref && Unknown_Esize (gnat_entity))
          {
-           tree gnu_back_size = DECL_SIZE (gnu_decl);
+           tree gnu_back_size;
 
-           if (TREE_CODE (TREE_TYPE (gnu_decl)) == RECORD_TYPE
-               && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (gnu_decl)))
+           if (TREE_CODE (gnu_type) == RECORD_TYPE
+               && TYPE_CONTAINS_TEMPLATE_P (gnu_type))
              gnu_back_size
-               = TYPE_SIZE (TREE_TYPE (TREE_CHAIN
-                                       (TYPE_FIELDS (TREE_TYPE (gnu_decl)))));
+               = TYPE_SIZE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type))));
+            else
+             gnu_back_size = TYPE_SIZE (gnu_type);
 
            Set_Esize (gnat_entity, annotate_value (gnu_back_size));
          }
@@ -3157,15 +3153,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                      && Present (Freeze_Node (gnat_desig_rep))))
          {
            gnu_desig_type = make_dummy_type (gnat_desig_equiv);
-           made_dummy = 1;
-         }
+           made_dummy = true;
+         }
 
        /* Otherwise handle the case of a pointer to itself.  */
        else if (gnat_desig_equiv == gnat_entity)
          {
            gnu_type
-             = build_pointer_type_for_mode (make_node (VOID_TYPE),
-                                            p_mode,
+             = build_pointer_type_for_mode (void_type_node, p_mode,
                                             No_Strict_Aliasing (gnat_entity));
            TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_type;
          }
@@ -3173,7 +3168,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        /* If expansion is disabled, the equivalent type of a concurrent
           type is absent, so build a dummy pointer type.  */
        else if (type_annotate_only && No (gnat_desig_equiv))
-         gnu_type = build_pointer_type (void_type_node);
+         gnu_type = ptr_void_type_node;
 
        /* Finally, handle the straightforward case where we can just
           elaborate our designated type and point to it.  */
@@ -3302,7 +3297,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
     case E_Access_Protected_Subprogram_Type:
     case E_Anonymous_Access_Protected_Subprogram_Type:
       if (type_annotate_only && No (gnat_equiv_type))
-       gnu_type = build_pointer_type (void_type_node);
+       gnu_type = ptr_void_type_node;
       else
        {
          /* The runtime representation is the equivalent type. */
@@ -6723,9 +6718,7 @@ validate_alignment (Uint alignment, Entity_Id gnat_entity, unsigned int align)
   Node_Id gnat_error_node = gnat_entity;
   unsigned int new_align;
 
-#ifndef MAX_OFILE_ALIGNMENT
-#define MAX_OFILE_ALIGNMENT BIGGEST_ALIGNMENT
-#endif
+  unsigned int max_allowed_alignment = get_target_maximum_allowed_alignment ();
 
   if (Present (Alignment_Clause (gnat_entity)))
     gnat_error_node = Expression (Alignment_Clause (gnat_entity));
@@ -6736,16 +6729,14 @@ validate_alignment (Uint alignment, Entity_Id gnat_entity, unsigned int align)
   if (Error_Posted (gnat_entity) && !Has_Alignment_Clause (gnat_entity))
     return align;
 
-  /* Within GCC, an alignment is an integer, so we must make sure a
-     value is specified that fits in that range.  Also, alignments of
-     more than MAX_OFILE_ALIGNMENT can't be supported.  */
+  /* Within GCC, an alignment is an integer, so we must make sure a value is
+     specified that fits in that range.  Also, there is an upper bound to
+     alignments we can support/allow.  */
 
   if (! UI_Is_In_Int_Range (alignment)
-      || ((new_align = UI_To_Int (alignment))
-          > MAX_OFILE_ALIGNMENT / BITS_PER_UNIT))
+      || ((new_align = UI_To_Int (alignment)) > max_allowed_alignment))
     post_error_ne_num ("largest supported alignment for& is ^",
-                      gnat_error_node, gnat_entity,
-                      MAX_OFILE_ALIGNMENT / BITS_PER_UNIT);
+                      gnat_error_node, gnat_entity, max_allowed_alignment);
   else if (!(Present (Alignment_Clause (gnat_entity))
             && From_At_Mod (Alignment_Clause (gnat_entity)))
           && new_align * BITS_PER_UNIT < align)
index d210c61..42e9233 100644 (file)
@@ -857,6 +857,9 @@ extern Pos get_target_double_size (void);
 extern Pos get_target_long_double_size (void);
 extern Pos get_target_pointer_size (void);
 extern Pos get_target_maximum_alignment (void);
+extern Pos get_target_default_allocator_alignment (void);
+extern Pos get_target_maximum_default_alignment (void);
+extern Pos get_target_maximum_allowed_alignment (void);
 extern Nat get_float_words_be (void);
 extern Nat get_words_be (void);
 extern Nat get_bytes_be (void);
index 61a24f2..c12a897 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *           Copyright (C) 1992-2004 Free Software Foundation, Inc.         *
+ *           Copyright (C) 1992-2007, Free Software Foundation, Inc.        *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
  %{!S:%{!c:%e-c or -S required for Ada}}\
  gnat1 %{I*} %{k8:-gnatk8} %{w:-gnatws} %{!Q:-quiet} %{nostdinc*}\
     %{nostdlib*}\
-    -dumpbase %{.adb:%b.adb}%{.ads:%b.ads}%{!.adb:%{!.ads:%b.ada}}\
-    %{O*} %{W*} %{w} %{p} %{pg:-p} %{a} %{f*} %{d*} %{g*&m*} %1\
+    -dumpbase %{.adb:%b.adb}%{.ads:%b.ads}%{!.adb:%{!.ads:%b.ada}} "
+#if defined(TARGET_VXWORKS_RTP)
+   "%{fRTS=rtp:-mrtp} "
+#endif
+#if CONFIG_DUAL_EXCEPTIONS
+   "%{fRTS=sjlj:-fsjlj} "
+#endif
+   "%{O*} %{W*} %{w} %{p} %{pg:-p} %{a} %{f*} %{d*} %{g*&m*} %1\
     %{!S:%{o*:%w%*-gnatO}} \
     %i %{S:%W{o*}%{!o*:-o %b.s}} \
     %{gnatc*|gnats*: -o %j} %{-param*} \
index 5f1ae85..a59b1d0 100644 (file)
@@ -511,7 +511,9 @@ gnat_init_gcc_eh (void)
      right exception regions.  */
   using_eh_for_cleanups ();
 
-  eh_personality_libfunc = init_one_libfunc ("__gnat_eh_personality");
+  eh_personality_libfunc = init_one_libfunc (USING_SJLJ_EXCEPTIONS
+                                            ? "__gnat_eh_personality_sj"
+                                            : "__gnat_eh_personality");
   lang_eh_type_covers = gnat_eh_type_covers;
   lang_eh_runtime_type = gnat_eh_runtime_type;
   default_init_unwind_resume_libfunc ();
index e6879f7..55371d5 100644 (file)
@@ -540,7 +540,7 @@ get_region_description_for (_Unwind_Context *uw_context,
                             region_descriptor *region)
 {
   const unsigned char * p;
-  _uleb128_t tmp;
+  _Unwind_Word tmp;
   unsigned char lpbase_encoding;
 
   /* Get the base address of the lsda information. If the provided context
@@ -705,7 +705,7 @@ get_call_site_action_for (_Unwind_Context *uw_context,
     }
   else
     {
-      _uleb128_t cs_lp, cs_action;
+      _Unwind_Word cs_lp, cs_action;
 
       /* Let the caller know there may be an action to take, but let it
         determine the kind.  */
@@ -765,7 +765,7 @@ get_call_site_action_for (_Unwind_Context *uw_context,
   while (p < region->action_table)
     {
       _Unwind_Ptr cs_start, cs_len, cs_lp;
-      _uleb128_t cs_action;
+      _Unwind_Word cs_action;
 
       /* Note that all call-site encodings are "absolute" displacements.  */
       p = read_encoded_value (0, region->call_site_encoding, p, &cs_start);
@@ -913,7 +913,7 @@ get_action_description_for (_Unwind_Context *uw_context,
     {
       const unsigned char * p = action->table_entry;
 
-      _sleb128_t ar_filter, ar_disp;
+      _Unwind_Sword ar_filter, ar_disp;
 
       action->kind = nothing;
 
@@ -1004,6 +1004,12 @@ extern void __gnat_notify_unhandled_exception (void);
 /* Below is the eh personality routine per se. We currently assume that only
    GNU-Ada exceptions are met.  */
 
+#ifdef __USING_SJLJ_EXCEPTIONS__
+#define PERSONALITY_FUNCTION    __gnat_eh_personality_sj
+#else
+#define PERSONALITY_FUNCTION    __gnat_eh_personality
+#endif
+
 /* Major tweak for ia64-vms : the CHF propagation phase calls this personality
    routine with sigargs/mechargs arguments and has very specific expectations
    on possible return values.
@@ -1036,11 +1042,11 @@ typedef _Unwind_Action phases_arg_t;
 #endif
 
 _Unwind_Reason_Code
-__gnat_eh_personality (version_arg_t version_arg,
-                       phases_arg_t phases_arg,
-                       _Unwind_Exception_Class uw_exception_class,
-                       _Unwind_Exception *uw_exception,
-                       _Unwind_Context *uw_context)
+PERSONALITY_FUNCTION (version_arg_t version_arg,
+                      phases_arg_t phases_arg,
+                      _Unwind_Exception_Class uw_exception_class,
+                      _Unwind_Exception *uw_exception,
+                      _Unwind_Context *uw_context)
 {
   /* Fetch the version and phases args with their nominal ABI types for later
      use. This is a noop everywhere except on ia64-vms when called from the
index c23d9e9..79dafca 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                                  Body                                    *
  *                                                                          *
- *          Copyright (C) 1992-2006, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2007, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -142,12 +142,63 @@ get_target_pointer_size (void)
   return POINTER_SIZE;
 }
 
+/* Alignment related values, mapped to attributes for functional and
+   documentation purposes.  */
+
+/* Standard'Maximum_Default_Alignment.  Maximum alignment that the compiler
+   might choose by default for a type or object.
+
+   Stricter alignment requests trigger gigi's aligning_type circuitry for
+   stack objects or objects allocated by the default allocator.  */
+
 Pos
-get_target_maximum_alignment (void)
+get_target_maximum_default_alignment (void)
 {
   return BIGGEST_ALIGNMENT / BITS_PER_UNIT;
 }
 
+/* Standard'Default_Allocator_Alignment.  Alignment guaranteed to be honored
+   by the default allocator (System.Memory.Alloc or malloc if we have no
+   run-time library at hand).
+
+   Stricter alignment requests trigger gigi's aligning_type circuitry for
+   objects allocated by the default allocator.  */
+
+#ifndef MALLOC_ALIGNMENT
+#define MALLOC_ALIGNMENT BIGGEST_ALIGNMENT
+#endif
+
+Pos
+get_target_default_allocator_alignment (void)
+{
+  /* ??? Need a way to get info about __gnat_malloc from here (whether
+     it is handy and what alignment it honors).  */
+
+  return MALLOC_ALIGNMENT / BITS_PER_UNIT;
+}
+
+/* Standard'Maximum_Allowed_Alignment.  Maximum alignment that we may
+   accept for any type or object.  */
+
+#ifndef MAX_OFILE_ALIGNMENT
+#define MAX_OFILE_ALIGNMENT BIGGEST_ALIGNMENT
+#endif
+
+Pos
+get_target_maximum_allowed_alignment (void)
+{
+  return MAX_OFILE_ALIGNMENT / BITS_PER_UNIT;
+}
+
+/* Standard'Maximum_Alignment.  The single attribute initially made
+   available, now a synonym of Standard'Maximum_Default_Alignment.  */
+
+Pos
+get_target_maximum_alignment (void)
+{
+  return get_target_maximum_default_alignment ();
+}
+
 #ifndef FLOAT_WORDS_BIG_ENDIAN
 #define FLOAT_WORDS_BIG_ENDIAN WORDS_BIG_ENDIAN
 #endif
index 8a8ee7f..d26395f 100644 (file)
@@ -156,11 +156,6 @@ static GTY(()) VEC(tree,gc) *builtin_decls;
 /* An array of global renaming pointers.  */
 static GTY(()) VEC(tree,gc) *global_renaming_pointers;
 
-/* Arrays of functions called automatically at the beginning and
-   end of execution, on targets without .ctors/.dtors sections.  */
-static GTY(()) VEC(tree,gc) *static_ctors;
-static GTY(()) VEC(tree,gc) *static_dtors;
-
 /* A chain of unused BLOCK nodes. */
 static GTY((deletable)) tree free_block_chain;
 
@@ -168,7 +163,6 @@ static void gnat_install_builtins (void);
 static tree merge_sizes (tree, tree, tree, bool, bool);
 static tree compute_related_constant (tree, tree);
 static tree split_plus (tree, tree *);
-static bool value_zerop (tree);
 static void gnat_gimplify_function (tree);
 static tree float_type_for_precision (int, enum machine_mode);
 static tree convert_to_fat_pointer (tree, tree);
@@ -505,17 +499,14 @@ gnat_init_decl_processing (void)
   build_common_tree_nodes_2 (0);
 
   /* Give names and make TYPE_DECLs for common types.  */
-  gnat_pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype),
-                Empty);
-  gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
-                            integer_type_node),
-                Empty);
-  gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
-                            char_type_node),
-                Empty);
-  gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("long integer"),
-                            long_integer_type_node),
-                Empty);
+  create_type_decl (get_identifier (SIZE_TYPE), sizetype,
+                   NULL, false, true, Empty);
+  create_type_decl (get_identifier ("integer"), integer_type_node,
+                   NULL, false, true, Empty);
+  create_type_decl (get_identifier ("unsigned char"), char_type_node,
+                   NULL, false, true, Empty);
+  create_type_decl (get_identifier ("long integer"), long_integer_type_node,
+                   NULL, false, true, Empty);
 
   ptr_void_type_node = build_pointer_type (void_type_node);
 
@@ -778,7 +769,7 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
 
   TYPE_FIELDS (record_type) = fieldlist;
   TYPE_STUB_DECL (record_type)
-    = build_decl (TYPE_DECL, NULL_TREE, record_type);
+    = build_decl (TYPE_DECL, TYPE_NAME (record_type), record_type);
 
   /* We don't need both the typedef name and the record name output in
      the debugging information, since they are the same.  */
@@ -947,6 +938,7 @@ rest_of_record_type_compilation (tree record_type)
 {
   tree fieldlist = TYPE_FIELDS (record_type);
   tree field;
+  enum tree_code code = TREE_CODE (record_type);
   bool var_size = false;
 
   for (field = fieldlist; field; field = TREE_CHAIN (field))
@@ -957,7 +949,11 @@ rest_of_record_type_compilation (tree record_type)
         same size, in which case we'll use that size.  But the debug
         output routines (except Dwarf2) won't be able to output the fields,
         so we need to make the special record.  */
-      if (TREE_CODE (DECL_SIZE (field)) != INTEGER_CST)
+      if (TREE_CODE (DECL_SIZE (field)) != INTEGER_CST
+         /* If a field has a non-constant qualifier, the record will have
+            variable size too.  */
+         || (code == QUAL_UNION_TYPE
+             && TREE_CODE (DECL_QUALIFIER (field)) != INTEGER_CST))
        {
          var_size = true;
          break;
@@ -991,7 +987,7 @@ rest_of_record_type_compilation (tree record_type)
       TYPE_NAME (new_record_type) = new_id;
       TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
       TYPE_STUB_DECL (new_record_type)
-       = build_decl (TYPE_DECL, NULL_TREE, new_record_type);
+       = build_decl (TYPE_DECL, new_id, new_record_type);
       DECL_ARTIFICIAL (TYPE_STUB_DECL (new_record_type)) = 1;
       DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
        = DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
@@ -1483,8 +1479,6 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
   if (TREE_CODE (var_decl) != CONST_DECL)
     rest_of_decl_compilation (var_decl, global_bindings_p (), 0);
   else
-    /* expand CONST_DECLs to set their MODE, ALIGN, SIZE and SIZE_UNIT,
-       which we need for later back-annotations.  */
     expand_decl (var_decl);
 
   return var_decl;
@@ -1631,35 +1625,28 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
       DECL_HAS_REP_P (field_decl) = 1;
     }
 
-  /* If the field type is passed by reference, we will have pointers to the
-     field, so it is addressable. */
-  if (must_pass_by_ref (field_type) || default_pass_by_ref (field_type))
+  /* In addition to what our caller says, claim the field is addressable if we
+     know we might ever attempt to take its address, then mark the decl as
+     nonaddressable accordingly.
+
+     The field may also be "technically" nonaddressable, meaning that even if
+     we attempt to take the field's address we will actually get the address
+     of a copy.  This is the case for true bitfields, but the DECL_BIT_FIELD
+     value we have at this point is not accurate enough, so we don't account
+     for this here and let finish_record_type decide.  */
+
+  /* We will take the address in any argument passing sequence if the field
+     type is passed by reference, and we might need the address for any array
+     type, even if normally passed by-copy, to construct a fat pointer if the
+     field is used as an actual for an unconstrained formal.  */
+  if (TREE_CODE (field_type) == ARRAY_TYPE
+      || must_pass_by_ref (field_type) || default_pass_by_ref (field_type))
     addressable = 1;
 
-  /* Mark the decl as nonaddressable if it is indicated so semantically,
-     meaning we won't ever attempt to take the address of the field.
-
-     It may also be "technically" nonaddressable, meaning that even if we
-     attempt to take the field's address we will actually get the address of a
-     copy. This is the case for true bitfields, but the DECL_BIT_FIELD value
-     we have at this point is not accurate enough, so we don't account for
-     this here and let finish_record_type decide.  */
   DECL_NONADDRESSABLE_P (field_decl) = !addressable;
 
   return field_decl;
 }
-
-/* Subroutine of previous function: return nonzero if EXP, ignoring any side
-   effects, has the value of zero.  */
-
-static bool
-value_zerop (tree exp)
-{
-  if (TREE_CODE (exp) == COMPOUND_EXPR)
-    return value_zerop (TREE_OPERAND (exp, 1));
-
-  return integer_zerop (exp);
-}
 \f
 /* Returns a PARM_DECL node. PARAM_NAME is the name of the parameter,
    PARAM_TYPE is its type.  READONLY is true if the parameter is
@@ -2142,14 +2129,6 @@ end_subprog_body (tree body)
   if (type_annotate_only)
     return;
 
-  /* If we don't have .ctors/.dtors sections, and this is a static
-     constructor or destructor, it must be recorded now.  */
-  if (DECL_STATIC_CONSTRUCTOR (fndecl) && !targetm.have_ctors_dtors)
-    VEC_safe_push (tree, gc, static_ctors, fndecl);
-
-  if (DECL_STATIC_DESTRUCTOR (fndecl) && !targetm.have_ctors_dtors)
-    VEC_safe_push (tree, gc, static_dtors, fndecl);
-
   /* Perform the required pre-gimplfication transformations on the tree.  */
   gnat_genericize (fndecl);
 
@@ -3474,6 +3453,22 @@ convert (tree type, tree expr)
        }
       break;
 
+    case CONSTRUCTOR:
+      /* If we are converting a CONSTRUCTOR to another constrained array type
+        with the same domain, just make a new one in the proper type.  */
+      if (code == ecode && code == ARRAY_TYPE
+         && TREE_TYPE (type) == TREE_TYPE (etype)
+         && tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (type)),
+                                TYPE_MIN_VALUE (TYPE_DOMAIN (etype)))
+         && tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (type)),
+                                TYPE_MAX_VALUE (TYPE_DOMAIN (etype))))
+       {
+         expr = copy_node (expr);
+         TREE_TYPE (expr) = type;
+         return expr;
+       }
+      break;
+
     case UNCONSTRAINED_ARRAY_REF:
       /* Convert this to the type of the inner array by getting the address of
         the array from the template.  */
@@ -4010,41 +4005,11 @@ tree_code_for_record_type (Entity_Id gnat_type)
   return UNION_TYPE;
 }
 
-/* Build a global constructor or destructor function.  METHOD_TYPE gives
-   the type of the function and VEC points to the vector of constructor
-   or destructor functions to be invoked.  FIXME: Migrate into cgraph.  */
-
-static void
-build_global_cdtor (int method_type, tree *vec, int len)
-{
-  tree body = NULL_TREE;
-  int i;
-
-  for (i = 0; i < len; i++)
-    {
-      tree fntype = TREE_TYPE (vec[i]);
-      tree fnaddr = build1 (ADDR_EXPR, build_pointer_type (fntype), vec[i]);
-      tree fncall = build_call_nary (TREE_TYPE (fntype), fnaddr, 0);
-      append_to_statement_list (fncall, &body);
-    }
-
-  if (body)
-    cgraph_build_static_cdtor (method_type, body, DEFAULT_INIT_PRIORITY);
-}
-
 /* Perform final processing on global variables.  */
 
 void
 gnat_write_global_declarations (void)
 {
-  /* Generate functions to call static constructors and destructors
-     for targets that do not support .ctors/.dtors sections.  These
-     functions have magic names which are detected by collect2.  */
-  build_global_cdtor ('I', VEC_address (tree, static_ctors),
-                          VEC_length (tree, static_ctors));
-  build_global_cdtor ('D', VEC_address (tree, static_dtors),
-                          VEC_length (tree, static_dtors));
-
   /* Proceed to optimize and emit assembly.
      FIXME: shouldn't be the front end's responsibility to call this.  */
   cgraph_optimize ();
index 9134f03..dd5a29e 100644 (file)
@@ -758,8 +758,17 @@ build_binary_op (enum tree_code op_code, tree result_type,
       /* ... fall through ... */
 
     case ARRAY_RANGE_REF:
+      /* First look through conversion between type variants.  Note that
+        this changes neither the operation type nor the type domain.  */
+      if (TREE_CODE (left_operand) == VIEW_CONVERT_EXPR
+         && TYPE_MAIN_VARIANT (TREE_TYPE (TREE_OPERAND (left_operand, 0)))
+            == TYPE_MAIN_VARIANT (left_type))
+       {
+         left_operand = TREE_OPERAND (left_operand, 0);
+         left_type = TREE_TYPE (left_operand);
+       }
 
-      /* First convert the right operand to its base type.  This will
+      /* Then convert the right operand to its base type.  This will
         prevent unneeded signedness conversions when sizetype is wider than
         integer.  */
       right_operand = convert (right_base_type, right_operand);
@@ -1632,7 +1641,7 @@ build_simple_component_ref (tree record_variable, tree component,
                             tree field, bool no_fold_p)
 {
   tree record_type = TYPE_MAIN_VARIANT (TREE_TYPE (record_variable));
-  tree ref;
+  tree ref, inner_variable;
 
   gcc_assert ((TREE_CODE (record_type) == RECORD_TYPE
               || TREE_CODE (record_type) == UNION_TYPE
@@ -1704,9 +1713,16 @@ build_simple_component_ref (tree record_variable, tree component,
       && TREE_OVERFLOW (DECL_FIELD_OFFSET (field)))
     return NULL_TREE;
 
-  /* It would be nice to call "fold" here, but that can lose a type
-     we need to tag a PLACEHOLDER_EXPR with, so we can't do it.  */
-  ref = build3 (COMPONENT_REF, TREE_TYPE (field), record_variable, field,
+  /* Look through conversion between type variants.  Note that this
+     is transparent as far as the field is concerned.  */
+  if (TREE_CODE (record_variable) == VIEW_CONVERT_EXPR
+      && TYPE_MAIN_VARIANT (TREE_TYPE (TREE_OPERAND (record_variable, 0)))
+        == record_type)
+    inner_variable = TREE_OPERAND (record_variable, 0);
+  else
+    inner_variable = record_variable;
+
+  ref = build3 (COMPONENT_REF, TREE_TYPE (field), inner_variable, field,
                NULL_TREE);
 
   if (TREE_READONLY (record_variable) || TREE_READONLY (field))
@@ -1715,7 +1731,25 @@ build_simple_component_ref (tree record_variable, tree component,
       || TYPE_VOLATILE (record_type))
     TREE_THIS_VOLATILE (ref) = 1;
 
-  return no_fold_p ? ref : fold (ref);
+  if (no_fold_p)
+    return ref;
+
+  /* The generic folder may punt in this case because the inner array type
+     can be self-referential, but folding is in fact not problematic.  */
+  else if (TREE_CODE (record_variable) == CONSTRUCTOR
+          && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (record_variable)))
+    {
+      VEC(constructor_elt,gc) *elts = CONSTRUCTOR_ELTS (record_variable);
+      unsigned HOST_WIDE_INT idx;
+      tree index, value;
+      FOR_EACH_CONSTRUCTOR_ELT (elts, idx, index, value)
+       if (index == field)
+         return value;
+      return ref;
+    }
+
+  else
+    return fold (ref);
 }
 \f
 /* Like build_simple_component_ref, except that we give an error if the
@@ -1822,12 +1856,17 @@ build_call_alloc_dealloc (tree gnu_obj, tree gnu_size, unsigned align,
 
   else if (gnu_obj)
     {
-      /* If the required alignement was greater than what malloc guarantees,
-        what we have in gnu_obj here is an address dynamically adjusted to
-        match the requirement (see build_allocator).  What we need to pass
-        to free is the initial underlying allocator's return value, which
-        has been stored just in front of the block we have.  */
-      if (align > BIGGEST_ALIGNMENT)
+      /* If the required alignement was greater than what the default
+        allocator guarantees, what we have in gnu_obj here is an address
+        dynamically adjusted to match the requirement (see build_allocator).
+        What we need to pass to free is the initial underlying allocator's
+        return value, which has been stored just in front of the block we
+        have.  */
+
+      unsigned int default_allocator_alignment
+       = get_target_default_allocator_alignment () * BITS_PER_UNIT;
+
+      if (align > default_allocator_alignment)
        {
          /* We set GNU_OBJ
             as * (void **)((void *)GNU_OBJ - (void *)sizeof(void *))
@@ -1900,6 +1939,8 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
 {
   tree size = TYPE_SIZE_UNIT (type);
   tree result;
+  unsigned int default_allocator_alignment
+    = get_target_default_allocator_alignment () * BITS_PER_UNIT;
 
   /* If the initializer, if present, is a NULL_EXPR, just return a new one.  */
   if (init && TREE_CODE (init) == NULL_EXPR)
@@ -1999,25 +2040,26 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
   if (TREE_CODE (size) == INTEGER_CST && TREE_OVERFLOW (size))
     size = ssize_int (-1);
 
-  /* If this is a type whose alignment is larger than what the underlying
-     allocator supports and this is in the default storage pool, make an
-     "aligning" record type with room to store a pointer before the field,
-     allocate an object of that type, store the system's allocator return
-     value just in front of the field and return the field's address.  */
+  /* If this is in the default storage pool and the type alignment is larger
+     than what the default allocator supports, make an "aligning" record type
+     with room to store a pointer before the field, allocate an object of that
+     type, store the system's allocator return value just in front of the
+     field and return the field's address.  */
 
-  if (TYPE_ALIGN (type) > BIGGEST_ALIGNMENT && No (gnat_proc))
+  if (No (gnat_proc) && TYPE_ALIGN (type) > default_allocator_alignment)
     {
       /* Construct the aligning type with enough room for a pointer ahead
         of the field, then allocate.  */
       tree record_type
        = make_aligning_type (type, TYPE_ALIGN (type), size,
-                             BIGGEST_ALIGNMENT, POINTER_SIZE / BITS_PER_UNIT);
+                             default_allocator_alignment,
+                             POINTER_SIZE / BITS_PER_UNIT);
 
       tree record, record_addr;
 
       record_addr
        = build_call_alloc_dealloc (NULL_TREE, TYPE_SIZE_UNIT (record_type),
-                                   BIGGEST_ALIGNMENT, Empty, Empty,
+                                   default_allocator_alignment, Empty, Empty,
                                    gnat_node);
 
       record_addr