More Ada front-end patches

Richard Kenner kenner@vlsi1.ultra.nyu.edu
Tue Jun 29 00:17:00 GMT 2004


With these, Ada bootstraps, but the ACATS tests are still a disaster,
so there's no point in reenabling it yet.

2004-06-28  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* decl.c: Remove calls to add_decl_expr, pushdecl, rest_of_compilation,
	and rest_of_type_compilation; add arg to create_*_decl.
 	(annotate_decl_with_node): Deleted.
	(gnat_to_gnu_entity, case E_Array_Type): Set location of fields.
	* gigi.h (get_decls, block_has_vars, pushdecl): Deleted.
	(get_current_block_context, gnat_pushdecl): New declarations.
	(gnat_init_stmt_group): Likewise.
	(create_var_decl, create_type_decl, create_subprog_decl): Add new arg.
	* misc.c (LANG_HOOKS_CLEAR_BINDING_STACK): Deleted.
	(LANG_HOOKS_GETDECLS, LANG_HOOKS_PUSHDECL): Deleted.
	(gnat_init): Call gnat_init_stmt_group.
	* trans.c (global_stmt_group, gnu_elab_proc_decl): New variables.
	(gnu_pending_elaboration_list): Deleted.
	(mark_visited, mark_unvisited, gnat_init_stmt_group): New functions.
	(gigi): Rearrange initialization calls and move some to last above.
	(gnat_to_gnu): If statement and not in procedure, go into elab proc.
	Delete calls to add_decl_expr; add arg to create_*_decl.
	(gnat_to_gnu, case N_Loop): Recalculate side effects on COND_EXPR.
	(gnat_to_gnu, case N_Subprogram_Body): Move some code to 
	begin_subprog_body and call it.
	Don't push and pop ggc context.
	(gnat_to_gnu, case N_Compilation_Unit): Rework to support elab proc.
	(add_stmt): Remove handling of DECL_EXPR from here.
	If not in function, mark visited.
	(add_decl_expr): Put global at top level.
	Check for cases of DECL_INITIAL we have to handle here.
	(process_type): Add extra arg to create_type_decl.
	(build_unit_elab): Rework to just gimplify.
	* utils.c (pending_elaborations, elist_stack, getdecls): Deleted.
	(block_has_vars, mark_visited, add_pending_elaborations): Likewise.
	(get_pending_elaborations, pending_elaborations_p): Likewise.
	(push_pending_elaborations, pop_pending_elaborations): Likewise.
	(get_elaboration_location, insert_elaboration_list): Likewise.
	(gnat_binding_level): Renamed from ada_binding_level.
	(init_gnat_to_gnu): Don't clear pending_elaborations.
	(global_bindings_p): Treat as global if no current_binding_level.
	(set_current_block_context): New function.
	(gnat_pushdecl): Renamed from pushdecl; major rework.
	All callers changed.
	(create_type_decl, create_var_decl, create_subprog_decl): Add new arg.
	(finish_record_type): Call call pushdecl for stub decl.
	(function_nesting_depth): Deleted.
	(begin_subprog_body): Delete obsolete code.
	* utils2.c (build_call_alloc_dealloc): Add new arg to create_var_decl.
	
*** decl.c	26 Jun 2004 22:20:53 -0000	1.63.2.60
--- decl.c	28 Jun 2004 04:00:39 -0000
*************** static tree make_type_from_size (tree, t
*** 104,108 ****
  static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
  static void check_ok_for_atomic (tree, Entity_Id, int);
- static void annotate_decl_with_node (tree, Node_Id);
  
  /* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a
--- 104,107 ----
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 958,964 ****
  	      = create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
  				 NULL_TREE, gnu_new_type, gnu_expr,
! 				 0, 0, 0, 0, 0);
! 	    annotate_decl_with_node (gnu_new_var, gnat_entity);
! 	    add_decl_expr (gnu_new_var, gnat_entity);
  
  	    if (gnu_expr != 0)
--- 957,961 ----
  	      = create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
  				 NULL_TREE, gnu_new_type, gnu_expr,
! 				 0, 0, 0, 0, 0, gnat_entity);
  
  	    if (gnu_expr != 0)
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1029,1034 ****
  				    Is_Public (gnat_entity),
  				    imported_p || !definition,
! 				    static_p, attr_list);
! 	annotate_decl_with_node (gnu_decl, gnat_entity);
  	DECL_BY_REF_P (gnu_decl) = used_by_ref;
  	DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
--- 1026,1030 ----
  				    Is_Public (gnat_entity),
  				    imported_p || !definition,
! 				    static_p, attr_list, gnat_entity);
  	DECL_BY_REF_P (gnu_decl) = used_by_ref;
  	DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1042,1047 ****
  	  DECL_POINTER_ALIAS_SET (gnu_decl) = 0;
  
- 	add_decl_expr (gnu_decl, gnat_entity);
- 
  	if (definition && DECL_SIZE (gnu_decl) != 0
  	    && get_block_jmpbuf_decl ()
--- 1038,1041 ----
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1070,1076 ****
  	      = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
  				 gnu_expr, 0, Is_Public (gnat_entity), 0,
! 				 static_p, 0);
  
- 	    add_decl_expr (gnu_corr_var, gnat_entity);
  	    SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
  	  }
--- 1064,1069 ----
  	      = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
  				 gnu_expr, 0, Is_Public (gnat_entity), 0,
! 				 static_p, 0, gnat_entity);
  
  	    SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
  	  }
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1153,1159 ****
  	    tree gnu_literal
  	      = create_var_decl (get_entity_name (gnat_literal),
! 				 0, gnu_type, gnu_value, 1, 0, 0, 0, 0);
  
- 	    add_decl_expr (gnu_literal, gnat_literal);
  	    save_gnu_tree (gnat_literal, gnu_literal, 0);
  	    gnu_literal_list = tree_cons (DECL_NAME (gnu_literal),
--- 1146,1152 ----
  	    tree gnu_literal
  	      = create_var_decl (get_entity_name (gnat_literal),
! 				 0, gnu_type, gnu_value, 1, 0, 0, 0, 0,
! 				 gnat_literal);
  
  	    save_gnu_tree (gnat_literal, gnu_literal, 0);
  	    gnu_literal_list = tree_cons (DECL_NAME (gnu_literal),
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1464,1468 ****
  	    gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  					 ! Comes_From_Source (gnat_entity),
! 					 debug_info_p);
  	    save_gnu_tree (gnat_entity, gnu_decl, 0);
  	    saved = 1;
--- 1457,1461 ----
  	    gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  					 ! Comes_From_Source (gnat_entity),
! 					 debug_info_p, gnat_entity);
  	    save_gnu_tree (gnat_entity, gnu_decl, 0);
  	    saved = 1;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1527,1532 ****
  					       gnu_template_type, 0, 0, 0, 0);
  
! 	    annotate_decl_with_node (gnu_min_field, gnat_entity);
! 	    annotate_decl_with_node (gnu_max_field, gnat_entity);
  	    gnu_temp_fields[index] = chainon (gnu_min_field, gnu_max_field);
  
--- 1520,1527 ----
  					       gnu_template_type, 0, 0, 0, 0);
  
! 	    Sloc_to_locus (Sloc (gnat_entity),
! 			   &DECL_SOURCE_LOCATION (gnu_min_field));
! 	    Sloc_to_locus (Sloc (gnat_entity),
! 			   &DECL_SOURCE_LOCATION (gnu_max_field));
  	    gnu_temp_fields[index] = chainon (gnu_min_field, gnu_max_field);
  
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1670,1675 ****
  	create_type_decl (create_concat_name (gnat_entity, "XUA"),
  			  tem, 0, ! Comes_From_Source (gnat_entity),
! 			  debug_info_p);
! 	rest_of_type_compilation (gnu_fat_type, global_bindings_p ());
  
  	/* Create a record type for the object and its template and
--- 1665,1669 ----
  	create_type_decl (create_concat_name (gnat_entity, "XUA"),
  			  tem, 0, ! Comes_From_Source (gnat_entity),
! 			  debug_info_p, gnat_entity);
  
  	/* Create a record type for the object and its template and
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 1689,1693 ****
  	create_type_decl (create_concat_name (gnat_entity, "XUX"),
  			  build_pointer_type (tem), 0,
! 			  ! Comes_From_Source (gnat_entity), debug_info_p);
        }
        break;
--- 1683,1688 ----
  	create_type_decl (create_concat_name (gnat_entity, "XUX"),
  			  build_pointer_type (tem), 0,
! 			  ! Comes_From_Source (gnat_entity), debug_info_p,
! 			  gnat_entity);
        }
        break;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2061,2066 ****
  	  gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  				       ! Comes_From_Source (gnat_entity),
! 				       debug_info_p);
! 	  annotate_decl_with_node (gnu_decl, gnat_entity);
  	  if (! Comes_From_Source (gnat_entity))
  	    DECL_ARTIFICIAL (gnu_decl) = 1;
--- 2056,2060 ----
  	  gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  				       ! Comes_From_Source (gnat_entity),
! 				       debug_info_p, gnat_entity);
  	  if (! Comes_From_Source (gnat_entity))
  	    DECL_ARTIFICIAL (gnu_decl) = 1;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2292,2297 ****
  	    gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  					 ! Comes_From_Source (gnat_entity),
! 					 debug_info_p);
! 	    annotate_decl_with_node (gnu_decl, gnat_entity);
  	    save_gnu_tree (gnat_entity, gnu_decl, 0);
  	    this_made_decl = saved = 1;
--- 2286,2290 ----
  	    gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  					 ! Comes_From_Source (gnat_entity),
! 					 debug_info_p, gnat_entity);
  	    save_gnu_tree (gnat_entity, gnu_decl, 0);
  	    this_made_decl = saved = 1;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2572,2576 ****
  	      TYPE_NAME (gnu_type) = gnu_entity_id;
  	      TYPE_STUB_DECL (gnu_type)
! 		= pushdecl (build_decl (TYPE_DECL, NULL_TREE, gnu_type));
  	      TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
  
--- 2565,2570 ----
  	      TYPE_NAME (gnu_type) = gnu_entity_id;
  	      TYPE_STUB_DECL (gnu_type)
! 		= create_type_decl (NULL_TREE, gnu_type, NULL, 0, 0,
! 				    gnat_entity);
  	      TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
  
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2737,2745 ****
  	      TYPE_NAME (gnu_type) = gnu_entity_id;
  	      TYPE_STUB_DECL (gnu_type)
! 		= pushdecl (build_decl (TYPE_DECL, TYPE_NAME (gnu_type),
! 				      gnu_type));
! 	      DECL_ARTIFICIAL (TYPE_STUB_DECL (gnu_type)) = 1;
! 	      DECL_IGNORED_P (TYPE_STUB_DECL (gnu_type)) = ! debug_info_p;
! 	      rest_of_type_compilation (gnu_type, global_bindings_p ());
  	    }
  
--- 2731,2736 ----
  	      TYPE_NAME (gnu_type) = gnu_entity_id;
  	      TYPE_STUB_DECL (gnu_type)
! 		= create_type_decl (TYPE_NAME (gnu_type), gnu_type,
! 				    NULL, 1, debug_info_p, gnat_entity);
  	    }
  
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 2773,2777 ****
  	  gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  				       ! Comes_From_Source (gnat_entity),
! 				       debug_info_p);
  	  save_gnu_tree (gnat_entity, gnu_decl, 0);
  	  this_made_decl = saved = 1;
--- 2764,2768 ----
  	  gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  				       ! Comes_From_Source (gnat_entity),
! 				       debug_info_p, gnat_entity);
  	  save_gnu_tree (gnat_entity, gnu_decl, 0);
  	  this_made_decl = saved = 1;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3040,3044 ****
  	    gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  					 ! Comes_From_Source (gnat_entity),
! 					 debug_info_p);
  	    save_gnu_tree (gnat_entity, gnu_decl, 0);
  	    this_made_decl = saved = 1;
--- 3031,3035 ----
  	    gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  					 ! Comes_From_Source (gnat_entity),
! 					 debug_info_p, gnat_entity);
  	    save_gnu_tree (gnat_entity, gnu_decl, 0);
  	    this_made_decl = saved = 1;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3501,3505 ****
  		  = (Ekind (gnat_param) == E_In_Parameter
  		     && (by_ref_p || by_component_ptr_p));
! 		annotate_decl_with_node (gnu_param, gnat_param);
  		save_gnu_tree (gnat_param, gnu_param, 0);
  		gnu_param_list = chainon (gnu_param, gnu_param_list);
--- 3492,3497 ----
  		  = (Ekind (gnat_param) == E_In_Parameter
  		     && (by_ref_p || by_component_ptr_p));
! 		Sloc_to_locus (Sloc (gnat_param),
! 			       &DECL_SOURCE_LOCATION (gnu_param));
  		save_gnu_tree (gnat_param, gnu_param, 0);
  		gnu_param_list = chainon (gnu_param, gnu_param_list);
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3529,3533 ****
  		gnu_field = create_field_decl (gnu_param_name, gnu_param_type,
  					       gnu_return_type, 0, 0, 0, 0);
! 		annotate_decl_with_node (gnu_field, gnat_param);
  		TREE_CHAIN (gnu_field) = gnu_field_list;
  		gnu_field_list = gnu_field;
--- 3521,3526 ----
  		gnu_field = create_field_decl (gnu_param_name, gnu_param_type,
  					       gnu_return_type, 0, 0, 0, 0);
! 		Sloc_to_locus (Sloc (gnat_param),
! 			       &DECL_SOURCE_LOCATION (gnu_field));
  		TREE_CHAIN (gnu_field) = gnu_field_list;
  		gnu_field_list = gnu_field;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3626,3632 ****
  	      = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
  				 gnu_address, 0, Is_Public (gnat_entity),
! 				 extern_flag, 0, 0);
  	    DECL_BY_REF_P (gnu_decl) = 1;
- 	    add_decl_expr (gnu_decl, gnat_entity);
  	  }
  
--- 3619,3624 ----
  	      = create_var_decl (gnu_entity_id, gnu_ext_name, gnu_type,
  				 gnu_address, 0, Is_Public (gnat_entity),
! 				 extern_flag, 0, 0, gnat_entity);
  	    DECL_BY_REF_P (gnu_decl) = 1;
  	  }
  
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3634,3638 ****
  	  gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  				       ! Comes_From_Source (gnat_entity),
! 				       debug_info_p);
  	else
  	  {
--- 3626,3630 ----
  	  gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  				       ! Comes_From_Source (gnat_entity),
! 				       debug_info_p, gnat_entity);
  	else
  	  {
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3640,3644 ****
  					    gnu_type, gnu_param_list,
  					    inline_flag, public_flag,
! 					    extern_flag, attr_list);
  	    DECL_STUBBED_P (gnu_decl)
  	      = Convention (gnat_entity) == Convention_Stubbed;
--- 3632,3637 ----
  					    gnu_type, gnu_param_list,
  					    inline_flag, public_flag,
! 					    extern_flag, attr_list,
! 					    gnat_entity);
  	    DECL_STUBBED_P (gnu_decl)
  	      = Convention (gnat_entity) == Convention_Stubbed;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3701,3706 ****
        gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  				   ! Comes_From_Source (gnat_entity),
! 				   debug_info_p);
!       annotate_decl_with_node (gnu_decl, gnat_entity);
        save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0);
        break;
--- 3694,3698 ----
        gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
  				   ! Comes_From_Source (gnat_entity),
! 				   debug_info_p, gnat_entity);
        save_gnu_tree (Full_View (gnat_entity), gnu_decl, 0);
        break;
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 3917,3930 ****
  
        if (gnu_decl == 0)
! 	{
! 	  gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! 				       ! Comes_From_Source (gnat_entity),
! 				       debug_info_p);
! 	  annotate_decl_with_node (gnu_decl, gnat_entity);
! 	}
        else
  	TREE_TYPE (gnu_decl) = gnu_type;
- 
-       add_decl_expr (gnu_decl, gnat_entity);
      }
  
--- 3909,3917 ----
  
        if (gnu_decl == 0)
! 	gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
! 				     ! Comes_From_Source (gnat_entity),
! 				     debug_info_p, gnat_entity);
        else
  	TREE_TYPE (gnu_decl) = gnu_type;
      }
  
*************** gnat_to_gnu_entity (Entity_Id gnat_entit
*** 4019,4023 ****
  	= gnat_to_gnu (Type_High_Bound (gnat_entity));
  
!       if (kind == E_Enumeration_Type)
  	{
  	  TYPE_STUB_DECL (gnu_scalar_type) = gnu_decl;
--- 4006,4010 ----
  	= gnat_to_gnu (Type_High_Bound (gnat_entity));
  
!       if (TREE_CODE (gnu_scalar_type) == ENUMERAL_TYPE)
  	{
  	  TYPE_STUB_DECL (gnu_scalar_type) = gnu_decl;
*************** make_dummy_type (Entity_Id gnat_type)
*** 4302,4310 ****
  
    TYPE_NAME (gnu_type) = get_entity_name (gnat_type);
    if (AGGREGATE_TYPE_P (gnu_type))
!     TYPE_STUB_DECL (gnu_type)
!       = pushdecl (build_decl (TYPE_DECL, NULL_TREE, gnu_type));
  
-   TYPE_DUMMY_P (gnu_type) = 1;
    dummy_node_table[gnat_underlying] = gnu_type;
  
--- 4289,4296 ----
  
    TYPE_NAME (gnu_type) = get_entity_name (gnat_type);
+   TYPE_DUMMY_P (gnu_type) = 1;
    if (AGGREGATE_TYPE_P (gnu_type))
!     TYPE_STUB_DECL (gnu_type) = build_decl (TYPE_DECL, NULL_TREE, gnu_type);
  
    dummy_node_table[gnat_underlying] = gnu_type;
  
*************** elaborate_expression_1 (Node_Id gnat_exp
*** 4539,4551 ****
    /* Now create the variable if we need it.  */
    if (need_debug || (expr_variable && expr_global))
!     {
!       gnu_decl
! 	= create_var_decl (create_concat_name (gnat_entity,
! 					       IDENTIFIER_POINTER (gnu_name)),
! 			   NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1,
! 			   Is_Public (gnat_entity), ! definition, 0, 0);
!       annotate_decl_with_node (gnu_decl, gnat_entity);
!       add_decl_expr (gnu_decl, gnat_entity);
!     }
  
    /* We only need to use this variable if we are in global context since GCC
--- 4525,4534 ----
    /* Now create the variable if we need it.  */
    if (need_debug || (expr_variable && expr_global))
!     gnu_decl
!       = create_var_decl (create_concat_name (gnat_entity,
! 					     IDENTIFIER_POINTER (gnu_name)),
! 			 NULL_TREE, TREE_TYPE (gnu_expr), gnu_expr, 1,
! 			 Is_Public (gnat_entity), ! definition, 0, 0,
! 			 gnat_entity);
  
    /* We only need to use this variable if we are in global context since GCC
*************** maybe_pad_type (tree type, tree size, un
*** 4758,4762 ****
  		      ! (TYPE_NAME (type) != 0
  			 && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
! 			 && DECL_IGNORED_P (TYPE_NAME (type))));
  
    /* If we are changing the alignment and the input type is a record with
--- 4741,4746 ----
  		      ! (TYPE_NAME (type) != 0
  			 && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
! 			 && DECL_IGNORED_P (TYPE_NAME (type))),
! 		      gnat_entity);
  
    /* If we are changing the alignment and the input type is a record with
*************** maybe_pad_type (tree type, tree size, un
*** 4806,4810 ****
      {
        tree marker = make_node (RECORD_TYPE);
!       tree name = DECL_NAME (TYPE_NAME (record));
        tree orig_name = TYPE_NAME (type);
  
--- 4790,4796 ----
      {
        tree marker = make_node (RECORD_TYPE);
!       tree name = (TREE_CODE (TYPE_NAME (record)) == TYPE_DECL
! 		   ? DECL_NAME (TYPE_NAME (record))
! 		   : TYPE_NAME (record));
        tree orig_name = TYPE_NAME (type);
  
*************** maybe_pad_type (tree type, tree size, un
*** 4820,4830 ****
  
        if (size != 0 && TREE_CODE (size) != INTEGER_CST && definition)
! 	{
! 	  tree gnu_xvz
! 	    = create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE,
! 			       sizetype, TYPE_SIZE (record), 0, 0, 0, 0, 0);
! 
! 	  add_decl_expr (gnu_xvz, gnat_entity);
! 	}
      }
  
--- 4806,4812 ----
  
        if (size != 0 && TREE_CODE (size) != INTEGER_CST && definition)
! 	create_var_decl (concat_id_with_name (name, "XVZ"), NULL_TREE,
! 			 sizetype, TYPE_SIZE (record), 0, 0, 0, 0, 0,
! 			 gnat_entity);
      }
  
*************** choices_to_gnu (tree operand, Node_Id ch
*** 4966,4972 ****
  
  static tree
! gnat_to_gnu_field (Entity_Id gnat_field,
!                    tree gnu_record_type,
!                    int packed,
                     int definition)
  {
--- 4948,4952 ----
  
  static tree
! gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
                     int definition)
  {
*************** gnat_to_gnu_field (Entity_Id gnat_field,
*** 5182,5186 ****
  				 packed, gnu_size, gnu_pos,
  				 Is_Aliased (gnat_field));
!   annotate_decl_with_node (gnu_field, gnat_field);
    TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field);
  
--- 5162,5166 ----
  				 packed, gnu_size, gnu_pos,
  				 Is_Aliased (gnat_field));
!   Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field));
    TREE_THIS_VOLATILE (gnu_field) = Treat_As_Volatile (gnat_field);
  
*************** is_variable_size (tree type)
*** 5251,5262 ****
  
  static void
! components_to_record (tree gnu_record_type,
!                       Node_Id component_list,
!                       tree gnu_field_list,
!                       int packed,
!                       int definition,
!                       tree *p_gnu_rep_list,
!                       int cancel_alignment,
!                       int all_rep)
  {
    Node_Id component_decl;
--- 5231,5237 ----
  
  static void
! components_to_record (tree gnu_record_type, Node_Id component_list,
!                       tree gnu_field_list, int packed, int definition,
!                       tree *p_gnu_rep_list, int cancel_alignment, int all_rep)
  {
    Node_Id component_decl;
*************** check_ok_for_atomic (tree object, Entity
*** 6186,6204 ****
  }
  
! /* Set the DECL_SOURCE_LOCATION of GNU_DECL to the location of
!    GNAT_NODE.  */
! 
! static void
! annotate_decl_with_node (tree gnu_decl, Node_Id gnat_node)
! {
!   Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (gnu_decl));
! }
! 
! /* Given a type T, a FIELD_DECL F, and a replacement value R,
!    return a new type with all size expressions that contain F
!    updated by replacing F with R.  This is identical to GCC's
!    substitute_in_type except that it knows about TYPE_INDEX_TYPE.
!    If F is NULL_TREE, always make a new RECORD_TYPE, even if nothing has
!    changed.  */
  
  tree
--- 6161,6169 ----
  }
  
! /* Given a type T, a FIELD_DECL F, and a replacement value R, return a new type
!    with all size expressions that contain F updated by replacing F with R.
!    This is identical to GCC's substitute_in_type except that it knows about
!    TYPE_INDEX_TYPE.  If F is NULL_TREE, always make a new RECORD_TYPE, even if
!    nothing has changed.  */
  
  tree
*** gigi.h	26 Jun 2004 22:21:16 -0000	1.20.2.19
--- gigi.h	28 Jun 2004 04:00:43 -0000
*************** extern tree maybe_variable (tree);
*** 112,117 ****
  
  /* Create a record type that contains a field of TYPE with a starting bit
-    position so that it is aligned to ALIGN bits.  */
- /* Create a record type that contains a field of TYPE with a starting bit
     position so that it is aligned to ALIGN bits and is SIZE bytes long.  */
  extern tree make_aligning_type (tree, int, tree);
--- 112,115 ----
*************** extern GTY(()) tree gnat_raise_decls[(in
*** 368,379 ****
  extern int global_bindings_p (void);
  
- /* Returns the list of declarations in the current level. Note that this list
-    is in reverse order (it has to be so for back-end compatibility).  */
- extern tree getdecls (void);
- 
  /* Enter and exit a new binding level. */
  extern void gnat_pushlevel (void);
  extern void gnat_poplevel (void);
  
  /* Set the jmpbuf_decl for the current binding level to DECL.  */
  extern void set_block_jmpbuf_decl (tree);
--- 366,377 ----
  extern int global_bindings_p (void);
  
  /* Enter and exit a new binding level. */
  extern void gnat_pushlevel (void);
  extern void gnat_poplevel (void);
  
+ /* Set SUPERCONTEXT of the BLOCK for the current binding level to FNDECL
+    and point FNDECL to this BLOCK.  */
+ extern void set_current_block_context (tree);
+ 
  /* Set the jmpbuf_decl for the current binding level to DECL.  */
  extern void set_block_jmpbuf_decl (tree);
*************** extern tree get_block_jmpbuf_decl (void)
*** 387,399 ****
  extern void insert_block (tree);
  
! /* Return nonzero if the are any variables in the current block.  */
! extern int block_has_vars (void);
  
! /* Records a ..._DECL node DECL as belonging to the current lexical scope.
!    Returns the ..._DECL node. */
! extern tree pushdecl (tree);
! 
! /* Create the predefined scalar types such as `integer_type_node' needed
!    in the gcc back-end and initialize the global binding level.  */
  extern void gnat_init_decl_processing (void);
  extern void init_gigi_decls (tree, tree);
--- 385,393 ----
  extern void insert_block (tree);
  
! /* Records a ..._DECL node DECL as belonging to the current lexical scope
!    and uses GNAT_ENTITY for location information.  */
! extern void gnat_pushdecl (tree, Entity_Id);
  
! extern void gnat_init_stmt_group (void);
  extern void gnat_init_decl_processing (void);
  extern void init_gigi_decls (tree, tree);
*************** extern tree create_index_type (tree, tre
*** 477,482 ****
     ARTIFICIAL_P is nonzero if this is a declaration that was generated
     by the compiler.  DEBUG_INFO_P is nonzero if we need to write debugging
!    information about this type.  */
! extern tree create_type_decl (tree, tree, struct attrib *, int, int);
  
  /* Returns a GCC VAR_DECL node. VAR_NAME gives the name of the variable.
--- 471,477 ----
     ARTIFICIAL_P is nonzero if this is a declaration that was generated
     by the compiler.  DEBUG_INFO_P is nonzero if we need to write debugging
!    information about this type.  GNAT_NODE is used for the position of
!    the decl.  */
! extern tree create_type_decl (tree, tree, struct attrib *, int, int, Node_Id);
  
  /* Returns a GCC VAR_DECL node. VAR_NAME gives the name of the variable.
*************** extern tree create_type_decl (tree, tree
*** 493,499 ****
     definition: no storage is to be allocated for the variable here).
     STATIC_FLAG is only relevant when not at top level.  In that case
!    it indicates whether to always allocate storage to the variable.  */
  extern tree create_var_decl (tree, tree, tree, tree, int, int, int, int,
! 			     struct attrib *);
  
  /* Given a DECL and ATTR_LIST, apply the listed attributes.  */
--- 488,496 ----
     definition: no storage is to be allocated for the variable here).
     STATIC_FLAG is only relevant when not at top level.  In that case
!    it indicates whether to always allocate storage to the variable.
! 
!    GNAT_NODE is used for the position of the decl.  */
  extern tree create_var_decl (tree, tree, tree, tree, int, int, int, int,
! 			     struct attrib *, Node_Id);
  
  /* Given a DECL and ATTR_LIST, apply the listed attributes.  */
*************** extern tree create_param_decl (tree, tre
*** 543,550 ****
     PARM_DECL nodes chained through the TREE_CHAIN field).
  
!    INLINE_FLAG, PUBLIC_FLAG, and EXTERN_FLAG are used to set the appropriate
!    fields in the FUNCTION_DECL.  */
  extern tree create_subprog_decl (tree, tree, tree, tree, int, int, int,
! 				 struct attrib *);
  
  /* Returns a LABEL_DECL node for LABEL_NAME.  */
--- 540,547 ----
     PARM_DECL nodes chained through the TREE_CHAIN field).
  
!    INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, and ATTR_LIST are used to set the
!    appropriate fields in the FUNCTION_DECL.  GNAT_NODE gives the location.  */ 
  extern tree create_subprog_decl (tree, tree, tree, tree, int, int, int,
! 				 struct attrib *, Node_Id);
  
  /* Returns a LABEL_DECL node for LABEL_NAME.  */
*** misc.c	7 Jun 2004 22:59:18 -0000	1.44.2.39
--- misc.c	28 Jun 2004 04:00:47 -0000
*************** static void gnat_adjust_rli		(record_lay
*** 124,127 ****
--- 124,129 ----
  #undef LANG_HOOKS_HASH_TYPES
  #define LANG_HOOKS_HASH_TYPES		false
+ #undef LANG_HOOKS_CLEAR_BINDING_STACK
+ #define LANG_HOOKS_CLEAR_BINDING_STACK	lhd_do_nothing
  #undef LANG_HOOKS_PUSHLEVEL
  #define LANG_HOOKS_PUSHLEVEL		lhd_do_nothing_i
*************** static void gnat_adjust_rli		(record_lay
*** 130,133 ****
--- 132,139 ----
  #undef LANG_HOOKS_SET_BLOCK
  #define LANG_HOOKS_SET_BLOCK		lhd_do_nothing_t
+ #undef LANG_HOOKS_GETDECLS
+ #define LANG_HOOKS_GETDECLS		lhd_return_null_tree_v
+ #undef LANG_HOOKS_PUSHDECL
+ #define LANG_HOOKS_PUSHDECL		lhd_return_tree
  #undef LANG_HOOKS_FINISH_INCOMPLETE_DECL
  #define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl
*************** static bool
*** 393,396 ****
--- 399,405 ----
  gnat_init (void)
  {
+   /* Initialize translations and the outer statement group.  */
+   gnat_init_stmt_group ();
+ 
    /* Performs whatever initialization steps needed by the language-dependent
       lexical analyzer.  */
*** trans.c	26 Jun 2004 22:21:56 -0000	1.68.2.57
--- trans.c	28 Jun 2004 04:01:00 -0000
*************** struct stmt_group GTY((chain_next ("%h.p
*** 89,92 ****
--- 89,93 ----
  
  static GTY(()) struct stmt_group *current_stmt_group;
+ static struct stmt_group *global_stmt_group;
  
  /* List of unused struct stmt_group nodes.  */
*************** static GTY(()) tree gnu_loop_label_stack
*** 114,120 ****
  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;
  
  /* Map GNAT tree codes to GCC tree codes for simple expressions.  */
--- 115,120 ----
  static GTY(()) tree gnu_switch_label_stack;
  
! /* The FUNCTION_DECL for the elaboration procedure for the main unit.  */
! static GTY(()) tree gnu_elab_proc_decl;
  
  /* Map GNAT tree codes to GCC tree codes for simple expressions.  */
*************** static void insert_code_for (Node_Id);
*** 128,131 ****
--- 128,133 ----
  static void start_stmt_group (void);
  static void add_cleanup (tree);
+ static tree mark_visited (tree *, int *, void *);
+ static tree mark_unvisited (tree *, int *, void *);
  static tree end_stmt_group (void);
  static void add_stmt_list (List_Id);
*************** static tree pos_to_constructor (Node_Id,
*** 149,153 ****
  static tree maybe_implicit_deref (tree);
  static tree gnat_stabilize_reference_1 (tree, int);
! static int build_unit_elab (Entity_Id, int, tree);
  static void annotate_with_node (tree, Node_Id);
  
--- 151,155 ----
  static tree maybe_implicit_deref (tree);
  static tree gnat_stabilize_reference_1 (tree, int);
! static bool build_unit_elab (void);
  static void annotate_with_node (tree, Node_Id);
  
*************** static REAL_VALUE_TYPE dconstmp5;
*** 160,179 ****
  
  void
! gigi (Node_Id gnat_root,
!       int max_gnat_node,
!       int number_name,
!       struct Node *nodes_ptr,
!       Node_Id *next_node_ptr,
!       Node_Id *prev_node_ptr,
!       struct Elist_Header *elists_ptr,
!       struct Elmt_Item *elmts_ptr,
!       struct String_Entry *strings_ptr,
!       Char_Code *string_chars_ptr,
!       struct List_Header *list_headers_ptr,
!       Int number_units ATTRIBUTE_UNUSED,
!       char *file_info_ptr ATTRIBUTE_UNUSED,
!       Entity_Id standard_integer,
!       Entity_Id standard_long_long_float,
!       Entity_Id standard_exception_type,
        Int gigi_operating_mode)
  {
--- 162,172 ----
  
  void
! gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
!       struct Node *nodes_ptr, Node_Id *next_node_ptr, Node_Id *prev_node_ptr,
!       struct Elist_Header *elists_ptr, struct Elmt_Item *elmts_ptr,
!       struct String_Entry *strings_ptr, Char_Code *string_chars_ptr,
!       struct List_Header *list_headers_ptr, Int number_units ATTRIBUTE_UNUSED,
!       char *file_info_ptr ATTRIBUTE_UNUSED, Entity_Id standard_integer,
!       Entity_Id standard_long_long_float, Entity_Id standard_exception_type,
        Int gigi_operating_mode)
  {
*************** gigi (Node_Id gnat_root,
*** 194,197 ****
--- 187,194 ----
    type_annotate_only = (gigi_operating_mode == 1);
  
+   init_gnat_to_gnu ();
+   gnat_compute_largest_alignment ();
+   init_dummy_type ();
+ 
    /* If we are just annotating types, give VOID_TYPE zero sizes to avoid
       errors.  */
*************** gigi (Node_Id gnat_root,
*** 205,222 ****
      gigi_abort (301);
  
-   /* Initialize ourselves.  */
-   init_gnat_to_gnu ();
-   init_dummy_type ();
-   init_code_table ();
-   gnat_compute_largest_alignment ();
-   start_stmt_group ();
- 
-   /* Enable GNAT stack checking method if needed */
-   if (!Stack_Check_Probes_On_Target)
-     set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
- 
-   if (Exception_Mechanism == Front_End_ZCX)
-     abort ();
- 
    /* Save the type we made for integer as the type for Standard.Integer.
       Then make the rest of the standard types.  Note that some of these
--- 202,205 ----
*************** gigi (Node_Id gnat_root,
*** 227,233 ****
    gnu_except_ptr_stack = tree_cons (NULL_TREE, NULL_TREE, NULL_TREE);
  
-   REAL_ARITHMETIC (dconstp5, RDIV_EXPR, dconst1, dconst2);
-   REAL_ARITHMETIC (dconstmp5, RDIV_EXPR, dconstm1, dconst2);
- 
    gnu_standard_long_long_float
      = gnat_to_gnu_entity (Base_Type (standard_long_long_float), NULL_TREE, 0);
--- 210,213 ----
*************** gigi (Node_Id gnat_root,
*** 252,255 ****
--- 232,257 ----
  }
  
+ /* Perform initializations for this module.  */
+ 
+ void
+ gnat_init_stmt_group ()
+ {
+   /* Initialize ourselves.  */
+   init_code_table ();
+   start_stmt_group ();
+ 
+   global_stmt_group = current_stmt_group;
+ 
+   /* Enable GNAT stack checking method if needed */
+   if (!Stack_Check_Probes_On_Target)
+     set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
+ 
+   if (Exception_Mechanism == Front_End_ZCX)
+     abort ();
+ 
+   REAL_ARITHMETIC (dconstp5, RDIV_EXPR, dconst1, dconst2);
+   REAL_ARITHMETIC (dconstmp5, RDIV_EXPR, dconstm1, dconst2);
+ }
+ 
  /* This function is the driver of the GNAT to GCC tree transformation
     process.  It is the entry point of the tree transformer.  GNAT_NODE is the
*************** tree
*** 264,267 ****
--- 266,270 ----
  gnat_to_gnu (Node_Id gnat_node)
  {
+   bool went_into_elab_proc = false;
    tree gnu_result = error_mark_node; /* Default to no value. */
    tree gnu_result_type = void_type_node;
*************** gnat_to_gnu (Node_Id gnat_node)
*** 288,291 ****
--- 291,315 ----
  		   build_call_raise (CE_Range_Check_Failed));
  
+   /* If this is a Statement and we are at top level, it must be part of
+      the elaboration procedure, so mark us as being in that procedure
+      and push our context.  */
+   if (!current_function_decl
+       && ((IN (Nkind (gnat_node), N_Statement_Other_Than_Procedure_Call)
+ 	   && Nkind (gnat_node) != N_Null_Statement)
+ 	  || Nkind (gnat_node) == N_Procedure_Call_Statement
+ 	  || Nkind (gnat_node) == N_Label
+ 	  || Nkind (gnat_node) == N_Handled_Sequence_Of_Statements
+ 	  || ((Nkind (gnat_node) == N_Raise_Constraint_Error
+ 	       || Nkind (gnat_node) == N_Raise_Storage_Error
+ 	       || Nkind (gnat_node) == N_Raise_Program_Error)
+ 	      && (Ekind (Etype (gnat_node)) == E_Void))))
+     {
+       current_function_decl = gnu_elab_proc_decl;
+       start_stmt_group ();
+       gnat_pushlevel ();
+       went_into_elab_proc = true;
+     }
+ 
+ 
    switch (Nkind (gnat_node))
      {
*************** gnat_to_gnu (Node_Id gnat_node)
*** 722,733 ****
  	      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);
! 		  add_decl_expr (gnu_expr, gnat_temp);
! 		}
  	      else
  		gnu_expr = maybe_variable (gnu_expr);
--- 746,754 ----
  	      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, gnat_temp);
  	      else
  		gnu_expr = maybe_variable (gnu_expr);
*************** gnat_to_gnu (Node_Id gnat_node)
*** 996,1008 ****
  	   for Elaborated, since that variable isn't otherwise known.  */
  	if (attribute == Attr_Elab_Body || attribute == Attr_Elab_Spec)
! 	  {
! 	    gnu_prefix
! 	      = create_subprog_decl
! 		(create_concat_name (Entity (Prefix (gnat_node)),
! 				     attribute == Attr_Elab_Body
! 				     ? "elabb" : "elabs"),
! 		 NULL_TREE, void_ftype, NULL_TREE, 0, 1, 1, 0);
! 	    return gnu_prefix;
! 	  }
  
  	gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
--- 1017,1025 ----
  	   for Elaborated, since that variable isn't otherwise known.  */
  	if (attribute == Attr_Elab_Body || attribute == Attr_Elab_Spec)
! 	  return (create_subprog_decl
! 		  (create_concat_name (Entity (Prefix (gnat_node)),
! 				       attribute == Attr_Elab_Body
! 				       ? "elabb" : "elabs"),
! 		   NULL_TREE, void_ftype, NULL_TREE, 0, 1, 1, 0, gnat_node));
  
  	gnu_prefix = gnat_to_gnu (Prefix (gnat_node));
*************** gnat_to_gnu (Node_Id gnat_node)
*** 2273,2276 ****
--- 2290,2294 ----
  	    COND_EXPR_THEN (gnu_cond_expr) = gnu_loop_stmt;
  	    gnu_result = gnu_cond_expr;
+ 	    recalculate_side_effects (gnu_cond_expr);
  	  }
  	else
*************** gnat_to_gnu (Node_Id gnat_node)
*** 2490,2501 ****
  	gnu_subprog_type = TREE_TYPE (gnu_subprog_decl);
  
- 	/* We handle pending sizes via the elaboration of types, so we don't
- 	   need to save them.  This causes them to be marked as part of the
- 	   outer function and then discarded.  */
- 	get_pending_sizes ();
- 
- 	/* ??? Temporarily do this to avoid GC throwing away outer stuff.  */
- 	ggc_push_context ();
- 
  	/* Set the line number in the decl to correspond to that of
  	   the body so that the line number notes are written
--- 2508,2511 ----
*************** gnat_to_gnu (Node_Id gnat_node)
*** 2504,2518 ****
  		       &DECL_SOURCE_LOCATION (gnu_subprog_decl));
  
! 	current_function_decl = gnu_subprog_decl;
! 	announce_function (gnu_subprog_decl);
  
- 	/* Enter a new binding level and show that all the parameters belong to
- 	   this function.  */
- 	gnat_pushlevel ();
- 	for (gnu_expr = DECL_ARGUMENTS (gnu_subprog_decl); gnu_expr;
- 	     gnu_expr = TREE_CHAIN (gnu_expr))
- 	  DECL_CONTEXT (gnu_expr) = gnu_subprog_decl;
- 	
- 	make_decl_rtl (gnu_subprog_decl, NULL);
  	gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
  
--- 2514,2519 ----
  		       &DECL_SOURCE_LOCATION (gnu_subprog_decl));
  
! 	begin_subprog_body (gnu_subprog_decl);
  
  	gnu_cico_list = TYPE_CI_CO_LIST (gnu_subprog_type);
  
*************** gnat_to_gnu (Node_Id gnat_node)
*** 2596,2601 ****
  
  	pop_stack (&gnu_return_label_stack);
- 	if (!type_annotate_only)
- 	  add_decl_expr (current_function_decl, gnat_node);
  
  	/* Initialize the information node for the function and set the
--- 2597,2600 ----
*************** gnat_to_gnu (Node_Id gnat_node)
*** 2622,2626 ****
  	write_symbols = save_write_symbols;
  	debug_hooks = save_debug_hooks;
- 	ggc_pop_context ();
  	gnu_result = alloc_stmt_list ();
        }
--- 2621,2624 ----
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3152,3156 ****
      case N_Compilation_Unit:
  
!       start_stmt_group ();
  
        /* For a body, first process the spec if there is one. */
--- 3150,3176 ----
      case N_Compilation_Unit:
  
!       /* If this is the main unit, make the decl for the elaboration
! 	 procedure.  Otherwise, push a statement group for this nested
! 	 compilation unit.  */
!       if (gnat_node == Cunit (Main_Unit))
! 	{
! 	  bool body_p = (Defining_Entity (Unit (gnat_node)),
! 			 Nkind (Unit (gnat_node)) == N_Package_Body
! 			 || Nkind (Unit (gnat_node)) == N_Subprogram_Body);
! 	  Entity_Id gnat_unit_entity = Defining_Entity (Unit (gnat_node));
! 
! 	  gnu_elab_proc_decl
! 	    = create_subprog_decl
! 	      (create_concat_name (gnat_unit_entity,
! 				   body_p ? "elabb" : "elabs"),
! 	       NULL_TREE, void_ftype, NULL_TREE, 0, 1, 0, 0, gnat_unit_entity);
! 
! 	  DECL_ELABORATION_PROC_P (gnu_elab_proc_decl) = 1;
! 	  allocate_struct_function (gnu_elab_proc_decl);
! 	  Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
! 	  cfun = 0;
! 	}
!       else
! 	start_stmt_group ();
  
        /* For a body, first process the spec if there is one. */
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3170,3174 ****
  	      || Nkind (Unit (gnat_node)) == N_Generic_Subprogram_Declaration)
  	    {
! 	      gnu_result = end_stmt_group ();
  	      break;
  	    }
--- 3190,3194 ----
  	      || Nkind (Unit (gnat_node)) == N_Generic_Subprogram_Declaration)
  	    {
! 	      gnu_result = alloc_stmt_list ();
  	      break;
  	    }
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3183,3197 ****
        add_stmt_list (Actions (Aux_Decls_Node (gnat_node)));
        
!       /* Generate elaboration code for this unit, if necessary, and
! 	 say whether we did or not.  */
!       Set_Has_No_Elaboration_Code
! 	(gnat_node,
! 	 build_unit_elab
! 	 (Defining_Entity (Unit (gnat_node)),
! 	  Nkind (Unit (gnat_node)) == N_Package_Body
! 	  || Nkind (Unit (gnat_node)) == N_Subprogram_Body,
! 	  get_pending_elaborations ()));
! 
!       gnu_result = end_stmt_group ();
        break;
  
--- 3203,3219 ----
        add_stmt_list (Actions (Aux_Decls_Node (gnat_node)));
        
!       /* If this is the main unit, generate elaboration code for this
! 	 unit, if necessary, and say whether we did or not.  Otherwise,
! 	 there is no elaboration code and we end our statement group. */
!       if (gnat_node == Cunit (Main_Unit))
! 	{
! 	  Set_Has_No_Elaboration_Code (gnat_node, build_unit_elab ());
! 	  gnu_result = alloc_stmt_list ();
! 	}
!       else
! 	{
! 	  Set_Has_No_Elaboration_Code (gnat_node, 1);
! 	  gnu_result = end_stmt_group ();
! 	}
        break;
  
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3259,3264 ****
  	bool at_end = !type_annotate_only && Present (At_End_Proc (gnat_node));
  	bool binding_for_block = (at_end || gcc_zcx || setjmp_longjmp);
! 	/* The statement(s) for the block itself.  */
! 	tree gnu_inner_block;
  
  	/* If there are any exceptions or cleanup processing involved, we need
--- 3281,3285 ----
  	bool at_end = !type_annotate_only && Present (At_End_Proc (gnat_node));
  	bool binding_for_block = (at_end || gcc_zcx || setjmp_longjmp);
! 	tree gnu_inner_block; /* The statement(s) for the block itself.  */
  
  	/* If there are any exceptions or cleanup processing involved, we need
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3286,3297 ****
  				 jmpbuf_ptr_type,
  				 build_call_0_expr (get_jmpbuf_decl),
! 				 0, 0, 0, 0, 0);
  	    gnu_jmpbuf_decl
  	      = create_var_decl (get_identifier ("JMP_BUF"),
  				 NULL_TREE, jmpbuf_type,
! 				 NULL_TREE, 0, 0, 0, 0, 0);
  
- 	    add_decl_expr (gnu_jmpsave_decl, gnat_node);
- 	    add_decl_expr (gnu_jmpbuf_decl, gnat_node);
  	    set_block_jmpbuf_decl (gnu_jmpbuf_decl);
  
--- 3307,3316 ----
  				 jmpbuf_ptr_type,
  				 build_call_0_expr (get_jmpbuf_decl),
! 				 0, 0, 0, 0, 0, gnat_node);
  	    gnu_jmpbuf_decl
  	      = create_var_decl (get_identifier ("JMP_BUF"),
  				 NULL_TREE, jmpbuf_type,
! 				 NULL_TREE, 0, 0, 0, 0, 0, gnat_node);
  
  	    set_block_jmpbuf_decl (gnu_jmpbuf_decl);
  
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3341,3346 ****
  					 build_pointer_type (except_type_node),
  					 build_call_0_expr (get_excptr_decl),
! 					 0, 0, 0, 0, 0));
! 	    add_decl_expr (TREE_VALUE (gnu_except_ptr_stack), gnat_node);
  
  	    /* Generate code for each handler. The N_Exception_Handler case
--- 3360,3364 ----
  					 build_pointer_type (except_type_node),
  					 build_call_0_expr (get_excptr_decl),
! 					 0, 0, 0, 0, 0, gnat_node));
  
  	    /* Generate code for each handler. The N_Exception_Handler case
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3603,3609 ****
  	    = create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
  			       ptr_type_node, gnu_current_exc_ptr,
! 			       0, 0, 0, 0, 0);
  
- 	  add_decl_expr (gnu_incoming_exc_ptr, gnat_node);
  	  add_stmt_with_node (build_call_1_expr (begin_handler_decl,
  						 gnu_incoming_exc_ptr),
--- 3621,3626 ----
  	    = create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
  			       ptr_type_node, gnu_current_exc_ptr,
! 			       0, 0, 0, 0, 0, gnat_node);
  
  	  add_stmt_with_node (build_call_1_expr (begin_handler_decl,
  						 gnu_incoming_exc_ptr),
*************** gnat_to_gnu (Node_Id gnat_node)
*** 3864,3867 ****
--- 3881,3894 ----
      }
  
+   /* If we pushed our level as part of processing the elaboration routine,
+      pop it back now.  */
+   if (went_into_elab_proc)
+     {
+       add_stmt (gnu_result);
+       gnat_poplevel ();
+       gnu_result = end_stmt_group ();
+       current_function_decl = NULL_TREE;
+     }
+ 
    /* Set the location information into the result.  If we're supposed to
       return something of void_type, it means we have something we're
*************** add_stmt (tree gnu_stmt)
*** 4031,4056 ****
    append_to_statement_list (gnu_stmt, &current_stmt_group->stmt_list);
  
!   /* If this is a DECL_EXPR for a variable with DECL_INITIAL set
!      and decl has a padded type, convert it to the unpadded type so the
!      assignment is done properly.  In other case, the gimplification
!      of the DECL_EXPR will deal with DECL_INITIAL.  */
!   if (TREE_CODE (gnu_stmt) == DECL_EXPR
!       && TREE_CODE (DECL_EXPR_DECL (gnu_stmt)) == VAR_DECL
!       && DECL_INITIAL (DECL_EXPR_DECL (gnu_stmt))
!       && TREE_CODE (TREE_TYPE (DECL_EXPR_DECL (gnu_stmt))) == RECORD_TYPE
!       && TYPE_IS_PADDING_P (TREE_TYPE (DECL_EXPR_DECL (gnu_stmt))))
!     {
!       tree gnu_decl = DECL_EXPR_DECL (gnu_stmt);
!       tree gnu_lhs
! 	= convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_decl))), gnu_decl);
!       tree gnu_assign_stmt
! 	= build_binary_op (MODIFY_EXPR, NULL_TREE,
! 			   gnu_lhs, DECL_INITIAL (gnu_decl));
! 
!       DECL_INITIAL (gnu_decl) = 0;
! 
!       annotate_with_locus (gnu_assign_stmt, DECL_SOURCE_LOCATION (gnu_decl));
!       add_stmt (gnu_assign_stmt);
!     }
  }
  
--- 4058,4065 ----
    append_to_statement_list (gnu_stmt, &current_stmt_group->stmt_list);
  
!   /* If we're at top level, show everything in here is in use in case
!      any of it is shared by a subprogram.  */
!   if (!current_function_decl)
!     walk_tree (&gnu_stmt, mark_visited, NULL, NULL);
  }
  
*************** void
*** 4071,4074 ****
--- 4080,4085 ----
  add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
  {
+   struct stmt_group *save_stmt_group = current_stmt_group;
+ 
    /* 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
*************** add_decl_expr (tree gnu_decl, Entity_Id 
*** 4080,4085 ****
--- 4091,4164 ----
      return;
  
+   if (global_bindings_p ())
+     current_stmt_group = global_stmt_group;
+ 
    add_stmt_with_node (build (DECL_EXPR, void_type_node, gnu_decl),
  		      gnat_entity);
+ 
+   if (global_bindings_p ())
+     current_stmt_group = save_stmt_group;
+ 
+   /* If this is a DECL_EXPR for a variable with DECL_INITIAl set,
+      there are two cases we need to handle here.  */
+   if (TREE_CODE (gnu_decl) == VAR_DECL && DECL_INITIAL (gnu_decl))
+     {
+       tree gnu_init = DECL_INITIAL (gnu_decl);
+       tree gnu_lhs = NULL_TREE;
+ 
+       /* If this is a DECL_EXPR for a variable with DECL_INITIAL set
+ 	 and decl has a padded type, convert it to the unpadded type so the
+ 	 assignment is done properly.  */
+       if (TREE_CODE (TREE_TYPE (gnu_decl)) == RECORD_TYPE
+ 	  && TYPE_IS_PADDING_P (TREE_TYPE (gnu_decl)))
+ 	gnu_lhs
+ 	  = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_decl))), gnu_decl);
+ 
+       /* Otherwise, if this is going into memory and the initializer isn't
+ 	 valid for the assembler and loader.  Gimplification could do this,
+ 	 but would be run too late if -fno-unit-at-a-time.  */
+       else if (TREE_STATIC (gnu_decl)
+ 	       && !initializer_constant_valid_p (gnu_init,
+ 						 TREE_TYPE (gnu_decl)))
+ 	gnu_lhs = gnu_decl;
+ 
+       if (gnu_lhs)
+ 	{
+ 	  tree gnu_assign_stmt
+ 	    = build_binary_op (MODIFY_EXPR, NULL_TREE,
+ 			       gnu_lhs, DECL_INITIAL (gnu_decl));
+ 	  
+ 	  DECL_INITIAL (gnu_decl) = 0;
+ 	  annotate_with_locus (gnu_assign_stmt,
+ 			       DECL_SOURCE_LOCATION (gnu_decl));
+ 	  add_stmt (gnu_assign_stmt);
+ 	}
+     }
+ }
+ 
+ /* 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;
+ }
+ 
+ /* Likewise, but to mark as unvisited.  */
+ 
+ static tree
+ mark_unvisited (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED,
+ 		void *data ATTRIBUTE_UNUSED)
+ {
+   TREE_VISITED (*tp) = 0;
+ 
+   return NULL_TREE;
  }
  
*************** process_type (Entity_Id gnat_entity)
*** 5084,5088 ****
  	  tree gnu_decl = create_type_decl (get_entity_name (gnat_entity),
  					    make_dummy_type (gnat_entity),
! 					    0, 0, 0);
p  
  	  save_gnu_tree (gnat_entity, gnu_decl, 0);
--- 5163,5167 ----
  	  tree gnu_decl = create_type_decl (get_entity_name (gnat_entity),
  					    make_dummy_type (gnat_entity),
! 					    0, 0, 0, gnat_entity);
  
  	  save_gnu_tree (gnat_entity, gnu_decl, 0);
*************** gnat_stabilize_reference_1 (tree e, int 
*** 5512,5602 ****
  }
  
! /* GNAT_UNIT is the Defining_Identifier for some package or subprogram,
!    either a spec or a body, BODY_P says which.  If needed, make a function
!    to be the elaboration routine for that object and perform the elaborations
!    in GNU_ELAB_LIST.
  
!    Return 1 if we didn't need an elaboration function, zero otherwise.  */
  
! static int
! build_unit_elab (Entity_Id gnat_unit, int body_p, tree gnu_elab_list)
  {
!   tree gnu_decl;
!   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;
! 
!   /* Prevent the elaboration list from being reclaimed by the GC.  */
!   gnu_pending_elaboration_lists = chainon (gnu_pending_elaboration_lists,
! 					   gnu_elab_list);
! 
!   /* Set our file and line number to that of the object and set up the
!      elaboration routine.  */
!   gnu_decl = create_subprog_decl (create_concat_name (gnat_unit,
! 						      body_p ?
! 						      "elabb" : "elabs"),
! 				  NULL_TREE, void_ftype, NULL_TREE, 0, 1, 0,
! 				  0);
!   DECL_ELABORATION_PROC_P (gnu_decl) = 1;
! 
!   begin_subprog_body (gnu_decl);
!   gnat_pushlevel ();
!   expand_start_bindings (0);
! 
!   /* Emit the assignments for the elaborations we have to do.  If there
!      is no destination, this is just a call to execute some statement
!      that was placed within the declarative region.   But first save a
!      pointer so we can see if any insns were generated.  */
  
!   insn = get_last_insn ();
! 
!   for (; gnu_elab_list; gnu_elab_list = TREE_CHAIN (gnu_elab_list))
!     if (TREE_PURPOSE (gnu_elab_list) == NULL_TREE)
!       {
! 	if (TREE_VALUE (gnu_elab_list) != 0)
! 	  expand_expr_stmt (TREE_VALUE (gnu_elab_list));
!       }
!     else
!       {
! 	tree lhs = TREE_PURPOSE (gnu_elab_list);
! 
! 	input_location = DECL_SOURCE_LOCATION (lhs);
! 
! 	/* If LHS has a padded type, convert it to the unpadded type
! 	   so the assignment is done properly.  */
! 	if (TREE_CODE (TREE_TYPE (lhs)) == RECORD_TYPE
! 	    && TYPE_IS_PADDING_P (TREE_TYPE (lhs)))
! 	  lhs = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (lhs))), lhs);
! 
! 	emit_line_note (input_location);
! 	expand_expr_stmt (build_binary_op (MODIFY_EXPR, NULL_TREE,
! 					   TREE_PURPOSE (gnu_elab_list),
! 					   TREE_VALUE (gnu_elab_list)));
!       }
! 
!   /* See if any non-NOTE insns were generated.  */
!   for (insn = NEXT_INSN (insn); insn; insn = NEXT_INSN (insn))
!     if (GET_RTX_CLASS (GET_CODE (insn)) == RTX_INSN)
!       {
! 	result = 0;
! 	break;
!       }
! 
!   expand_end_bindings (NULL_TREE, block_has_vars (), -1);
    gnat_poplevel ();
!   end_subprog_body (alloc_stmt_list ());
! 
!   /* We are finished with the elaboration list it can now be discarded.  */
!   gnu_pending_elaboration_lists = TREE_CHAIN (gnu_pending_elaboration_lists);
  
!   /* If there were no insns, we don't need an elab routine.  It would
!      be nice to not output this one, but there's no good way to do that.  */
!   return result;
  }
  
--- 5591,5631 ----
  }
  
! /* Take care of building the elaboration procedure for the main unit.
  
!    Return true if we didn't need an elaboration function, false otherwise.  */
  
! static bool
! build_unit_elab ()
  {
!   tree body, stmts;
  
!   /* Mark everything we have as not visited.  */
!   walk_tree_without_duplicates (&current_stmt_group->stmt_list,
! 				mark_unvisited, NULL);
! 
!   /* Set the current function to be the elaboration procedure, pop our
!      binding level, end our statement group, and gimplify what we have.  */
!   set_current_block_context (gnu_elab_proc_decl);
    gnat_poplevel ();
!   body = end_stmt_group ();
!   current_function_decl = gnu_elab_proc_decl;
!   gimplify_body (&body, gnu_elab_proc_decl);
! 
!   /* We should have a BIND_EXPR, but it may or may not have any statements
!      in it.  If it doesn't have any, we have nothing to do.  */
!   stmts = body;
!   if (TREE_CODE (stmts) == BIND_EXPR)
!     stmts = BIND_EXPR_BODY (stmts);
! 
!   /* If there are no statements, we have nothing to do.  */
!   if (!stmts || !STATEMENT_LIST_HEAD (stmts))
!     return true;
! 
!   /* Otherwise, compile the function.  Note that we'll be gimplifying
!      it twice, but that's fine for the nodes we use.  */
!   begin_subprog_body (gnu_elab_proc_decl);
!   end_subprog_body (body);
  
!   return false;
  }
  
*** utils.c	26 Jun 2004 22:22:32 -0000	1.48.2.53
--- utils.c	28 Jun 2004 04:01:01 -0000
*************** tree gnat_raise_decls[(int) LAST_REASON_
*** 80,98 ****
  static GTY((length ("max_gnat_nodes"))) tree *associate_gnat_to_gnu;
  
- /* This listhead is used to record any global objects that need elaboration.
-    TREE_PURPOSE is the variable to be elaborated and TREE_VALUE is the
-    initial value to assign.  */
- 
- static GTY(()) tree pending_elaborations;
- 
- /* This stack allows us to momentarily switch to generating elaboration
-    lists for an inner context.  */
- 
- struct e_stack GTY((chain_next ("%h.next"))) {
-   struct e_stack *next;
-   tree elab_list;
- };
- static GTY(()) struct e_stack *elist_stack;
- 
  /* This variable keeps a table for types for each precision so that we only
     allocate each of them once. Signed and unsigned types are kept separate.
--- 80,83 ----
*************** static GTY(()) tree float_types[NUM_MACH
*** 109,116 ****
     the binding depth.  */
  
! struct ada_binding_level GTY((chain_next ("%h.chain")))
  {
    /* The binding level containing this one (the enclosing binding level). */
!   struct ada_binding_level *chain;
    /* The BLOCK node for this level.  */
    tree block;
--- 94,101 ----
     the binding depth.  */
  
! struct gnat_binding_level GTY((chain_next ("%h.chain")))
  {
    /* The binding level containing this one (the enclosing binding level). */
!   struct gnat_binding_level *chain;
    /* The BLOCK node for this level.  */
    tree block;
*************** struct ada_binding_level GTY((chain_next
*** 121,128 ****
  
  /* The binding level currently in effect.  */
! static GTY(()) struct ada_binding_level *current_binding_level;
  
! /* A chain of ada_binding_level structures awaiting reuse.  */
! static GTY((deletable)) struct ada_binding_level *free_binding_level;
  
  /* A chain of unused BLOCK nodes. */
--- 106,113 ----
  
  /* The binding level currently in effect.  */
! static GTY(()) struct gnat_binding_level *current_binding_level;
  
! /* A chain of gnat_binding_level structures awaiting reuse.  */
! static GTY((deletable)) struct gnat_binding_level *free_binding_level;
  
  /* A chain of unused BLOCK nodes. */
*************** struct language_function GTY(())
*** 134,144 ****
  };
  
- 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);
  static tree compute_related_constant (tree, tree);
  static tree split_plus (tree, tree *);
! static int value_zerop (tree);
  static void gnat_gimplify_function (tree);
  static void gnat_finalize (tree);
--- 119,128 ----
  };
  
  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, bool, bool);
  static tree compute_related_constant (tree, tree);
  static tree split_plus (tree, tree *);
! static bool value_zerop (tree);
  static void gnat_gimplify_function (tree);
  static void gnat_finalize (tree);
*************** static tree convert_to_fat_pointer (tree
*** 147,152 ****
  static tree convert_to_thin_pointer (tree, tree);
  static tree make_descriptor_field (const char *,tree, tree, tree);
! static int value_factor_p (tree, int);
! static int potential_alignment_gap (tree, tree, tree);
  
  /* Initialize the association of GNAT nodes to GCC trees.  */
--- 131,136 ----
  static tree convert_to_thin_pointer (tree, tree);
  static tree make_descriptor_field (const char *,tree, tree, tree);
! static bool value_factor_p (tree, HOST_WIDE_INT);
! static bool potential_alignment_gap (tree, tree, tree);
  
  /* Initialize the association of GNAT nodes to GCC trees.  */
*************** init_gnat_to_gnu (void)
*** 157,162 ****
    associate_gnat_to_gnu
      = (tree *) ggc_alloc_cleared (max_gnat_nodes * sizeof (tree));
- 
-   pending_elaborations = build_tree_list (NULL_TREE, NULL_TREE);
  }
  
--- 141,144 ----
*************** int
*** 212,225 ****
  global_bindings_p (void)
  {
!   return (force_global != 0 || current_binding_level->chain == 0 ? -1 : 0);
! }
! 
! /* Return the list of declarations in the current level. Note that this list
!    is in reverse order (it has to be so for back-end compatibility).  */
! 
! tree
! getdecls (void)
! {
!   return BLOCK_VARS (current_binding_level->block);
  }
  
--- 194,199 ----
  global_bindings_p (void)
  {
!   return (force_global != 0 || current_binding_level == 0
! 	  || current_binding_level->chain == 0 ? -1 : 0);
  }
  
*************** void
*** 229,233 ****
  gnat_pushlevel ()
  {
!   struct ada_binding_level *newlevel = NULL;
  
    /* Reuse a struct for this binding level, if there is one.  */
--- 203,207 ----
  gnat_pushlevel ()
  {
!   struct gnat_binding_level *newlevel = NULL;
  
    /* Reuse a struct for this binding level, if there is one.  */
*************** gnat_pushlevel ()
*** 239,244 ****
    else
      newlevel
!       = (struct ada_binding_level *)
! 	ggc_alloc (sizeof (struct ada_binding_level));
  
    /* Use a free BLOCK, if any; otherwise, allocate one.  */
--- 213,218 ----
    else
      newlevel
!       = (struct gnat_binding_level *)
! 	ggc_alloc (sizeof (struct gnat_binding_level));
  
    /* Use a free BLOCK, if any; otherwise, allocate one.  */
*************** gnat_pushlevel ()
*** 265,268 ****
--- 239,252 ----
  }
  
+ /* Set SUPERCONTEXT of the BLOCK for the current binding level to FNDECL
+    and point FNDECL to this BLOCK.  */
+ 
+ void
+ set_current_block_context (tree fndecl)
+ {
+   BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
+   DECL_INITIAL (fndecl) = current_binding_level->block;
+ }
+ 
  /* Set the jmpbuf_decl for the current binding level to DECL.  */
  
*************** void
*** 286,290 ****
  gnat_poplevel ()
  {
!   struct ada_binding_level *level = current_binding_level;
    tree block = level->block;
  
--- 270,274 ----
  gnat_poplevel ()
  {
!   struct gnat_binding_level *level = current_binding_level;
    tree block = level->block;
  
*************** insert_block (tree block)
*** 330,386 ****
    BLOCK_SUBBLOCKS (current_binding_level->block) = block;
  }
- 
- /* Return nonzero if the current binding has any variables.  This means
-    it will have a BLOCK node.  */
- 
- int
- block_has_vars ()
- {
-   return BLOCK_VARS (current_binding_level->block) != 0;
- }
- 
- /* 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;
- }
  
! /* Records a ..._DECL node DECL as belonging to the current lexical scope.
!    Returns the ..._DECL node. */
  
! tree
! pushdecl (tree decl)
  {
    /* If at top level, there is no context. But PARM_DECLs always go in the
!      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)
!     {
!       /* Make a DECL_EXPR so we'll walk into the appropriate fields of
! 	 the type or decl.  */
!       tree decl_expr = build1 (DECL_EXPR, void_type_node, decl);
! 
!       DECL_CONTEXT (decl) = 0;
!       walk_tree (&decl_expr, mark_visited, NULL, NULL);
!     }
    else
      DECL_CONTEXT (decl) = current_function_decl;
  
!   /* Put the declaration on the list.  The list of declarations is in reverse
!      order. The list will be reversed later.
  
!      Don't put TYPE_DECLs for UNCONSTRAINED_ARRAY_TYPE into the list.  They
!      will cause trouble with the debugger and aren't needed anyway.  */
!   if (TREE_CODE (decl) != TYPE_DECL
!       || TREE_CODE (TREE_TYPE (decl)) != UNCONSTRAINED_ARRAY_TYPE)
      {
        TREE_CHAIN (decl) = BLOCK_VARS (current_binding_level->block);
--- 314,344 ----
    BLOCK_SUBBLOCKS (current_binding_level->block) = block;
  }
  
! /* Records a ..._DECL node DECL as belonging to the current lexical scope
!    and uses GNAT_NODE for location information.  */
  
! void
! gnat_pushdecl (tree decl, Node_Id gnat_node)
  {
    /* If at top level, there is no context. But PARM_DECLs always go in the
!      level of its function.  */
    if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL)
!     DECL_CONTEXT (decl) = 0;
    else
      DECL_CONTEXT (decl) = current_function_decl;
  
!   /* Set the location of DECL and emit a declaration for it.  */
!   if (Present (gnat_node))
!     Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (decl));
!   add_decl_expr (decl, gnat_node);
  
!   /* Put the declaration on the list.  The list of declarations is in reverse
!      order. The list will be reversed later.  We don't do this for global
!      variables.  Also, don't put TYPE_DECLs for UNCONSTRAINED_ARRAY_TYPE into
!      the list.  They will cause trouble with the debugger and aren't needed
!      anyway.  */
!   if (!global_bindings_p ()
!       && (TREE_CODE (decl) != TYPE_DECL
! 	  || TREE_CODE (TREE_TYPE (decl)) != UNCONSTRAINED_ARRAY_TYPE))
      {
        TREE_CHAIN (decl) = BLOCK_VARS (current_binding_level->block);
*************** pushdecl (tree decl)
*** 405,410 ****
  	      && ! DECL_ARTIFICIAL (decl))))
      TYPE_NAME (TREE_TYPE (decl)) = decl;
! 
!   return decl;
  }
  
--- 363,369 ----
  	      && ! DECL_ARTIFICIAL (decl))))
      TYPE_NAME (TREE_TYPE (decl)) = decl;
!   
!   if (TREE_CODE (decl) != CONST_DECL)
!     rest_of_decl_compilation (decl, NULL, global_bindings_p (), 0);
  }
  
*************** gnat_init_decl_processing (void)
*** 434,445 ****
    build_common_tree_nodes_2 (0);
  
!   pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype));
! 
!   /* We need to make the integer type before doing anything else.
!      We stitch this in to the appropriate GNAT type later.  */
!   pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
! 			integer_type_node));
!   pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
! 			char_type_node));
  
    ptr_void_type_node = build_pointer_type (void_type_node);
--- 393,411 ----
    build_common_tree_nodes_2 (0);
  
!   /* Give names and make TYPE_DECLs for common types.  */
!   gnat_pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype),
! 		 Empty);
!   gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
! 			     integer_type_node),
! 		 Empty);
!   gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
! 			     char_type_node),
! 		 Empty);
!   gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("long integer"),
! 			     long_integer_type_node),
! 		 Empty);
!   gnat_pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
! 			     void_type_node),
! 		 Empty);
  
    ptr_void_type_node = build_pointer_type (void_type_node);
*************** gnat_define_builtin (const char *name, t
*** 463,467 ****
      SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
    make_decl_rtl (decl, NULL);
!   pushdecl (decl);
    DECL_BUILT_IN_CLASS (decl) = BUILT_IN_NORMAL;
    DECL_FUNCTION_CODE (decl) = function_code;
--- 429,433 ----
      SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
    make_decl_rtl (decl, NULL);
!   gnat_pushdecl (decl, Empty);
    DECL_BUILT_IN_CLASS (decl) = BUILT_IN_NORMAL;
    DECL_FUNCTION_CODE (decl) = function_code;
*************** gnat_install_builtins ()
*** 541,545 ****
  }
  
- 
  /* Create the predefined scalar types such as `integer_type_node' needed
     in the gcc back-end and initialize the global binding level.  */
--- 507,510 ----
*************** init_gigi_decls (tree long_long_float_ty
*** 561,566 ****
        TYPE_PRECISION (longest_float_type_node) = LONG_DOUBLE_TYPE_SIZE;
        layout_type (longest_float_type_node);
!       pushdecl (build_decl (TYPE_DECL, get_identifier ("longest float type"),
! 			    longest_float_type_node));
      }
    else
--- 526,531 ----
        TYPE_PRECISION (longest_float_type_node) = LONG_DOUBLE_TYPE_SIZE;
        layout_type (longest_float_type_node);
!       create_type_decl (get_identifier ("longest float type"),
! 			longest_float_type_node, NULL, 0, 1, Empty);
      }
    else
*************** init_gigi_decls (tree long_long_float_ty
*** 570,579 ****
  
    unsigned_type_node = gnat_type_for_size (INT_TYPE_SIZE, 1);
!   pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned int"),
! 			unsigned_type_node));
  
!   void_type_decl_node
!     = pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
! 			    void_type_node));
  
    void_ftype = build_function_type (void_type_node, NULL_TREE);
--- 535,543 ----
  
    unsigned_type_node = gnat_type_for_size (INT_TYPE_SIZE, 1);
!   create_type_decl (get_identifier ("unsigned int"), unsigned_type_node,
! 		    NULL, 0, 1, Empty);
  
!   void_type_decl_node = create_type_decl (get_identifier ("void"),
! 					  void_type_node, NULL, 0, 1, Empty);
  
    void_ftype = build_function_type (void_type_node, NULL_TREE);
*************** init_gigi_decls (tree long_long_float_ty
*** 591,595 ****
  								     sizetype,
  								     endlink)),
! 				     NULL_TREE, 0, 1, 1, 0);
  
    /* free is a function declaration tree for a function to free memory.  */
--- 555,559 ----
  								     sizetype,
  								     endlink)),
! 				     NULL_TREE, 0, 1, 1, 0, Empty);
  
    /* free is a function declaration tree for a function to free memory.  */
*************** init_gigi_decls (tree long_long_float_ty
*** 600,604 ****
  							   ptr_void_type_node,
  							   endlink)),
! 			   NULL_TREE, 0, 1, 1, 0);
  
    /* Make the types and functions used for exception processing.    */
--- 564,568 ----
  							   ptr_void_type_node,
  							   endlink)),
! 			   NULL_TREE, 0, 1, 1, 0, Empty);
  
    /* Make the types and functions used for exception processing.    */
*************** init_gigi_decls (tree long_long_float_ty
*** 606,610 ****
      = build_array_type (gnat_type_for_mode (Pmode, 0),
  			build_index_type (build_int_2 (5, 0)));
!   pushdecl (build_decl (TYPE_DECL, get_identifier ("JMPBUF_T"), jmpbuf_type));
    jmpbuf_ptr_type = build_pointer_type (jmpbuf_type);
  
--- 570,575 ----
      = build_array_type (gnat_type_for_mode (Pmode, 0),
  			build_index_type (build_int_2 (5, 0)));
!   create_type_decl (get_identifier ("JMPBUF_T"), jmpbuf_type, NULL,
! 		    0, 1, Empty);
    jmpbuf_ptr_type = build_pointer_type (jmpbuf_type);
  
*************** init_gigi_decls (tree long_long_float_ty
*** 614,618 ****
      (get_identifier ("system__soft_links__get_jmpbuf_address_soft"),
       NULL_TREE, build_function_type (jmpbuf_ptr_type, NULL_TREE),
!      NULL_TREE, 0, 1, 1, 0);
  
    set_jmpbuf_decl
--- 579,583 ----
      (get_identifier ("system__soft_links__get_jmpbuf_address_soft"),
       NULL_TREE, build_function_type (jmpbuf_ptr_type, NULL_TREE),
!      NULL_TREE, 0, 1, 1, 0, Empty);
  
    set_jmpbuf_decl
*************** init_gigi_decls (tree long_long_float_ty
*** 622,626 ****
       build_function_type (void_type_node,
  			  tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)),
!      NULL_TREE, 0, 1, 1, 0);
  
    /* Function to get the current exception.  */
--- 587,591 ----
       build_function_type (void_type_node,
  			  tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)),
!      NULL_TREE, 0, 1, 1, 0, Empty);
  
    /* Function to get the current exception.  */
*************** init_gigi_decls (tree long_long_float_ty
*** 630,634 ****
       NULL_TREE,
       build_function_type (build_pointer_type (except_type_node), NULL_TREE),
!      NULL_TREE, 0, 1, 1, 0);
  
    /* Functions that raise exceptions. */
--- 595,599 ----
       NULL_TREE,
       build_function_type (build_pointer_type (except_type_node), NULL_TREE),
!      NULL_TREE, 0, 1, 1, 0, Empty);
  
    /* Functions that raise exceptions. */
*************** init_gigi_decls (tree long_long_float_ty
*** 640,644 ****
  				       build_pointer_type (except_type_node),
  				       endlink)),
!        NULL_TREE, 0, 1, 1, 0);
  
    /* Hooks to call when entering/leaving an exception handler.  */
--- 605,609 ----
  				       build_pointer_type (except_type_node),
  				       endlink)),
!        NULL_TREE, 0, 1, 1, 0, Empty);
  
    /* Hooks to call when entering/leaving an exception handler.  */
*************** init_gigi_decls (tree long_long_float_ty
*** 649,653 ****
  							   ptr_void_type_node,
  							   endlink)),
! 			   NULL_TREE, 0, 1, 1, 0);
  
    end_handler_decl
--- 614,618 ----
  							   ptr_void_type_node,
  							   endlink)),
! 			   NULL_TREE, 0, 1, 1, 0, Empty);
  
    end_handler_decl
*************** init_gigi_decls (tree long_long_float_ty
*** 657,661 ****
  							   ptr_void_type_node,
  							   endlink)),
! 			   NULL_TREE, 0, 1, 1, 0);
  
    /* If in no exception handlers mode, all raise statements are redirected to
--- 622,626 ----
  							   ptr_void_type_node,
  							   endlink)),
! 			   NULL_TREE, 0, 1, 1, 0, Empty);
  
    /* If in no exception handlers mode, all raise statements are redirected to
*************** init_gigi_decls (tree long_long_float_ty
*** 673,677 ****
  						      integer_type_node,
  						      endlink))),
! 	   NULL_TREE, 0, 1, 1, 0);
  
        for (i = 0; i < ARRAY_SIZE (gnat_raise_decls); i++)
--- 638,642 ----
  						      integer_type_node,
  						      endlink))),
! 	   NULL_TREE, 0, 1, 1, 0, Empty);
  
        for (i = 0; i < ARRAY_SIZE (gnat_raise_decls); i++)
*************** init_gigi_decls (tree long_long_float_ty
*** 695,699 ****
  							integer_type_node,
  							endlink))),
! 	     NULL_TREE, 0, 1, 1, 0);
        }
  
--- 660,664 ----
  							integer_type_node,
  							endlink))),
! 	     NULL_TREE, 0, 1, 1, 0, Empty);
        }
  
*************** init_gigi_decls (tree long_long_float_ty
*** 721,725 ****
         build_function_type (integer_type_node,
  			    tree_cons (NULL_TREE,  jmpbuf_ptr_type, endlink)),
!        NULL_TREE, 0, 1, 1, 0);
  
    DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL;
--- 686,690 ----
         build_function_type (integer_type_node,
  			    tree_cons (NULL_TREE,  jmpbuf_ptr_type, endlink)),
!        NULL_TREE, 0, 1, 1, 0, Empty);
  
    DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL;
*************** init_gigi_decls (tree long_long_float_ty
*** 733,737 ****
         build_function_type (void_type_node,
  			    tree_cons (NULL_TREE,  jmpbuf_ptr_type, endlink)),
!        NULL_TREE, 0, 1, 1, 0);
  
    DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL;
--- 698,702 ----
         build_function_type (void_type_node,
  			    tree_cons (NULL_TREE,  jmpbuf_ptr_type, endlink)),
!        NULL_TREE, 0, 1, 1, 0, Empty);
  
    DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL;
*************** init_gigi_decls (tree long_long_float_ty
*** 741,755 ****
  }
  
! /* Given a record type (RECORD_TYPE) and a chain of FIELD_DECL
!    nodes (FIELDLIST), finish constructing the record or union type.
!    If HAS_REP is nonzero, this record has a rep clause; don't call
!    layout_type but merely set the size and alignment ourselves.
!    If DEFER_DEBUG is nonzero, do not call the debugging routines
!    on this type; it will be done later. */
  
  void
! finish_record_type (tree record_type,
!                     tree fieldlist,
!                     int has_rep,
                      int defer_debug)
  {
--- 706,717 ----
  }
  
! /* Given a record type (RECORD_TYPE) and a chain of FIELD_DECL nodes
!    (FIELDLIST), finish constructing the record or union type.  If HAS_REP is
!    nonzero, this record has a rep clause; don't call layout_type but merely set
!    the size and alignment ourselves.  If DEFER_DEBUG is nonzero, do not call
!    the debugging routines on this type; it will be done later. */
  
  void
! finish_record_type (tree record_type, tree fieldlist, int has_rep,
                      int defer_debug)
  {
*************** finish_record_type (tree record_type,
*** 762,773 ****
  
    TYPE_FIELDS (record_type) = fieldlist;
! 
!   if (TYPE_NAME (record_type) != 0
!       && TREE_CODE (TYPE_NAME (record_type)) == TYPE_DECL)
!     TYPE_STUB_DECL (record_type) = TYPE_NAME (record_type);
!   else
!     TYPE_STUB_DECL (record_type)
!       = pushdecl (build_decl (TYPE_DECL, TYPE_NAME (record_type),
! 			      record_type));
  
    /* We don't need both the typedef name and the record name output in
--- 724,729 ----
  
    TYPE_FIELDS (record_type) = fieldlist;
!   TYPE_STUB_DECL (record_type)
!     = build_decl (TYPE_DECL, NULL_TREE, record_type);
  
    /* We don't need both the typedef name and the record name output in
*************** finish_record_type (tree record_type,
*** 943,947 ****
  	    = make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE
  			 ? UNION_TYPE : TREE_CODE (record_type));
! 	  tree orig_id = DECL_NAME (TYPE_STUB_DECL (record_type));
  	  tree new_id
  	    = concat_id_with_name (orig_id,
--- 899,906 ----
  	    = make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE
  			 ? UNION_TYPE : TREE_CODE (record_type));
! 	  tree orig_name = TYPE_NAME (record_type);
! 	  tree orig_id
! 	    = (TREE_CODE (orig_name) == TYPE_DECL ? DECL_NAME (orig_name)
! 	       : orig_name);
  	  tree new_id
  	    = concat_id_with_name (orig_id,
*************** finish_record_type (tree record_type,
*** 955,959 ****
  	  TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
  	  TYPE_STUB_DECL (new_record_type)
! 	    = pushdecl (build_decl (TYPE_DECL, new_id, new_record_type));
  	  DECL_ARTIFICIAL (TYPE_STUB_DECL (new_record_type)) = 1;
  	  DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
--- 914,918 ----
  	  TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
  	  TYPE_STUB_DECL (new_record_type)
! 	    = build_decl (TYPE_DECL, NULL_TREE, new_record_type);
  	  DECL_ARTIFICIAL (TYPE_STUB_DECL (new_record_type)) = 1;
  	  DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
*************** finish_record_type (tree record_type,
*** 1087,1095 ****
  
  static tree
! merge_sizes (tree last_size,
!              tree first_bit,
!              tree size,
!              int special,
!              int has_rep)
  {
    tree type = TREE_TYPE (last_size);
--- 1046,1051 ----
  
  static tree
! merge_sizes (tree last_size, tree first_bit, tree size, bool special,
! 	     bool has_rep)
  {
    tree type = TREE_TYPE (last_size);
*************** split_plus (tree in, tree *pvar)
*** 1189,1199 ****
     RETURNS_WITH_DSP is nonzero if the function is to return with a
     depressed stack pointer.  */
- 
  tree
! create_subprog_type (tree return_type,
!                      tree param_decl_list,
!                      tree cico_list,
!                      int returns_unconstrained,
!                      int returns_by_ref,
                       int returns_with_dsp)
  {
--- 1145,1151 ----
     RETURNS_WITH_DSP is nonzero if the function is to return with a
     depressed stack pointer.  */
  tree
! create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
!                      int returns_unconstrained, int returns_by_ref,
                       int returns_with_dsp)
  {
*************** create_index_type (tree min, tree max, t
*** 1276,1280 ****
  
    SET_TYPE_INDEX_TYPE (type, index);
!   add_decl_expr (create_type_decl (NULL_TREE, type, NULL, 1, 0), Empty);
    return type;
  }
--- 1228,1232 ----
  
    SET_TYPE_INDEX_TYPE (type, index);
!   create_type_decl (NULL_TREE, type, NULL, 1, 0, Empty);
    return type;
  }
*************** create_index_type (tree min, tree max, t
*** 1284,1292 ****
     ARTIFICIAL_P is nonzero if this is a declaration that was generated
     by the compiler.  DEBUG_INFO_P is nonzero if we need to write debugging
!    information about this type.  */
  
  tree
  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);
--- 1236,1245 ----
     ARTIFICIAL_P is nonzero if this is a declaration that was generated
     by the compiler.  DEBUG_INFO_P is nonzero if we need to write debugging
!    information about this type.  GNAT_NODE is used for the position of
!    the decl.  */
  
  tree
  create_type_decl (tree type_name, tree type, struct attrib *attr_list,
! 		  int artificial_p, int debug_info_p, Node_Id gnat_node)
  {
    tree type_decl = build_decl (TYPE_DECL, type_name, type);
*************** create_type_decl (tree type_name, tree t
*** 1294,1298 ****
  
    DECL_ARTIFICIAL (type_decl) = artificial_p;
!   pushdecl (type_decl);
    process_attributes (type_decl, attr_list);
  
--- 1247,1251 ----
  
    DECL_ARTIFICIAL (type_decl) = artificial_p;
! 
    process_attributes (type_decl, attr_list);
  
*************** create_type_decl (tree type_name, tree t
*** 1310,1313 ****
--- 1263,1269 ----
      rest_of_decl_compilation (type_decl, NULL, global_bindings_p (), 0);
  
+   if (!TYPE_IS_DUMMY_P (type))
+     gnat_pushdecl (type_decl, gnat_node);
+ 
    return type_decl;
  }
*************** create_type_decl (tree type_name, tree t
*** 1327,1336 ****
  
     STATIC_FLAG is only relevant when not at top level.  In that case
!    it indicates whether to always allocate storage to the variable.   */
  
  tree
  create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
                   int const_flag, int public_flag, int extern_flag,
!                  int static_flag, struct attrib *attr_list)
  {
    int init_const
--- 1283,1294 ----
  
     STATIC_FLAG is only relevant when not at top level.  In that case
!    it indicates whether to always allocate storage to the variable.
! 
!    GNAT_NODE is used for the position of the decl.  */
  
  tree
  create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
                   int const_flag, int public_flag, int extern_flag,
!                  int static_flag, struct attrib *attr_list, Node_Id gnat_node)
  {
    int init_const
*************** create_var_decl (tree var_name, tree asm
*** 1358,1372 ****
       just annotating types, throw away the initialization if it isn't a
       constant.  */
- 
    if ((extern_flag && TREE_CODE (var_decl) != CONST_DECL)
        || (type_annotate_only && var_init != 0 && ! TREE_CONSTANT (var_init)))
      var_init = 0;
  
-   if (global_bindings_p () && var_init != 0 && ! init_const)
-     {
-       add_pending_elaborations (var_decl, var_init);
-       var_init = 0;
-     }
- 
    DECL_INITIAL  (var_decl) = var_init;
    TREE_READONLY (var_decl) = const_flag;
--- 1316,1323 ----
*************** create_var_decl (tree var_name, tree asm
*** 1387,1393 ****
    process_attributes (var_decl, attr_list);
  
!   /* Add this decl to the current binding level and generate any
!      needed code and RTL. */
!   var_decl = pushdecl (var_decl);
  
    if (TREE_SIDE_EFFECTS (var_decl))
--- 1338,1343 ----
    process_attributes (var_decl, attr_list);
  
!   /* Add this decl to the current binding level.  */
!   gnat_pushdecl (var_decl, gnat_node);
  
    if (TREE_SIDE_EFFECTS (var_decl))
*************** create_var_decl (tree var_name, tree asm
*** 1408,1418 ****
  
  tree
! create_field_decl (tree field_name,
!                    tree field_type,
!                    tree record_type,
!                    int packed,
!                    tree size,
!                    tree pos,
!                    int addressable)
  {
    tree field_decl = build_decl (FIELD_DECL, field_name, field_type);
--- 1358,1363 ----
  
  tree
! create_field_decl (tree field_name, tree field_type, tree record_type,
!                    int packed, tree size, tree pos, int addressable)
  {
    tree field_decl = build_decl (FIELD_DECL, field_name, field_type);
*************** create_field_decl (tree field_name,
*** 1541,1545 ****
     effects, has the value of zero.  */
  
! static int
  value_zerop (tree exp)
  {
--- 1486,1490 ----
     effects, has the value of zero.  */
  
! static bool
  value_zerop (tree exp)
  {
*************** process_attributes (tree decl, struct at
*** 1630,1663 ****
  }
  
! /* Add some pending elaborations on the list.  */
! 
! void
! add_pending_elaborations (tree var_decl, tree var_init)
! {
!   if (var_init != 0)
!     Check_Elaboration_Code_Allowed (error_gnat_node);
! 
!   pending_elaborations
!     = chainon (pending_elaborations, build_tree_list (var_decl, var_init));
! }
  
! /* Obtain any pending elaborations and clear the old list.  */
! 
! tree
! get_pending_elaborations (void)
! {
!   /* Each thing added to the list went on the end; we want it on the
!      beginning.  */
!   tree result = TREE_CHAIN (pending_elaborations);
! 
!   TREE_CHAIN (pending_elaborations) = 0;
!   return result;
! }
! 
! /* Return true if VALUE is a multiple of FACTOR. FACTOR must be a power
!    of 2. */
! 
! static int
! value_factor_p (tree value, int factor)
  {
    if (host_integerp (value, 1))
--- 1575,1583 ----
  }
  
! /* Return true if VALUE is a known to be a multiple of FACTOR, which must be
!    a power of 2. */
  
! static bool
! value_factor_p (tree value, HOST_WIDE_INT factor)
  {
    if (host_integerp (value, 1))
*************** value_factor_p (tree value, int factor)
*** 1677,1681 ****
     position of CURR_FIELD. It is ignored if null. */
  
! static int
  potential_alignment_gap (tree prev_field, tree curr_field, tree offset)
  {
--- 1597,1601 ----
     position of CURR_FIELD. It is ignored if null. */
  
! static bool
  potential_alignment_gap (tree prev_field, tree curr_field, tree offset)
  {
*************** potential_alignment_gap (tree prev_field
*** 1717,1778 ****
  }
  
- /* Return nonzero if there are pending elaborations.  */
- 
- int
- pending_elaborations_p (void)
- {
-   return TREE_CHAIN (pending_elaborations) != 0;
- }
- 
- /* Save a copy of the current pending elaboration list and make a new
-    one.  */
- 
- void
- push_pending_elaborations (void)
- {
-   struct e_stack *p = (struct e_stack *) ggc_alloc (sizeof (struct e_stack));
- 
-   p->next = elist_stack;
-   p->elab_list = pending_elaborations;
-   elist_stack = p;
-   pending_elaborations = build_tree_list (NULL_TREE, NULL_TREE);
- }
- 
- /* Pop the stack of pending elaborations.  */
- 
- void
- pop_pending_elaborations (void)
- {
-   struct e_stack *p = elist_stack;
- 
-   pending_elaborations = p->elab_list;
-   elist_stack = p->next;
- }
- 
- /* Return the current position in pending_elaborations so we can insert
-    elaborations after that point.  */
- 
- tree
- get_elaboration_location (void)
- {
-   return tree_last (pending_elaborations);
- }
- 
- /* Insert the current elaborations after ELAB, which is in some elaboration
-    list.  */
- 
- void
- insert_elaboration_list (tree elab)
- {
-   tree next = TREE_CHAIN (elab);
- 
-   if (TREE_CHAIN (pending_elaborations))
-     {
-       TREE_CHAIN (elab) = TREE_CHAIN (pending_elaborations);
-       TREE_CHAIN (tree_last (pending_elaborations)) = next;
-       TREE_CHAIN (pending_elaborations) = 0;
-     }
- }
- 
  /* Returns a LABEL_DECL node for LABEL_NAME.  */
  
--- 1637,1640 ----
*************** create_label_decl (tree label_name)
*** 1795,1809 ****
  
     INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, and ATTR_LIST are used to set the
!    appropriate fields in the FUNCTION_DECL.  */
  
  tree
! create_subprog_decl (tree subprog_name,
!                      tree asm_name,
!                      tree subprog_type,
!                      tree param_decl_list,
!                      int inline_flag,
!                      int public_flag,
!                      int extern_flag,
!                      struct attrib *attr_list)
  {
    tree return_type  = TREE_TYPE (subprog_type);
--- 1657,1667 ----
  
     INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, and ATTR_LIST are used to set the
!    appropriate fields in the FUNCTION_DECL.  GNAT_NODE gives the location.  */
  
  tree
! create_subprog_decl (tree subprog_name, tree asm_name,
!                      tree subprog_type, tree param_decl_list, int inline_flag,
!                      int public_flag, int extern_flag,
!                      struct attrib *attr_list, Node_Id gnat_node)
  {
    tree return_type  = TREE_TYPE (subprog_type);
*************** create_subprog_decl (tree subprog_name,
*** 1835,1839 ****
  
    /* Add this decl to the current binding level.  */
!   subprog_decl = pushdecl (subprog_decl);
  
    /* Output the assembler code and/or RTL for the declaration.  */
--- 1693,1697 ----
  
    /* Add this decl to the current binding level.  */
!   gnat_pushdecl (subprog_decl, gnat_node);
  
    /* Output the assembler code and/or RTL for the declaration.  */
*************** create_subprog_decl (tree subprog_name,
*** 1843,1852 ****
  }
  
- /* Count how deep we are into nested functions.  This is because
-    we shouldn't call the backend function context routines unless we
-    are in a nested function.  */
- 
- static int function_nesting_depth;
- 
  /* Set up the framework for generating code for SUBPROG_DECL, a subprogram
     body. This routine needs to be invoked before processing the declarations
--- 1701,1704 ----
*************** begin_subprog_body (tree subprog_decl)
*** 1858,1885 ****
    tree param_decl;
  
!   if (function_nesting_depth++ != 0)
!     push_function_context ();
! 
    announce_function (subprog_decl);
  
-   /* Make this field nonzero so further routines know that this is not
-      tentative. error_mark_node is replaced below with the adequate BLOCK.  */
-   DECL_INITIAL (subprog_decl)  = error_mark_node;
- 
-   /* This function exists in static storage. This does not mean `static' in
-      the C sense!  */
-   TREE_STATIC (subprog_decl)   = 1;
- 
    /* Enter a new binding level and show that all the parameters belong to
       this function.  */
-   current_function_decl = subprog_decl;
    gnat_pushlevel ();
- 
    for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
         param_decl = TREE_CHAIN (param_decl))
      DECL_CONTEXT (param_decl) = subprog_decl;
  
!   init_function_start (subprog_decl);
!   expand_function_start (subprog_decl, 0);
  }
  
--- 1710,1729 ----
    tree param_decl;
  
!   current_function_decl = subprog_decl;
    announce_function (subprog_decl);
  
    /* Enter a new binding level and show that all the parameters belong to
       this function.  */
    gnat_pushlevel ();
    for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
         param_decl = TREE_CHAIN (param_decl))
      DECL_CONTEXT (param_decl) = subprog_decl;
  
!   make_decl_rtl (subprog_decl, NULL);
! 
!   /* We handle pending sizes via the elaboration of types, so we don't need to
!      save them.  This causes them to be marked as part of the outer function
!      and then discarded.  */
!   get_pending_sizes ();
  }
  
*************** gnat_finalize (tree fndecl)
*** 1979,1987 ****
  
  tree
! builtin_function (const char *name,
!                   tree type,
!                   int function_code,
!                   enum built_in_class class,
!                   const char *library_name,
                    tree attrs)
  {
--- 1823,1828 ----
  
  tree
! builtin_function (const char *name, tree type, int function_code,
!                   enum built_in_class class, const char *library_name,
                    tree attrs)
  {
*************** builtin_function (const char *name,
*** 1993,1997 ****
      SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
  
!   pushdecl (decl);
    DECL_BUILT_IN_CLASS (decl) = class;
    DECL_FUNCTION_CODE (decl) = function_code;
--- 1834,1838 ----
      SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
  
!   gnat_pushdecl (decl, Empty);
    DECL_BUILT_IN_CLASS (decl) = class;
    DECL_FUNCTION_CODE (decl) = function_code;
*************** build_template (tree template_type, tree
*** 2296,2300 ****
     a descriptor type, and the GCC type of an object.  Each FIELD_DECL
     in the type contains in its DECL_INITIAL the expression to use when
!    a constructor is made for the type.  GNAT_ENTITY is a gnat node used
     to print out an error message if the mechanism cannot be applied to
     an object of that type and also for the name.  */
--- 2137,2141 ----
     a descriptor type, and the GCC type of an object.  Each FIELD_DECL
     in the type contains in its DECL_INITIAL the expression to use when
!    a constructor is made for the type.  GNAT_ENTITY is an entity used
     to print out an error message if the mechanism cannot be applied to
     an object of that type and also for the name.  */
*************** build_vms_descriptor (tree type, Mechani
*** 2582,2587 ****
  
    finish_record_type (record_type, field_list, 0, 1);
!   pushdecl (build_decl (TYPE_DECL, create_concat_name (gnat_entity, "DESC"),
! 			record_type));
  
    return record_type;
--- 2423,2428 ----
  
    finish_record_type (record_type, field_list, 0, 1);
!   create_type_decl (create_concat_name (gnat_entity, "DESC"), record_type,
! 		    NULL, 1, 0, gnat_entity);
  
    return record_type;
*** utils2.c	20 Jun 2004 11:24:13 -0000	1.21.4.21
--- utils2.c	28 Jun 2004 04:01:04 -0000
*************** build_call_alloc_dealloc (tree gnu_obj, 
*** 1752,1758 ****
  	    = build_range_type (NULL_TREE, size_one_node, gnu_size);
  	  tree gnu_array_type = build_array_type (char_type_node, gnu_range);
! 	  tree gnu_decl =
! 	    create_var_decl (get_identifier ("RETVAL"), NULL_TREE,
! 			     gnu_array_type, NULL_TREE, 0, 0, 0, 0, 0);
  
  	  return convert (ptr_void_type_node,
--- 1752,1759 ----
  	    = build_range_type (NULL_TREE, size_one_node, gnu_size);
  	  tree gnu_array_type = build_array_type (char_type_node, gnu_range);
! 	  tree gnu_decl
! 	    = create_var_decl (get_identifier ("RETVAL"), NULL_TREE,
! 			       gnu_array_type, NULL_TREE, 0, 0, 0, 0, 0,
! 			       gnat_node);
  
  	  return convert (ptr_void_type_node,
*************** build_call_alloc_dealloc (tree gnu_obj, 
*** 1780,1789 ****
  
  tree
! build_allocator (tree type,
!                  tree init,
!                  tree result_type,
!                  Entity_Id gnat_proc,
!                  Entity_Id gnat_pool,
!                  Node_Id gnat_node)
  {
    tree size = TYPE_SIZE_UNIT (type);
--- 1781,1786 ----
  
  tree
! build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
!                  Entity_Id gnat_pool, Node_Id gnat_node)
  {
    tree size = TYPE_SIZE_UNIT (type);



More information about the Gcc-patches mailing list