+ 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 (size_int (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);
+
+ /* 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);
+ record_builtin_type ("descriptor", fdesc_type_node);
+ null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_list);
+ }
+
+ 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);
+
+ /* 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 ();