decl.c (elaborate_expression, [...]): Arguments now bool instead of int.
authorRichard Kenner <kenner@vlsi1.ultra.nyu.edu>
Sun, 20 Jun 2004 11:19:47 +0000 (11:19 +0000)
committerRichard Kenner <kenner@gcc.gnu.org>
Sun, 20 Jun 2004 11:19:47 +0000 (07:19 -0400)
* decl.c (elaborate_expression, elaborate_expression_1): Arguments
now bool instead of int.
(gnat_to_gnu_entity, elaborate_expression_1): New arg to COMPONENT_REF.
* trans.c (gnu_switch_label_stack): New function.
(gnat_to_gnu, N_Object_Renaming_Declaration): Result is what the
elaboration of renamed entity returns.
(gnat_to_gnu, case N_Case_Statement): Add branches to end label.
(add_decl_stmt): Don't add TYPE_DECL for UNCONSTRAINED_ARRAY_TYPE.
(gnat_gimplify_stmt): Use alloc_stmt_list, not build_empty_stmt.
(gnat_gimplify_stmt, case DECL_STMT): gimplify DECL_SIZE and
DECL_SIZE_UNIT and simplify variable-sized case.
(gnat_gimplify_type_sizes, gnat_gimplify_one_sizepos): Deleted.
Callers changes to call gimplify_type_sizes and gimplify_one_sizepos.
(gnat_stabilize_reference): Add arg to COMPONENT_REF.
(build_unit_elab): Disable for now.
* utils.c (mark_visited): New function.
(pushdecl): Walk tree to call it for global decl.
(update_pointer_to): Update all variants of pointer and ref types.
Add arg to COMPONENT_REF.
(convert): Likewise.
Move check for converting between variants lower down.
* utils2.c (build_simple_component_ref): Add arg to COMPONENT_REF.
(build_allocator): Don't force type of MODIFY_EXPR.
(gnat_mark_addressable, case VAR_DECL): Unconditionally call
put_var_into_stack.

From-SVN: r83410

gcc/ada/ChangeLog
gcc/ada/decl.c
gcc/ada/trans.c
gcc/ada/utils.c
gcc/ada/utils2.c

index f0551826626a692b93fa6747557da46a38614a16..d6788f3d3beafdf3ef366f5e49cf9cd624ca0115 100644 (file)
@@ -1,3 +1,31 @@
+2004-06-20  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+       * decl.c (elaborate_expression, elaborate_expression_1): Arguments
+       now bool instead of int.
+       (gnat_to_gnu_entity, elaborate_expression_1): New arg to COMPONENT_REF.
+       * trans.c (gnu_switch_label_stack): New function.
+       (gnat_to_gnu, N_Object_Renaming_Declaration): Result is what the
+       elaboration of renamed entity returns.
+       (gnat_to_gnu, case N_Case_Statement): Add branches to end label.
+       (add_decl_stmt): Don't add TYPE_DECL for UNCONSTRAINED_ARRAY_TYPE.
+       (gnat_gimplify_stmt): Use alloc_stmt_list, not build_empty_stmt.
+       (gnat_gimplify_stmt, case DECL_STMT): gimplify DECL_SIZE and
+       DECL_SIZE_UNIT and simplify variable-sized case.
+       (gnat_gimplify_type_sizes, gnat_gimplify_one_sizepos): Deleted.
+       Callers changes to call gimplify_type_sizes and gimplify_one_sizepos.
+       (gnat_stabilize_reference): Add arg to COMPONENT_REF.
+       (build_unit_elab): Disable for now.
+       * utils.c (mark_visited): New function.
+       (pushdecl): Walk tree to call it for global decl.
+       (update_pointer_to): Update all variants of pointer and ref types.
+       Add arg to COMPONENT_REF.
+       (convert): Likewise.
+       Move check for converting between variants lower down.
+       * utils2.c (build_simple_component_ref): Add arg to COMPONENT_REF.
+       (build_allocator): Don't force type of MODIFY_EXPR.
+       (gnat_mark_addressable, case VAR_DECL): Unconditionally call
+       put_var_into_stack.
+
 2004-06-14  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
 
        * ada-tree.def (LOOP_STMT, EXIT_STMT): Update documentation.
index 3f5d80939fb1cd16473a30065c425209d0567ad4..25fe2c8dd580e16a1c3b2ffadac955fbc8a36af4 100644 (file)
@@ -84,9 +84,10 @@ static void copy_alias_set (tree, tree);
 static tree substitution_list (Entity_Id, Entity_Id, tree, int);
 static int allocatable_size_p (tree, int);
 static struct attrib *build_attr_list (Entity_Id);
-static tree elaborate_expression (Node_Id, Entity_Id, tree, int, int, int);
+static tree elaborate_expression (Node_Id, Entity_Id, tree, bool, bool, bool);
 static int is_variable_size (tree);
-static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree, int, int);
+static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree,
+                                   bool, bool);
 static tree make_packable_type (tree);
 static tree maybe_pad_type (tree, tree, unsigned int, Entity_Id, const char *,
                             int, int, int);
@@ -1487,7 +1488,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
           fields once we build them.  */
        tem = build (COMPONENT_REF, gnu_ptr_template,
                     build (PLACEHOLDER_EXPR, gnu_fat_type),
-                    TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)));
+                    TREE_CHAIN (TYPE_FIELDS (gnu_fat_type)), NULL_TREE);
        gnu_template_reference
          = build_unary_op (INDIRECT_REF, gnu_template_type, tem);
        TREE_READONLY (gnu_template_reference) = 1;
@@ -1532,9 +1533,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            /* We can't use build_component_ref here since the template
               type isn't complete yet.  */
            gnu_min = build (COMPONENT_REF, gnu_ind_subtype,
-                            gnu_template_reference, gnu_min_field);
+                            gnu_template_reference, gnu_min_field, NULL_TREE);
            gnu_max = build (COMPONENT_REF, gnu_ind_subtype,
-                            gnu_template_reference, gnu_max_field);
+                            gnu_template_reference, gnu_max_field, NULL_TREE);
            TREE_READONLY (gnu_min) = TREE_READONLY (gnu_max) = 1;
 
            /* Make a range type with the new ranges, but using
@@ -2331,7 +2332,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            gnu_get_parent = build (COMPONENT_REF, void_type_node,
                                    build (PLACEHOLDER_EXPR, gnu_type),
                                    build_decl (FIELD_DECL, NULL_TREE,
-                                               NULL_TREE));
+                                               NULL_TREE),
+                                   NULL_TREE);
 
            if (Has_Discriminants (gnat_entity))
              for (gnat_field = First_Stored_Discriminant (gnat_entity);
@@ -2345,7 +2347,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                            gnu_get_parent,
                            gnat_to_gnu_entity (Corresponding_Discriminant
                                                (gnat_field),
-                                               NULL_TREE, 0)),
+                                               NULL_TREE, 0),
+                           NULL_TREE),
                     1);
 
            gnu_parent = gnat_to_gnu_type (Parent_Subtype (gnat_entity));
@@ -2387,7 +2390,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                             build (COMPONENT_REF, TREE_TYPE (gnu_field),
                                    build (PLACEHOLDER_EXPR,
                                           DECL_CONTEXT (gnu_field)),
-                                   gnu_field),
+                                   gnu_field, NULL_TREE),
                             1);
 
              TREE_CHAIN (gnu_field) = gnu_field_list;
@@ -4453,12 +4456,9 @@ maybe_variable (tree gnu_operand)
    purposes even if it isn't needed for code generation.  */
 
 static tree
-elaborate_expression (Node_Id gnat_expr,
-                      Entity_Id gnat_entity,
-                      tree gnu_name,
-                      int definition,
-                      int need_value,
-                      int need_debug)
+elaborate_expression (Node_Id gnat_expr, Entity_Id gnat_entity,
+                      tree gnu_name, bool definition, bool need_value,
+                     bool need_debug)
 {
   tree gnu_expr;
 
@@ -4480,10 +4480,8 @@ elaborate_expression (Node_Id gnat_expr,
     = elaborate_expression_1 (gnat_expr, gnat_entity, gnat_to_gnu (gnat_expr),
                              gnu_name, definition, need_debug);
 
-  /* Save the expression in case we try to elaborate this entity again.
-     Since this is not a DECL, don't check it.  If this is a constant,
-     don't save it since GNAT_EXPR might be used more than once.  Also,
-     don't save if it's a discriminant.  */
+  /* Save the expression in case we try to elaborate this entity again.  Since
+     this is not a DECL, don't check it.  Don't save if it's a discriminant. */
   if (! CONTAINS_PLACEHOLDER_P (gnu_expr))
     save_gnu_tree (gnat_expr, gnu_expr, 1);
 
@@ -4493,12 +4491,9 @@ elaborate_expression (Node_Id gnat_expr,
 /* Similar, but take a GNU expression.  */
 
 static tree
-elaborate_expression_1 (Node_Id gnat_expr,
-                        Entity_Id gnat_entity,
-                        tree gnu_expr,
-                        tree gnu_name,
-                        int definition,
-                        int need_debug)
+elaborate_expression_1 (Node_Id gnat_expr, Entity_Id gnat_entity,
+                        tree gnu_expr, tree gnu_name, bool definition,
+                        bool need_debug)
 {
   tree gnu_decl = 0;
   /* Strip any conversions to see if the expression is a readonly variable.
@@ -4517,7 +4512,7 @@ elaborate_expression_1 (Node_Id gnat_expr,
   if (TREE_CODE (gnu_expr) == FIELD_DECL)
     gnu_expr = build (COMPONENT_REF, TREE_TYPE (gnu_expr),
                      build (PLACEHOLDER_EXPR, DECL_CONTEXT (gnu_expr)),
-                     gnu_expr);
+                     gnu_expr, NULL_TREE);
 
   /* If GNU_EXPR is neither a placeholder nor a constant, nor a variable
      that is a constant, make a variable that is initialized to contain the
index 0dec672125239feee4df82147f9900a72066f3fc..b6e9abcfcea1782855ffa0b0f7f07c016319631d 100644 (file)
@@ -109,6 +109,10 @@ static GTY(()) tree gnu_return_label_stack;
    TREE_VALUE of each entry is the label of the corresponding LOOP_STMT.  */
 static GTY(()) tree gnu_loop_label_stack;
 
+/* List of TREE_LIST nodes representing labels for switch statements.
+   TREE_VALUE of each entry is the label at the end of the switch.  */
+static GTY(()) tree gnu_switch_label_stack;
+
 /* List of TREE_LIST nodes containing pending elaborations lists.
    used to prevent the elaborations being reclaimed by GC.  */
 static GTY(()) tree gnu_pending_elaboration_lists;
@@ -746,18 +750,21 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Object_Renaming_Declaration:
       gnat_temp = Defining_Entity (gnat_node);
-      gnu_result = alloc_stmt_list ();
 
-      /* Don't do anything if this renaming is handled by the front end.
-        or if we are just annotating types and this object has a
-        composite or task type, don't elaborate it.  */
+      /* Don't do anything if this renaming is handled by the front end.  or if
+        we are just annotating types and this object has a composite or task
+        type, don't elaborate it.  We return the result in case it has any
+        SAVE_EXPRs in it that need to be evaluated here.  */
       if (! Is_Renaming_Of_Object (gnat_temp)
          && ! (type_annotate_only
                && (Is_Array_Type (Etype (gnat_temp))
                    || Is_Record_Type (Etype (gnat_temp))
                    || Is_Concurrent_Type (Etype (gnat_temp)))))
-       gnat_to_gnu_entity (gnat_temp,
-                           gnat_to_gnu (Renamed_Object (gnat_temp)), 1);
+       gnu_result
+         = gnat_to_gnu_entity (gnat_temp,
+                               gnat_to_gnu (Renamed_Object (gnat_temp)), 1);
+      else
+       gnu_result = alloc_stmt_list ();
       break;
 
     case N_Implicit_Label_Declaration:
@@ -2053,6 +2060,8 @@ gnat_to_gnu (Node_Id gnat_node)
        /* We build a SWITCH_EXPR that contains the code with interspersed
           CASE_LABEL_EXPRs for each label.  */
 
+       push_stack (&gnu_switch_label_stack, NULL_TREE,
+                   create_artificial_label ());
        start_stmt_group ();
        for (gnat_when = First_Non_Pragma (Alternatives (gnat_node));
             Present (gnat_when);
@@ -2121,10 +2130,17 @@ gnat_to_gnu (Node_Id gnat_node)
               we want them to be local to this set of statements instead of
               the block containing the Case statement.  */
            add_stmt (build_stmt_group (Statements (gnat_when), true));
+           add_stmt (build1 (GOTO_EXPR, void_type_node,
+                             TREE_VALUE (gnu_switch_label_stack)));
+
          }
        
+       /* Now emit a definition of the label all the cases branched to. */
+       add_stmt (build1 (LABEL_EXPR, void_type_node,
+                         TREE_VALUE (gnu_switch_label_stack)));
        gnu_result = build (SWITCH_EXPR, TREE_TYPE (gnu_expr), gnu_expr,
                            end_stmt_group (), NULL_TREE);
+       pop_stack (&gnu_switch_label_stack);
        break;
       }
 
@@ -4051,8 +4067,11 @@ add_decl_stmt (tree gnu_decl, Entity_Id gnat_entity)
 {
   /* If this is a variable that Gigi is to ignore, we may have been given
      an ERROR_MARK.  So test for it.  We also might have been given a
-     reference for a renaming.  So only do something for a decl.  */
-  if (!DECL_P (gnu_decl))
+     reference for a renaming.  So only do something for a decl.  Also
+     ignore a TYPE_DECL for an UNCONSTRAINED_ARRAY_TYPE.  */
+  if (!DECL_P (gnu_decl)
+      || (TREE_CODE (gnu_decl) == TYPE_DECL
+         && TREE_CODE (TREE_TYPE (gnu_decl)) == UNCONSTRAINED_ARRAY_TYPE))
     return;
 
   add_stmt_with_node (build (DECL_STMT, void_type_node, gnu_decl),
@@ -4254,7 +4273,7 @@ gnat_gimplify_stmt (tree *stmt_p)
       return GS_OK;
 
     case USE_STMT:
-      *stmt_p = build_empty_stmt ();
+      *stmt_p = alloc_stmt_list ();
       return GS_ALL_DONE;
 
     case DECL_STMT:
@@ -4262,31 +4281,33 @@ gnat_gimplify_stmt (tree *stmt_p)
        tree var = DECL_STMT_VAR (stmt);
 
        if (TREE_CODE (var) == TYPE_DECL)
-         *stmt_p = gnat_gimplify_type_sizes (TREE_TYPE (var));
-       else if (TREE_CODE (var) == VAR_DECL && !DECL_EXTERNAL (var)
-                && !TREE_CONSTANT (DECL_SIZE_UNIT (var)))
+         *stmt_p = gimplify_type_sizes (TREE_TYPE (var));
+       else if (TREE_CODE (var) == VAR_DECL)
          {
-           tree pt_type = build_pointer_type (TREE_TYPE (var));
-           tree size, pre = NULL_TREE, post = NULL_TREE;
-
-           /* This is a variable-sized decl.  Simplify its size and mark it
-              for deferred expansion.  Note that mudflap depends on the format
-              of the emitted code: see mx_register_decls.  */
            *stmt_p = NULL_TREE;
-           size = get_initialized_tmp_var (DECL_SIZE_UNIT (var), &pre, &post);
-           DECL_DEFER_OUTPUT (var) = 1;
-           append_to_statement_list (pre, stmt_p);
-           append_to_statement_list
-             (build_function_call_expr
-              (implicit_built_in_decls[BUILT_IN_STACK_ALLOC],
-               tree_cons (NULL_TREE,
-                          build1 (ADDR_EXPR, pt_type, var),
-                          tree_cons (NULL_TREE, size, NULL_TREE))),
-              stmt_p);
-           append_to_statement_list (post, stmt_p);
+           gimplify_one_sizepos (&DECL_SIZE (var), stmt_p);
+           gimplify_one_sizepos (&DECL_SIZE_UNIT (var), stmt_p);
+
+           if (!DECL_EXTERNAL (var) && !TREE_CONSTANT (DECL_SIZE_UNIT (var)))
+             {
+               DECL_DEFER_OUTPUT (var) = 1;
+               append_to_statement_list
+                 (build_function_call_expr
+                  (implicit_built_in_decls[BUILT_IN_STACK_ALLOC],
+                   tree_cons (NULL_TREE,
+                              build1 (ADDR_EXPR,
+                                      build_pointer_type (TREE_TYPE (var)),
+                                      var),
+                              tree_cons (NULL_TREE, DECL_SIZE_UNIT (var),
+                                         NULL_TREE))),
+                  stmt_p);
+             }
+
+           if (*stmt_p == NULL_TREE)
+             *stmt_p = alloc_stmt_list ();
          }
        else
-         *stmt_p = build_empty_stmt ();
+         *stmt_p = alloc_stmt_list ();
        return GS_ALL_DONE;
       }
 
@@ -4352,76 +4373,6 @@ gnat_gimplify_stmt (tree *stmt_p)
       abort ();
     }
 }
-
-/* Look through GNU_TYPE for variable-sized objects and gimplify each such
-   size that we find.  Return a STATEMENT_LIST containing the result.  */
-
-static tree
-gnat_gimplify_type_sizes (tree gnu_type)
-{
-  tree gnu_stmts = NULL_TREE;
-  tree gnu_field;
-
-  switch (TREE_CODE (gnu_type))
-    {
-    case ERROR_MARK:
-    case UNCONSTRAINED_ARRAY_TYPE:
-      return alloc_stmt_list ();
-
-    case INTEGER_TYPE:
-    case ENUMERAL_TYPE:
-    case BOOLEAN_TYPE:
-    case CHAR_TYPE:
-    case REAL_TYPE:
-      gnat_gimplify_one_sizepos (&TYPE_MIN_VALUE (gnu_type), &gnu_stmts);
-      gnat_gimplify_one_sizepos (&TYPE_MAX_VALUE (gnu_type), &gnu_stmts);
-      break;
-
-    case RECORD_TYPE:
-    case UNION_TYPE:
-    case QUAL_UNION_TYPE:
-      for (gnu_field = TYPE_FIELDS (gnu_type); gnu_field;
-          gnu_field = TREE_CHAIN (gnu_field))
-       if (TREE_CODE (gnu_field) == FIELD_DECL)
-         gnat_gimplify_one_sizepos (&DECL_FIELD_OFFSET (gnu_field),
-                                    &gnu_stmts);
-      break;
-
-    default:
-      break;
-    }
-
-  gnat_gimplify_one_sizepos (&TYPE_SIZE (gnu_type), &gnu_stmts);
-  gnat_gimplify_one_sizepos (&TYPE_SIZE_UNIT (gnu_type), &gnu_stmts);
-
-  if (!gnu_stmts)
-    gnu_stmts = alloc_stmt_list ();
-
-  return gnu_stmts;
-}
-
-/* Subroutine of the above to gimplify one size or position, *GNU_EXPR_P.
-   We add any required statements to GNU_STMT_P.  */
-
-static void
-gnat_gimplify_one_sizepos (tree *gnu_expr_p, tree *gnu_stmt_p)
-{
-  tree gnu_pre = NULL_TREE, gnu_post = NULL_TREE;
-
-  /* We don't do anything if the value isn't there, is constant, or
-     contains a PLACEHOLDER_EXPR.  */
-  if (*gnu_expr_p == NULL_TREE
-      || TREE_CONSTANT (*gnu_expr_p)
-      || CONTAINS_PLACEHOLDER_P (*gnu_expr_p))
-    return;
-
-  gimplify_expr (gnu_expr_p, &gnu_pre, &gnu_post, is_gimple_val, fb_rvalue);
-
-  if (gnu_pre)
-    append_to_statement_list (gnu_pre, gnu_stmt_p);
-  if (gnu_post)
-    append_to_statement_list (gnu_post, gnu_stmt_p);
-}
 \f
 /* Generate the RTL for the body of GNU_DECL.  If NESTED_P is nonzero,
    then we are already in the process of generating RTL for another
@@ -5472,7 +5423,7 @@ gnat_stabilize_reference (tree ref, int force)
       result = build (COMPONENT_REF, type,
                      gnat_stabilize_reference (TREE_OPERAND (ref, 0),
                                                force),
-                     TREE_OPERAND (ref, 1));
+                     TREE_OPERAND (ref, 1), NULL_TREE);
       break;
 
     case BIT_FIELD_REF:
@@ -5592,6 +5543,9 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list)
   rtx insn;
   int result = 1;
 
+  /* ??? For now, force nothing to do.  */
+  gnu_elab_list = 0;
+
   /* If we have nothing to do, return.  */
   if (gnu_elab_list == 0)
     return 1;
index 6906e98e2934d9950e3382a90b42ce38cc50f689..7619b4a0e572b6d816251f430b889ddf996344fb 100644 (file)
@@ -133,6 +133,7 @@ struct language_function GTY(())
   int unused;
 };
 
+static tree mark_visited (tree *, int *, void *);
 static void gnat_define_builtin (const char *, tree, int, const char *, bool);
 static void gnat_install_builtins (void);
 static tree merge_sizes (tree, tree, tree, int, int);
@@ -338,6 +339,21 @@ block_has_vars ()
   return BLOCK_VARS (current_binding_level->block) != 0;
 }
 \f
+/* Utility function to mark nodes with TREE_VISITED.  Called from walk_tree.
+   We use this to indicate all variable sizes and positions in global types
+   may not be shared by any subprogram.  */
+
+static tree
+mark_visited (tree *tp, int *walk_subtrees, void *data ATTRIBUTE_UNUSED)
+{
+  if (TREE_VISITED (*tp))
+    *walk_subtrees = 0;
+  else
+    TREE_VISITED (*tp) = 1;
+
+  return NULL_TREE;
+}
+\f
 /* Records a ..._DECL node DECL as belonging to the current lexical scope.
    Returns the ..._DECL node. */
 
@@ -345,9 +361,13 @@ tree
 pushdecl (tree decl)
 {
   /* If at top level, there is no context. But PARM_DECLs always go in the
-     level of its function. */
+     level of its function.  Also, at toplevel we must protect all trees
+     that are part of sizes and positions.  */
   if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL)
-    DECL_CONTEXT (decl) = 0;
+    {
+      DECL_CONTEXT (decl) = 0;
+      walk_tree (&decl, mark_visited, NULL, NULL);
+    }
   else
     DECL_CONTEXT (decl) = current_function_decl;
 
@@ -1261,11 +1281,8 @@ create_index_type (tree min, tree max, tree index)
    information about this type.  */
 
 tree
-create_type_decl (tree type_name,
-                  tree type,
-                  struct attrib *attr_list,
-                  int artificial_p,
-                  int debug_info_p)
+create_type_decl (tree type_name, tree type, struct attrib *attr_list,
+                 int artificial_p, int debug_info_p)
 {
   tree type_decl = build_decl (TYPE_DECL, type_name, type);
   enum tree_code code = TREE_CODE (type);
@@ -1929,7 +1946,7 @@ gnat_gimplify_function (tree fndecl)
      so that items like VLA sizes are expanded properly in the context of the
      correct function.  */
   cgn = cgraph_node (fndecl);
-  for (cgn = cgn->nested; cgn ; cgn = cgn->next_nested)
+  for (cgn = cgn->nested; cgn; cgn = cgn->next_nested)
     gnat_gimplify_function (cgn->decl);
 }
 
@@ -2615,6 +2632,7 @@ update_pointer_to (tree old_type, tree new_type)
 {
   tree ptr = TYPE_POINTER_TO (old_type);
   tree ref = TYPE_REFERENCE_TO (old_type);
+  tree ptr1, ref1;
   tree type;
 
   /* If this is the main variant, process all the other variants first.  */
@@ -2662,26 +2680,30 @@ update_pointer_to (tree old_type, tree new_type)
       TYPE_REFERENCE_TO (new_type) = ref;
 
       for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr))
-       {
-         TREE_TYPE (ptr) = new_type;
+       for (ptr1 = TYPE_MAIN_VARIANT (ptr); ptr1;
+            ptr1 = TYPE_NEXT_VARIANT (ptr1))
+         {
+           TREE_TYPE (ptr1) = new_type;
 
-         if (TYPE_NAME (ptr) != 0
-             && TREE_CODE (TYPE_NAME (ptr)) == TYPE_DECL
-             && TREE_CODE (new_type) != ENUMERAL_TYPE)
-           rest_of_decl_compilation (TYPE_NAME (ptr), NULL,
-                                     global_bindings_p (), 0);
-       }
+           if (TYPE_NAME (ptr1) != 0
+               && TREE_CODE (TYPE_NAME (ptr1)) == TYPE_DECL
+               && TREE_CODE (new_type) != ENUMERAL_TYPE)
+             rest_of_decl_compilation (TYPE_NAME (ptr1), NULL,
+                                       global_bindings_p (), 0);
+         }
 
       for (; ref; ref = TYPE_NEXT_PTR_TO (ref))
-       {
-         TREE_TYPE (ref) = new_type;
+       for (ref1 = TYPE_MAIN_VARIANT (ref); ref1;
+            ref1 = TYPE_NEXT_VARIANT (ref1))
+         {
+           TREE_TYPE (ref1) = new_type;
 
-         if (TYPE_NAME (ref) != 0
-             && TREE_CODE (TYPE_NAME (ref)) == TYPE_DECL
-             && TREE_CODE (new_type) != ENUMERAL_TYPE)
-           rest_of_decl_compilation (TYPE_NAME (ref), NULL,
-                                     global_bindings_p (), 0);
-       }
+           if (TYPE_NAME (ref1) != 0
+               && TREE_CODE (TYPE_NAME (ref1)) == TYPE_DECL
+               && TREE_CODE (new_type) != ENUMERAL_TYPE)
+             rest_of_decl_compilation (TYPE_NAME (ref1), NULL,
+                                       global_bindings_p (), 0);
+         }
     }
 
   /* Now deal with the unconstrained array case. In this case the "pointer"
@@ -2711,7 +2733,7 @@ update_pointer_to (tree old_type, tree new_type)
       ptr_temp_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (ptr)));
       new_ref = build (COMPONENT_REF, ptr_temp_type,
                       build (PLACEHOLDER_EXPR, ptr),
-                      TREE_CHAIN (TYPE_FIELDS (ptr)));
+                      TREE_CHAIN (TYPE_FIELDS (ptr)), NULL_TREE);
 
       update_pointer_to
        (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (ptr))),
@@ -2854,11 +2876,6 @@ convert (tree type, tree expr)
   /* If EXPR is already the right type, we are done.  */
   if (type == etype)
     return expr;
-  /* If we're converting between two aggregate types that have the same main
-     variant, just make a VIEW_CONVER_EXPR.  */
-  else if (AGGREGATE_TYPE_P (type)
-          && TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
-    return build1 (VIEW_CONVERT_EXPR, type, expr);
 
   /* If the input type has padding, remove it by doing a component reference
      to the field.  If the output type has padding, make a constructor
@@ -2995,7 +3012,7 @@ convert (tree type, tree expr)
          && operand_equal_p (TYPE_SIZE (type), TYPE_SIZE (etype), 0)
          && get_alias_set (type) == get_alias_set (etype))
        return build (COMPONENT_REF, type, TREE_OPERAND (expr, 0),
-                     TREE_OPERAND (expr, 1));
+                     TREE_OPERAND (expr, 1), NULL_TREE);
 
       break;
 
@@ -3043,9 +3060,16 @@ convert (tree type, tree expr)
   if (TYPE_FAT_POINTER_P (type) && ! TYPE_FAT_POINTER_P (etype))
     return convert_to_fat_pointer (type, expr);
 
-  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)
-      || (code == INTEGER_CST && ecode == INTEGER_CST
-         && (type == TREE_TYPE (etype) || etype == TREE_TYPE (type))))
+  /* If we're converting between two aggregate types that have the same main
+     variant, just make a VIEW_CONVER_EXPR.  */
+  else if (AGGREGATE_TYPE_P (type)
+          && TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
+    return build1 (VIEW_CONVERT_EXPR, type, expr);
+
+  /* In all other cases of related types, make a NOP_EXPR.  */
+  else if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)
+          || (code == INTEGER_CST && ecode == INTEGER_CST
+              && (type == TREE_TYPE (etype) || etype == TREE_TYPE (type))))
     return fold (build1 (NOP_EXPR, type, expr));
 
   switch (code)
index 0d83f74e9b6344afafef441b7016d2a267eb0e2a..f1c167f46f39a51ba4fc1c5d13a7f6fb688f8ba1 100644 (file)
@@ -1535,10 +1535,8 @@ gnat_build_constructor (tree type, tree list)
    actual record and know how to look for fields in variant parts.  */
 
 static tree
-build_simple_component_ref (tree record_variable,
-                            tree component,
-                            tree field,
-                            int no_fold_p)
+build_simple_component_ref (tree record_variable, tree component,
+                            tree field, int no_fold_p)
 {
   tree record_type = TYPE_MAIN_VARIANT (TREE_TYPE (record_variable));
   tree ref;
@@ -1610,7 +1608,8 @@ build_simple_component_ref (tree record_variable,
 
   /* 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 = build (COMPONENT_REF, TREE_TYPE (field), record_variable, field);
+  ref = build (COMPONENT_REF, TREE_TYPE (field), record_variable, field,
+              NULL_TREE);
 
   if (TREE_READONLY (record_variable) || TREE_READONLY (field))
     TREE_READONLY (ref) = 1;
@@ -1625,10 +1624,8 @@ build_simple_component_ref (tree record_variable,
    reference could not be found.  */
 
 tree
-build_component_ref (tree record_variable,
-                     tree component,
-                     tree field,
-                     int no_fold_p)
+build_component_ref (tree record_variable, tree component,
+                     tree field, int no_fold_p)
 {
   tree ref = build_simple_component_ref (record_variable, component, field,
                                         no_fold_p);
@@ -1930,7 +1927,7 @@ build_allocator (tree type,
       result
        = build (COMPOUND_EXPR, TREE_TYPE (result),
                 build_binary_op
-                (MODIFY_EXPR, TREE_TYPE (TREE_TYPE (result)),
+                (MODIFY_EXPR, NULL_TREE,
                  build_unary_op (INDIRECT_REF, TREE_TYPE (TREE_TYPE (result)),
                                  result),
                  init),
@@ -1993,19 +1990,8 @@ gnat_mark_addressable (tree expr_node)
       case VAR_DECL:
       case PARM_DECL:
       case RESULT_DECL:
-       /* If we have already made a REG for this decl, we must put it
-          directly into the stack.  Likewise for a MEM whose address is a
-          pseudo.  Otherwise, set a flag to mark us to do it later.  */
-       if (DECL_RTL_SET_P (expr_node)
-           && (GET_CODE (DECL_RTL (expr_node)) == REG
-               || (GET_CODE (DECL_RTL (expr_node)) == MEM
-                   && GET_CODE (XEXP (DECL_RTL (expr_node), 0)) == REG
-                   && (REGNO (XEXP (DECL_RTL (expr_node), 0))
-                       > LAST_VIRTUAL_REGISTER))))
-         put_var_into_stack (expr_node, 1);
-       else
-         TREE_ADDRESSABLE (expr_node) = 1;
-
+       put_var_into_stack (expr_node, 1);
+       TREE_ADDRESSABLE (expr_node) = 1;
        return true;
 
       case FUNCTION_DECL: