gigi.h (standard_datatypes): Remove ADT_void_type_decl.

	* gcc-interface/gigi.h (standard_datatypes): Remove ADT_void_type_decl.
	(void_type_decl_node): Remove.
	(init_gigi_decls): Likewise.
	(gnat_install_builtins): Declare.
	(record_builtin_type): Likewise.
	(create_type_stub_decl): Likewise.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Void>: Use void_type.
	(gnat_to_gnu_entity) <E_Array_Type>: Make fat and thin pointer types
	artificial.
	<E_Array_Subtype>: Use the index types, not only their name, in the
	record giving the names of the bounds, if any.
	For a packed array type, make it artificial only if the base type
	was artificial as well.  Remove redundant statement.
	(gnat_to_gnu_entity) <E_Incomplete_Type>: Do not create TYPE_DECL for
	dummy types.
	Use create_type_stub_decl to build the TYPE_STUB_DECL of types.
	(rest_of_type_decl_compilation_no_defer): Likewise.
	* gcc-interface/misc.c (gnat_printable_name): Add missing guard.
	* gcc-interface/utils.c (make_dummy_type): Always create TYPE_STUB_DECL
	and use create_type_stub_decl to build it.
	(gnat_pushdecl): Rewrite condition.
	(gnat_install_builtins): Remove bogus declaration.
	(record_builtin_type): New function.
	(finish_record_type): Use create_type_stub_decl to build TYPE_STUB_DECL
	of types.
	(create_type_stub_decl): New function.
	(create_type_decl): Assert that the type is not dummy.  If the type
	hasn't been named yet, equate the TYPE_STUB_DECL to the created node.
	(build_vms_descriptor32): Do not create TYPE_DECL for the descriptor.
	(build_vms_descriptor): Likewise.
	(init_gigi_decls): Delete and move bulk of code to...
	* gcc-interface/trans.c (gigi): ...here.  Use record_builtin_type.
	(emit_range_check): Add gnat_node parameter.
	(emit_index_check): Likewise.
	(emit_check): Likewise.
	(build_unary_op_trapv): Likewise.
	(build_binary_op_trapv): Likewise.
	(convert_with_check): Likewise.
	(Attribute_to_gnu): Adjust calls for above changes.
	(call_to_gnu): Likewise.
	(gnat_to_gnu): Likewise.
	(assoc_to_constructor): Likewise.
	(pos_to_constructor): Likewise.
	(Sloc_to_locus): Set BUILTINS_LOCATION for Standard_Location nodes.
	(process_type): Do not create TYPE_DECL for dummy types.

From-SVN: r145660

gcc/ada/ChangeLog

 2009-04-07  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/gigi.h (standard_datatypes): Remove ADT_void_type_decl.
+	(void_type_decl_node): Remove.
+	(init_gigi_decls): Likewise.
+	(gnat_install_builtins): Declare.
+	(record_builtin_type): Likewise.
+	(create_type_stub_decl): Likewise.
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Void>: Use void_type.
+	(gnat_to_gnu_entity) <E_Array_Type>: Make fat and thin pointer types
+	artificial.
+	<E_Array_Subtype>: Use the index types, not only their name, in the
+	record giving the names of the bounds, if any.
+	For a packed array type, make it artificial only if the base type
+	was artificial as well.  Remove redundant statement.
+	(gnat_to_gnu_entity) <E_Incomplete_Type>: Do not create TYPE_DECL for
+	dummy types.
+	Use create_type_stub_decl to build the TYPE_STUB_DECL of types.
+	(rest_of_type_decl_compilation_no_defer): Likewise.
+	* gcc-interface/misc.c (gnat_printable_name): Add missing guard.
+	* gcc-interface/utils.c (make_dummy_type): Always create TYPE_STUB_DECL
+	and use create_type_stub_decl to build it.
+	(gnat_pushdecl): Rewrite condition.
+	(gnat_install_builtins): Remove bogus declaration.
+	(record_builtin_type): New function.
+	(finish_record_type): Use create_type_stub_decl to build TYPE_STUB_DECL
+	of types.
+	(create_type_stub_decl): New function.
+	(create_type_decl): Assert that the type is not dummy.  If the type
+	hasn't been named yet, equate the TYPE_STUB_DECL to the created node.
+	(build_vms_descriptor32): Do not create TYPE_DECL for the descriptor.
+	(build_vms_descriptor): Likewise.
+	(init_gigi_decls): Delete and move bulk of code to...
+	* gcc-interface/trans.c (gigi): ...here.  Use record_builtin_type.
+	(emit_range_check): Add gnat_node parameter.
+	(emit_index_check): Likewise.
+	(emit_check): Likewise.
+	(build_unary_op_trapv): Likewise.
+	(build_binary_op_trapv): Likewise.
+	(convert_with_check): Likewise.
+	(Attribute_to_gnu): Adjust calls for above changes.
+	(call_to_gnu): Likewise.
+	(gnat_to_gnu): Likewise.
+	(assoc_to_constructor): Likewise.
+	(pos_to_constructor): Likewise.
+	(Sloc_to_locus): Set BUILTINS_LOCATION for Standard_Location nodes.
+	(process_type): Do not create TYPE_DECL for dummy types.
+
+2009-04-07  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/decl.c (gnat_to_gnu_entity): Reorder local variables.
 	* gcc-interface/trans.c: Fix formatting throughout.  Fix comments.
 	* gcc-interface/utils.c: Fix comments.

gcc/ada/gcc-interface/decl.c

@@ -1384,7 +1384,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
     case E_Void:
       /* Return a TYPE_DECL for "void" that we previously made.  */
-      gnu_decl = void_type_decl_node;
+      gnu_decl = TYPE_NAME (void_type_node);
       break;
 
     case E_Enumeration_Type:
@@ -2033,7 +2033,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	/* Give the fat pointer type a name.  */
 	create_type_decl (create_concat_name (gnat_entity, "XUP"),
-			  gnu_fat_type, NULL, !Comes_From_Source (gnat_entity),
+			  gnu_fat_type, NULL, true,
 			  debug_info_p, gnat_entity);
 
        /* Create the type to be used as what a thin pointer designates: an
@@ -2048,9 +2048,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	/* Give the thin pointer type a name.  */
 	create_type_decl (create_concat_name (gnat_entity, "XUX"),
-			  build_pointer_type (tem), NULL,
-			  !Comes_From_Source (gnat_entity), debug_info_p,
-			  gnat_entity);
+			  build_pointer_type (tem), NULL, true,
+			  debug_info_p, gnat_entity);
       }
       break;
 
@@ -2352,6 +2351,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
 	    }
 
+	  /* Attach the TYPE_STUB_DECL in case we have a parallel type.  */
+	  if (need_index_type_struct)
+	    TYPE_STUB_DECL (gnu_type)
+	      = create_type_stub_decl (gnu_entity_id, gnu_type);
+
 	  /* If we are at file level and this is a multi-dimensional array, we
 	     need to make a variable corresponding to the stride of the
 	     inner dimensions.   */
@@ -2395,40 +2399,35 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    }
 
 	  /* If we need to write out a record type giving the names of
-	     the bounds, do it now.  */
+	     the bounds, do it now.  Make sure to reference the index
+	     types themselves, not just their names, as the debugger
+	     may fall back on them in some cases.  */
 	  if (need_index_type_struct && debug_info_p)
 	    {
-	      tree gnu_bound_rec_type = make_node (RECORD_TYPE);
+	      tree gnu_bound_rec = make_node (RECORD_TYPE);
 	      tree gnu_field_list = NULL_TREE;
 	      tree gnu_field;
 
-	      TYPE_NAME (gnu_bound_rec_type)
+	      TYPE_NAME (gnu_bound_rec)
 		= create_concat_name (gnat_entity, "XA");
 
 	      for (index = array_dim - 1; index >= 0; index--)
 		{
-		  tree gnu_type_name
-		    = TYPE_NAME (TYPE_INDEX_TYPE (gnu_index_type[index]));
+		  tree gnu_index = TYPE_INDEX_TYPE (gnu_index_type[index]);
+		  tree gnu_index_name = TYPE_NAME (gnu_index);
 
-		  if (TREE_CODE (gnu_type_name) == TYPE_DECL)
-		    gnu_type_name = DECL_NAME (gnu_type_name);
+		  if (TREE_CODE (gnu_index_name) == TYPE_DECL)
+		    gnu_index_name = DECL_NAME (gnu_index_name);
 
-		  gnu_field = create_field_decl (gnu_type_name,
-						 integer_type_node,
-						 gnu_bound_rec_type,
+		  gnu_field = create_field_decl (gnu_index_name, gnu_index,
+						 gnu_bound_rec,
 						 0, NULL_TREE, NULL_TREE, 0);
 		  TREE_CHAIN (gnu_field) = gnu_field_list;
 		  gnu_field_list = gnu_field;
 		}
 
-	      finish_record_type (gnu_bound_rec_type, gnu_field_list,
-				  0, false);
-
-	      TYPE_STUB_DECL (gnu_type)
-		= build_decl (TYPE_DECL, NULL_TREE, gnu_type);
-
-	      add_parallel_type
-		(TYPE_STUB_DECL (gnu_type), gnu_bound_rec_type);
+	      finish_record_type (gnu_bound_rec, gnu_field_list, 0, false);
+	      add_parallel_type (TYPE_STUB_DECL (gnu_type), gnu_bound_rec);
 	    }
 
 	  TYPE_CONVENTION_FORTRAN_P (gnu_type)
@@ -2460,24 +2459,27 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
       /* If this is a packed type, make this type the same as the packed
 	 array type, but do some adjusting in the type first.  */
-
       if (Present (Packed_Array_Type (gnat_entity)))
 	{
 	  Entity_Id gnat_index;
 	  tree gnu_inner_type;
 
 	  /* First finish the type we had been making so that we output
-	     debugging information for it  */
+	     debugging information for it.  */
 	  gnu_type
 	    = build_qualified_type (gnu_type,
 				    (TYPE_QUALS (gnu_type)
 				     | (TYPE_QUAL_VOLATILE
 					* Treat_As_Volatile (gnat_entity))));
-	  gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
-				       !Comes_From_Source (gnat_entity),
+
+	  /* Make it artificial only if the base type was artificial as well.
+	     That's sort of "morally" true and will make it possible for the
+	     debugger to look it up by name in DWARF more easily.  */
+	  gnu_decl
+	    = create_type_decl (gnu_entity_id, gnu_type, attr_list,
+				!Comes_From_Source (gnat_entity)
+				&& !Comes_From_Source (Etype (gnat_entity)),
 				debug_info_p, gnat_entity);
-	  if (!Comes_From_Source (gnat_entity))
-	    DECL_ARTIFICIAL (gnu_decl) = 1;
 
 	  /* Save it as our equivalent in case the call below elaborates
 	     this type again.  */
@@ -4195,7 +4197,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	if (No (full_view))
 	  {
 	    if (kind == E_Incomplete_Type)
+	      {
 		gnu_type = make_dummy_type (gnat_entity);
+		gnu_decl = TYPE_STUB_DECL (gnu_type);
+	      }
 	    else
 	      {
 		gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity),
@@ -4227,14 +4232,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  }
 
 	/* For incomplete types, make a dummy type entry which will be
-	   replaced later.  */
+	   replaced later.  Save it as the full declaration's type so
+	   we can do any needed updates when we see it.  */
 	gnu_type = make_dummy_type (gnat_entity);
-
-	/* Save this type as the full declaration's type so we can do any
-	   needed updates when we see it.  */
-	gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list,
-				     !Comes_From_Source (gnat_entity),
-				     debug_info_p, gnat_entity);
+	gnu_decl = TYPE_STUB_DECL (gnu_type);
 	save_gnu_tree (full_view, gnu_decl, 0);
 	break;
       }
@@ -4790,10 +4791,7 @@ rest_of_type_decl_compilation_no_defer (tree decl)
 	continue;
 
       if (!TYPE_STUB_DECL (t))
-	{
-	  TYPE_STUB_DECL (t) = build_decl (TYPE_DECL, DECL_NAME (decl), t);
-	  DECL_ARTIFICIAL (TYPE_STUB_DECL (t)) = 1;
-	}
+	TYPE_STUB_DECL (t) = create_type_stub_decl (DECL_NAME (decl), t);
 
       rest_of_type_compilation (t, toplev);
     }

gcc/ada/gcc-interface/gigi.h

@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2008, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -363,9 +363,8 @@ extern const struct attribute_spec gnat_internal_attribute_table[];
 /* Define the entries in the standard data array.  */
 enum standard_datatypes
 {
-/* Various standard data types and nodes.  */
+  /* The longest floating-point type.  */
   ADT_longest_float_type,
-  ADT_void_type_decl,
 
   /* The type of an exception.  */
   ADT_except_type,
@@ -418,7 +417,6 @@ extern GTY(()) tree gnat_std_decls[(int) ADT_LAST];
 extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
 
 #define longest_float_type_node gnat_std_decls[(int) ADT_longest_float_type]
-#define void_type_decl_node gnat_std_decls[(int) ADT_void_type_decl]
 #define except_type_node gnat_std_decls[(int) ADT_except_type]
 #define ptr_void_type_node gnat_std_decls[(int) ADT_ptr_void_type]
 #define void_ftype gnat_std_decls[(int) ADT_void_ftype]
@@ -468,8 +466,8 @@ extern tree get_block_jmpbuf_decl (void);
 extern void gnat_pushdecl (tree decl, Node_Id gnat_node);
 
 extern void gnat_init_decl_processing (void);
-extern void init_gigi_decls (tree long_long_float_type, tree exception_type);
 extern void gnat_init_gcc_eh (void);
+extern void gnat_install_builtins (void);
 
 /* Return an integer type with the number of bits of precision given by
    PRECISION.  UNSIGNEDP is nonzero if the type is unsigned; otherwise
@@ -522,6 +520,9 @@ extern bool present_gnu_tree (Entity_Id gnat_entity);
 /* Initialize tables for above routines.  */
 extern void init_gnat_to_gnu (void);
 
+/* Record TYPE as a builtin type for Ada.  NAME is the name of the type.  */
+extern void record_builtin_type (const char *name, tree type);
+
 /* Given a record type RECORD_TYPE and a chain of FIELD_DECL nodes FIELDLIST,
    finish constructing the record or union type.  If REP_LEVEL is zero, this
    record has no representation clause and so will be entirely laid out here.
@@ -569,12 +570,16 @@ extern tree copy_type (tree type);
 extern tree create_index_type (tree min, tree max, tree index,
 			       Node_Id gnat_node);
 
-/* Return a TYPE_DECL node. TYPE_NAME gives the name of the type (a character
-   string) and TYPE is a ..._TYPE node giving its data type.
-   ARTIFICIAL_P is true if this is a declaration that was generated
-   by the compiler.  DEBUG_INFO_P is true if we need to write debugging
-   information about this type.  GNAT_NODE is used for the position of
-   the decl.  */
+/* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of a type.
+   TYPE_NAME gives the name of the type and TYPE is a ..._TYPE node giving
+   its data type.  */
+extern tree create_type_stub_decl (tree type_name, tree type);
+
+/* Return a TYPE_DECL node.  TYPE_NAME gives the name of the type and TYPE
+   is a ..._TYPE node giving its data type.  ARTIFICIAL_P is true if this
+   is a declaration that was generated by the compiler.  DEBUG_INFO_P is
+   true if we need to write debug information about this type.  GNAT_NODE
+   is used for the position of the decl.  */
 extern tree create_type_decl (tree type_name, tree type,
                               struct attrib *attr_list,
                               bool artificial_p, bool debug_info_p,

gcc/ada/gcc-interface/misc.c

@@ -610,7 +610,7 @@ gnat_printable_name (tree decl, int verbosity)
 
   __gnat_decode (coded_name, ada_name, 0);
 
-  if (verbosity == 2)
+  if (verbosity == 2 && !DECL_IS_BUILTIN (decl))
     {
       Set_Identifier_Casing (ada_name, (char *) DECL_SOURCE_FILE (decl));
       return ggc_strdup (Name_Buffer);

gcc/ada/gcc-interface/trans.c

@@ -213,12 +213,12 @@ static void elaborate_all_entities (Node_Id);
 static void process_freeze_entity (Node_Id);
 static void process_inlined_subprograms (Node_Id);
 static void process_decls (List_Id, List_Id, Node_Id, bool, bool);
-static tree emit_range_check (tree, Node_Id);
-static tree emit_index_check (tree, tree, tree, tree);
-static tree emit_check (tree, tree, int);
-static tree build_unary_op_trapv (enum tree_code, tree, tree);
-static tree build_binary_op_trapv (enum tree_code, tree, tree, tree);
-static tree convert_with_check (Entity_Id, tree, bool, bool, bool);
+static tree emit_range_check (tree, Node_Id, Node_Id);
+static tree emit_index_check (tree, tree, tree, tree, Node_Id);
+static tree emit_check (tree, tree, int, Node_Id);
+static tree build_unary_op_trapv (enum tree_code, tree, tree, Node_Id);
+static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id);
+static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id);
 static bool smaller_packable_type_p (tree, tree);
 static bool addressable_p (tree, tree);
 static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
@@ -249,7 +249,8 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
       Entity_Id standard_exception_type, Int gigi_operating_mode)
 {
   Entity_Id gnat_literal;
-  tree gnu_standard_long_long_float, gnu_standard_exception_type, t;
+  tree long_long_float_type, exception_type, t;
+  tree int64_type = gnat_type_for_size (64, 0);
   struct elab_info *info;
   int i;
 
@@ -321,17 +322,20 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
   if (!Stack_Check_Probes_On_Target)
     set_stack_check_libfunc (gen_rtx_SYMBOL_REF (Pmode, "_gnat_stack_check"));
 
-  /* Give names and make TYPE_DECLs for common types.  */
-  create_type_decl (get_identifier (SIZE_TYPE), sizetype,
-		    NULL, false, true, Empty);
-  create_type_decl (get_identifier ("boolean"), boolean_type_node,
-		    NULL, false, true, Empty);
-  create_type_decl (get_identifier ("integer"), integer_type_node,
-		    NULL, false, true, Empty);
-  create_type_decl (get_identifier ("unsigned char"), char_type_node,
-		    NULL, false, true, Empty);
-  create_type_decl (get_identifier ("long integer"), long_integer_type_node,
-		    NULL, false, true, Empty);
+  /* Record the builtin types.  Define `integer' and `unsigned char' first so
+     that dbx will output them first.  */
+  record_builtin_type ("integer", integer_type_node);
+  record_builtin_type ("unsigned char", char_type_node);
+  record_builtin_type ("long integer", long_integer_type_node);
+  unsigned_type_node = gnat_type_for_size (INT_TYPE_SIZE, 1);
+  record_builtin_type ("unsigned int", unsigned_type_node);
+  record_builtin_type (SIZE_TYPE, sizetype);
+  record_builtin_type ("boolean", boolean_type_node);
+  record_builtin_type ("void", void_type_node);
+
+  /* Save the type we made for integer as the type for Standard.Integer.  */
+  save_gnu_tree (Base_Type (standard_integer), TYPE_NAME (integer_type_node),
+		 false);
 
   /* Save the type we made for boolean as the type for Standard.Boolean.  */
   save_gnu_tree (Base_Type (standard_boolean), TYPE_NAME (boolean_type_node),
@@ -353,11 +357,249 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
   DECL_IGNORED_P (t) = 1;
   save_gnu_tree (gnat_literal, t, false);
 
-  /* 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
-     may be subtypes.  */
-  save_gnu_tree (Base_Type (standard_integer), TYPE_NAME (integer_type_node),
-		 false);
+  void_ftype = build_function_type (void_type_node, NULL_TREE);
+  ptr_void_ftype = build_pointer_type (void_ftype);
+
+  /* Now declare runtime functions.  */
+  t = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
+
+  /* malloc is a function declaration tree for a function to allocate
+     memory.  */
+  malloc_decl
+    = create_subprog_decl (get_identifier ("__gnat_malloc"), NULL_TREE,
+			   build_function_type (ptr_void_type_node,
+						tree_cons (NULL_TREE,
+							   sizetype, t)),
+			   NULL_TREE, false, true, true, NULL, Empty);
+  DECL_IS_MALLOC (malloc_decl) = 1;
+
+  /* malloc32 is a function declaration tree for a function to allocate
+     32-bit memory on a 64-bit system.  Needed only on 64-bit VMS.  */
+  malloc32_decl
+    = create_subprog_decl (get_identifier ("__gnat_malloc32"), NULL_TREE,
+			   build_function_type (ptr_void_type_node,
+						tree_cons (NULL_TREE,
+							   sizetype, t)),
+			   NULL_TREE, false, true, true, NULL, Empty);
+  DECL_IS_MALLOC (malloc32_decl) = 1;
+
+  /* free is a function declaration tree for a function to free memory.  */
+  free_decl
+    = create_subprog_decl (get_identifier ("__gnat_free"), NULL_TREE,
+			   build_function_type (void_type_node,
+						tree_cons (NULL_TREE,
+							   ptr_void_type_node,
+							   t)),
+			   NULL_TREE, false, true, true, NULL, Empty);
+
+  /* This is used for 64-bit multiplication with overflow checking.  */
+  mulv64_decl
+    = create_subprog_decl (get_identifier ("__gnat_mulv64"), NULL_TREE,
+			   build_function_type_list (int64_type, int64_type,
+						     int64_type, NULL_TREE),
+			   NULL_TREE, false, true, true, NULL, Empty);
+
+  /* Make the types and functions used for exception processing.  */
+  jmpbuf_type
+    = build_array_type (gnat_type_for_mode (Pmode, 0),
+			build_index_type (build_int_cst (NULL_TREE, 5)));
+  record_builtin_type ("JMPBUF_T", jmpbuf_type);
+  jmpbuf_ptr_type = build_pointer_type (jmpbuf_type);
+
+  /* Functions to get and set the jumpbuf pointer for the current thread.  */
+  get_jmpbuf_decl
+    = create_subprog_decl
+    (get_identifier ("system__soft_links__get_jmpbuf_address_soft"),
+     NULL_TREE, build_function_type (jmpbuf_ptr_type, NULL_TREE),
+     NULL_TREE, false, true, true, NULL, Empty);
+  /* Avoid creating superfluous edges to __builtin_setjmp receivers.  */
+  DECL_PURE_P (get_jmpbuf_decl) = 1;
+
+  set_jmpbuf_decl
+    = create_subprog_decl
+    (get_identifier ("system__soft_links__set_jmpbuf_address_soft"),
+     NULL_TREE,
+     build_function_type (void_type_node,
+			  tree_cons (NULL_TREE, jmpbuf_ptr_type, t)),
+     NULL_TREE, false, true, true, NULL, Empty);
+
+  /* setjmp returns an integer and has one operand, which is a pointer to
+     a jmpbuf.  */
+  setjmp_decl
+    = create_subprog_decl
+      (get_identifier ("__builtin_setjmp"), NULL_TREE,
+       build_function_type (integer_type_node,
+			    tree_cons (NULL_TREE,  jmpbuf_ptr_type, t)),
+       NULL_TREE, false, true, true, NULL, Empty);
+
+  DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL;
+  DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP;
+
+  /* update_setjmp_buf updates a setjmp buffer from the current stack pointer
+     address.  */
+  update_setjmp_buf_decl
+    = create_subprog_decl
+      (get_identifier ("__builtin_update_setjmp_buf"), NULL_TREE,
+       build_function_type (void_type_node,
+			    tree_cons (NULL_TREE,  jmpbuf_ptr_type, t)),
+       NULL_TREE, false, true, true, NULL, Empty);
+
+  DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL;
+  DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF;
+
+  /* Hooks to call when entering/leaving an exception handler.  */
+  begin_handler_decl
+    = create_subprog_decl (get_identifier ("__gnat_begin_handler"), NULL_TREE,
+			   build_function_type (void_type_node,
+						tree_cons (NULL_TREE,
+							   ptr_void_type_node,
+							   t)),
+			   NULL_TREE, false, true, true, NULL, Empty);
+
+  end_handler_decl
+    = create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE,
+			   build_function_type (void_type_node,
+						tree_cons (NULL_TREE,
+							   ptr_void_type_node,
+							   t)),
+			   NULL_TREE, false, true, true, NULL, Empty);
+
+  /* If in no exception handlers mode, all raise statements are redirected to
+     __gnat_last_chance_handler.  No need to redefine raise_nodefer_decl since
+     this procedure will never be called in this mode.  */
+  if (No_Exception_Handlers_Set ())
+    {
+      tree decl
+	= create_subprog_decl
+	  (get_identifier ("__gnat_last_chance_handler"), NULL_TREE,
+	   build_function_type (void_type_node,
+				tree_cons (NULL_TREE,
+					   build_pointer_type (char_type_node),
+					   tree_cons (NULL_TREE,
+						      integer_type_node,
+						      t))),
+	   NULL_TREE, false, true, true, NULL, Empty);
+
+      for (i = 0; i < (int) ARRAY_SIZE (gnat_raise_decls); i++)
+	gnat_raise_decls[i] = decl;
+    }
+  else
+    /* Otherwise, make one decl for each exception reason.  */
+    for (i = 0; i < (int) ARRAY_SIZE (gnat_raise_decls); i++)
+      {
+	char name[17];
+
+	sprintf (name, "__gnat_rcheck_%.2d", i);
+	gnat_raise_decls[i]
+	  = create_subprog_decl
+	    (get_identifier (name), NULL_TREE,
+	     build_function_type (void_type_node,
+				  tree_cons (NULL_TREE,
+					     build_pointer_type
+					     (char_type_node),
+					     tree_cons (NULL_TREE,
+							integer_type_node,
+							t))),
+	     NULL_TREE, false, true, true, NULL, Empty);
+      }
+
+  for (i = 0; i < (int) ARRAY_SIZE (gnat_raise_decls); i++)
+    {
+      TREE_THIS_VOLATILE (gnat_raise_decls[i]) = 1;
+      TREE_SIDE_EFFECTS (gnat_raise_decls[i]) = 1;
+      TREE_TYPE (gnat_raise_decls[i])
+	= build_qualified_type (TREE_TYPE (gnat_raise_decls[i]),
+				TYPE_QUAL_VOLATILE);
+    }
+
+  /* Set the types that GCC and Gigi use from the front end.  We would
+     like to do this for char_type_node, but it needs to correspond to
+     the C char type.  */
+  exception_type
+    = gnat_to_gnu_entity (Base_Type (standard_exception_type),  NULL_TREE, 0);
+  except_type_node = TREE_TYPE (exception_type);
+
+  /* Make other functions used for exception processing.  */
+  get_excptr_decl
+    = create_subprog_decl
+    (get_identifier ("system__soft_links__get_gnat_exception"),
+     NULL_TREE,
+     build_function_type (build_pointer_type (except_type_node), NULL_TREE),
+     NULL_TREE, false, true, true, NULL, Empty);
+  /* Avoid creating superfluous edges to __builtin_setjmp receivers.  */
+  DECL_PURE_P (get_excptr_decl) = 1;
+
+  raise_nodefer_decl
+    = create_subprog_decl
+      (get_identifier ("__gnat_raise_nodefer_with_msg"), NULL_TREE,
+       build_function_type (void_type_node,
+			    tree_cons (NULL_TREE,
+				       build_pointer_type (except_type_node),
+				       t)),
+       NULL_TREE, false, true, true, NULL, Empty);
+
+  /* Indicate that these never return.  */
+  TREE_THIS_VOLATILE (raise_nodefer_decl) = 1;
+  TREE_SIDE_EFFECTS (raise_nodefer_decl) = 1;
+  TREE_TYPE (raise_nodefer_decl)
+    = build_qualified_type (TREE_TYPE (raise_nodefer_decl),
+			    TYPE_QUAL_VOLATILE);
+
+  long_long_float_type
+    = gnat_to_gnu_entity (Base_Type (standard_long_long_float), NULL_TREE, 0);
+
+  if (TREE_CODE (TREE_TYPE (long_long_float_type)) == INTEGER_TYPE)
+    {
+      /* In this case, the builtin floating point types are VAX float,
+	 so make up a type for use.  */
+      longest_float_type_node = make_node (REAL_TYPE);
+      TYPE_PRECISION (longest_float_type_node) = LONG_DOUBLE_TYPE_SIZE;
+      layout_type (longest_float_type_node);
+      record_builtin_type ("longest float type", longest_float_type_node);
+    }
+  else
+    longest_float_type_node = TREE_TYPE (long_long_float_type);
+
+  /* Build the special descriptor type and its null node if needed.  */
+  if (TARGET_VTABLE_USES_DESCRIPTORS)
+    {
+      tree null_node = fold_convert (ptr_void_ftype, null_pointer_node);
+      tree field_list = NULL_TREE, null_list = NULL_TREE;
+      int j;
+
+      fdesc_type_node = make_node (RECORD_TYPE);
+
+      for (j = 0; j < TARGET_VTABLE_USES_DESCRIPTORS; j++)
+	{
+	  tree field = create_field_decl (NULL_TREE, ptr_void_ftype,
+					  fdesc_type_node, 0, 0, 0, 1);
+	  TREE_CHAIN (field) = field_list;
+	  field_list = field;
+	  null_list = tree_cons (field, null_node, null_list);
+	}
+
+      finish_record_type (fdesc_type_node, nreverse (field_list), 0, false);
+      null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_list);
+    }
+
+  /* Dummy objects to materialize "others" and "all others" in the exception
+     tables.  These are exported by a-exexpr.adb, so see this unit for the
+     types to use.  */
+  others_decl
+    = create_var_decl (get_identifier ("OTHERS"),
+		       get_identifier ("__gnat_others_value"),
+		       integer_type_node, 0, 1, 0, 1, 1, 0, Empty);
+
+  all_others_decl
+    = create_var_decl (get_identifier ("ALL_OTHERS"),
+		       get_identifier ("__gnat_all_others_value"),
+		       integer_type_node, 0, 1, 0, 1, 1, 0, Empty);
+
+  main_identifier_node = get_identifier ("main");
+
+  /* Install the builtins we might need, either internally or as
+     user available facilities for Intrinsic imports.  */
+  gnat_install_builtins ();
 
   gnu_except_ptr_stack = tree_cons (NULL_TREE, NULL_TREE, NULL_TREE);
   gnu_constraint_error_label_stack
@@ -365,13 +607,6 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
   gnu_storage_error_label_stack = tree_cons (NULL_TREE, NULL_TREE, NULL_TREE);
   gnu_program_error_label_stack = tree_cons (NULL_TREE, NULL_TREE, NULL_TREE);
 
-  gnu_standard_long_long_float
-    = gnat_to_gnu_entity (Base_Type (standard_long_long_float), NULL_TREE, 0);
-  gnu_standard_exception_type
-    = gnat_to_gnu_entity (Base_Type (standard_exception_type),  NULL_TREE, 0);
-
-  init_gigi_decls (gnu_standard_long_long_float, gnu_standard_exception_type);
-
   /* Process any Pragma Ident for the main unit.  */
 #ifdef ASM_OUTPUT_IDENT
   if (Present (Ident_String (Main_Unit)))
@@ -873,7 +1108,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 	gnu_result = gnat_to_gnu (First (Expressions (gnat_node)));
 	gnu_result_type = get_unpadded_type (Etype (gnat_node));
 	gnu_result = convert_with_check (Etype (gnat_node), gnu_result,
-					 checkp, checkp, true);
+					 checkp, checkp, true, gnat_node);
       }
       break;
 
@@ -894,7 +1129,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 				attribute == Attr_Pred
 				? TYPE_MIN_VALUE (gnu_result_type)
 				: TYPE_MAX_VALUE (gnu_result_type)),
-	       gnu_expr, CE_Range_Check_Failed);
+	       gnu_expr, CE_Range_Check_Failed, gnat_node);
 	}
 
       gnu_result
@@ -2343,13 +2578,15 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 
 	  if (Ekind (gnat_formal) != E_Out_Parameter
 	      && Do_Range_Check (gnat_actual))
-	    gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal));
+	    gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal),
+					   gnat_actual);
 	}
       else
 	{
 	  if (Ekind (gnat_formal) != E_Out_Parameter
 	      && Do_Range_Check (gnat_actual))
-	    gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal));
+	    gnu_actual = emit_range_check (gnu_actual, Etype (gnat_formal),
+					   gnat_actual);
 
 	  /* We may have suppressed a conversion to the Etype of the actual
 	     since the parent is a procedure call.  So put it back here.
@@ -2636,7 +2873,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 		    (Etype (Expression (gnat_actual)), gnu_result,
 		     Do_Overflow_Check (gnat_actual),
 		     Do_Range_Check (Expression (gnat_actual)),
-		     Float_Truncate (gnat_actual));
+		     Float_Truncate (gnat_actual), gnat_actual);
 
 		if (!Is_Composite_Type (Underlying_Type (Etype (gnat_formal))))
 		  gnu_actual = convert (TREE_TYPE (gnu_result), gnu_actual);
@@ -2653,8 +2890,9 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 	    else
 	      {
 		if (Do_Range_Check (gnat_actual))
-		  gnu_result = emit_range_check (gnu_result,
-						 Etype (gnat_actual));
+		  gnu_result
+		    = emit_range_check (gnu_result, Etype (gnat_actual),
+					gnat_actual);
 
 		if (!(!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual)))
 		      && TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_result)))))
@@ -3434,7 +3672,8 @@ gnat_to_gnu (Node_Id gnat_node)
 	{
 	  gnu_expr = gnat_to_gnu (Expression (gnat_node));
 	  if (Do_Range_Check (Expression (gnat_node)))
-	    gnu_expr = emit_range_check (gnu_expr, Etype (gnat_temp));
+	    gnu_expr
+	      = emit_range_check (gnu_expr, Etype (gnat_temp), gnat_node);
 
 	  /* If this object has its elaboration delayed, we must force
 	     evaluation of GNU_EXPR right now and save it for when the object
@@ -3569,7 +3808,8 @@ gnat_to_gnu (Node_Id gnat_node)
 		= emit_index_check
 		  (gnu_array_object, gnu_expr,
 		   TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))),
-		   TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))));
+		   TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))),
+		   gnat_temp);
 
 	    gnu_result = build_binary_op (ARRAY_REF, NULL_TREE,
 					  gnu_result, gnu_expr);
@@ -3633,7 +3873,7 @@ gnat_to_gnu (Node_Id gnat_node)
 	    gnu_expr = emit_check
 	      (build_binary_op (TRUTH_ORIF_EXPR, integer_type_node,
 				gnu_expr_l, gnu_expr_h),
-	       gnu_min_expr, CE_Index_Check_Failed);
+	       gnu_min_expr, CE_Index_Check_Failed, gnat_node);
 
 	   /* Build a conditional expression that does the index checks and
 	      returns the low bound if the slice is not empty (max >= min),
@@ -3813,7 +4053,7 @@ gnat_to_gnu (Node_Id gnat_node)
 			      Do_Overflow_Check (gnat_node),
 			      Do_Range_Check (Expression (gnat_node)),
 			      Nkind (gnat_node) == N_Type_Conversion
-			      && Float_Truncate (gnat_node));
+			      && Float_Truncate (gnat_node), gnat_node);
       break;
 
     case N_Unchecked_Type_Conversion:
@@ -4028,8 +4268,8 @@ gnat_to_gnu (Node_Id gnat_node)
 		|| Nkind (gnat_node) == N_Op_Multiply)
 	    && !TYPE_UNSIGNED (gnu_type)
 	    && !FLOAT_TYPE_P (gnu_type))
-	  gnu_result
-	    = build_binary_op_trapv (code, gnu_type, gnu_lhs, gnu_rhs);
+	  gnu_result = build_binary_op_trapv (code, gnu_type,
+					      gnu_lhs, gnu_rhs, gnat_node);
 	else
 	  gnu_result = build_binary_op (code, gnu_type, gnu_lhs, gnu_rhs);
 
@@ -4099,8 +4339,9 @@ gnat_to_gnu (Node_Id gnat_node)
       if (Do_Overflow_Check (gnat_node)
 	  && !TYPE_UNSIGNED (gnu_result_type)
 	  && !FLOAT_TYPE_P (gnu_result_type))
-	gnu_result = build_unary_op_trapv (gnu_codes[Nkind (gnat_node)],
-					   gnu_result_type, gnu_expr);
+	gnu_result
+	  = build_unary_op_trapv (gnu_codes[Nkind (gnat_node)],
+				  gnu_result_type, gnu_expr, gnat_node);
       else
 	gnu_result = build_unary_op (gnu_codes[Nkind (gnat_node)],
 				     gnu_result_type, gnu_expr);
@@ -4131,7 +4372,8 @@ gnat_to_gnu (Node_Id gnat_node)
 
 	    gnu_init = maybe_unconstrained_array (gnu_init);
 	    if (Do_Range_Check (Expression (gnat_temp)))
-	      gnu_init = emit_range_check (gnu_init, gnat_desig_type);
+	      gnu_init
+		= emit_range_check (gnu_init, gnat_desig_type, gnat_temp);
 
 	    if (Is_Elementary_Type (gnat_desig_type)
 		|| Is_Constrained (gnat_desig_type))
@@ -4196,7 +4438,8 @@ gnat_to_gnu (Node_Id gnat_node)
 
 	  /* If range check is needed, emit code to generate it.  */
 	  if (Do_Range_Check (Expression (gnat_node)))
-	    gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node)));
+	    gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node)),
+					gnat_node);
 
 	  gnu_result
 	    = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_lhs, gnu_rhs);
@@ -6002,10 +6245,13 @@ process_decls (List_Id gnat_decls, List_Id gnat_decls2,
 /* Make a unary operation of kind CODE using build_unary_op, but guard
    the operation by an overflow check.  CODE can be one of NEGATE_EXPR
    or ABS_EXPR.  GNU_TYPE is the type desired for the result.  Usually
-   the operation is to be performed in that type.  */
+   the operation is to be performed in that type.  GNAT_NODE is the gnat
+   node conveying the source location for which the error should be
+   signaled.  */
 
 static tree
-build_unary_op_trapv (enum tree_code code, tree gnu_type, tree operand)
+build_unary_op_trapv (enum tree_code code, tree gnu_type, tree operand,
+		      Node_Id gnat_node)
 {
   gcc_assert (code == NEGATE_EXPR || code == ABS_EXPR);
 
@@ -6014,17 +6260,19 @@ build_unary_op_trapv (enum tree_code code, tree gnu_type, tree operand)
   return emit_check (build_binary_op (EQ_EXPR, integer_type_node,
 				      operand, TYPE_MIN_VALUE (gnu_type)),
 		     build_unary_op (code, gnu_type, operand),
-		     CE_Overflow_Check_Failed);
+		     CE_Overflow_Check_Failed, gnat_node);
 }
 
 /* Make a binary operation of kind CODE using build_binary_op, but guard
    the operation by an overflow check.  CODE can be one of PLUS_EXPR,
    MINUS_EXPR or MULT_EXPR.  GNU_TYPE is the type desired for the result.
-   Usually the operation is to be performed in that type.  */
+   Usually the operation is to be performed in that type.  GNAT_NODE is
+   the GNAT node conveying the source location for which the error should
+   be signaled.  */
 
 static tree
 build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
-		       tree right)
+		       tree right, Node_Id gnat_node)
 {
   tree lhs = protect_multiple_eval (left);
   tree rhs = protect_multiple_eval (right);
@@ -6098,7 +6346,8 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
 
 	  tree result = convert (gnu_type, wide_result);
 
-	  return emit_check (check, result, CE_Overflow_Check_Failed);
+	  return
+	    emit_check (check, result, CE_Overflow_Check_Failed, gnat_node);
 	}
 
       else if (code == PLUS_EXPR || code == MINUS_EXPR)
@@ -6119,7 +6368,8 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
 	     build_binary_op (code == PLUS_EXPR ? LT_EXPR : GT_EXPR,
 			      integer_type_node, wrapped_expr, lhs));
 
-	  return emit_check (check, result, CE_Overflow_Check_Failed);
+	  return
+	    emit_check (check, result, CE_Overflow_Check_Failed, gnat_node);
 	}
    }
 
@@ -6191,15 +6441,16 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
   check = fold_build3 (COND_EXPR, integer_type_node,
 		       rhs_lt_zero,  check_neg, check_pos);
 
-  return emit_check (check, gnu_expr, CE_Overflow_Check_Failed);
+  return emit_check (check, gnu_expr, CE_Overflow_Check_Failed, gnat_node);
 }
 
 /* Emit code for a range check.  GNU_EXPR is the expression to be checked,
    GNAT_RANGE_TYPE the gnat type or subtype containing the bounds against
-   which we have to check.  */
+   which we have to check.  GNAT_NODE is the GNAT node conveying the source
+   location for which the error should be signaled.  */
 
 static tree
-emit_range_check (tree gnu_expr, Entity_Id gnat_range_type)
+emit_range_check (tree gnu_expr, Entity_Id gnat_range_type, Node_Id gnat_node)
 {
   tree gnu_range_type = get_unpadded_type (gnat_range_type);
   tree gnu_low  = TYPE_MIN_VALUE (gnu_range_type);
@@ -6238,7 +6489,7 @@ emit_range_check (tree gnu_expr, Entity_Id gnat_range_type)
 					convert (gnu_compare_type, gnu_expr),
 					convert (gnu_compare_type,
 						 gnu_high)))),
-     gnu_expr, CE_Range_Check_Failed);
+     gnu_expr, CE_Range_Check_Failed, gnat_node);
 }
 
 /* Emit code for an index check.  GNU_ARRAY_OBJECT is the array object which
@@ -6250,11 +6501,12 @@ emit_range_check (tree gnu_expr, Entity_Id gnat_range_type)
    checking the indices may be unconstrained and consequently we need to get
    the actual index bounds from the array object itself (GNU_ARRAY_OBJECT).
    The place where we need to do that is in subprograms having unconstrained
-   array formal parameters.  */
+   array formal parameters.  GNAT_NODE is the GNAT node conveying the source
+   location for which the error should be signaled.  */
 
 static tree
 emit_index_check (tree gnu_array_object, tree gnu_expr, tree gnu_low,
-		  tree gnu_high)
+		  tree gnu_high, Node_Id gnat_node)
 {
   tree gnu_expr_check;
 
@@ -6282,18 +6534,21 @@ emit_index_check (tree gnu_array_object, tree gnu_expr, tree gnu_low,
 				       gnu_expr_check,
 				       convert (TREE_TYPE (gnu_expr_check),
 						gnu_high))),
-     gnu_expr, CE_Index_Check_Failed);
+     gnu_expr, CE_Index_Check_Failed, gnat_node);
 }
 
 /* GNU_COND contains the condition corresponding to an access, discriminant or
    range check of value GNU_EXPR.  Build a COND_EXPR that returns GNU_EXPR if
    GNU_COND is false and raises a CONSTRAINT_ERROR if GNU_COND is true.
-   REASON is the code that says why the exception was raised.  */
+   REASON is the code that says why the exception was raised.  GNAT_NODE is
+   the GNAT node conveying the source location for which the error should be
+   signaled.  */
 
 static tree
-emit_check (tree gnu_cond, tree gnu_expr, int reason)
+emit_check (tree gnu_cond, tree gnu_expr, int reason, Node_Id gnat_node)
 {
-  tree gnu_call = build_call_raise (reason, Empty, N_Raise_Constraint_Error);
+  tree gnu_call
+    = build_call_raise (reason, gnat_node, N_Raise_Constraint_Error);
   tree gnu_result
     = fold_build3 (COND_EXPR, TREE_TYPE (gnu_expr), gnu_cond,
 		   build2 (COMPOUND_EXPR, TREE_TYPE (gnu_expr), gnu_call,
@@ -6313,11 +6568,13 @@ emit_check (tree gnu_cond, tree gnu_expr, int reason)
 /* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing overflow
    checks if OVERFLOW_P is true and range checks if RANGE_P is true.
    GNAT_TYPE is known to be an integral type.  If TRUNCATE_P true, do a
-   float to integer conversion with truncation; otherwise round.  */
+   float to integer conversion with truncation; otherwise round.
+   GNAT_NODE is the GNAT node conveying the source location for which the
+   error should be signaled.  */
 
 static tree
 convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
-		    bool rangep, bool truncatep)
+		    bool rangep, bool truncatep, Node_Id gnat_node)
 {
   tree gnu_type = get_unpadded_type (gnat_type);
   tree gnu_in_type = TREE_TYPE (gnu_expr);
@@ -6408,8 +6665,8 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
 							gnu_out_ub))));
 
       if (!integer_zerop (gnu_cond))
-	gnu_result
-	  = emit_check (gnu_cond, gnu_input, CE_Overflow_Check_Failed);
+	gnu_result = emit_check (gnu_cond, gnu_input,
+				 CE_Overflow_Check_Failed, gnat_node);
     }
 
   /* Now convert to the result base type.  If this is a non-truncating
@@ -6484,7 +6741,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
   if (rangep
       || (TREE_CODE (gnu_base_type) == INTEGER_TYPE
 	  && TYPE_MODULAR_P (gnu_base_type) && overflowp))
-    gnu_result = emit_range_check (gnu_result, gnat_type);
+    gnu_result = emit_range_check (gnu_result, gnat_type, gnat_node);
 
   return convert (gnu_type, gnu_result);
 }
@@ -6685,10 +6942,7 @@ process_type (Entity_Id gnat_entity)
 
       if (!gnu_old)
 	{
-	  tree gnu_decl = create_type_decl (get_entity_name (gnat_entity),
-					    make_dummy_type (gnat_entity),
-					    NULL, false, false, gnat_entity);
-
+	  tree gnu_decl = TYPE_STUB_DECL (make_dummy_type (gnat_entity));
 	  save_gnu_tree (gnat_entity, gnu_decl, false);
 	  if (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
 	      && Present (Full_View (gnat_entity)))
@@ -6781,7 +7035,7 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type)
       /* Before assigning a value in an aggregate make sure range checks
 	 are done if required.  Then convert to the type of the field.  */
       if (Do_Range_Check (Expression (gnat_assoc)))
-	gnu_expr = emit_range_check (gnu_expr, Etype (gnat_field));
+	gnu_expr = emit_range_check (gnu_expr, Etype (gnat_field), Empty);
 
       gnu_expr = convert (TREE_TYPE (gnu_field), gnu_expr);
 
@@ -6823,7 +7077,6 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
       /* If the expression is itself an array aggregate then first build the
 	 innermost constructor if it is part of our array (multi-dimensional
 	 case).  */
-
       if (Nkind (gnat_expr) == N_Aggregate
 	  && TREE_CODE (TREE_TYPE (gnu_array_type)) == ARRAY_TYPE
 	  && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_array_type)))
@@ -6834,10 +7087,10 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
 	{
 	  gnu_expr = gnat_to_gnu (gnat_expr);
 
-	  /* before assigning the element to the array make sure it is
+	  /* Before assigning the element to the array, make sure it is
 	     in range.  */
 	  if (Do_Range_Check (gnat_expr))
-	    gnu_expr = emit_range_check (gnu_expr, gnat_component_type);
+	    gnu_expr = emit_range_check (gnu_expr, gnat_component_type, Empty);
 	}
 
       gnu_expr_list
@@ -7183,7 +7436,6 @@ Sloc_to_locus (Source_Ptr Sloc, location_t *locus)
 
   if (Sloc <= Standard_Location)
     {
-      if (*locus == UNKNOWN_LOCATION)
       *locus = BUILTINS_LOCATION;
       return false;
     }

gcc/ada/gcc-interface/utils.c

@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2008, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2009, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -188,7 +188,6 @@ static GTY(()) VEC(tree,gc) *global_renaming_pointers;
 /* A chain of unused BLOCK nodes. */
 static GTY((deletable)) tree free_block_chain;
 
-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 *);
@@ -287,11 +286,10 @@ make_dummy_type (Entity_Id gnat_type)
 			: ENUMERAL_TYPE);
   TYPE_NAME (gnu_type) = get_entity_name (gnat_type);
   TYPE_DUMMY_P (gnu_type) = 1;
+  TYPE_STUB_DECL (gnu_type)
+    = create_type_stub_decl (TYPE_NAME (gnu_type), gnu_type);
   if (AGGREGATE_TYPE_P (gnu_type))
-    {
-      TYPE_STUB_DECL (gnu_type) = build_decl (TYPE_DECL, NULL_TREE, gnu_type);
     TYPE_BY_REFERENCE_P (gnu_type) = Is_By_Reference_Type (gnat_type);
-    }
 
   SET_DUMMY_NODE (gnat_underlying, gnu_type);
 
@@ -465,8 +463,7 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
     }
 
   /* For the declaration of a type, set its name if it either is not already
-     set, was set to an IDENTIFIER_NODE, indicating an internal name,
-     or if the previous type name was not derived from a source name.
+     set or if the previous type name was not derived from a source name.
      We'd rather have the type named with a real name and all the pointer
      types to the same object have the same POINTER_TYPE node.  Code in the
      equivalent function of c-decl.c makes a copy of the type node here, but
@@ -478,7 +475,7 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
     {
       tree t = TREE_TYPE (decl);
 
-      if (!TYPE_NAME (t) || TREE_CODE (TYPE_NAME (t)) == IDENTIFIER_NODE)
+      if (!(TYPE_NAME (t) && TREE_CODE (TYPE_NAME (t)) == TYPE_DECL))
 	;
       else if (TYPE_FAT_POINTER_P (t))
 	{
@@ -535,270 +532,17 @@ gnat_init_decl_processing (void)
   ptr_void_type_node = build_pointer_type (void_type_node);
 }
 
-/* Create the predefined scalar types such as `integer_type_node' needed
-   in the gcc back-end and initialize the global binding level.  */
+/* Record TYPE as a builtin type for Ada.  NAME is the name of the type.  */
 
 void
-init_gigi_decls (tree long_long_float_type, tree exception_type)
+record_builtin_type (const char *name, tree type)
 {
-  tree endlink, decl;
-  tree int64_type = gnat_type_for_size (64, 0);
-  unsigned int i;
+  tree type_decl = build_decl (TYPE_DECL, get_identifier (name), type);
 
-  /* Set the types that GCC and Gigi use from the front end.  We would like
-     to do this for char_type_node, but it needs to correspond to the C
-     char type.  */
-  if (TREE_CODE (TREE_TYPE (long_long_float_type)) == INTEGER_TYPE)
-    {
-      /* In this case, the builtin floating point types are VAX float,
-	 so make up a type for use.  */
-      longest_float_type_node = make_node (REAL_TYPE);
-      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, false, true, Empty);
-    }
-  else
-    longest_float_type_node = TREE_TYPE (long_long_float_type);
-
-  except_type_node = TREE_TYPE (exception_type);
-
-  unsigned_type_node = gnat_type_for_size (INT_TYPE_SIZE, 1);
-  create_type_decl (get_identifier ("unsigned int"), unsigned_type_node,
-		    NULL, false, true, Empty);
-
-  void_type_decl_node = create_type_decl (get_identifier ("void"),
-					  void_type_node, NULL, false, true,
-					  Empty);
-
-  void_ftype = build_function_type (void_type_node, NULL_TREE);
-  ptr_void_ftype = build_pointer_type (void_ftype);
-
-  /* Build the special descriptor type and its null node if needed.  */
-  if (TARGET_VTABLE_USES_DESCRIPTORS)
-    {
-      tree null_node = fold_convert (ptr_void_ftype, null_pointer_node);
-      tree field_list = NULL_TREE, null_list = NULL_TREE;
-      int j;
-
-      fdesc_type_node = make_node (RECORD_TYPE);
-
-      for (j = 0; j < TARGET_VTABLE_USES_DESCRIPTORS; j++)
-	{
-	  tree field = create_field_decl (NULL_TREE, ptr_void_ftype,
-					  fdesc_type_node, 0, 0, 0, 1);
-	  TREE_CHAIN (field) = field_list;
-	  field_list = field;
-	  null_list = tree_cons (field, null_node, null_list);
-	}
-
-      finish_record_type (fdesc_type_node, nreverse (field_list), 0, false);
-      null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_list);
-    }
-
-  /* Now declare runtime functions. */
-  endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
-
-  /* malloc is a function declaration tree for a function to allocate
-     memory.  */
-  malloc_decl = create_subprog_decl (get_identifier ("__gnat_malloc"),
-				     NULL_TREE,
-				     build_function_type (ptr_void_type_node,
-							  tree_cons (NULL_TREE,
-								     sizetype,
-								     endlink)),
-				     NULL_TREE, false, true, true, NULL,
-				     Empty);
-  DECL_IS_MALLOC (malloc_decl) = 1;
-
-  /* malloc32 is a function declaration tree for a function to allocate
-     32bit memory on a 64bit system. Needed only on 64bit VMS.  */
-  malloc32_decl = create_subprog_decl (get_identifier ("__gnat_malloc32"),
-				     NULL_TREE,
-				     build_function_type (ptr_void_type_node,
-							  tree_cons (NULL_TREE,
-								     sizetype,
-								     endlink)),
-				     NULL_TREE, false, true, true, NULL,
-				     Empty);
-  DECL_IS_MALLOC (malloc32_decl) = 1;
-
-  /* free is a function declaration tree for a function to free memory.  */
-  free_decl
-    = create_subprog_decl (get_identifier ("__gnat_free"), NULL_TREE,
-			   build_function_type (void_type_node,
-						tree_cons (NULL_TREE,
-							   ptr_void_type_node,
-							   endlink)),
-			   NULL_TREE, false, true, true, NULL, Empty);
-
-  /* This is used for 64-bit multiplication with overflow checking.  */
-  mulv64_decl
-    = create_subprog_decl (get_identifier ("__gnat_mulv64"), NULL_TREE,
-			   build_function_type_list (int64_type, int64_type,
-						     int64_type, NULL_TREE),
-			   NULL_TREE, false, true, true, NULL, Empty);
-
-  /* Make the types and functions used for exception processing.    */
-  jmpbuf_type
-    = build_array_type (gnat_type_for_mode (Pmode, 0),
-			build_index_type (build_int_cst (NULL_TREE, 5)));
-  create_type_decl (get_identifier ("JMPBUF_T"), jmpbuf_type, NULL,
-		    true, true, Empty);
-  jmpbuf_ptr_type = build_pointer_type (jmpbuf_type);
-
-  /* Functions to get and set the jumpbuf pointer for the current thread.  */
-  get_jmpbuf_decl
-    = create_subprog_decl
-    (get_identifier ("system__soft_links__get_jmpbuf_address_soft"),
-     NULL_TREE, build_function_type (jmpbuf_ptr_type, NULL_TREE),
-     NULL_TREE, false, true, true, NULL, Empty);
-  /* Avoid creating superfluous edges to __builtin_setjmp receivers.  */
-  DECL_PURE_P (get_jmpbuf_decl) = 1;
-
-  set_jmpbuf_decl
-    = create_subprog_decl
-    (get_identifier ("system__soft_links__set_jmpbuf_address_soft"),
-     NULL_TREE,
-     build_function_type (void_type_node,
-			  tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)),
-     NULL_TREE, false, true, true, NULL, Empty);
-
-  /* Function to get the current exception.  */
-  get_excptr_decl
-    = create_subprog_decl
-    (get_identifier ("system__soft_links__get_gnat_exception"),
-     NULL_TREE,
-     build_function_type (build_pointer_type (except_type_node), NULL_TREE),
-     NULL_TREE, false, true, true, NULL, Empty);
-  /* Avoid creating superfluous edges to __builtin_setjmp receivers.  */
-  DECL_PURE_P (get_excptr_decl) = 1;
-
-  /* Functions that raise exceptions. */
-  raise_nodefer_decl
-    = create_subprog_decl
-      (get_identifier ("__gnat_raise_nodefer_with_msg"), NULL_TREE,
-       build_function_type (void_type_node,
-			    tree_cons (NULL_TREE,
-				       build_pointer_type (except_type_node),
-				       endlink)),
-       NULL_TREE, false, true, true, NULL, Empty);
-
-  /* Dummy objects to materialize "others" and "all others" in the exception
-     tables.  These are exported by a-exexpr.adb, so see this unit for the
-     types to use.  */
-
-  others_decl
-    = create_var_decl (get_identifier ("OTHERS"),
-		       get_identifier ("__gnat_others_value"),
-		       integer_type_node, 0, 1, 0, 1, 1, 0, Empty);
-
-  all_others_decl
-    = create_var_decl (get_identifier ("ALL_OTHERS"),
-		       get_identifier ("__gnat_all_others_value"),
-		       integer_type_node, 0, 1, 0, 1, 1, 0, Empty);
-
-  /* Hooks to call when entering/leaving an exception handler.  */
-  begin_handler_decl
-    = create_subprog_decl (get_identifier ("__gnat_begin_handler"), NULL_TREE,
-			   build_function_type (void_type_node,
-						tree_cons (NULL_TREE,
-							   ptr_void_type_node,
-							   endlink)),
-			   NULL_TREE, false, true, true, NULL, Empty);
-
-  end_handler_decl
-    = create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE,
-			   build_function_type (void_type_node,
-						tree_cons (NULL_TREE,
-							   ptr_void_type_node,
-							   endlink)),
-			   NULL_TREE, false, true, true, NULL, Empty);
-
-  /* If in no exception handlers mode, all raise statements are redirected to
-     __gnat_last_chance_handler. No need to redefine raise_nodefer_decl, since
-     this procedure will never be called in this mode.  */
-  if (No_Exception_Handlers_Set ())
-    {
-      decl
-	= create_subprog_decl
-	  (get_identifier ("__gnat_last_chance_handler"), NULL_TREE,
-	   build_function_type (void_type_node,
-				tree_cons (NULL_TREE,
-					   build_pointer_type (char_type_node),
-					   tree_cons (NULL_TREE,
-						      integer_type_node,
-						      endlink))),
-	   NULL_TREE, false, true, true, NULL, Empty);
-
-      for (i = 0; i < ARRAY_SIZE (gnat_raise_decls); i++)
-	gnat_raise_decls[i] = decl;
-    }
-  else
-    /* Otherwise, make one decl for each exception reason.  */
-    for (i = 0; i < ARRAY_SIZE (gnat_raise_decls); i++)
-      {
-	char name[17];
-
-	sprintf (name, "__gnat_rcheck_%.2d", i);
-	gnat_raise_decls[i]
-	  = create_subprog_decl
-	    (get_identifier (name), NULL_TREE,
-	     build_function_type (void_type_node,
-				  tree_cons (NULL_TREE,
-					     build_pointer_type
-					     (char_type_node),
-					     tree_cons (NULL_TREE,
-							integer_type_node,
-							endlink))),
-	     NULL_TREE, false, true, true, NULL, Empty);
-      }
-
-  /* Indicate that these never return.  */
-  TREE_THIS_VOLATILE (raise_nodefer_decl) = 1;
-  TREE_SIDE_EFFECTS (raise_nodefer_decl) = 1;
-  TREE_TYPE (raise_nodefer_decl)
-    = build_qualified_type (TREE_TYPE (raise_nodefer_decl),
-			    TYPE_QUAL_VOLATILE);
-
-  for (i = 0; i < ARRAY_SIZE (gnat_raise_decls); i++)
-    {
-      TREE_THIS_VOLATILE (gnat_raise_decls[i]) = 1;
-      TREE_SIDE_EFFECTS (gnat_raise_decls[i]) = 1;
-      TREE_TYPE (gnat_raise_decls[i])
-	= build_qualified_type (TREE_TYPE (gnat_raise_decls[i]),
-				TYPE_QUAL_VOLATILE);
-    }
-
-  /* setjmp returns an integer and has one operand, which is a pointer to
-     a jmpbuf.  */
-  setjmp_decl
-    = create_subprog_decl
-      (get_identifier ("__builtin_setjmp"), NULL_TREE,
-       build_function_type (integer_type_node,
-			    tree_cons (NULL_TREE,  jmpbuf_ptr_type, endlink)),
-       NULL_TREE, false, true, true, NULL, Empty);
-
-  DECL_BUILT_IN_CLASS (setjmp_decl) = BUILT_IN_NORMAL;
-  DECL_FUNCTION_CODE (setjmp_decl) = BUILT_IN_SETJMP;
-
-  /* update_setjmp_buf updates a setjmp buffer from the current stack pointer
-     address.  */
-  update_setjmp_buf_decl
-    = create_subprog_decl
-      (get_identifier ("__builtin_update_setjmp_buf"), NULL_TREE,
-       build_function_type (void_type_node,
-			    tree_cons (NULL_TREE,  jmpbuf_ptr_type, endlink)),
-       NULL_TREE, false, true, true, NULL, Empty);
-
-  DECL_BUILT_IN_CLASS (update_setjmp_buf_decl) = BUILT_IN_NORMAL;
-  DECL_FUNCTION_CODE (update_setjmp_buf_decl) = BUILT_IN_UPDATE_SETJMP_BUF;
-
-  main_identifier_node = get_identifier ("main");
-
-  /* Install the builtins we might need, either internally or as
-     user available facilities for Intrinsic imports.  */
-  gnat_install_builtins ();
+  gnat_pushdecl (type_decl, Empty);
+
+  if (debug_hooks->type_decl)
+    debug_hooks->type_decl (type_decl, false);
 }
 
 /* Given a record type RECORD_TYPE and a chain of FIELD_DECL nodes FIELDLIST,
@@ -824,15 +568,13 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
   bool had_align = TYPE_ALIGN (record_type) != 0;
   tree field;
 
-  if (name && TREE_CODE (name) == TYPE_DECL)
-    name = DECL_NAME (name);
-
   TYPE_FIELDS (record_type) = fieldlist;
-  TYPE_STUB_DECL (record_type) = build_decl (TYPE_DECL, name, record_type);
 
-  /* We don't need both the typedef name and the record name output in
-     the debugging information, since they are the same.  */
-  DECL_ARTIFICIAL (TYPE_STUB_DECL (record_type)) = 1;
+  /* Always attach the TYPE_STUB_DECL for a record type.  It is required to
+     generate debug info and have a parallel type.  */
+  if (name && TREE_CODE (name) == TYPE_DECL)
+    name = DECL_NAME (name);
+  TYPE_STUB_DECL (record_type) = create_type_stub_decl (name, record_type);
 
   /* Globally initialize the record first.  If this is a rep'ed record,
      that just means some initializations; otherwise, layout the record.  */
@@ -1075,8 +817,7 @@ rest_of_record_type_compilation (tree record_type)
       TYPE_NAME (new_record_type) = new_id;
       TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
       TYPE_STUB_DECL (new_record_type)
-	= build_decl (TYPE_DECL, new_id, new_record_type);
-      DECL_ARTIFICIAL (TYPE_STUB_DECL (new_record_type)) = 1;
+	= create_type_stub_decl (new_id, new_record_type);
       DECL_IGNORED_P (TYPE_STUB_DECL (new_record_type))
 	= DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
       TYPE_SIZE (new_record_type) = size_int (TYPE_ALIGN (record_type));
@@ -1448,30 +1189,62 @@ create_index_type (tree min, tree max, tree index, Node_Id gnat_node)
   return type;
 }
 
-/* Return a TYPE_DECL node. TYPE_NAME gives the name of the type (a character
-   string) and TYPE is a ..._TYPE node giving its data type.
-   ARTIFICIAL_P is true if this is a declaration that was generated
-   by the compiler.  DEBUG_INFO_P is true if we need to write debugging
-   information about this type.  GNAT_NODE is used for the position of
-   the decl.  */
+/* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of a type.
+   TYPE_NAME gives the name of the type and TYPE is a ..._TYPE node giving
+   its data type.  */
+
+tree
+create_type_stub_decl (tree type_name, tree type)
+{
+  /* Using a named TYPE_DECL ensures that a type name marker is emitted in
+     STABS while setting DECL_ARTIFICIAL ensures that no DW_TAG_typedef is
+     emitted in DWARF.  */
+  tree type_decl = build_decl (TYPE_DECL, type_name, type);
+  DECL_ARTIFICIAL (type_decl) = 1;
+  return type_decl;
+}
+
+/* Return a TYPE_DECL node.  TYPE_NAME gives the name of the type and TYPE
+   is a ..._TYPE node giving its data type.  ARTIFICIAL_P is true if this
+   is a declaration that was generated by the compiler.  DEBUG_INFO_P is
+   true if we need to write debug 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,
 		  bool artificial_p, bool debug_info_p, Node_Id gnat_node)
 {
-  tree type_decl = build_decl (TYPE_DECL, type_name, type);
   enum tree_code code = TREE_CODE (type);
+  bool named = TYPE_NAME (type) && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL;
+  tree type_decl;
 
-  DECL_ARTIFICIAL (type_decl) = artificial_p;
+  /* Only the builtin TYPE_STUB_DECL should be used for dummy types.  */
+  gcc_assert (!TYPE_IS_DUMMY_P (type));
 
-  if (!TYPE_IS_DUMMY_P (type))
-    gnat_pushdecl (type_decl, gnat_node);
+  /* If the type hasn't been named yet, we're naming it; preserve an existing
+     TYPE_STUB_DECL that has been attached to it for some purpose.  */
+  if (!named && TYPE_STUB_DECL (type))
+    {
+      type_decl = TYPE_STUB_DECL (type);
+      DECL_NAME (type_decl) = type_name;
+    }
+  else
+    type_decl = build_decl (TYPE_DECL, type_name, type);
 
+  DECL_ARTIFICIAL (type_decl) = artificial_p;
+  gnat_pushdecl (type_decl, gnat_node);
   process_attributes (type_decl, attr_list);
 
-  /* Pass type declaration information to the debugger unless this is an
-     UNCONSTRAINED_ARRAY_TYPE, which the debugger does not support,
-     and ENUMERAL_TYPE or RECORD_TYPE which is handled separately, or
+  /* If we're naming the type, equate the TYPE_STUB_DECL to the name.
+     This causes the name to be also viewed as a "tag" by the debug
+     back-end, with the advantage that no DW_TAG_typedef is emitted
+     for artificial "tagged" types in DWARF.  */
+  if (!named)
+    TYPE_STUB_DECL (type) = type_decl;
+
+  /* Pass the type declaration to the debug back-end unless this is an
+     UNCONSTRAINED_ARRAY_TYPE that the back-end does not support, an
+     ENUMERAL_TYPE or RECORD_TYPE which are handled separately, or a
      type for which debugging information was not requested.  */
   if (code == UNCONSTRAINED_ARRAY_TYPE || !debug_info_p)
     DECL_IGNORED_P (type_decl) = 1;
@@ -2298,7 +2071,6 @@ gnat_gimplify_function (tree fndecl)
     gnat_gimplify_function (cgn->decl);
 }
 
-
 tree
 gnat_builtin_function (tree decl)
 {
@@ -2966,10 +2738,8 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
       post_error ("unsupported descriptor type for &", gnat_entity);
     }
 
+  TYPE_NAME (record_type) = create_concat_name (gnat_entity, "DESC");
   finish_record_type (record_type, field_list, 0, true);
-  create_type_decl (create_concat_name (gnat_entity, "DESC"), record_type,
-		    NULL, true, false, gnat_entity);
-
   return record_type;
 }
 
@@ -3282,10 +3052,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
       post_error ("unsupported descriptor type for &", gnat_entity);
     }
 
+  TYPE_NAME (record64_type) = create_concat_name (gnat_entity, "DESC64");
   finish_record_type (record64_type, field_list64, 0, true);
-  create_type_decl (create_concat_name (gnat_entity, "DESC64"), record64_type,
-		    NULL, true, false, gnat_entity);
-
   return record64_type;
 }