2004-05-17 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>

	Part of function-at-a-time conversion

	* misc.c (adjust_decl_rtl): Deleted.
	(LANG_HOOKS_PUSHLEVEL, LANG_HOOKS_POPLEVEL, LANG_HOOKS_SET_BLOCK):
	Define.

	* gigi.h: (adjust_decl_rtl, kept_level_p, set_block): Deleted.
	(add_decl_stmt, add_stmt, block_has_vars): New functions.
	(gnat_pushlevel, gnat_poplevel): Renamed from pushlevel and poplevel.

	* decl.c (elaborate_expression, maybe_pad_type): Call add_decl_stmt
	when making a decl.
	(gnat_to_gnu_entity): Likewise.
	Use add_stmt to update setjmp buffer.
	Set TREE_ADDRESSABLE instead of calling put_var_into_stack and
	flush_addressof.
	No longer call adjust_decl_rtl.
	(DECL_INIT_BY_ASSIGN_P): New macro.
	(DECL_STMT_VAR): Likewise.

	* trans.c (gigi): Call start_block_stmt to make the outermost
	BLOCK_STMT.
	(gnat_to_code, gnu_to_gnu, tree_transform, process_decls, process_type):
	Call start_block_stmt and end_block_stmt temporarily.
	Use gnat_expand_stmt instead of expand_expr_stmt.
	(add_decl_stmt): New function.
	(tree_transform): Call it.
	(add_stmt): Also emit initializing assignment for DECL_STMT if needed.
	(end_block_stmt): Set type and NULL_STMT.
	(gnat_expand_stmt): Make recursize call instead of calling
	expand_expr_stmt.
	(gnat_expand_stmt, case DECL_STMT): New case.
	(set_lineno_from_sloc): Do nothing if global.
	(gnu_block_stmt_node, gnu_block_stmt_free_list): New variables.
	(start_block_stmt, add_stmt, end_block_stmt): New functions.
	(build_block_stmt): Call them.
	(gnat_to_code): Don't expand NULL_STMT.
	(build_unit_elab): Rename pushlevel and poplevel to gnat_* and change
	args.
	(tree_transform): Likewise.
	(tree_transform, case N_Null_Statement): Return NULL_STMT.
	(gnat_expand_stmt, case NULL_STMT): New case.
	(gnat_expand_stmt, case IF_STMT): Allow nested IF_STMT to have no
	IF_STMT_TRUE.

	* utils2.c (gnat_mark_addressable, case VAR_DECL): Do not set
	TREE_ADDRESSABLE.

	* utils.c (create_var_decl): Do not call expand_decl or
	expand_decl_init.
	Set TREE_ADDRESSABLE instead of calling gnat_mark_addressable.
	Set DECL_INIT_BY_ASSIGN_P when needed and do not generate MODIFY_EXPR
	here.
	(struct e_stack): Add chain_next to GTY.
	(struct binding_level): Deleted.
	(struct ada_binding_level): New struct.
	(free_block_chain): New.
	(global_binding_level, clear_binding_level): Deleted.
	(global_bindings_p): Rework to see if no chain.
	(kept_level_p, set_block): Deleted.
	(gnat_pushlevel): Renamed from pushlevel and extensive reworked to use
	new data structure and work directly on BLOCK node.
	(gnat_poplevel): Similarly.
	(get_decls): Look at BLOCK_VARS.
	(insert_block): Work directly on BLOCK node.
	(block_has_var): New function.
	(pushdecl): Rework for new binding structures.
	(gnat_init_decl_processing): Rename and rework calls to pushlevel and
	poplevel.
	(build_subprog_body): Likewise.
	(end_subprog_body): Likewise; also set up BLOCK in DECL_INITIAL.

	* ada-tree.def (DECL_STMT, NULL_STMT): New codes.

	* ada-tree.h: (DECL_INIT_BY_ASSIGN_P): New macro.
	(DECL_STMT_VAR): Likewise.

2004-05-17  Robert Dewar  <dewar@gnat.com>

	* restrict.ads, restrict.adb (Process_Restriction_Synonym): New
	procedure

	* sem_prag.adb (Analyze_Pragma, case Restrictions): Cleanup handling
	of restriction synonyums by using
	Restrict.Process_Restriction_Synonyms.

	* snames.ads, snames.adb: Add entries for Process_Restriction_Synonym

	* s-restri.ads (Tasking_Allowed): Correct missing comment

	* s-rident.ads: Add entries for restriction synonyms

	* ali.adb: Fix some problems with badly formatted ALI files that can
	result in infinite loops.

	* s-taprop-lynxos.adb, s-tpopsp-lynxos.adb, s-taprop-tru64.adb,
	s-tpopsp-posix-foreign.adb, s-taprop-irix.adb, s-interr-sigaction.adb,
	s-taprop-irix-athread.adb, s-taprop-hpux-dce.adb, s-taprop-linux.adb,
	s-taprop-dummy.adb, s-interr-dummy.adb, s-taprop-os2.adb,
	s-taprop-solaris.adb, s-tpopsp-solaris.adb, s-asthan-vms.adb,
	s-inmaop-vms.adb, s-interr-vms.adb, s-taprop-vms.adb,
	s-tpopde-vms.adb, s-taprop-mingw.adb, s-interr-vxworks.adb,
	s-taprop-vxworks.adb, s-tpopsp-vxworks.adb, s-taprop-posix.adb,
	s-tpopsp-posix.adb, s-tratas-default.adb, a-dynpri.adb,
	a-tasatt.adb, a-taside.adb, a-taside.ads, exp_attr.adb,
	exp_ch9.adb, g-thread.adb, rtsfind.ads, sem_attr.adb,
	s-interr.adb, s-interr.ads, s-soflin.ads, s-taasde.adb,
	s-taasde.ads, s-taenca.adb, s-taenca.ads, s-taprop.ads,
	s-tarest.adb, s-tarest.ads, s-tasdeb.adb, s-tasdeb.ads,
	s-tasini.adb, s-tasini.ads, s-taskin.adb, s-taskin.ads,
	s-tasque.adb, s-tasque.ads, s-tasren.adb, s-tasren.ads,
	s-tassta.adb, s-tassta.ads, s-tasuti.adb, s-tasuti.ads,
	s-tataat.adb, s-tataat.ads, s-tpinop.adb, s-tpinop.ads,
	s-tpoben.adb, s-tpobop.adb, s-tpobop.ads, s-tporft.adb,
	s-tposen.adb, s-tposen.ads, s-tratas.adb, s-tratas.ads: Change Task_ID
	to Task_Id (minor cleanup).

2004-05-17  Vincent Celier  <celier@gnat.com>

	* g-os_lib.adb (Normalize_Pathname.Final_Value): Remove trailing
	directory separator.

	* prj-proc.adb (Recursive_Process): Inherit attribute Languages from
	project being extended, if Languages is not declared in extending
	project.

2004-05-17  Javier Miranda  <miranda@gnat.com>

	* sem_ch10.adb (Install_Limited_Withed_Unit): Do not install the
	limited view of a visible sibling.


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

1 files changed, 277 insertions, 72 deletions

diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index 117a95360dc..c9286121ee3 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -83,6 +83,13 @@ int type_annotate_only;
    over GC.  */
 tree gnu_block_stack;
 
+/* The current BLOCK_STMT node.  TREE_CHAIN points to the previous
+   BLOCK_STMT node.  */
+static GTY(()) tree gnu_block_stmt_node;
+
+/* List of unused BLOCK_STMT nodes.  */
+static GTY((deletable)) tree gnu_block_stmt_free_list;
+
 /* List of TREE_LIST nodes representing a stack of exception pointer
    variables.  TREE_VALUE is the VAR_DECL that stores the address of
    the raised exception.  Nonzero means we are in an exception
@@ -105,6 +112,8 @@ static GTY(()) tree gnu_return_label_stack;
 
 static tree tree_transform (Node_Id);
 static rtx first_nondeleted_insn (rtx);
+static tree start_block_stmt (void);
+static tree end_block_stmt (void);
 static tree build_block_stmt (List_Id);
 static tree make_expr_stmt_from_rtl (rtx, Node_Id);
 static void elaborate_all_entities (Node_Id);
@@ -186,6 +195,7 @@ gigi (Node_Id gnat_root,
   init_dummy_type ();
   init_code_table ();
   gnat_compute_largest_alignment ();
+  start_block_stmt ();
 
   /* Enable GNAT stack checking method if needed */
   if (!Stack_Check_Probes_On_Target)
@@ -237,12 +247,16 @@ gnat_to_code (Node_Id gnat_node)
   /* Save node number in case error */
   error_gnat_node = gnat_node;
 
+  start_block_stmt ();
   gnu_root = tree_transform (gnat_node);
+  gnat_expand_stmt (end_block_stmt ());
 
   /* If we return a statement, generate code for it.  */
   if (IS_STMT (gnu_root))
-    expand_expr_stmt (gnu_root);
-
+    {
+      if (TREE_CODE (gnu_root) != NULL_STMT)
+	gnat_expand_stmt (gnu_root);
+    }
   /* This should just generate code, not return a value.  If it returns
      a value, something is wrong.  */
   else if (gnu_root != error_mark_node)
@@ -275,7 +289,9 @@ gnat_to_gnu (Node_Id gnat_node)
   /* Save node number in case error */
   error_gnat_node = gnat_node;
 
+  start_block_stmt ();
   gnu_root = tree_transform (gnat_node);
+  gnat_expand_stmt (end_block_stmt ());
 
   if (gnu_root == error_mark_node)
     {
@@ -808,10 +824,14 @@ tree_transform (Node_Id gnat_node)
 	    {
 	      if ((Is_Public (gnat_temp) || global_bindings_p ())
 		  && ! TREE_CONSTANT (gnu_expr))
-		gnu_expr
-		  = create_var_decl (create_concat_name (gnat_temp, "init"),
-				     NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr,
-				     0, Is_Public (gnat_temp), 0, 0, 0);
+		{
+		  gnu_expr
+		    = create_var_decl (create_concat_name (gnat_temp, "init"),
+				       NULL_TREE, TREE_TYPE (gnu_expr),
+				       gnu_expr, 0, Is_Public (gnat_temp), 0,
+				       0, 0);
+		  add_decl_stmt (gnu_expr, gnat_temp);
+		}
 	      else
 		gnu_expr = maybe_variable (gnu_expr, Expression (gnat_node));
 
@@ -841,10 +861,8 @@ tree_transform (Node_Id gnat_node)
 		&& (Is_Array_Type (Etype (gnat_temp))
 		    || Is_Record_Type (Etype (gnat_temp))
 		    || Is_Concurrent_Type (Etype (gnat_temp)))))
-        {
-          gnu_expr = gnat_to_gnu (Renamed_Object (gnat_temp));
-          gnat_to_gnu_entity (gnat_temp, gnu_expr, 1);
-        }
+	gnat_to_gnu_entity (gnat_temp,
+			    gnat_to_gnu (Renamed_Object (gnat_temp)), 1);
       break;
 
     case N_Implicit_Label_Declaration:
@@ -2083,6 +2101,7 @@ tree_transform (Node_Id gnat_node)
       break;
 
     case N_Null_Statement:
+      gnu_result = build_nt (NULL_STMT);
       break;
 
     case N_Assignment_Statement:
@@ -2255,7 +2274,7 @@ tree_transform (Node_Id gnat_node)
 	       variables are declared since we want them to be local to this
 	       set of statements instead of the block containing the Case
 	       statement.  */
-	    pushlevel (0);
+	    gnat_pushlevel ();
 	    expand_start_bindings (0);
 	    for (gnat_statement = First (Statements (gnat_when));
 		 Present (gnat_statement);
@@ -2265,8 +2284,8 @@ tree_transform (Node_Id gnat_node)
 	    /* Communicate to GCC that we are done with the current WHEN,
 	       i.e. insert a "break" statement.  */
 	    expand_exit_something ();
-	    expand_end_bindings (NULL_TREE, kept_level_p (), -1);
-	    poplevel (kept_level_p (), 1, 0);
+	    expand_end_bindings (NULL_TREE, block_has_vars (), -1);
+	    gnat_poplevel ();
 	  }
 
 	expand_end_case (gnu_expr);
@@ -2334,11 +2353,13 @@ tree_transform (Node_Id gnat_node)
 
 	    /* Open a new nesting level that will surround the loop to declare
 	       the loop index variable.  */
-	    pushlevel (0);
+	    gnat_pushlevel ();
 	    expand_start_bindings (0);
 
 	    /* Declare the loop index and set it to its initial value.  */
+	    start_block_stmt ();
 	    gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1);
+	    expand_expr_stmt (end_block_stmt ());
 	    if (DECL_BY_REF_P (gnu_loop_var))
 	      gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE,
 					     gnu_loop_var);
@@ -2394,7 +2415,7 @@ tree_transform (Node_Id gnat_node)
            storage will be released every iteration.  This is needed
            for stack allocation.  */
 
-        pushlevel (0);
+        gnat_pushlevel ();
         gnu_block_stack
 	  = tree_cons (gnu_bottom_condition, NULL_TREE, gnu_block_stack);
         expand_start_bindings (0);
@@ -2404,8 +2425,8 @@ tree_transform (Node_Id gnat_node)
 	     gnat_statement = Next (gnat_statement))
 	  gnat_to_code (gnat_statement);
 
-        expand_end_bindings (NULL_TREE, kept_level_p (), -1);
-        poplevel (kept_level_p (), 1, 0);
+        expand_end_bindings (NULL_TREE, block_has_vars (), -1);
+        gnat_poplevel ();
         gnu_block_stack = TREE_CHAIN (gnu_block_stack);
 
 	set_lineno (gnat_node, 1);
@@ -2430,8 +2451,8 @@ tree_transform (Node_Id gnat_node)
 	    /* Close the nesting level that sourround the loop that was used to
 	       declare the loop index variable.   */
 	    set_lineno (gnat_node, 1);
-	    expand_end_bindings (NULL_TREE, 1, -1);
-	    poplevel (1, 1, 0);
+	    expand_end_bindings (NULL_TREE, block_has_vars (), -1);
+	    gnat_poplevel ();
 	  }
 
 	if (enclosing_if_p)
@@ -2443,13 +2464,15 @@ tree_transform (Node_Id gnat_node)
       break;
 
     case N_Block_Statement:
-      pushlevel (0);
+      gnat_pushlevel ();
       gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack);
       expand_start_bindings (0);
+      start_block_stmt ();
       process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
+      gnat_expand_stmt (end_block_stmt ());
       gnat_to_code (Handled_Statement_Sequence (gnat_node));
-      expand_end_bindings (NULL_TREE, kept_level_p (), -1);
-      poplevel (kept_level_p (), 1, 0);
+      expand_end_bindings (NULL_TREE, block_has_vars (), -1);
+      gnat_poplevel ();
       gnu_block_stack = TREE_CHAIN (gnu_block_stack);
       if (Present (Identifier (gnat_node)))
 	mark_out_of_scope (Entity (Identifier (gnat_node)));
@@ -2678,9 +2701,10 @@ tree_transform (Node_Id gnat_node)
 	   result in having the first line of the subprogram counted twice by
 	   gcov.  */
 
-	pushlevel (0);
+	gnat_pushlevel ();
 	gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack);
   	expand_start_bindings (0);
+	start_block_stmt ();
 
 	gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
 
@@ -2695,7 +2719,7 @@ tree_transform (Node_Id gnat_node)
 	      = tree_cons (NULL_TREE,
 			   build_decl (LABEL_DECL, NULL_TREE, NULL_TREE),
 			   gnu_return_label_stack);
-	    pushlevel (0);
+	    gnat_pushlevel ();
 	    expand_start_bindings (0);
 	  }
 	else
@@ -2712,38 +2736,39 @@ tree_transform (Node_Id gnat_node)
 	for (gnat_param = First_Formal (gnat_subprog_id);
 	     Present (gnat_param);
 	     gnat_param = Next_Formal_With_Extras (gnat_param))
-	  if (present_gnu_tree (gnat_param))
-	    adjust_decl_rtl (get_gnu_tree (gnat_param));
-	  else
+	  if (!present_gnu_tree (gnat_param))
 	    {
 	      /* Skip any entries that have been already filled in; they
 		 must correspond to IN OUT parameters.  */
-	    for (; gnu_cico_list != 0 && TREE_VALUE (gnu_cico_list) != 0;
-		 gnu_cico_list = TREE_CHAIN (gnu_cico_list))
-	      ;
-
-	    /* Do any needed references for padded types.  */
-	    TREE_VALUE (gnu_cico_list)
-	      = convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_list)),
-			 gnat_to_gnu_entity (gnat_param, NULL_TREE, 1));
-	  }
+	      for (; gnu_cico_list != 0 && TREE_VALUE (gnu_cico_list) != 0;
+		   gnu_cico_list = TREE_CHAIN (gnu_cico_list))
+		;
+
+	      /* Do any needed references for padded types.  */
+	      TREE_VALUE (gnu_cico_list)
+		= convert (TREE_TYPE (TREE_PURPOSE (gnu_cico_list)),
+			   gnat_to_gnu_entity (gnat_param, NULL_TREE, 1));
+	    }
 
+	gnat_expand_stmt (end_block_stmt());
+	start_block_stmt ();
 	process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
+	gnat_expand_stmt (end_block_stmt ());
 
 	/* Generate the code of the subprogram itself.  A return statement
 	   will be present and any OUT parameters will be handled there.  */
 	gnat_to_code (Handled_Statement_Sequence (gnat_node));
 
-	expand_end_bindings (NULL_TREE, kept_level_p (), -1);
-	poplevel (kept_level_p (), 1, 0);
+	expand_end_bindings (NULL_TREE, block_has_vars (), -1);
+	gnat_poplevel ();
 	gnu_block_stack = TREE_CHAIN (gnu_block_stack);
 
 	if (TREE_VALUE (gnu_return_label_stack) != 0)
 	  {
 	    tree gnu_retval;
 
-	    expand_end_bindings (NULL_TREE, kept_level_p (), -1);
-	    poplevel (kept_level_p (), 1, 0);
+	    expand_end_bindings (NULL_TREE, block_has_vars (), -1);
+	    gnat_poplevel ();
 	    expand_label (TREE_VALUE (gnu_return_label_stack));
 
 	    gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
@@ -3270,8 +3295,10 @@ tree_transform (Node_Id gnat_node)
 
     case N_Package_Specification:
 
+      start_block_stmt ();
       process_decls (Visible_Declarations (gnat_node),
 		     Private_Declarations (gnat_node), Empty, 1, 1);
+      gnat_expand_stmt (end_block_stmt ());
       break;
 
     case N_Package_Body:
@@ -3280,7 +3307,9 @@ tree_transform (Node_Id gnat_node)
       if (Ekind (Corresponding_Spec (gnat_node)) == E_Generic_Package)
 	break;
 
+      start_block_stmt ();
       process_decls (Declarations (gnat_node), Empty, Empty, 1, 1);
+      gnat_expand_stmt (end_block_stmt ());
 
       if (Present (Handled_Statement_Sequence (gnat_node)))
 	{
@@ -3334,8 +3363,10 @@ tree_transform (Node_Id gnat_node)
 	    break;
 	};
 
+      start_block_stmt();
       process_decls (Declarations (Aux_Decls_Node (gnat_node)),
 		     Empty, Empty, 1, 1);
+      gnat_expand_stmt (end_block_stmt ());
 
       gnat_to_code (Unit (gnat_node));
 
@@ -3440,7 +3471,7 @@ tree_transform (Node_Id gnat_node)
 	/* Make a binding level that we can exit if we need one.  */
 	if (exitable_binding_for_block)
 	  {
-	    pushlevel (0);
+	    gnat_pushlevel ();
 	    expand_start_bindings (1);
 	  }
 
@@ -3457,6 +3488,9 @@ tree_transform (Node_Id gnat_node)
 				 integer_type_node, NULL_TREE, 0, 0, 0, 0,
 				 0);
 
+	    start_block_stmt ();
+	    add_decl_stmt (gnu_cleanup_decl, gnat_node);
+	    gnat_expand_stmt (end_block_stmt ());
 	    expand_decl_cleanup (gnu_cleanup_decl, gnu_cleanup_call);
 	  }
 
@@ -3487,6 +3521,11 @@ tree_transform (Node_Id gnat_node)
 				 NULL_TREE, 0, 0, 0, 0,
 				 0);
 
+	    start_block_stmt ();
+	    add_decl_stmt (gnu_jmpsave_decl, gnat_node);
+	    add_decl_stmt (gnu_jmpbuf_decl, gnat_node);
+	    gnat_expand_stmt (end_block_stmt ());
+
 	    TREE_VALUE (gnu_block_stack) = gnu_jmpbuf_decl;
 
 	    /* When we exit this block, restore the saved value.  */
@@ -3509,7 +3548,7 @@ tree_transform (Node_Id gnat_node)
 	    /* Make a binding level for the exception handling declarations
 	       and code. Don't assign it an exit label, since this is the
 	       outer block we want to exit at the end of each handler.  */
-	    pushlevel (0);
+	    gnat_pushlevel ();
 	    expand_start_bindings (0);
 
 	    gnu_except_ptr_stack
@@ -3520,6 +3559,9 @@ tree_transform (Node_Id gnat_node)
 			    build_call_0_expr (get_excptr_decl),
 			    0, 0, 0, 0, 0),
 			   gnu_except_ptr_stack);
+	    start_block_stmt ();
+	    add_decl_stmt (TREE_VALUE (gnu_except_ptr_stack), gnat_node);
+	    gnat_expand_stmt (end_block_stmt ());
 
 	    /* Generate code for each handler. The N_Exception_Handler case
 	       below does the real work. We ignore the dummy exception handler
@@ -3540,8 +3582,8 @@ tree_transform (Node_Id gnat_node)
 	    gnu_except_ptr_stack = TREE_CHAIN (gnu_except_ptr_stack);
 
 	    /* End the binding level dedicated to the exception handlers.  */
-	    expand_end_bindings (NULL_TREE, kept_level_p (), -1);
-	    poplevel (kept_level_p (), 1, 0);
+	    expand_end_bindings (NULL_TREE, block_has_vars (), -1);
+	    gnat_poplevel ();
 
 	    /* End the "if" on setjmp.  Note that we have arranged things so
 	       control never returns here.  */
@@ -3566,9 +3608,11 @@ tree_transform (Node_Id gnat_node)
 
 	/* Generate code and declarations for the prefix of this block,
 	   if any.  */
+	start_block_stmt ();
 	if (Present (First_Real_Statement (gnat_node)))
 	  process_decls (Statements (gnat_node), Empty,
 			 First_Real_Statement (gnat_node), 1, 1);
+	gnat_expand_stmt (end_block_stmt ());
 
 	/* Generate code for each statement in the block.  */
 	for (gnat_temp = (Present (First_Real_Statement (gnat_node))
@@ -3603,8 +3647,8 @@ tree_transform (Node_Id gnat_node)
 	/* Close the binding level we made, if any.  */
 	if (exitable_binding_for_block)
 	  {
-	    expand_end_bindings (NULL_TREE, kept_level_p (), -1);
-	    poplevel (kept_level_p (), 1, 0);
+	    expand_end_bindings (NULL_TREE, block_has_vars (), -1);
+	    gnat_poplevel ();
 	  }
       }
 
@@ -3766,7 +3810,7 @@ tree_transform (Node_Id gnat_node)
 
 	  expand_start_catch (gnu_etypes_list);
 
-	  pushlevel (0);
+	  gnat_pushlevel ();
 	  expand_start_bindings (0);
 
 	  {
@@ -3797,6 +3841,9 @@ tree_transform (Node_Id gnat_node)
 				 ptr_type_node, gnu_current_exc_ptr,
 				 0, 0, 0, 0, 0);
 
+	    start_block_stmt ();
+	    add_decl_stmt (gnu_incoming_exc_ptr, gnat_node);
+	    gnat_expand_stmt (end_block_stmt ());
 	    expand_expr_stmt
 	      (build_call_1_expr (begin_handler_decl, gnu_incoming_exc_ptr));
 	    expand_decl_cleanup
@@ -3811,9 +3858,8 @@ tree_transform (Node_Id gnat_node)
       if (Exception_Mechanism == GCC_ZCX)
 	{
 	  /* Tell the back end that we're done with the current handler.  */
-	  expand_end_bindings (NULL_TREE, kept_level_p (), -1);
-	  poplevel (kept_level_p (), 1, 0);
-
+	  expand_end_bindings (NULL_TREE, block_has_vars (), -1);
+	  gnat_poplevel ();
 	  expand_end_catch ();
 	}
       else
@@ -3927,7 +3973,9 @@ tree_transform (Node_Id gnat_node)
 
     case N_Freeze_Entity:
       process_freeze_entity (gnat_node);
+      start_block_stmt ();
       process_decls (Actions (gnat_node), Empty, Empty, 1, 1);
+      gnat_expand_stmt (end_block_stmt ());
       break;
 
     case N_Itype_Reference:
@@ -4196,6 +4244,136 @@ first_nondeleted_insn (rtx insns)
   return insns;
 }
 
+/* Push the BLOCK_STMT stack and allocate a new BLOCK_STMT.  */
+
+static tree
+start_block_stmt ()
+{
+  tree gnu_block_stmt;
+
+  /* First see if we can get one from the free list.  */
+  if (gnu_block_stmt_free_list)
+    {
+      gnu_block_stmt = gnu_block_stmt_free_list;
+      gnu_block_stmt_free_list = TREE_CHAIN (gnu_block_stmt_free_list);
+    }
+  else
+    {
+      gnu_block_stmt = make_node (BLOCK_STMT);
+      TREE_TYPE (gnu_block_stmt) = void_type_node;
+    }
+
+  BLOCK_STMT_LIST (gnu_block_stmt) = 0;
+  TREE_CHAIN (gnu_block_stmt) = gnu_block_stmt_node;
+  gnu_block_stmt_node = gnu_block_stmt;
+
+  return gnu_block_stmt;
+}
+
+/* Add GNU_STMT to the current BLOCK_STMT node.  We add them backwards
+   order and the reverse in end_block_stmt.  */
+
+void
+add_stmt (tree gnu_stmt)
+{
+  if (TREE_CODE_CLASS (TREE_CODE (gnu_stmt)) != 's')
+    gigi_abort (340);
+
+  if (TREE_CODE (gnu_stmt) != NULL_STMT)
+    {
+      TREE_CHAIN (gnu_stmt) = BLOCK_STMT_LIST (gnu_block_stmt_node);
+      BLOCK_STMT_LIST (gnu_block_stmt_node) = gnu_stmt;
+    }
+
+  /* If this is a DECL_STMT for a variable with DECL_INIT_BY_ASSIGN_P set,
+     generate the assignment statement too.  */
+  if (TREE_CODE (gnu_stmt) == DECL_STMT
+      && TREE_CODE (DECL_STMT_VAR (gnu_stmt)) == VAR_DECL
+      && DECL_INIT_BY_ASSIGN_P (DECL_STMT_VAR (gnu_stmt)))
+    {
+      tree gnu_decl = DECL_STMT_VAR (gnu_stmt);
+      tree gnu_lhs = gnu_decl;
+      tree gnu_assign_stmt;
+
+      /* If decl has a padded type, convert it to the unpadded type so the
+	 assignment is done properly.  */
+      if (TREE_CODE (TREE_TYPE (gnu_lhs)) == RECORD_TYPE
+	  && TYPE_IS_PADDING_P (TREE_TYPE (gnu_lhs)))
+	gnu_lhs
+	  = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_lhs))), gnu_lhs);
+
+      gnu_assign_stmt
+	= build_nt (EXPR_STMT,
+		    build_binary_op (MODIFY_EXPR, NULL_TREE,
+				     gnu_lhs, DECL_INITIAL (gnu_decl)));
+      DECL_INITIAL (gnu_decl) = 0;
+      DECL_INIT_BY_ASSIGN_P (gnu_decl) = 0;
+
+      TREE_SLOC (gnu_assign_stmt) = TREE_SLOC (gnu_stmt);
+      TREE_TYPE (gnu_assign_stmt) = void_type_node;
+      add_stmt (gnu_assign_stmt);
+    }
+}
+
+/* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node.
+   Get SLOC from Entity_Id.  */
+
+void
+add_decl_stmt (tree gnu_decl, Entity_Id gnat_entity)
+{
+  tree gnu_stmt;
+
+  /* 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))
+    return;
+
+  gnu_stmt = build_nt (DECL_STMT, gnu_decl);
+  TREE_TYPE (gnu_stmt) = void_type_node;
+  TREE_SLOC (gnu_stmt) = Sloc (gnat_entity);
+  add_stmt (gnu_stmt);
+}
+
+/* Return the BLOCK_STMT that corresponds to the statement that add_stmt
+   has been emitting or just a single statement if only one.  */
+
+static tree
+end_block_stmt ()
+{
+  tree gnu_block_stmt = gnu_block_stmt_node;
+  tree gnu_retval = gnu_block_stmt;
+
+  gnu_block_stmt_node = TREE_CHAIN (gnu_block_stmt);
+  TREE_CHAIN (gnu_block_stmt) = 0;
+
+  /* If we have only one statement, return it and free this node.  Otherwise,
+     finish setting up this node and return it.  If we have no statements,
+     return a NULL_STMT.  */
+  if (BLOCK_STMT_LIST (gnu_block_stmt) == 0)
+    {
+      gnu_retval = build_nt (NULL_STMT);
+      TREE_TYPE (gnu_retval) = void_type_node;
+    }
+  else if (TREE_CHAIN (BLOCK_STMT_LIST (gnu_block_stmt)) == 0)
+    gnu_retval = BLOCK_STMT_LIST (gnu_block_stmt);
+  else
+    {
+      BLOCK_STMT_LIST (gnu_block_stmt)
+	= nreverse (BLOCK_STMT_LIST (gnu_block_stmt));
+      TREE_SLOC (gnu_block_stmt)
+	= TREE_SLOC (BLOCK_STMT_LIST (gnu_block_stmt));
+    }
+
+  if (gnu_retval != gnu_block_stmt)
+    {
+      TREE_CHAIN (gnu_block_stmt) = gnu_block_stmt_free_list;
+      gnu_block_stmt_free_list = gnu_block_stmt;
+    }
+
+  return gnu_retval;
+}
+   
 /* Build a BLOCK_STMT from GNAT_LIST, a possibly-empty list of statements.  */
 
 static tree
@@ -4207,15 +4385,15 @@ build_block_stmt (List_Id gnat_list)
   if (No (gnat_list) || Is_Empty_List (gnat_list))
     return NULL_TREE;
 
+  start_block_stmt ();
+
   for (gnat_node = First (gnat_list);
        Present (gnat_node);
        gnat_node = Next (gnat_node))
-    gnu_result = chainon (gnat_to_gnu (gnat_node), gnu_result);
+    add_stmt (gnat_to_gnu (gnat_node));
 
-  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;
+  gnu_result = end_block_stmt ();
+  return TREE_CODE (gnu_result) == NULL_STMT ? NULL_TREE : gnu_result;
 } 
 
 /* Build an EXPR_STMT to evaluate INSNS.  Use Sloc from GNAT_NODE.   */
@@ -4253,17 +4431,37 @@ gnat_expand_stmt (tree gnu_stmt)
       expand_expr_stmt (EXPR_STMT_EXPR (gnu_stmt));
       break;
 
+    case NULL_STMT:
+      break;
+
+    case DECL_STMT:
+      if (TREE_CODE (DECL_STMT_VAR (gnu_stmt)) == TYPE_DECL)
+	force_type_save_exprs (TREE_TYPE (DECL_STMT_VAR (gnu_stmt)));
+      else
+	{
+	  expand_decl (DECL_STMT_VAR (gnu_stmt));
+	  if (DECL_CONTEXT (DECL_STMT_VAR (gnu_stmt)))
+	    expand_decl_init (DECL_STMT_VAR (gnu_stmt));
+
+	  if (TREE_ADDRESSABLE (DECL_STMT_VAR (gnu_stmt)))
+	    {
+	      put_var_into_stack (DECL_STMT_VAR (gnu_stmt), true);
+	      flush_addressof (DECL_STMT_VAR (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);
+	gnat_expand_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));
+	gnat_expand_stmt (IF_STMT_TRUE (gnu_stmt));
 
       for (gnu_elmt = IF_STMT_ELSEIF (gnu_stmt); gnu_elmt;
 	   gnu_elmt = TREE_CHAIN (gnu_elmt))
@@ -4271,13 +4469,14 @@ gnat_expand_stmt (tree gnu_stmt)
 	  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_TRUE (gnu_elmt))
+	    gnat_expand_stmt (IF_STMT_TRUE (gnu_elmt));
 	}
 
       if (IF_STMT_ELSE (gnu_stmt))
 	{
 	  expand_start_else ();
-	  expand_expr_stmt (IF_STMT_ELSE (gnu_stmt));
+	  gnat_expand_stmt (IF_STMT_ELSE (gnu_stmt));
 	}
 
       expand_end_cond ();
@@ -4324,8 +4523,8 @@ gnat_expand_stmt (tree gnu_stmt)
 	  }
       break;
 
-    default:
-      abort ();
+    default: 
+     abort ();
     }
 }
 
@@ -4570,11 +4769,8 @@ process_inlined_subprograms (Node_Id gnat_node)
    correspond to the public and private parts of a package.  */
 
 static void
-process_decls (List_Id gnat_decls,
-               List_Id gnat_decls2,
-               Node_Id gnat_end_list,
-               int pass1p,
-               int pass2p)
+process_decls (List_Id gnat_decls, List_Id gnat_decls2,
+               Node_Id gnat_end_list, int pass1p, int pass2p)
 {
   List_Id gnat_decl_array[2];
   Node_Id gnat_decl;
@@ -4603,7 +4799,9 @@ process_decls (List_Id gnat_decls,
 	       freeze node.  */
 	    else if (Nkind (gnat_decl) == N_Freeze_Entity)
 	      {
+		start_block_stmt ();
 		process_freeze_entity (gnat_decl);
+		gnat_expand_stmt (end_block_stmt ());
 		process_decls (Actions (gnat_decl), Empty, Empty, 1, 0);
 	      }
 
@@ -4643,7 +4841,7 @@ process_decls (List_Id gnat_decls,
                   Node_Id gnat_subprog_id =
                      Defining_Entity (Specification (gnat_decl));
 
-		    if    (Ekind (gnat_subprog_id) != E_Subprogram_Body
+		    if (Ekind (gnat_subprog_id) != E_Subprogram_Body
                         && Ekind (gnat_subprog_id) != E_Generic_Procedure
 			&& Ekind (gnat_subprog_id) != E_Generic_Function)
 		      gnat_to_gnu_entity (gnat_subprog_id, NULL_TREE, 1);
@@ -4656,7 +4854,11 @@ process_decls (List_Id gnat_decls,
 		;
 
 	    else
-	      gnat_to_code (gnat_decl);
+	      {
+		start_block_stmt ();
+		gnat_to_code (gnat_decl);
+		gnat_expand_stmt (end_block_stmt ());
+	      }
 	  }
 
   /* Here we elaborate everything we deferred above except for package bodies,
@@ -5082,6 +5284,7 @@ process_type (Entity_Id gnat_entity)
     }
 
   /* Now fully elaborate the type.  */
+  start_block_stmt ();
   gnu_new = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 1);
   if (TREE_CODE (gnu_new) != TYPE_DECL)
     gigi_abort (324);
@@ -5112,6 +5315,8 @@ process_type (Entity_Id gnat_entity)
       update_pointer_to (TYPE_MAIN_VARIANT (TREE_TYPE (gnu_task_old)),
 			 TREE_TYPE (gnu_new));
     }
+
+  gnat_expand_stmt (end_block_stmt ());
 }
 
 /* GNAT_ASSOC is the front of the Component_Associations of an N_Aggregate.
@@ -5499,7 +5704,7 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list)
 
   begin_subprog_body (gnu_decl);
   set_lineno (gnat_unit, 1);
-  pushlevel (0);
+  gnat_pushlevel ();
   gnu_block_stack = tree_cons (NULL_TREE, NULL_TREE, gnu_block_stack);
   expand_start_bindings (0);
 
@@ -5542,8 +5747,8 @@ build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list)
 	break;
       }
 
-  expand_end_bindings (NULL_TREE, kept_level_p (), -1);
-  poplevel (kept_level_p (), 1, 0);
+  expand_end_bindings (NULL_TREE, block_has_vars (), -1);
+  gnat_poplevel ();
   gnu_block_stack = TREE_CHAIN (gnu_block_stack);
   end_subprog_body ();
 
@@ -5599,7 +5804,7 @@ set_lineno_from_sloc (Source_Ptr source_location, int write_note_p)
 	(Debug_Source_Name (Get_Source_File_Index (source_location)))));;
   input_line = Get_Logical_Line_Number (source_location);
 
-  if (write_note_p)
+  if (! global_bindings_p () && write_note_p)
     emit_line_note (input_location);
 }