[multiple changes]

2004-04-08  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* trans.c (tree_transform): Shortcut returning error_mark_node for
	statements in annotate_only_mode.
	(tree_transform, case N_Label, case N_Return_Statement,
	N_Goto_Statement): Make statement tree instead of generating code.
	(tree_transform, case N_Assignment_Statement): No longer check
	type_annotate_only.
	(gnat_expand_stmt, case GOTO_STMT, case LABEL_STMT, case
	RETURN_STMT): New.
	(first_nondeleted_insn, build_block_stmt, make_expr_stmt_from_rtl):
	New fcns.
	(gnat_to_gnu): Collect any RTL generated and deal with it.
	(tree_transform, case N_And_Then): Refine when have non-null RTL_EXPR.
	(tree_transform case N_If_Statement): Rewrite to make IF_STMT.
	(gnat_expand_stmt, case BLOCK_STMT, IF_STMT): New cases.

	* ada-tree.def (GOTO_STMT, LABEL_STMT, RETURN_STMT): New tree nodes.

	* ada-tree.def (EXPR_STMT): Fix typo in name.
	(BLOCK_STMT, IF_STMT): New nodes.

	* ada-tree.h (GOTO_STMT_LABEL, LABEL_STMT_LABEL,
	LABEL_STMT_FIRST_IN_EH): New macros.
	(RETURN_STMT_EXPR): Likewise.

	* ada-tree.h: (BLOCK_STMT_LIST, IF_STMT_COND, IF_STMT_TRUE,
	IF_STMT_ELSEIF, IF_STMT_ELSE): New macros.

2004-04-08  Thomas Quinot  <quinot@act-europe.fr>

	* atree.ads: Correct documentation on extended nodes.

	* link.c: Set run_path_option for FreeBSD.

2004-04-08  Vincent Celier  <celier@gnat.com>

	* mlib-prj.adb (Build_Library.Check_Libs): On OpenVMS, if dec.ali is
	one of the ALI file, do not link with DEC lib.

	* par.adb Remove the last two characters ("%s" or "%b") when checking
	if a language defined unit may be recompiled.

2004-04-08  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch4.adb (Remove_Abstract_Operations): Improve error message when
	removal of abstract operation leaves no possible interpretation for
	expression.

	* sem_eval.adb (Eval_Qualified_Expression): Use
	Set_Raises_Constraint_Error on node when needed, so that it does not
	get optimized away by subsequent optimizations.

	* sem_res.adb (Resolve_Intrinsic_Operator): Save interpretations of
	operands even when they are not wrapped in a type conversion.

2004-04-08  Olivier Hainque  <hainque@act-europe.fr>

	* sem_prag.adb (Set_Exported): Warn about making static as result of
	export only when the export is coming from source. This may be not
	be true e.g. on VMS where we expand export pragmas for exception codes
	together with imported or exported exceptions, and we don't want the
	user to be warned about something he didn't write.

2004-04-08  Thomas Quinot  <quinot@act-europe.fr>

	* sem_util.adb (Note_Possible_Modification): Reorganize to remove code
	duplication between normal entities and those declared as renamings.
	No functional change.

	* s-fileio.ads (Form): Remove pragma Inline, as we cannot currently
	inline functions returning an unconstrained result.

2004-04-08  Eric Botcazou  <ebotcazou@act-europe.fr>

	* utils.c (type_for_mode): Handle BLKmode and VOIDmode properly, to
	conform to what other front-ends do.

2004-04-08  Doug Rupp  <rupp@gnat.com>

	* 5vml-tgt.adb: Use Gas instead of VMS Macro to build auto init shared
	libraries.

From-SVN: r80504

1 files changed, 199 insertions, 87 deletions

diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index efa99fe..8b24761 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -104,6 +104,9 @@ Node_Id error_gnat_node;
 static GTY(()) tree gnu_return_label_stack;
 
 static tree tree_transform (Node_Id);
+static rtx first_nondeleted_insn (rtx);
+static tree build_block_stmt (List_Id);
+static tree make_expr_stmt_from_rtl (rtx, Node_Id);
 static void elaborate_all_entities (Node_Id);
 static void process_freeze_entity (Node_Id);
 static void process_inlined_subprograms (Node_Id);
@@ -255,15 +258,60 @@ tree
 gnat_to_gnu (Node_Id gnat_node)
 {
   tree gnu_root;
+  bool made_sequence = false;
+    
+  /* We support the use of this on statements now as a transition
+     to full function-at-a-time processing.  So we need to see if anything
+     we do generates RTL and returns error_mark_node.  */
+  if (!global_bindings_p ())
+    {
+      start_sequence ();
+      emit_note (NOTE_INSN_DELETED);
+      made_sequence = true;
+    }
 
   /* Save node number in case error */
   error_gnat_node = gnat_node;
 
   gnu_root = tree_transform (gnat_node);
 
-  /* If we got no code as a result, something is wrong.  */
-  if (gnu_root == error_mark_node && ! type_annotate_only)
-    gigi_abort (303);
+  if (gnu_root == error_mark_node)
+    {
+      if (!made_sequence)
+	{
+	  if (type_annotate_only)
+	    return gnu_root;
+	  else
+	    gigi_abort (303);
+	}
+
+      gnu_root = make_expr_stmt_from_rtl (first_nondeleted_insn (get_insns ()),
+					  gnat_node);
+      end_sequence ();
+    }
+  else if (made_sequence)
+    {
+      rtx insns = first_nondeleted_insn (get_insns ());
+
+      end_sequence ();
+
+      if (insns)
+	{
+	  /* If we have a statement, we need to first evaluate any RTL we
+	     made in the process of building it and then the statement.  */
+	  if (IS_STMT (gnu_root))
+	    {
+	      tree gnu_expr_stmt = make_expr_stmt_from_rtl (insns, gnat_node);
+
+	      TREE_CHAIN (gnu_expr_stmt) = gnu_root;
+	      gnu_root = build_nt (BLOCK_STMT, gnu_expr_stmt);
+	      TREE_TYPE (gnu_root) = void_type_node;
+	      TREE_SLOC (gnu_root) = Sloc (gnat_node);
+	    }
+	  else
+	    emit_insn (insns);
+	}
+    }
 
   return gnu_root;
 }
@@ -290,6 +338,10 @@ tree_transform (Node_Id gnat_node)
   /* Set input_file_name and lineno from the Sloc in the GNAT tree. */
   set_lineno (gnat_node, 0);
 
+  if (IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call)
+      && type_annotate_only)
+    return error_mark_node;
+
   /* If this is a Statement and we are at top level, we add the statement
      as an elaboration for a null tree.  That will cause it to be placed
      in the elaboration procedure.  */
@@ -1795,7 +1847,7 @@ tree_transform (Node_Id gnat_node)
 
 	gnu_result_type = get_unpadded_type (Etype (gnat_node));
 
-	if (RTL_EXPR_SEQUENCE (gnu_rhs_side) != 0)
+	if (first_nondeleted_insn (RTL_EXPR_SEQUENCE (gnu_rhs_side)))
 	  gnu_rhs = build (COMPOUND_EXPR, gnu_result_type, gnu_rhs_side,
 			   gnu_rhs);
 
@@ -2020,31 +2072,17 @@ tree_transform (Node_Id gnat_node)
     /***************************/
 
     case N_Label:
-      if (! type_annotate_only)
-	{
-	  tree gnu_label = gnat_to_gnu (Identifier (gnat_node));
-	  Node_Id gnat_parent = Parent (gnat_node);
-
-	  expand_label (gnu_label);
-
-	  /* If this is the first label of an exception handler, we must
-	     mark that any CALL_INSN can jump to it.  */
-	  if (Present (gnat_parent)
-	      && Nkind (gnat_parent) == N_Exception_Handler
-	      && First (Statements (gnat_parent)) == gnat_node)
-	    nonlocal_goto_handler_labels
-	      = gen_rtx_EXPR_LIST (VOIDmode, label_rtx (gnu_label),
-				   nonlocal_goto_handler_labels);
-	}
+      gnu_result = build_nt (LABEL_STMT, gnat_to_gnu (Identifier (gnat_node)));
+      LABEL_STMT_FIRST_IN_EH (gnu_result)
+	=  (Present (Parent (gnat_node))
+	    && Nkind (Parent (gnat_node)) == N_Exception_Handler
+	    && First (Statements (Parent (gnat_node))) == gnat_node);
       break;
 
     case N_Null_Statement:
       break;
 
     case N_Assignment_Statement:
-      if (type_annotate_only)
-	break;
-
       /* Get the LHS and RHS of the statement and convert any reference to an
 	 unconstrained array into a reference to the underlying array.  */
       gnu_lhs = maybe_unconstrained_array (gnat_to_gnu (Name (gnat_node)));
@@ -2071,53 +2109,28 @@ tree_transform (Node_Id gnat_node)
       break;
 
     case N_If_Statement:
-      /* Start an IF statement giving the condition.  */
-      gnu_expr = gnat_to_gnu (Condition (gnat_node));
-      set_lineno (gnat_node, 1);
-      expand_start_cond (gnu_expr, 0);
-
-      /* Generate code for the statements to be executed if the condition
-	 is true.  */
+      gnu_result = NULL_TREE;
 
-      for (gnat_temp = First (Then_Statements (gnat_node));
-	   Present (gnat_temp);
-	   gnat_temp = Next (gnat_temp))
-	gnat_to_code (gnat_temp);
-
-      /* Generate each of the "else if" parts.  */
+      /* Make an IF_STMT for each of the "else if" parts.  */
       if (Present (Elsif_Parts (gnat_node)))
-	{
-	  for (gnat_temp = First (Elsif_Parts (gnat_node));
-	       Present (gnat_temp);
-	       gnat_temp = Next (gnat_temp))
-	    {
-	      Node_Id gnat_statement;
-
-	      expand_start_else ();
-
-	      /* Set up the line numbers for each condition we test.  */
-	      set_lineno (Condition (gnat_temp), 1);
-	      expand_elseif (gnat_to_gnu (Condition (gnat_temp)));
-
-	      for (gnat_statement = First (Then_Statements (gnat_temp));
-		   Present (gnat_statement);
-		   gnat_statement = Next (gnat_statement))
-		gnat_to_code (gnat_statement);
-	    }
-	}
-
-      /* Finally, handle any statements in the "else" part.  */
-      if (Present (Else_Statements (gnat_node)))
-	{
-	  expand_start_else ();
-
-	  for (gnat_temp = First (Else_Statements (gnat_node));
-	       Present (gnat_temp);
-	       gnat_temp = Next (gnat_temp))
-	    gnat_to_code (gnat_temp);
-	}
+	for (gnat_temp = First (Elsif_Parts (gnat_node));
+	     Present (gnat_temp); gnat_temp = Next (gnat_temp))
+	  {
+	    tree gnu_elseif
+	      = build_nt (IF_STMT, gnat_to_gnu (Condition (gnat_temp)),
+			  build_block_stmt (Then_Statements (gnat_temp)),
+			  NULL_TREE, NULL_TREE);
+
+	    TREE_SLOC (gnu_elseif) = Sloc (Condition (gnat_temp));
+	    TREE_CHAIN (gnu_elseif) = gnu_result;
+	    TREE_TYPE (gnu_elseif) = void_type_node;
+	    gnu_result = gnu_elseif;
+	  }
 
-      expand_end_cond ();
+      gnu_result = build_nt (IF_STMT, gnat_to_gnu (Condition (gnat_node)),
+			     build_block_stmt (Then_Statements (gnat_node)),
+			     nreverse (gnu_result),
+			     build_block_stmt (Else_Statements (gnat_node)));
       break;
 
     case N_Case_Statement:
@@ -2456,9 +2469,6 @@ tree_transform (Node_Id gnat_node)
       break;
 
     case N_Return_Statement:
-      if (type_annotate_only)
-	break;
-
       {
 	/* The gnu function type of the subprogram currently processed.  */
 	tree gnu_subprog_type = TREE_TYPE (current_function_decl);
@@ -2478,7 +2488,11 @@ tree_transform (Node_Id gnat_node)
 	   a branch to that label.  */
 
 	if (TREE_VALUE (gnu_return_label_stack) != 0)
-	  expand_goto (TREE_VALUE (gnu_return_label_stack));
+	  {
+	    gnu_result = build_nt (GOTO_STMT,
+				   TREE_VALUE (gnu_return_label_stack));
+	    break;
+	  }
 
 	else if (TYPE_CI_CO_LIST (gnu_subprog_type) != NULL_TREE)
 	  {
@@ -2538,25 +2552,12 @@ tree_transform (Node_Id gnat_node)
 	      }
 	  }
 
-	set_lineno (gnat_node, 1);
-	if (gnu_ret_val)
-	  expand_return (build_binary_op (MODIFY_EXPR, NULL_TREE,
-					  DECL_RESULT (current_function_decl),
-					  gnu_ret_val));
-	else
-	  expand_null_return ();
-
+	gnu_result = build_nt (RETURN_STMT, gnu_ret_val);
       }
       break;
 
     case N_Goto_Statement:
-      if (type_annotate_only)
-	break;
-
-      gnu_expr = gnat_to_gnu (Name (gnat_node));
-      TREE_USED (gnu_expr) = 1;
-      set_lineno (gnat_node, 1);
-      expand_goto (gnu_expr);
+      gnu_result = build_nt (GOTO_STMT, gnat_to_gnu (Name (gnat_node)));
       break;
 
     /****************************/
@@ -4174,12 +4175,70 @@ tree_transform (Node_Id gnat_node)
   return gnu_result;
 }
 
+/* INSN is a list of insns.  Return the first rtl in the list that isn't
+   an INSN_NOTE_DELETED.  */
+
+static rtx
+first_nondeleted_insn (rtx insns)
+{
+  for (; insns && GET_CODE (insns) == NOTE
+       && NOTE_LINE_NUMBER (insns) == NOTE_INSN_DELETED;
+       insns = NEXT_INSN (insns))
+    ;
+
+  return insns;
+}
+
+/* Build a BLOCK_STMT from GNAT_LIST, a possibly-empty list of statements.  */
+
+static tree
+build_block_stmt (List_Id gnat_list)
+{
+  tree gnu_result = NULL_TREE;
+  Node_Id gnat_node;
+
+  if (No (gnat_list) || Is_Empty_List (gnat_list))
+    return NULL_TREE;
+
+  for (gnat_node = First (gnat_list);
+       Present (gnat_node);
+       gnat_node = Next (gnat_node))
+    gnu_result = chainon (gnat_to_gnu (gnat_node), gnu_result);
+
+  gnu_result = build_nt (BLOCK_STMT, nreverse (gnu_result));
+  TREE_SLOC (gnu_result) = TREE_SLOC (BLOCK_STMT_LIST (gnu_result));
+  TREE_TYPE (gnu_result) = void_type_node;
+  return gnu_result;
+} 
+
+/* Build an EXPR_STMT to evaluate INSNS.  Use Sloc from GNAT_NODE.   */
+
+static tree
+make_expr_stmt_from_rtl (rtx insns, Node_Id gnat_node)
+{
+  tree gnu_result = make_node (RTL_EXPR);
+
+  TREE_TYPE (gnu_result) = void_type_node;
+  RTL_EXPR_RTL (gnu_result) = RTL_EXPR_ALT_RTL (gnu_result) = const0_rtx;
+  RTL_EXPR_SEQUENCE (gnu_result) = insns;
+  rtl_expr_chain = tree_cons (NULL_TREE, gnu_result, rtl_expr_chain);
+
+  gnu_result = build_nt (EXPR_STMT, gnu_result);
+  TREE_SLOC (gnu_result) = Sloc (gnat_node);
+  TREE_TYPE (gnu_result) = void_type_node;
+
+  return gnu_result;
+}
+
 /* GNU_STMT is a statement.  We generate code for that statement.  */
 
 void
 gnat_expand_stmt (tree gnu_stmt)
 {
-  set_lineno_from_sloc (TREE_SLOC (gnu_stmt), 1);
+  tree gnu_elmt;
+
+  if (TREE_SLOC (gnu_stmt))
+    set_lineno_from_sloc (TREE_SLOC (gnu_stmt), 1);
 
   switch (TREE_CODE (gnu_stmt))
     {
@@ -4187,6 +4246,59 @@ gnat_expand_stmt (tree gnu_stmt)
       expand_expr_stmt (EXPR_STMT_EXPR (gnu_stmt));
       break;
 
+    case BLOCK_STMT:
+      for (gnu_elmt = BLOCK_STMT_LIST (gnu_stmt); gnu_elmt;
+	   gnu_elmt = TREE_CHAIN (gnu_elmt))
+	expand_expr_stmt (gnu_elmt);
+      break;
+
+    case IF_STMT:
+      expand_start_cond (IF_STMT_COND (gnu_stmt), 0);
+
+      if (IF_STMT_TRUE (gnu_stmt))
+	expand_expr_stmt (IF_STMT_TRUE (gnu_stmt));
+
+      for (gnu_elmt = IF_STMT_ELSEIF (gnu_stmt); gnu_elmt;
+	   gnu_elmt = TREE_CHAIN (gnu_elmt))
+	{
+	  expand_start_else ();
+	  set_lineno_from_sloc (TREE_SLOC (gnu_elmt), 1);
+	  expand_elseif (IF_STMT_COND (gnu_elmt));
+	  expand_expr_stmt (IF_STMT_TRUE (gnu_elmt));
+	}
+
+      if (IF_STMT_ELSE (gnu_stmt))
+	{
+	  expand_start_else ();
+	  expand_expr_stmt (IF_STMT_ELSE (gnu_stmt));
+	}
+
+      expand_end_cond ();
+      break;
+
+    case GOTO_STMT:
+      TREE_USED (GOTO_STMT_LABEL (gnu_stmt)) = 1;
+      expand_goto (GOTO_STMT_LABEL (gnu_stmt));
+      break;
+
+    case LABEL_STMT:
+      expand_label (LABEL_STMT_LABEL (gnu_stmt));
+      if (LABEL_STMT_FIRST_IN_EH (gnu_stmt))
+	nonlocal_goto_handler_labels
+	  = gen_rtx_EXPR_LIST (VOIDmode,
+			       label_rtx (LABEL_STMT_LABEL (gnu_stmt)),
+			       nonlocal_goto_handler_labels);
+      break;
+
+    case RETURN_STMT:
+      if (RETURN_STMT_EXPR (gnu_stmt))
+	expand_return (build_binary_op (MODIFY_EXPR, NULL_TREE,
+					DECL_RESULT (current_function_decl),
+					RETURN_STMT_EXPR (gnu_stmt)));
+      else
+	expand_null_return ();
+      break;
+
     default:
       abort ();
     }