ada-tree.def (LOOP_STMT, EXIT_STMT): Update documentation.
authorRichard Kenner <kenner@vlsi1.ultra.nyu.edu>
Mon, 14 Jun 2004 14:09:38 +0000 (14:09 +0000)
committerRichard Kenner <kenner@gcc.gnu.org>
Mon, 14 Jun 2004 14:09:38 +0000 (10:09 -0400)
* ada-tree.def (LOOP_STMT, EXIT_STMT): Update documentation.
* ada-tree.h (EXIT_STMT_LABEL): Renamed from EXIT_STMT_LOOP.
* decl.c (gnat_to_gnu_entity): Also set force_global for imported
subprograms.
* trans.c (gnu_loop_label_stack): Renamed from gnu_loop_stmt_stack;
all callers changed.
(gnat_to_gnu, case N_Loop_Statement, case N_Exit_Statement): Change
the way that EXIT_STMT finds the loop label.
(gnat_gimplify_stmt, case LOOP_STMT, EXIT_STMT): Likewise.
(gnat_gimplify_stmt, case DECL_STMT): Handle variable-sized decls here.
(add_stmt): Use annotate_with_locus insted of setting directly.
(pos_to_construct): Set TREE_PURPOSE of each entry to index.
(gnat_stabilize_reference, case ARRAY_RANGE_REF): Merge with ARRAY_REF.
* utils.c (gnat_install_builtins): Install __builtin_memcmp.
(build_vms_descriptor): Add extra args to ARRAY_REF.
(convert): Use VIEW_CONVERT_EXPR between aggregate types.
* utils2.c (gnat_truthvalue_conversion, case INTEGER_CST, REAL_CST):
New cases.
(build_binary_op): Don't make explicit CONVERT_EXPR.
Add extra rgs to ARRAY_REF.

From-SVN: r83103

gcc/ada/ChangeLog
gcc/ada/ada-tree.def
gcc/ada/ada-tree.h
gcc/ada/decl.c
gcc/ada/trans.c
gcc/ada/utils.c
gcc/ada/utils2.c

index 8cb9164d8480d9e4801eb1f35ff08ac904de8b83..f0551826626a692b93fa6747557da46a38614a16 100644 (file)
@@ -1,3 +1,26 @@
+2004-06-14  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+       * ada-tree.def (LOOP_STMT, EXIT_STMT): Update documentation.
+       * ada-tree.h (EXIT_STMT_LABEL): Renamed from EXIT_STMT_LOOP.
+       * decl.c (gnat_to_gnu_entity): Also set force_global for imported
+       subprograms.
+       * trans.c (gnu_loop_label_stack): Renamed from gnu_loop_stmt_stack;
+       all callers changed.
+       (gnat_to_gnu, case N_Loop_Statement, case N_Exit_Statement): Change
+       the way that EXIT_STMT finds the loop label.
+       (gnat_gimplify_stmt, case LOOP_STMT, EXIT_STMT): Likewise.
+       (gnat_gimplify_stmt, case DECL_STMT): Handle variable-sized decls here.
+       (add_stmt): Use annotate_with_locus insted of setting directly.
+       (pos_to_construct): Set TREE_PURPOSE of each entry to index.
+       (gnat_stabilize_reference, case ARRAY_RANGE_REF): Merge with ARRAY_REF.
+       * utils.c (gnat_install_builtins): Install __builtin_memcmp.
+       (build_vms_descriptor): Add extra args to ARRAY_REF.
+       (convert): Use VIEW_CONVERT_EXPR between aggregate types.
+       * utils2.c (gnat_truthvalue_conversion, case INTEGER_CST, REAL_CST):
+       New cases.
+       (build_binary_op): Don't make explicit CONVERT_EXPR.
+       Add extra rgs to ARRAY_REF.
+
 2004-06-14  Pascal Obry  <obry@gnat.com>
 
        * gnat_ugn.texi: Document relocatable vs. dynamic Library_Kind on
index 5922d54ef511f49d9da9642aaef7b973c87ab24c..b185106f62e819293f302a9adfb4d3058a33e593 100644 (file)
@@ -61,13 +61,13 @@ DEFTREECODE (STMT_STMT, "stmt_stmt", 's', 1)
 /* A loop.  LOOP_STMT_TOP_COND and LOOP_STMT_BOT_COND are the tests to exit a
    loop at the top and bottom, respectively.  LOOP_STMT_UPDATE is the statement
    to update the loop iterator at the continue point.  LOOP_STMT_BODY are the
-   statements in the body of the loop.  LOOP_STMT_LABEL is used during
-   gimplification to point to the LABEL_DECL of the end label of the loop.  */
+   statements in the body of the loop.  LOOP_STMT_LABEL points to the LABEL_DECL
+   of the end label of the loop.  */
 DEFTREECODE (LOOP_STMT, "loop_stmt", 's', 5)
 
 /* Conditionally exit a loop.  EXIT_STMT_COND is the condition, which, if
    true, will cause the loop to be exited.  If no condition is specified,
-   the loop is unconditionally exited.  EXIT_STMT_LOOP is the LOOP_STMT
+   the loop is unconditionally exited.  EXIT_STMT_LABEL is the end label
    corresponding to the loop to exit.  */
 DEFTREECODE (EXIT_STMT, "exit_stmt", 's', 2)
 
@@ -85,4 +85,3 @@ DEFTREECODE (HANDLER_STMT, "handler_stmt", 's', 3)
 
 /* A statement that emits a USE for its single operand.  */
 DEFTREECODE (USE_STMT, "use_expr", 's', 1)
-
index a43cd48ecf270ade2a698d17f1af34f876768b23..9cdcc5d5584eecf2d11cd5f775aa4201c41b2104 100644 (file)
@@ -272,7 +272,7 @@ struct lang_type GTY(()) {union lang_tree_node t; };
 #define LOOP_STMT_BODY(NODE)   TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 3)
 #define LOOP_STMT_LABEL(NODE)  TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 4)
 #define EXIT_STMT_COND(NODE)   TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 0)
-#define EXIT_STMT_LOOP(NODE)   TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 1)
+#define EXIT_STMT_LABEL(NODE)  TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 1)
 #define REGION_STMT_BODY(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 0)
 #define REGION_STMT_HANDLE(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 1)
 #define REGION_STMT_BLOCK(NODE)        TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 2)
index 41d405a47d4d103d1b6721c0ed4893fcdfd25368..3f5d80939fb1cd16473a30065c425209d0567ad4 100644 (file)
@@ -299,12 +299,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
   /* For cases when we are not defining (i.e., we are referencing from
      another compilation unit) Public entities, show we are at global level
-     for the purpose of computing sizes.  Don't do this for components or
+     for the purpose of computing scopes.  Don't do this for components or
      discriminants since the relevant test is whether or not the record is
-     being defined.  */
-  if (! definition && Is_Public (gnat_entity)
-      && ! Is_Statically_Allocated (gnat_entity)
-      && kind != E_Discriminant && kind != E_Component)
+     being defined.  But do this for Imported functions or procedures in
+     all cases.  */
+  if ((! definition && Is_Public (gnat_entity)
+       && ! Is_Statically_Allocated (gnat_entity)
+       && kind != E_Discriminant && kind != E_Component)
+      || (Is_Imported (gnat_entity)
+         && (kind == E_Function || kind == E_Procedure)))
     force_global++, this_global = 1;
 
   /* Handle any attributes.  */
index e7a5f9fc89a36bbdf06d53dacd6126582f302f90..0dec672125239feee4df82147f9900a72066f3fc 100644 (file)
@@ -106,8 +106,8 @@ static GTY(()) tree gnu_except_ptr_stack;
 static GTY(()) tree gnu_return_label_stack;
 
 /* List of TREE_LIST nodes representing a stack of LOOP_STMT nodes.
-   TREE_VALUE of each entry is the corresponding LOOP_STMT.  */
-static GTY(()) tree gnu_loop_stmt_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 containing pending elaborations lists.
    used to prevent the elaborations being reclaimed by GC.  */
@@ -2139,11 +2139,13 @@ gnat_to_gnu (Node_Id gnat_node)
 
        TREE_TYPE (gnu_loop_stmt) = void_type_node;
        TREE_SIDE_EFFECTS (gnu_loop_stmt) = 1;
+       LOOP_STMT_LABEL (gnu_loop_stmt) = create_artificial_label ();
        annotate_with_node (gnu_loop_stmt, gnat_node);
 
-       /* Save this LOOP_STMT in a stack so that the corresponding
-          N_Exit_Statement can find it.  */
-       push_stack (&gnu_loop_stmt_stack, NULL_TREE, gnu_loop_stmt);
+       /* Save the end label of this LOOP_STMT in a stack so that the
+          corresponding N_Exit_Statement can find it.  */
+       push_stack (&gnu_loop_label_stack, NULL_TREE,
+                   LOOP_STMT_LABEL (gnu_loop_stmt));
 
        /* Set the condition that under which the loop should continue.
           For "LOOP .... END LOOP;" the condition is always true.  */
@@ -2227,10 +2229,12 @@ gnat_to_gnu (Node_Id gnat_node)
                                gnat_iter_scheme);
          }
 
-       /* If the loop was named, have the name point to this loop.  In this
-          case, the association is not a ..._DECL node, but this LOOP_STMT. */
+       /* If the loop was named, have the name point to this loop.  In this case,
+          the association is not a ..._DECL node, but the end label from this
+          LOOP_STMT. */
         if (Present (Identifier (gnat_node)))
-         save_gnu_tree (Entity (Identifier (gnat_node)), gnu_loop_stmt, 1);
+         save_gnu_tree (Entity (Identifier (gnat_node)),
+                        LOOP_STMT_LABEL (gnu_loop_stmt), 1);
 
         /* Make the loop body into its own block, so any allocated storage
            will be released every iteration.  This is needed for stack
@@ -2258,7 +2262,7 @@ gnat_to_gnu (Node_Id gnat_node)
        else
          gnu_result = gnu_loop_stmt;
 
-       pop_stack (&gnu_loop_stmt_stack);
+       pop_stack (&gnu_loop_label_stack);
       }
       break;
 
@@ -2281,7 +2285,7 @@ gnat_to_gnu (Node_Id gnat_node)
                  ? gnat_to_gnu (Condition (gnat_node)) : NULL_TREE),
                 (Present (Name (gnat_node))
                  ? get_gnu_tree (Entity (Name (gnat_node)))
-                 : TREE_VALUE (gnu_loop_stmt_stack)));
+                 : TREE_VALUE (gnu_loop_label_stack)));
       break;
 
     case N_Return_Statement:
@@ -4025,7 +4029,7 @@ add_stmt (tree gnu_stmt)
                           gnu_lhs, DECL_INITIAL (gnu_decl));
       DECL_INITIAL (gnu_decl) = 0;
 
-      SET_EXPR_LOCUS (gnu_assign_stmt, &DECL_SOURCE_LOCATION (gnu_decl));
+      annotate_with_locus (gnu_assign_stmt, DECL_SOURCE_LOCATION (gnu_decl));
       add_stmt (gnu_assign_stmt);
     }
 }
@@ -4254,20 +4258,44 @@ gnat_gimplify_stmt (tree *stmt_p)
       return GS_ALL_DONE;
 
     case DECL_STMT:
-      if (TREE_CODE (DECL_STMT_VAR (stmt)) == TYPE_DECL)
-       *stmt_p = gnat_gimplify_type_sizes (TREE_TYPE (DECL_STMT_VAR (stmt)));
-      else
-       *stmt_p = build_empty_stmt ();
-      return GS_ALL_DONE;
+      {
+       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)))
+         {
+           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);
+         }
+       else
+         *stmt_p = build_empty_stmt ();
+       return GS_ALL_DONE;
+      }
 
     case LOOP_STMT:
       {
        tree gnu_start_label = create_artificial_label ();
-       tree gnu_end_label = create_artificial_label ();
+       tree gnu_end_label = LOOP_STMT_LABEL (stmt);
 
-       /* Save the end label for EXIT_STMT and set to emit the statements
-          of the loop.  */
-       LOOP_STMT_LABEL (stmt) = gnu_end_label;
+       /* Set to emit the statements of the loop.  */
        *stmt_p = NULL_TREE;
 
        /* We first emit the start label and then a conditional jump to
@@ -4314,8 +4342,7 @@ gnat_gimplify_stmt (tree *stmt_p)
     case EXIT_STMT:
       /* Build a statement to jump to the corresponding end label, then
         see if it needs to be conditional.  */
-      *stmt_p = build1 (GOTO_EXPR, void_type_node,
-                       LOOP_STMT_LABEL (EXIT_STMT_LOOP (stmt)));
+      *stmt_p = build1 (GOTO_EXPR, void_type_node, EXIT_STMT_LABEL (stmt));
       if (EXIT_STMT_COND (stmt))
        *stmt_p = build (COND_EXPR, void_type_node,
                         EXIT_STMT_COND (stmt), *stmt_p, alloc_stmt_list ());
@@ -5255,12 +5282,12 @@ assoc_to_constructor (Node_Id gnat_assoc, tree gnu_type)
    of the array component. It is needed for range checking. */
 
 static tree
-pos_to_constructor (Node_Id gnat_expr,
-                    tree gnu_array_type,
+pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
                     Entity_Id gnat_component_type)
 {
-  tree gnu_expr;
   tree gnu_expr_list = NULL_TREE;
+  tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type));
+  tree gnu_expr;
 
   for ( ; Present (gnat_expr); gnat_expr = Next (gnat_expr))
     {
@@ -5285,8 +5312,12 @@ pos_to_constructor (Node_Id gnat_expr,
        }
 
       gnu_expr_list
-       = tree_cons (NULL_TREE, convert (TREE_TYPE (gnu_array_type), gnu_expr),
+       = tree_cons (gnu_index, convert (TREE_TYPE (gnu_array_type), gnu_expr),
                     gnu_expr_list);
+
+      gnu_index = fold (build2 (PLUS_EXPR, TREE_TYPE (gnu_index), gnu_index,
+                               convert (TREE_TYPE (gnu_index),
+                                        integer_one_node)));
     }
 
   return gnat_build_constructor (gnu_array_type, nreverse (gnu_expr_list));
@@ -5454,17 +5485,12 @@ gnat_stabilize_reference (tree ref, int force)
       break;
 
     case ARRAY_REF:
-      result = build (ARRAY_REF, type,
-                     gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
-                     gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
-                                                 force));
-      break;
-
     case ARRAY_RANGE_REF:
-      result = build (ARRAY_RANGE_REF, type,
+      result = build (code, type,
                      gnat_stabilize_reference (TREE_OPERAND (ref, 0), force),
                      gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
-                                                 force));
+                                                 force),
+                     NULL_TREE, NULL_TREE);
       break;
 
     case COMPOUND_EXPR:
index 1b50b71313e94fa5a5256ea64b8356b87c436f2f..6906e98e2934d9950e3382a90b42ce38cc50f689 100644 (file)
@@ -467,6 +467,13 @@ gnat_install_builtins ()
   gnat_define_builtin ("__builtin_memcpy", ftype, BUILT_IN_MEMCPY,
                       "memcpy", false);
 
+  tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
+  tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+  tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+  ftype = build_function_type (integer_type_node, tmp);
+  gnat_define_builtin ("__builtin_memcmp", ftype, BUILT_IN_MEMCMP,
+                      "memcmp", false);
+
   tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
   ftype = build_function_type (integer_type_node, tmp);
   gnat_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ, "clz", true);
@@ -2489,7 +2496,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
       for (i = 0, inner_type = type; i < ndim;
           i++, inner_type = TREE_TYPE (inner_type))
        tem = build (ARRAY_REF, TREE_TYPE (inner_type), tem,
-                    convert (TYPE_DOMAIN (inner_type), size_zero_node));
+                    convert (TYPE_DOMAIN (inner_type), size_zero_node),
+                    NULL_TREE, NULL_TREE);
 
       field_list
        = chainon (field_list,
@@ -2847,10 +2855,10 @@ convert (tree type, tree expr)
   if (type == etype)
     return expr;
   /* If we're converting between two aggregate types that have the same main
-     variant, just make a NOP_EXPR.  */
+     variant, just make a VIEW_CONVER_EXPR.  */
   else if (AGGREGATE_TYPE_P (type)
           && TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
-    return build1 (NOP_EXPR, type, expr);
+    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
index ed9953103c0b225d12046a0a08c68c90569d5376..0d83f74e9b6344afafef441b7016d2a267eb0e2a 100644 (file)
@@ -84,6 +84,14 @@ gnat_truthvalue_conversion (tree expr)
     case ERROR_MARK:
       return expr;
 
+    case INTEGER_CST:
+      return (integer_zerop (expr) ? convert (type, integer_zero_node)
+             : convert (type, integer_one_node));
+
+    case REAL_CST:
+      return (real_zerop (expr) ? convert (type, integer_zero_node)
+             : convert (type, integer_one_node));
+
     case COND_EXPR:
       /* Distribute the conversion into the arms of a COND_EXPR.  */
       return fold
@@ -578,10 +586,8 @@ nonbinary_modular_operation (enum tree_code op_code,
    have to do here is validate the work done by SEM and handle subtypes.  */
 
 tree
-build_binary_op (enum tree_code op_code,
-                 tree result_type,
-                 tree left_operand,
-                 tree right_operand)
+build_binary_op (enum tree_code op_code, tree result_type,
+                 tree left_operand, tree right_operand)
 {
   tree left_type  = TREE_TYPE (left_operand);
   tree right_type = TREE_TYPE (right_operand);
@@ -739,17 +745,7 @@ build_binary_op (enum tree_code op_code,
       if (operation_type != right_type
          && (! CONTAINS_PLACEHOLDER_P (TYPE_SIZE (operation_type))))
        {
-         /* For a variable-size type, with both BLKmode, convert using
-            CONVERT_EXPR instead of an unchecked conversion since we don't
-            need to make a temporary (and can't anyway).  */
-         if (TREE_CODE (TYPE_SIZE (operation_type)) != INTEGER_CST
-             && TYPE_MODE (TREE_TYPE (right_operand)) == BLKmode
-             && TREE_CODE (right_operand) != UNCONSTRAINED_ARRAY_REF)
-           right_operand = build1 (CONVERT_EXPR, operation_type,
-                                   right_operand);
-         else
-           right_operand = convert (operation_type, right_operand);
-
+         right_operand = convert (operation_type, right_operand);
          right_type = operation_type;
        }
 
@@ -894,7 +890,8 @@ build_binary_op (enum tree_code op_code,
         just compare the data pointer.  */
       else if (TYPE_FAT_POINTER_P (left_base_type)
               && TREE_CODE (right_operand) == CONSTRUCTOR
-              && integer_zerop (TREE_VALUE (CONSTRUCTOR_ELTS (right_operand))))
+              && integer_zerop (TREE_VALUE
+                                (CONSTRUCTOR_ELTS (right_operand))))
        {
          right_operand = build_component_ref (left_operand, NULL_TREE,
                                               TYPE_FIELDS (left_base_type),
@@ -1008,9 +1005,12 @@ build_binary_op (enum tree_code op_code,
     return build1 (NULL_EXPR, operation_type, TREE_OPERAND (left_operand, 0));
   else if (TREE_CODE (right_operand) == NULL_EXPR)
     return build1 (NULL_EXPR, operation_type, TREE_OPERAND (right_operand, 0));
+  else if (op_code == ARRAY_REF || op_code == ARRAY_RANGE_REF)
+    result = fold (build (op_code, operation_type, left_operand, right_operand,
+                         NULL_TREE, NULL_TREE));
   else
-    result = fold (build (op_code, operation_type,
-                         left_operand, right_operand));
+    result
+      = fold (build (op_code, operation_type, left_operand, right_operand));
 
   TREE_SIDE_EFFECTS (result) |= has_side_effects;
   TREE_CONSTANT (result)