ada-tree.def (LOOP_STMT, EXIT_STMT): Update documentation.

	* 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

+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

gcc/ada/ada-tree.def

@@ -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)
-

gcc/ada/ada-tree.h

@@ -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)

gcc/ada/decl.c

@@ -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.  */

gcc/ada/trans.c

@@ -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:

gcc/ada/utils.c

@@ -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

gcc/ada/utils2.c

@@ -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)