#include "debug.h"
#include "convert.h"
#include "target.h"
+#include "function.h"
+#include "cgraph.h"
+#include "tree-inline.h"
+#include "tree-gimple.h"
+#include "tree-dump.h"
#include "ada.h"
#include "types.h"
of `save_gnu_tree' for more info. */
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(()) {
- 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.
/* Likewise for float types, but record these by mode. */
static GTY(()) tree float_types[NUM_MACHINE_MODES];
-/* For each binding contour we allocate a binding_level structure which records
- the entities defined or declared in that contour. Contours include:
-
- the global one
- one for each subprogram definition
- one for each compound statement (declare block)
-
- Binding contours are used to create GCC tree BLOCK nodes. */
+/* For each binding contour we allocate a binding_level structure to indicate
+ the binding depth. */
-struct binding_level GTY(())
+struct gnat_binding_level GTY((chain_next ("%h.chain")))
{
- /* A chain of ..._DECL nodes for all variables, constants, functions,
- parameters and type declarations. These ..._DECL nodes are chained
- through the TREE_CHAIN field. Note that these ..._DECL nodes are stored
- in the reverse of the order supplied to be compatible with the
- back-end. */
- tree names;
- /* For each level (except the global one), a chain of BLOCK nodes for all
- the levels that were entered and exited one level down from this one. */
- tree blocks;
- /* The BLOCK node for this level, if one has been preallocated.
- If 0, the BLOCK is allocated (if needed) when the level is popped. */
- tree this_block;
/* The binding level containing this one (the enclosing binding level). */
- struct binding_level *level_chain;
+ struct gnat_binding_level *chain;
+ /* The BLOCK node for this level. */
+ tree block;
+ /* If nonzero, the setjmp buffer that needs to be updated for any
+ variable-sized definition within this context. */
+ tree jmpbuf_decl;
};
/* The binding level currently in effect. */
-static GTY(()) struct binding_level *current_binding_level;
+static GTY(()) struct gnat_binding_level *current_binding_level;
-/* A chain of binding_level structures awaiting reuse. */
-static GTY((deletable (""))) struct binding_level *free_binding_level;
+/* A chain of gnat_binding_level structures awaiting reuse. */
+static GTY((deletable)) struct gnat_binding_level *free_binding_level;
-/* The outermost binding level. This binding level is created when the
- compiler is started and it will exist through the entire compilation. */
-static struct binding_level *global_binding_level;
-
-/* Binding level structures are initialized by copying this one. */
-static struct binding_level clear_binding_level = {NULL, NULL, NULL, NULL};
+/* A chain of unused BLOCK nodes. */
+static GTY((deletable)) tree free_block_chain;
struct language_function GTY(())
{
int unused;
};
-static tree merge_sizes (tree, tree, tree, int, int);
+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 int value_zerop (tree);
+static bool value_zerop (tree);
+static void gnat_gimplify_function (tree);
+static void gnat_finalize (tree);
static tree float_type_for_precision (int, enum machine_mode);
static tree convert_to_fat_pointer (tree, tree);
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);
+static bool value_factor_p (tree, HOST_WIDE_INT);
+static bool potential_alignment_gap (tree, tree, tree);
\f
/* Initialize the association of GNAT nodes to GCC trees. */
{
associate_gnat_to_gnu
= (tree *) ggc_alloc_cleared (max_gnat_nodes * sizeof (tree));
-
- pending_elaborations = build_tree_list (NULL_TREE, NULL_TREE);
}
/* GNAT_ENTITY is a GNAT tree node for an entity. GNU_DECL is the GCC tree
If GNU_DECL is zero, a previous association is to be reset. */
void
-save_gnu_tree (Entity_Id gnat_entity, tree gnu_decl, int no_check)
+save_gnu_tree (Entity_Id gnat_entity, tree gnu_decl, bool no_check)
{
/* Check that GNAT_ENTITY is not already defined and that it is being set
to something which is a decl. Raise gigi 401 if not. Usually, this
Gigi problem. */
if (gnu_decl
&& (associate_gnat_to_gnu[gnat_entity - First_Node_Id]
- || (! no_check && ! DECL_P (gnu_decl))))
- gigi_abort (401);
+ || (!no_check && !DECL_P (gnu_decl))))
+ abort ();
associate_gnat_to_gnu[gnat_entity - First_Node_Id] = gnu_decl;
}
tree
get_gnu_tree (Entity_Id gnat_entity)
{
- if (! associate_gnat_to_gnu[gnat_entity - First_Node_Id])
- gigi_abort (402);
+ if (!associate_gnat_to_gnu[gnat_entity - First_Node_Id])
+ abort ();
return associate_gnat_to_gnu[gnat_entity - First_Node_Id];
}
/* Return nonzero if a GCC tree has been associated with GNAT_ENTITY. */
-int
+bool
present_gnu_tree (Entity_Id gnat_entity)
{
- return (associate_gnat_to_gnu[gnat_entity - First_Node_Id] != NULL_TREE);
+ return (associate_gnat_to_gnu[gnat_entity - First_Node_Id]) != 0;
}
\f
int
global_bindings_p (void)
{
- return (force_global != 0 || current_binding_level == global_binding_level
- ? -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 current_binding_level->names;
-}
-
-/* Nonzero if the current level needs to have a BLOCK made. */
-
-int
-kept_level_p (void)
-{
- return (current_binding_level->names != 0);
+ return ((force_global || !current_function_decl) ? -1 : 0);
}
-/* Enter a new binding level. The input parameter is ignored, but has to be
- specified for back-end compatibility. */
+/* Enter a new binding level. */
void
-pushlevel (int ignore ATTRIBUTE_UNUSED)
+gnat_pushlevel ()
{
- struct binding_level *newlevel = NULL;
+ struct gnat_binding_level *newlevel = NULL;
/* Reuse a struct for this binding level, if there is one. */
if (free_binding_level)
{
newlevel = free_binding_level;
- free_binding_level = free_binding_level->level_chain;
+ free_binding_level = free_binding_level->chain;
}
else
newlevel
- = (struct binding_level *) ggc_alloc (sizeof (struct binding_level));
+ = (struct gnat_binding_level *)
+ ggc_alloc (sizeof (struct gnat_binding_level));
- *newlevel = clear_binding_level;
+ /* Use a free BLOCK, if any; otherwise, allocate one. */
+ if (free_block_chain)
+ {
+ newlevel->block = free_block_chain;
+ free_block_chain = TREE_CHAIN (free_block_chain);
+ TREE_CHAIN (newlevel->block) = NULL_TREE;
+ }
+ else
+ newlevel->block = make_node (BLOCK);
+
+ /* Point the BLOCK we just made to its parent. */
+ if (current_binding_level)
+ BLOCK_SUPERCONTEXT (newlevel->block) = current_binding_level->block;
+
+ BLOCK_VARS (newlevel->block) = BLOCK_SUBBLOCKS (newlevel->block) = NULL_TREE;
+ TREE_USED (newlevel->block) = 1;
/* Add this level to the front of the chain (stack) of levels that are
active. */
- newlevel->level_chain = current_binding_level;
+ newlevel->chain = current_binding_level;
+ newlevel->jmpbuf_decl = NULL_TREE;
current_binding_level = newlevel;
}
-/* Exit a binding level.
- Pop the level off, and restore the state of the identifier-decl mappings
- that were in effect when this level was entered.
-
- If KEEP is nonzero, this level had explicit declarations, so
- and create a "block" (a BLOCK node) for the level
- to record its declarations and subblocks for symbol table output.
+/* Set SUPERCONTEXT of the BLOCK for the current binding level to FNDECL
+ and point FNDECL to this BLOCK. */
- If FUNCTIONBODY is nonzero, this level is the body of a function,
- so create a block as if KEEP were set and also clear out all
- label names.
+void
+set_current_block_context (tree fndecl)
+{
+ BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
+ DECL_INITIAL (fndecl) = current_binding_level->block;
+}
- If REVERSE is nonzero, reverse the order of decls before putting
- them into the BLOCK. */
+/* Set the jmpbuf_decl for the current binding level to DECL. */
-tree
-poplevel (int keep, int reverse, int functionbody)
+void
+set_block_jmpbuf_decl (tree decl)
{
- /* Points to a GCC BLOCK tree node. This is the BLOCK node construted for the
- binding level that we are about to exit and which is returned by this
- routine. */
- tree block = NULL_TREE;
- tree decl_chain;
- tree decl_node;
- tree subblock_chain = current_binding_level->blocks;
- tree subblock_node;
- int block_previously_created;
-
- /* Reverse the list of XXXX_DECL nodes if desired. Note that the ..._DECL
- nodes chained through the `names' field of current_binding_level are in
- reverse order except for PARM_DECL node, which are explicitly stored in
- the right order. */
- current_binding_level->names
- = decl_chain = (reverse) ? nreverse (current_binding_level->names)
- : current_binding_level->names;
-
- /* Output any nested inline functions within this block which must be
- compiled because their address is needed. */
- for (decl_node = decl_chain; decl_node; decl_node = TREE_CHAIN (decl_node))
- if (TREE_CODE (decl_node) == FUNCTION_DECL
- && ! TREE_ASM_WRITTEN (decl_node) && TREE_ADDRESSABLE (decl_node)
- && DECL_INITIAL (decl_node) != 0)
- {
- push_function_context ();
- output_inline_function (decl_node);
- pop_function_context ();
- }
+ current_binding_level->jmpbuf_decl = decl;
+}
- block = 0;
- block_previously_created = (current_binding_level->this_block != 0);
- if (block_previously_created)
- block = current_binding_level->this_block;
- else if (keep || functionbody)
- block = make_node (BLOCK);
- if (block != 0)
- {
- BLOCK_VARS (block) = keep ? decl_chain : 0;
- BLOCK_SUBBLOCKS (block) = subblock_chain;
- }
+/* Get the jmpbuf_decl, if any, for the current binding level. */
- /* Record the BLOCK node just built as the subblock its enclosing scope. */
- for (subblock_node = subblock_chain; subblock_node;
- subblock_node = TREE_CHAIN (subblock_node))
- BLOCK_SUPERCONTEXT (subblock_node) = block;
+tree
+get_block_jmpbuf_decl ()
+{
+ return current_binding_level->jmpbuf_decl;
+}
- /* Clear out the meanings of the local variables of this level. */
+/* Exit a binding level. Set any BLOCK into the current code group. */
- for (subblock_node = decl_chain; subblock_node;
- subblock_node = TREE_CHAIN (subblock_node))
- if (DECL_NAME (subblock_node) != 0)
- /* If the identifier was used or addressed via a local extern decl,
- don't forget that fact. */
- if (DECL_EXTERNAL (subblock_node))
- {
- if (TREE_USED (subblock_node))
- TREE_USED (DECL_NAME (subblock_node)) = 1;
- if (TREE_ADDRESSABLE (subblock_node))
- TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
- }
+void
+gnat_poplevel ()
+{
+ struct gnat_binding_level *level = current_binding_level;
+ tree block = level->block;
- {
- /* Pop the current level, and free the structure for reuse. */
- struct binding_level *level = current_binding_level;
- current_binding_level = current_binding_level->level_chain;
- level->level_chain = free_binding_level;
- free_binding_level = level;
- }
+ BLOCK_VARS (block) = nreverse (BLOCK_VARS (block));
+ BLOCK_SUBBLOCKS (block) = nreverse (BLOCK_SUBBLOCKS (block));
- if (functionbody)
+ /* If this is a function-level BLOCK don't do anything. Otherwise, if there
+ are no variables free the block and merge its subblocks into those of its
+ parent block. Otherwise, add it to the list of its parent. */
+ if (TREE_CODE (BLOCK_SUPERCONTEXT (block)) == FUNCTION_DECL)
+ ;
+ else if (BLOCK_VARS (block) == NULL_TREE)
{
- /* This is the top level block of a function. The ..._DECL chain stored
- in BLOCK_VARS are the function's parameters (PARM_DECL nodes). Don't
- leave them in the BLOCK because they are found in the FUNCTION_DECL
- instead. */
- DECL_INITIAL (current_function_decl) = block;
- BLOCK_VARS (block) = 0;
+ BLOCK_SUBBLOCKS (level->chain->block)
+ = chainon (BLOCK_SUBBLOCKS (block),
+ BLOCK_SUBBLOCKS (level->chain->block));
+ TREE_CHAIN (block) = free_block_chain;
+ free_block_chain = block;
}
- else if (block)
+ else
{
- if (!block_previously_created)
- current_binding_level->blocks
- = chainon (current_binding_level->blocks, block);
+ TREE_CHAIN (block) = BLOCK_SUBBLOCKS (level->chain->block);
+ BLOCK_SUBBLOCKS (level->chain->block) = block;
+ TREE_USED (block) = 1;
+ set_block_for_group (block);
}
- /* If we did not make a block for the level just exited, any blocks made for
- inner levels (since they cannot be recorded as subblocks in that level)
- must be carried forward so they will later become subblocks of something
- else. */
- else if (subblock_chain)
- current_binding_level->blocks
- = chainon (current_binding_level->blocks, subblock_chain);
- if (block)
- TREE_USED (block) = 1;
-
- return block;
+ /* Free this binding structure. */
+ current_binding_level = level->chain;
+ level->chain = free_binding_level;
+ free_binding_level = level;
}
-\f
+
/* Insert BLOCK at the end of the list of subblocks of the
current binding level. This is used when a BIND_EXPR is expanded,
to handle the BLOCK node inside the BIND_EXPR. */
insert_block (tree block)
{
TREE_USED (block) = 1;
- current_binding_level->blocks
- = chainon (current_binding_level->blocks, block);
+ TREE_CHAIN (block) = BLOCK_SUBBLOCKS (current_binding_level->block);
+ BLOCK_SUBBLOCKS (current_binding_level->block) = block;
}
-
-/* Set the BLOCK node for the innermost scope
- (the one we are currently in). */
+\f
+/* Records a ..._DECL node DECL as belonging to the current lexical scope
+ and uses GNAT_NODE for location information. */
void
-set_block (tree block)
-{
- current_binding_level->this_block = block;
- current_binding_level->names = chainon (current_binding_level->names,
- BLOCK_VARS (block));
- current_binding_level->blocks = chainon (current_binding_level->blocks,
- BLOCK_SUBBLOCKS (block));
-}
-
-/* Records a ..._DECL node DECL as belonging to the current lexical scope.
- Returns the ..._DECL node. */
-
-tree
-pushdecl (tree decl)
+gnat_pushdecl (tree decl, Node_Id gnat_node)
{
- struct binding_level *b;
-
/* If at top level, there is no context. But PARM_DECLs always go in the
- level of its function. */
+ level of its function. */
if (global_bindings_p () && TREE_CODE (decl) != PARM_DECL)
- {
- b = global_binding_level;
- DECL_CONTEXT (decl) = 0;
- }
+ DECL_CONTEXT (decl) = 0;
else
- {
- b = current_binding_level;
- DECL_CONTEXT (decl) = current_function_decl;
- }
+ 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 if necessary. This needs to be
- this way for compatibility with the back-end.
+ /* 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);
- 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)
+ /* 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) = b->names;
- b->names = decl;
+ TREE_CHAIN (decl) = BLOCK_VARS (current_binding_level->block);
+ BLOCK_VARS (current_binding_level->block) = decl;
}
/* For the declaration of a type, set its name if it either is not already
for now). */
if (TREE_CODE (decl) == TYPE_DECL
- && DECL_NAME (decl) != 0
- && (TYPE_NAME (TREE_TYPE (decl)) == 0
+ && DECL_NAME (decl)
+ && (!TYPE_NAME (TREE_TYPE (decl))
|| TREE_CODE (TYPE_NAME (TREE_TYPE (decl))) == IDENTIFIER_NODE
|| (TREE_CODE (TYPE_NAME (TREE_TYPE (decl))) == TYPE_DECL
&& DECL_ARTIFICIAL (TYPE_NAME (TREE_TYPE (decl)))
- && ! DECL_ARTIFICIAL (decl))))
+ && !DECL_ARTIFICIAL (decl))))
TYPE_NAME (TREE_TYPE (decl)) = decl;
- return decl;
+ if (TREE_CODE (decl) != CONST_DECL)
+ rest_of_decl_compilation (decl, global_bindings_p (), 0);
}
\f
/* Do little here. Set up the standard declarations later after the
current_function_decl = 0;
current_binding_level = 0;
free_binding_level = 0;
- pushlevel (0);
- global_binding_level = current_binding_level;
+ gnat_pushlevel ();
- build_common_tree_nodes (0);
+ build_common_tree_nodes (false, false);
/* In Ada, we use a signed type for SIZETYPE. Use the signed type
corresponding to the size of Pmode. In most cases when ptr_mode and
Pmode differ, C will use the width of ptr_mode as sizetype. But we get
far better code using the width of Pmode. Make this here since we need
this before we can expand the GNAT types. */
- set_sizetype (gnat_type_for_size (GET_MODE_BITSIZE (Pmode), 0));
+ size_type_node = gnat_type_for_size (GET_MODE_BITSIZE (Pmode), 0);
+ set_sizetype (size_type_node);
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));
+ /* 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);
ptr_void_type_node = build_pointer_type (void_type_node);
+ gnat_install_builtins ();
+}
+
+/* Define a builtin function. This is temporary and is just being done
+ to initialize implicit_built_in_decls for the middle-end. We'll want
+ to do full builtin processing soon. */
+
+static void
+gnat_define_builtin (const char *name, tree type,
+ int function_code, const char *library_name, bool const_p)
+{
+ tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
+
+ DECL_EXTERNAL (decl) = 1;
+ TREE_PUBLIC (decl) = 1;
+ if (library_name)
+ SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
+ make_decl_rtl (decl);
+ gnat_pushdecl (decl, Empty);
+ DECL_BUILT_IN_CLASS (decl) = BUILT_IN_NORMAL;
+ DECL_FUNCTION_CODE (decl) = function_code;
+ TREE_READONLY (decl) = const_p;
+
+ implicit_built_in_decls[function_code] = decl;
+}
+
+/* Install the builtin functions the middle-end needs. */
+
+static void
+gnat_install_builtins ()
+{
+ tree ftype;
+ tree tmp;
+
+ tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
+ tmp = tree_cons (NULL_TREE, long_integer_type_node, tmp);
+ ftype = build_function_type (long_integer_type_node, tmp);
+ gnat_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
+ "__builtin_expect", true);
+
+ tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+ ftype = build_function_type (ptr_void_type_node, tmp);
+ gnat_define_builtin ("__builtin_memcpy", ftype, BUILT_IN_MEMCPY,
+ "memcpy", false);
+
+ tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+ ftype = build_function_type (integer_type_node, tmp);
+ gnat_define_builtin ("__builtin_memcmp", ftype, BUILT_IN_MEMCMP,
+ "memcmp", false);
+
+ tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
+ tmp = tree_cons (NULL_TREE, integer_type_node, tmp);
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+ ftype = build_function_type (integer_type_node, tmp);
+ gnat_define_builtin ("__builtin_memset", ftype, BUILT_IN_MEMSET,
+ "memset", false);
+
+ tmp = tree_cons (NULL_TREE, integer_type_node, void_list_node);
+ ftype = build_function_type (integer_type_node, tmp);
+ gnat_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ, "clz", true);
+
+ tmp = tree_cons (NULL_TREE, long_integer_type_node, void_list_node);
+ ftype = build_function_type (integer_type_node, tmp);
+ gnat_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL, "clzl", true);
+
+ tmp = tree_cons (NULL_TREE, long_long_integer_type_node, void_list_node);
+ ftype = build_function_type (integer_type_node, tmp);
+ gnat_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL, "clzll",
+ true);
+
+ /* The init_trampoline and adjust_trampoline builtins aren't used directly.
+ They are inserted during lowering of nested functions. */
+
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, void_list_node);
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, tmp);
+ ftype = build_function_type (void_type_node, tmp);
+ gnat_define_builtin ("__builtin_init_trampoline", ftype,
+ BUILT_IN_INIT_TRAMPOLINE, "init_trampoline", false);
+
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, void_list_node);
+ ftype = build_function_type (ptr_void_type_node, tmp);
+ gnat_define_builtin ("__builtin_adjust_trampoline", ftype,
+ BUILT_IN_ADJUST_TRAMPOLINE, "adjust_trampoline", true);
+
+ /* The stack_save, stack_restore, and alloca builtins aren't used directly.
+ They are inserted during gimplification to implement variable sized stack
+ allocation. */
+
+ ftype = build_function_type (ptr_void_type_node, void_list_node);
+ gnat_define_builtin ("__builtin_stack_save", ftype, BUILT_IN_STACK_SAVE,
+ "stack_save", false);
+
+ tmp = tree_cons (NULL_TREE, ptr_void_type_node, void_list_node);
+ ftype = build_function_type (void_type_node, tmp);
+ gnat_define_builtin ("__builtin_stack_restore", ftype,
+ BUILT_IN_STACK_RESTORE, "stack_restore", false);
+
+ tmp = tree_cons (NULL_TREE, size_type_node, void_list_node);
+ ftype = build_function_type (ptr_void_type_node, tmp);
+ gnat_define_builtin ("__builtin_alloca", ftype, BUILT_IN_ALLOCA,
+ "alloca", false);
+
}
/* Create the predefined scalar types such as `integer_type_node' needed
longest_float_type_node = make_node (REAL_TYPE);
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));
+ 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);
- pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned int"),
- unsigned_type_node));
+ create_type_decl (get_identifier ("unsigned int"), unsigned_type_node,
+ NULL, false, true, Empty);
- void_type_decl_node
- = pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
- void_type_node));
+ 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);
tree_cons (NULL_TREE,
sizetype,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, false, true, true, NULL,
+ Empty);
/* free is a function declaration tree for a function to free memory. */
free_decl
tree_cons (NULL_TREE,
ptr_void_type_node,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ 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_2 (5, 0)));
- pushdecl (build_decl (TYPE_DECL, get_identifier ("JMPBUF_T"), jmpbuf_type));
+ build_index_type (build_int_cst (NULL_TREE, 5)));
+ create_type_decl (get_identifier ("JMPBUF_T"), jmpbuf_type, NULL,
+ false, true, Empty);
jmpbuf_ptr_type = build_pointer_type (jmpbuf_type);
/* Functions to get and set the jumpbuf pointer for the current thread. */
= create_subprog_decl
(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);
+ NULL_TREE, false, true, true, NULL, Empty);
set_jmpbuf_decl
= create_subprog_decl
NULL_TREE,
build_function_type (void_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, false, true, true, NULL, Empty);
/* Function to get the current exception. */
get_excptr_decl
(get_identifier ("system__soft_links__get_gnat_exception"),
NULL_TREE,
build_function_type (build_pointer_type (except_type_node), NULL_TREE),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, false, true, true, NULL, Empty);
/* Functions that raise exceptions. */
raise_nodefer_decl
tree_cons (NULL_TREE,
build_pointer_type (except_type_node),
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, false, true, true, NULL, Empty);
/* Hooks to call when entering/leaving an exception handler. */
begin_handler_decl
tree_cons (NULL_TREE,
ptr_void_type_node,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, false, true, true, NULL, Empty);
end_handler_decl
= create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE,
tree_cons (NULL_TREE,
ptr_void_type_node,
endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ 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
tree_cons (NULL_TREE,
integer_type_node,
endlink))),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, false, true, true, NULL, Empty);
for (i = 0; i < ARRAY_SIZE (gnat_raise_decls); i++)
gnat_raise_decls[i] = decl;
tree_cons (NULL_TREE,
integer_type_node,
endlink))),
- NULL_TREE, 0, 1, 1, 0);
+ NULL_TREE, false, true, true, NULL, Empty);
}
/* Indicate that these never return. */
(get_identifier ("__builtin_setjmp"), NULL_TREE,
build_function_type (integer_type_node,
tree_cons (NULL_TREE, jmpbuf_ptr_type, endlink)),
- NULL_TREE, 0, 1, 1, 0);
+ 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");
}
\f
-/* 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. */
+/* 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
+ true, this record has a rep clause; don't call layout_type but merely set
+ the size and alignment ourselves. If DEFER_DEBUG is true, 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, tree fieldlist, bool has_rep,
+ bool defer_debug)
{
enum tree_code code = TREE_CODE (record_type);
tree ada_size = bitsize_zero_node;
tree size = bitsize_zero_node;
tree size_unit = size_zero_node;
- int var_size = 0;
+ bool var_size = false;
tree field;
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));
+ 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
the debugging information, since they are the same. */
{
TYPE_ALIGN (record_type) = MAX (BITS_PER_UNIT, TYPE_ALIGN (record_type));
TYPE_MODE (record_type) = BLKmode;
- if (TYPE_SIZE (record_type) == 0)
+ if (!TYPE_SIZE (record_type))
{
TYPE_SIZE (record_type) = bitsize_zero_node;
TYPE_SIZE_UNIT (record_type) = size_zero_node;
output routines (except Dwarf2) won't be able to output the fields,
so we need to make the special record. */
if (TREE_CODE (this_size) != INTEGER_CST)
- var_size = 1;
+ var_size = true;
if ((TREE_CODE (type) == RECORD_TYPE || TREE_CODE (type) == UNION_TYPE
|| TREE_CODE (type) == QUAL_UNION_TYPE)
- && ! TYPE_IS_FAT_POINTER_P (type)
- && ! TYPE_CONTAINS_TEMPLATE_P (type)
- && TYPE_ADA_SIZE (type) != 0)
+ && !TYPE_IS_FAT_POINTER_P (type)
+ && !TYPE_CONTAINS_TEMPLATE_P (type)
+ && TYPE_ADA_SIZE (type))
this_ada_size = TYPE_ADA_SIZE (type);
/* Clear DECL_BIT_FIELD for the cases layout_decl does not handle. */
DECL_NONADDRESSABLE_P (field)
|= DECL_BIT_FIELD (field) && DECL_MODE (field) != BLKmode;
- if (has_rep && ! DECL_BIT_FIELD (field))
+ if (has_rep && !DECL_BIT_FIELD (field))
TYPE_ALIGN (record_type)
= MAX (TYPE_ALIGN (record_type), DECL_ALIGN (field));
/* If this is a padding record, we never want to make the size smaller than
what was specified in it, if any. */
if (TREE_CODE (record_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (record_type) && TYPE_SIZE (record_type) != 0)
+ && TYPE_IS_PADDING_P (record_type) && TYPE_SIZE (record_type))
{
size = TYPE_SIZE (record_type);
size_unit = TYPE_SIZE_UNIT (record_type);
}
/* Now set any of the values we've just computed that apply. */
- if (! TYPE_IS_FAT_POINTER_P (record_type)
- && ! TYPE_CONTAINS_TEMPLATE_P (record_type))
+ if (!TYPE_IS_FAT_POINTER_P (record_type)
+ && !TYPE_CONTAINS_TEMPLATE_P (record_type))
SET_TYPE_ADA_SIZE (record_type, ada_size);
if (has_rep)
{
- if (! (TREE_CODE (record_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (record_type)
- && CONTAINS_PLACEHOLDER_P (size)))
+ if (!(TREE_CODE (record_type) == RECORD_TYPE
+ && TYPE_IS_PADDING_P (record_type)
+ && CONTAINS_PLACEHOLDER_P (size)))
{
TYPE_SIZE (record_type) = round_up (size, TYPE_ALIGN (record_type));
TYPE_SIZE_UNIT (record_type)
compute_record_mode (record_type);
}
- if (! defer_debug)
+ if (!defer_debug)
{
/* If this record is of variable size, rename it so that the
debugger knows it is and make a new, parallel, record
exp_dbug.ads. But don't do this for records that are padding
since they confuse GDB. */
if (var_size
- && ! (TREE_CODE (record_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (record_type)))
+ && !(TREE_CODE (record_type) == RECORD_TYPE
+ && TYPE_IS_PADDING_P (record_type)))
{
tree new_record_type
= 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 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,
TREE_CODE (record_type) == QUAL_UNION_TYPE
TYPE_NAME (new_record_type) = new_id;
TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT;
TYPE_STUB_DECL (new_record_type)
- = pushdecl (build_decl (TYPE_DECL, new_id, 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))
= DECL_IGNORED_P (TYPE_STUB_DECL (record_type));
TYPE_SIZE (new_record_type) = size_int (TYPE_ALIGN (record_type));
+ TYPE_SIZE_UNIT (new_record_type)
+ = size_int (TYPE_ALIGN (record_type) / BITS_PER_UNIT);
/* Now scan all the fields, replacing each field with a new
field corresponding to the new encoding. */
- for (old_field = TYPE_FIELDS (record_type); old_field != 0;
+ for (old_field = TYPE_FIELDS (record_type); old_field;
old_field = TREE_CHAIN (old_field))
{
tree field_type = TREE_TYPE (old_field);
tree field_name = DECL_NAME (old_field);
tree new_field;
tree curpos = bit_position (old_field);
- int var = 0;
+ bool var = false;
unsigned int align = 0;
tree pos;
else
pos = compute_related_constant (curpos, last_pos);
- if (pos == 0 && TREE_CODE (curpos) == MULT_EXPR
+ if (!pos && TREE_CODE (curpos) == MULT_EXPR
&& TREE_CODE (TREE_OPERAND (curpos, 1)) == INTEGER_CST)
{
align = TREE_INT_CST_LOW (TREE_OPERAND (curpos, 1));
pos = compute_related_constant (curpos,
round_up (last_pos, align));
}
- else if (pos == 0 && TREE_CODE (curpos) == PLUS_EXPR
+ else if (!pos && TREE_CODE (curpos) == PLUS_EXPR
&& TREE_CODE (TREE_OPERAND (curpos, 1)) == INTEGER_CST
&& TREE_CODE (TREE_OPERAND (curpos, 0)) == MULT_EXPR
&& host_integerp (TREE_OPERAND
??? We really should abort here, but it's too much work
to get this correct for all cases. */
- if (pos == 0)
+ if (!pos)
pos = bitsize_zero_node;
/* See if this type is variable-size and make a new type
if (TREE_CODE (DECL_SIZE (old_field)) != INTEGER_CST)
{
field_type = build_pointer_type (field_type);
- var = 1;
+ var = true;
}
/* Make a new field name, if necessary. */
We return an expression for the size. */
static tree
-merge_sizes (tree last_size,
- tree first_bit,
- tree size,
- int special,
- int has_rep)
+merge_sizes (tree last_size, tree first_bit, tree size, bool special,
+ bool has_rep)
{
tree type = TREE_TYPE (last_size);
tree new;
- if (! special || TREE_CODE (size) != COND_EXPR)
+ if (!special || TREE_CODE (size) != COND_EXPR)
{
new = size_binop (PLUS_EXPR, first_bit, size);
if (has_rep)
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_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
+ bool returns_unconstrained, bool returns_by_ref,
+ bool returns_with_dsp)
{
/* A chain of TREE_LIST nodes whose TREE_VALUEs are the data type nodes of
the subprogram formal parameters. This list is generated by traversing the
for (param_decl = param_decl_list; param_decl;
param_decl = TREE_CHAIN (param_decl))
param_type_list = tree_cons (NULL_TREE, TREE_TYPE (param_decl),
- param_type_list);
+ param_type_list);
/* The list of the function parameter types has to be terminated by the void
type to signal to the back-end that we are not dealing with a variable
/* TYPE may have been shared since GCC hashes types. If it has a CICO_LIST
or the new type should, make a copy of TYPE. Likewise for
RETURNS_UNCONSTRAINED and RETURNS_BY_REF. */
- if (TYPE_CI_CO_LIST (type) != 0 || cico_list != 0
+ if (TYPE_CI_CO_LIST (type) || cico_list
|| TYPE_RETURNS_UNCONSTRAINED_P (type) != returns_unconstrained
|| TYPE_RETURNS_BY_REF_P (type) != returns_by_ref)
type = copy_type (type);
only a small hole. */
if (TYPE_INDEX_TYPE (type) == index)
return type;
- else if (TYPE_INDEX_TYPE (type) != 0)
+ else if (TYPE_INDEX_TYPE (type))
type = copy_type (type);
SET_TYPE_INDEX_TYPE (type, index);
+ create_type_decl (NULL_TREE, type, NULL, true, false, Empty);
return type;
}
\f
/* 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 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. */
+ 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. */
tree
-create_type_decl (tree type_name,
- tree type,
- struct attrib *attr_list,
- int artificial_p,
- int debug_info_p)
+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);
DECL_ARTIFICIAL (type_decl) = artificial_p;
- pushdecl (type_decl);
+
process_attributes (type_decl, attr_list);
/* Pass type declaration information to the debugger unless this is an
a dummy type, which will be completed later, or a type for which
debugging information was not requested. */
if (code == UNCONSTRAINED_ARRAY_TYPE || TYPE_IS_DUMMY_P (type)
- || ! debug_info_p)
+ || !debug_info_p)
DECL_IGNORED_P (type_decl) = 1;
else if (code != ENUMERAL_TYPE && code != RECORD_TYPE
- && ! ((code == POINTER_TYPE || code == REFERENCE_TYPE)
- && TYPE_IS_DUMMY_P (TREE_TYPE (type))))
- rest_of_decl_compilation (type_decl, NULL, global_bindings_p (), 0);
+ && !((code == POINTER_TYPE || code == REFERENCE_TYPE)
+ && TYPE_IS_DUMMY_P (TREE_TYPE (type))))
+ rest_of_decl_compilation (type_decl, global_bindings_p (), 0);
+
+ if (!TYPE_IS_DUMMY_P (type))
+ gnat_pushdecl (type_decl, gnat_node);
return type_decl;
}
(a GCC ..._TYPE node). VAR_INIT is the GCC tree for an optional initial
expression; NULL_TREE if none.
- CONST_FLAG is nonzero if this variable is constant.
+ CONST_FLAG is true if this variable is constant.
- PUBLIC_FLAG is nonzero if this definition is to be made visible outside of
+ PUBLIC_FLAG is true if this definition is to be made visible outside of
the current compilation unit. This flag should be set when processing the
variable definitions in a package specification. EXTERN_FLAG is nonzero
when processing an external variable declaration (as opposed to a
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. */
+ 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)
+create_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
+ bool const_flag, bool public_flag, bool extern_flag,
+ bool static_flag, struct attrib *attr_list, Node_Id gnat_node)
{
- int init_const
- = (var_init == 0
- ? 0
+ bool init_const
+ = (!var_init
+ ? false
: (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (var_init))
&& (global_bindings_p () || static_flag
? 0 != initializer_constant_valid_p (var_init,
&& 0 >= compare_tree_int (TYPE_SIZE_UNIT (type),
GET_MODE_SIZE (DCmode)))
? CONST_DECL : VAR_DECL, var_name, type);
- tree assign_init = 0;
/* If this is external, throw away any initializations unless this is a
- CONST_DECL (meaning we have a constant); they will be done elsewhere. If
- we are defining a global here, leave a constant initialization and save
- any variable elaborations for the elaboration routine. Otherwise, if
- the initializing expression is not the same as TYPE, generate the
- initialization with an assignment statement, since it knows how
- to do the required adjustents. If we are just annotating types,
- throw away the initialization if it isn't a constant. */
-
+ CONST_DECL (meaning we have a constant); they will be done elsewhere.
+ If we are defining a global here, leave a constant initialization and
+ save any variable elaborations for the elaboration routine. If we are
+ 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;
- }
-
- else if (var_init != 0
- && ((TYPE_MAIN_VARIANT (TREE_TYPE (var_init))
- != TYPE_MAIN_VARIANT (type))
- || (static_flag && ! init_const)))
- assign_init = var_init, var_init = 0;
+ || (type_annotate_only && var_init && !TREE_CONSTANT (var_init)))
+ var_init = NULL_TREE;
- DECL_COMMON (var_decl) = !flag_no_common;
DECL_INITIAL (var_decl) = var_init;
TREE_READONLY (var_decl) = const_flag;
DECL_EXTERNAL (var_decl) = extern_flag;
we allocate automatic storage unless requested not to. */
TREE_STATIC (var_decl) = global_bindings_p () ? !extern_flag : static_flag;
- if (asm_name != 0)
+ if (asm_name)
SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
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);
- expand_decl (var_decl);
-
- if (DECL_CONTEXT (var_decl) != 0)
- expand_decl_init (var_decl);
+ /* Add this decl to the current binding level. */
+ gnat_pushdecl (var_decl, gnat_node);
- /* If this is volatile, force it into memory. */
if (TREE_SIDE_EFFECTS (var_decl))
- gnat_mark_addressable (var_decl);
+ TREE_ADDRESSABLE (var_decl) = 1;
if (TREE_CODE (var_decl) != CONST_DECL)
- rest_of_decl_compilation (var_decl, 0, global_bindings_p (), 0);
-
- if (assign_init != 0)
- {
- /* If VAR_DECL has a padded type, convert it to the unpadded
- type so the assignment is done properly. */
- tree lhs = var_decl;
-
- 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);
-
- expand_expr_stmt (build_binary_op (MODIFY_EXPR, NULL_TREE, lhs,
- assign_init));
- }
+ rest_of_decl_compilation (var_decl, global_bindings_p (), 0);
return var_decl;
}
the address of this field for aliasing purposes. */
tree
-create_field_decl (tree field_name,
- tree field_type,
- tree record_type,
- int packed,
- tree size,
- tree pos,
- int addressable)
+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);
DECL_CONTEXT (field_decl) = record_type;
- TREE_READONLY (field_decl) = TREE_READONLY (field_type);
+ TREE_READONLY (field_decl) = TYPE_READONLY (field_type);
/* If FIELD_TYPE is BLKmode, we must ensure this is aligned to at least a
byte boundary since GCC cannot handle less-aligned BLKmode bitfields. */
We always set a size in this case to trigger the checks for bitfield
creation below, which is typically required when no position has been
specified. */
- if (size != 0)
+ if (size)
size = convert (bitsizetype, size);
else if (packed == 1)
{
We also don't look at STRICT_ALIGNMENT here, and rely on later processing
in layout_decl or finish_record_type to clear the bit_field indication if
it is in fact not needed. */
- if (size != 0 && TREE_CODE (size) == INTEGER_CST
+ if (size && TREE_CODE (size) == INTEGER_CST
&& TREE_CODE (TYPE_SIZE (field_type)) == INTEGER_CST
- && ! addressable
- && (! operand_equal_p (TYPE_SIZE (field_type), size, 0)
- || (pos != 0
- && ! value_zerop (size_binop (TRUNC_MOD_EXPR, pos,
- bitsize_int (TYPE_ALIGN
- (field_type)))))
+ && !addressable
+ && (!operand_equal_p (TYPE_SIZE (field_type), size, 0)
+ || (pos
+ && !value_zerop (size_binop (TRUNC_MOD_EXPR, pos,
+ bitsize_int (TYPE_ALIGN
+ (field_type)))))
|| packed
|| (TYPE_ALIGN (record_type) != 0
&& TYPE_ALIGN (record_type) < TYPE_ALIGN (field_type))))
{
DECL_BIT_FIELD (field_decl) = 1;
DECL_SIZE (field_decl) = size;
- if (! packed && pos == 0)
+ if (!packed && !pos)
DECL_ALIGN (field_decl)
= (TYPE_ALIGN (record_type) != 0
? MIN (TYPE_ALIGN (record_type), TYPE_ALIGN (field_type))
: TYPE_ALIGN (field_type));
}
- DECL_PACKED (field_decl) = pos != 0 ? DECL_BIT_FIELD (field_decl) : packed;
+ DECL_PACKED (field_decl) = pos ? DECL_BIT_FIELD (field_decl) : packed;
DECL_ALIGN (field_decl)
= MAX (DECL_ALIGN (field_decl),
DECL_BIT_FIELD (field_decl) ? 1
: packed && TYPE_MODE (field_type) != BLKmode ? BITS_PER_UNIT
: TYPE_ALIGN (field_type));
- if (pos != 0)
+ if (pos)
{
/* We need to pass in the alignment the DECL is known to have.
This is the lowest-order bit set in POS, but no more than
copy. This is the case for true bitfields, but the DECL_BIT_FIELD value
we have at this point is not accurate enough, so we don't account for
this here and let finish_record_type decide. */
- DECL_NONADDRESSABLE_P (field_decl) = ! addressable;
+ DECL_NONADDRESSABLE_P (field_decl) = !addressable;
return field_decl;
}
/* Subroutine of previous function: return nonzero if EXP, ignoring any side
effects, has the value of zero. */
-static int
+static bool
value_zerop (tree exp)
{
if (TREE_CODE (exp) == COMPOUND_EXPR)
}
\f
/* Returns a PARM_DECL node. PARAM_NAME is the name of the parameter,
- PARAM_TYPE is its type. READONLY is nonzero if the parameter is
+ PARAM_TYPE is its type. READONLY is true if the parameter is
readonly (either an IN parameter or an address of a pass-by-ref
parameter). */
tree
-create_param_decl (tree param_name, tree param_type, int readonly)
+create_param_decl (tree param_name, tree param_type, bool readonly)
{
tree param_decl = build_decl (PARM_DECL, param_name, param_type);
DECL_SECTION_NAME (decl)
= build_string (IDENTIFIER_LENGTH (attr_list->name),
IDENTIFIER_POINTER (attr_list->name));
- DECL_COMMON (decl) = 0;
}
else
post_error ("?section attributes are not supported for this target",
}
}
\f
-/* Add some pending elaborations on the list. */
+/* Return true if VALUE is a known to be a multiple of FACTOR, which must be
+ a power of 2. */
-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)
+static bool
+value_factor_p (tree value, HOST_WIDE_INT factor)
{
if (host_integerp (value, 1))
return tree_low_cst (value, 1) % factor == 0;
is the distance in bits between the end of PREV_FIELD and the starting
position of CURR_FIELD. It is ignored if null. */
-static int
+static bool
potential_alignment_gap (tree prev_field, tree curr_field, tree offset)
{
/* If this is the first field of the record, there cannot be any gap */
if (!prev_field)
- return 0;
+ return false;
/* If the previous field is a union type, then return False: The only
time when such a field is not the last field of the record is when
was a rep clause for every field), in which case we don't want the
alignment constraint to override them. */
if (TREE_CODE (TREE_TYPE (prev_field)) == QUAL_UNION_TYPE)
- return 0;
+ return false;
/* If the distance between the end of prev_field and the begining of
curr_field is constant, then there is a gap if the value of this
constant is not null. */
if (offset && host_integerp (offset, 1))
- return (!integer_zerop (offset));
+ return !integer_zerop (offset);
/* If the size and position of the previous field are constant,
then check the sum of this size and position. There will be a gap
of the current field alignment, there can not be any gap. */
if (value_factor_p (bit_position (prev_field), DECL_ALIGN (curr_field))
&& value_factor_p (DECL_SIZE (prev_field), DECL_ALIGN (curr_field)))
- return 0;
+ return false;
/* Fallback, return that there may be a potential gap */
- return 1;
-}
-
-/* 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;
- }
+ return true;
}
/* Returns a LABEL_DECL node for LABEL_NAME. */
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. */
+ 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)
+create_subprog_decl (tree subprog_name, tree asm_name,
+ tree subprog_type, tree param_decl_list, bool inline_flag,
+ bool public_flag, bool extern_flag,
+ struct attrib *attr_list, Node_Id gnat_node)
{
tree return_type = TREE_TYPE (subprog_type);
tree subprog_decl = build_decl (FUNCTION_DECL, subprog_name, subprog_type);
/* If this is a function nested inside an inlined external function, it
means we aren't going to compile the outer function unless it is
actually inlined, so do the same for us. */
- if (current_function_decl != 0 && DECL_INLINE (current_function_decl)
+ if (current_function_decl && DECL_INLINE (current_function_decl)
&& DECL_EXTERNAL (current_function_decl))
- extern_flag = 1;
+ extern_flag = true;
DECL_EXTERNAL (subprog_decl) = extern_flag;
TREE_PUBLIC (subprog_decl) = public_flag;
- DECL_INLINE (subprog_decl) = inline_flag;
+ TREE_STATIC (subprog_decl) = 1;
TREE_READONLY (subprog_decl) = TYPE_READONLY (subprog_type);
TREE_THIS_VOLATILE (subprog_decl) = TYPE_VOLATILE (subprog_type);
TREE_SIDE_EFFECTS (subprog_decl) = TYPE_VOLATILE (subprog_type);
DECL_ARGUMENTS (subprog_decl) = param_decl_list;
DECL_RESULT (subprog_decl) = build_decl (RESULT_DECL, 0, return_type);
+ DECL_ARTIFICIAL (DECL_RESULT (subprog_decl)) = 1;
+ DECL_IGNORED_P (DECL_RESULT (subprog_decl)) = 1;
- if (asm_name != 0)
+ if (inline_flag)
+ DECL_DECLARED_INLINE_P (subprog_decl) = 1;
+
+ if (asm_name)
SET_DECL_ASSEMBLER_NAME (subprog_decl, asm_name);
process_attributes (subprog_decl, attr_list);
/* Add this decl to the current binding level. */
- subprog_decl = pushdecl (subprog_decl);
+ gnat_pushdecl (subprog_decl, gnat_node);
/* Output the assembler code and/or RTL for the declaration. */
- rest_of_decl_compilation (subprog_decl, 0, global_bindings_p (), 0);
+ rest_of_decl_compilation (subprog_decl, global_bindings_p (), 0);
return subprog_decl;
}
\f
-/* 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
appearing in the subprogram. */
void
begin_subprog_body (tree subprog_decl)
{
- tree param_decl_list;
tree param_decl;
- tree next_param;
-
- 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 (in poplevel) 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. */
current_function_decl = subprog_decl;
- pushlevel (0);
-
- /* Push all the PARM_DECL nodes onto the current scope (i.e. the scope of the
- subprogram body) so that they can be recognized as local variables in the
- subprogram.
-
- The list of PARM_DECL nodes is stored in the right order in
- DECL_ARGUMENTS. Since ..._DECL nodes get stored in the reverse order in
- which they are transmitted to `pushdecl' we need to reverse the list of
- PARM_DECLs if we want it to be stored in the right order. The reason why
- we want to make sure the PARM_DECLs are stored in the correct order is
- that this list will be retrieved in a few lines with a call to `getdecl'
- to store it back into the DECL_ARGUMENTS field. */
- param_decl_list = nreverse (DECL_ARGUMENTS (subprog_decl));
-
- for (param_decl = param_decl_list; param_decl; param_decl = next_param)
- {
- next_param = TREE_CHAIN (param_decl);
- TREE_CHAIN (param_decl) = NULL;
- pushdecl (param_decl);
- }
+ announce_function (subprog_decl);
- /* Store back the PARM_DECL nodes. They appear in the right order. */
- DECL_ARGUMENTS (subprog_decl) = getdecls ();
+ /* 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;
- init_function_start (subprog_decl);
- expand_function_start (subprog_decl, 0);
+ make_decl_rtl (subprog_decl);
- /* If this function is `main', emit a call to `__main'
- to run global initializers, etc. */
- if (DECL_ASSEMBLER_NAME (subprog_decl) != 0
- && MAIN_NAME_P (DECL_ASSEMBLER_NAME (subprog_decl))
- && DECL_CONTEXT (subprog_decl) == NULL_TREE)
- expand_main_function ();
+ /* 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 ();
}
/* Finish the definition of the current subprogram and compile it all the way
- to assembler language output. */
+ to assembler language output. BODY is the tree corresponding to
+ the subprogram. */
void
-end_subprog_body (void)
+end_subprog_body (tree body)
{
- tree decl;
- tree cico_list;
+ tree fndecl = current_function_decl;
- poplevel (1, 0, 1);
- BLOCK_SUPERCONTEXT (DECL_INITIAL (current_function_decl))
- = current_function_decl;
+ /* Mark the BLOCK for this level as being for this function and pop the
+ level. Since the vars in it are the parameters, clear them. */
+ BLOCK_VARS (current_binding_level->block) = 0;
+ BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
+ DECL_INITIAL (fndecl) = current_binding_level->block;
+ gnat_poplevel ();
- /* Mark the RESULT_DECL as being in this subprogram. */
- DECL_CONTEXT (DECL_RESULT (current_function_decl)) = current_function_decl;
+ /* Deal with inline. If declared inline or we should default to inline,
+ set the flag in the decl. */
+ DECL_INLINE (fndecl)
+ = DECL_DECLARED_INLINE_P (fndecl) || flag_inline_trees == 2;
- expand_function_end ();
+ /* We handle pending sizes via the elaboration of types, so we don't
+ need to save them. */
+ get_pending_sizes ();
- /* If this is a nested function, push a new GC context. That will keep
- local variables on the stack from being collected while we're doing
- the compilation of this function. */
- if (function_nesting_depth > 1)
- ggc_push_context ();
+ /* Mark the RESULT_DECL as being in this subprogram. */
+ DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
- /* If we're only annotating types, don't actually compile this
- function. */
- if (!type_annotate_only)
- rest_of_compilation (current_function_decl);
+ DECL_SAVED_TREE (fndecl) = body;
- if (function_nesting_depth > 1)
- ggc_pop_context ();
+ current_function_decl = DECL_CONTEXT (fndecl);
+ cfun = NULL;
- /* Throw away any VAR_DECLs we made for OUT parameters; they must
- not be seen when we call this function and will be in
- unallocated memory anyway. */
- for (cico_list = TYPE_CI_CO_LIST (TREE_TYPE (current_function_decl));
- cico_list != 0; cico_list = TREE_CHAIN (cico_list))
- TREE_VALUE (cico_list) = 0;
+ /* If we're only annotating types, don't actually compile this function. */
+ if (type_annotate_only)
+ return;
- if (DECL_STRUCT_FUNCTION (current_function_decl) == 0)
+ /* We do different things for nested and non-nested functions.
+ ??? This should be in cgraph. */
+ if (!DECL_CONTEXT (fndecl))
{
- /* Throw away DECL_RTL in any PARM_DECLs unless this function
- was saved for inline, in which case the DECL_RTLs are in
- preserved memory. */
- for (decl = DECL_ARGUMENTS (current_function_decl);
- decl != 0; decl = TREE_CHAIN (decl))
- {
- SET_DECL_RTL (decl, 0);
- DECL_INCOMING_RTL (decl) = 0;
- }
+ gnat_gimplify_function (fndecl);
+ lower_nested_functions (fndecl);
+ gnat_finalize (fndecl);
+ }
+ else
+ /* Register this function with cgraph just far enough to get it
+ added to our parent's nested function list. */
+ (void) cgraph_node (fndecl);
+}
- /* Similarly, discard DECL_RTL of the return value. */
- SET_DECL_RTL (DECL_RESULT (current_function_decl), 0);
+/* Convert FNDECL's code to GIMPLE and handle any nested functions. */
- /* But DECL_INITIAL must remain nonzero so we know this
- was an actual function definition unless toplev.c decided not
- to inline it. */
- if (DECL_INITIAL (current_function_decl) != 0)
- DECL_INITIAL (current_function_decl) = error_mark_node;
+static void
+gnat_gimplify_function (tree fndecl)
+{
+ struct cgraph_node *cgn;
+
+ dump_function (TDI_original, fndecl);
+ gimplify_function_tree (fndecl);
+ dump_function (TDI_generic, fndecl);
+
+ /* Convert all nested functions to GIMPLE now. We do things in this order
+ so that items like VLA sizes are expanded properly in the context of the
+ correct function. */
+ cgn = cgraph_node (fndecl);
+ for (cgn = cgn->nested; cgn; cgn = cgn->next_nested)
+ gnat_gimplify_function (cgn->decl);
+}
- DECL_ARGUMENTS (current_function_decl) = 0;
- }
+/* Give FNDECL and all its nested functions to cgraph for compilation. */
- /* If we are not at the bottom of the function nesting stack, pop up to
- the containing function. Otherwise show we aren't in any function. */
- if (--function_nesting_depth != 0)
- pop_function_context ();
- else
- current_function_decl = 0;
+static void
+gnat_finalize (tree fndecl)
+{
+ struct cgraph_node *cgn;
+
+ /* Finalize all nested functions now. */
+ cgn = cgraph_node (fndecl);
+ for (cgn = cgn->nested; cgn ; cgn = cgn->next_nested)
+ gnat_finalize (cgn->decl);
+
+ cgraph_finalize_function (fndecl, false);
}
\f
/* Return a definition for a builtin function named NAME and whose data type
ATTRS is nonzero, use that for the function attribute list. */
tree
-builtin_function (const char *name,
- tree type,
- int function_code,
- enum built_in_class class,
- const char *library_name,
+builtin_function (const char *name, tree type, int function_code,
+ enum built_in_class class, const char *library_name,
tree attrs)
{
tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
if (library_name)
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
- pushdecl (decl);
+ gnat_pushdecl (decl, Empty);
DECL_BUILT_IN_CLASS (decl) = class;
DECL_FUNCTION_CODE (decl) = function_code;
if (attrs)
char type_name[20];
if (precision <= 2 * MAX_BITS_PER_WORD
- && signed_and_unsigned_types[precision][unsignedp] != 0)
+ && signed_and_unsigned_types[precision][unsignedp])
return signed_and_unsigned_types[precision][unsignedp];
if (unsignedp)
if (precision <= 2 * MAX_BITS_PER_WORD)
signed_and_unsigned_types[precision][unsignedp] = t;
- if (TYPE_NAME (t) == 0)
+ if (!TYPE_NAME (t))
{
sprintf (type_name, "%sSIGNED_%d", unsignedp ? "UN" : "", precision);
TYPE_NAME (t) = get_identifier (type_name);
tree t;
char type_name[20];
- if (float_types[(int) mode] != 0)
+ if (float_types[(int) mode])
return float_types[(int) mode];
float_types[(int) mode] = t = make_node (REAL_TYPE);
layout_type (t);
if (TYPE_MODE (t) != mode)
- gigi_abort (414);
+ abort ();
- if (TYPE_NAME (t) == 0)
+ if (!TYPE_NAME (t))
{
sprintf (type_name, "FLOAT_%d", precision);
TYPE_NAME (t) = get_identifier (type_name);
tree
gnat_type_for_mode (enum machine_mode mode, int unsignedp)
{
- if (GET_MODE_CLASS (mode) == MODE_FLOAT)
+ if (mode == BLKmode)
+ return NULL_TREE;
+ else if (mode == VOIDmode)
+ return void_type_node;
+ else if (GET_MODE_CLASS (mode) == MODE_FLOAT)
return float_type_for_precision (GET_MODE_PRECISION (mode), mode);
else
return gnat_type_for_size (GET_MODE_BITSIZE (mode), unsignedp);
type = copy_node (type);
TREE_TYPE (type) = type_node;
}
- else if (TREE_TYPE (type_node) != 0
+ else if (TREE_TYPE (type_node)
&& TREE_CODE (TREE_TYPE (type_node)) == INTEGER_TYPE
&& TYPE_MODULAR_P (TREE_TYPE (type_node)))
{
type = copy_node (type);
TREE_TYPE (type) = type_node;
}
- else if (TREE_TYPE (type_node) != 0
+ else if (TREE_TYPE (type_node)
&& TREE_CODE (TREE_TYPE (type_node)) == INTEGER_TYPE
&& TYPE_MODULAR_P (TREE_TYPE (type_node)))
{
tree
gnat_signed_or_unsigned_type (int unsignedp, tree type)
{
- if (! INTEGRAL_TYPE_P (type) || TREE_UNSIGNED (type) == unsignedp)
+ if (!INTEGRAL_TYPE_P (type) || TYPE_UNSIGNED (type) == unsignedp)
return type;
else
return gnat_type_for_size (TYPE_PRECISION (type), unsignedp);
\f
/* EXP is an expression for the size of an object. If this size contains
discriminant references, replace them with the maximum (if MAX_P) or
- minimum (if ! MAX_P) possible value of the discriminant. */
+ minimum (if !MAX_P) possible value of the discriminant. */
tree
-max_size (tree exp, int max_p)
+max_size (tree exp, bool max_p)
{
enum tree_code code = TREE_CODE (exp);
tree type = TREE_TYPE (exp);
if (code == TREE_LIST)
return tree_cons (TREE_PURPOSE (exp),
max_size (TREE_VALUE (exp), max_p),
- TREE_CHAIN (exp) != 0
- ? max_size (TREE_CHAIN (exp), max_p) : 0);
+ TREE_CHAIN (exp)
+ ? max_size (TREE_CHAIN (exp), max_p) : NULL_TREE);
break;
case 'r':
/* If this contains a PLACEHOLDER_EXPR, it is the thing we want to
modify. Otherwise, we treat it like a variable. */
- if (! CONTAINS_PLACEHOLDER_P (exp))
+ if (!CONTAINS_PLACEHOLDER_P (exp))
return exp;
type = TREE_TYPE (TREE_OPERAND (exp, 1));
return
- max_size (max_p ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type), 1);
+ max_size (max_p ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type), true);
case '<':
return max_p ? size_one_node : size_zero_node;
return
fold (build1 (code, type,
max_size (TREE_OPERAND (exp, 0),
- code == NEGATE_EXPR ? ! max_p : max_p)));
+ code == NEGATE_EXPR ? !max_p : max_p)));
case 2:
- if (code == RTL_EXPR)
- gigi_abort (407);
- else if (code == COMPOUND_EXPR)
+ if (code == COMPOUND_EXPR)
return max_size (TREE_OPERAND (exp, 1), max_p);
- else if (code == WITH_RECORD_EXPR)
- return exp;
{
tree lhs = max_size (TREE_OPERAND (exp, 0), max_p);
tree rhs = max_size (TREE_OPERAND (exp, 1),
- code == MINUS_EXPR ? ! max_p : max_p);
+ code == MINUS_EXPR ? !max_p : max_p);
/* Special-case wanting the maximum value of a MIN_EXPR.
In that case, if one side overflows, return the other.
else if ((code == MINUS_EXPR || code == PLUS_EXPR)
&& ((TREE_CONSTANT (lhs) && TREE_OVERFLOW (lhs))
|| operand_equal_p (lhs, TYPE_MAX_VALUE (type), 0))
- && ! TREE_CONSTANT (rhs))
+ && !TREE_CONSTANT (rhs))
return lhs;
else
return fold (build (code, type, lhs, rhs));
if (code == SAVE_EXPR)
return exp;
else if (code == COND_EXPR)
- return fold (build (MAX_EXPR, type,
+ return fold (build (max_p ? MAX_EXPR : MIN_EXPR, type,
max_size (TREE_OPERAND (exp, 1), max_p),
max_size (TREE_OPERAND (exp, 2), max_p)));
- else if (code == CALL_EXPR && TREE_OPERAND (exp, 1) != 0)
+ else if (code == CALL_EXPR && TREE_OPERAND (exp, 1))
return build (CALL_EXPR, type, TREE_OPERAND (exp, 0),
- max_size (TREE_OPERAND (exp, 1), max_p));
+ max_size (TREE_OPERAND (exp, 1), max_p), NULL);
}
}
- gigi_abort (408);
+ abort ();
}
\f
/* Build a template of type TEMPLATE_TYPE from the array bounds of ARRAY_TYPE.
nested arrays stop being the underlying object. */
for (field = TYPE_FIELDS (template_type); field;
- (bound_list != 0
+ (bound_list
? (bound_list = TREE_CHAIN (bound_list))
: (array_type = TREE_TYPE (array_type))),
field = TREE_CHAIN (TREE_CHAIN (field)))
for an ARRAY_TYPE. Otherwise, if expr is a PARM_DECL with
DECL_BY_COMPONENT_PTR_P, use the bounds of the field in the template.
This will give us a maximum range. */
- if (bound_list != 0)
+ if (bound_list)
bounds = TREE_VALUE (bound_list);
else if (TREE_CODE (array_type) == ARRAY_TYPE)
bounds = TYPE_INDEX_TYPE (TYPE_DOMAIN (array_type));
- else if (expr != 0 && TREE_CODE (expr) == PARM_DECL
+ else if (expr && TREE_CODE (expr) == PARM_DECL
&& DECL_BY_COMPONENT_PTR_P (expr))
bounds = TREE_TYPE (field);
else
- gigi_abort (411);
+ abort ();
min = convert (TREE_TYPE (TREE_CHAIN (field)), TYPE_MIN_VALUE (bounds));
max = convert (TREE_TYPE (field), TYPE_MAX_VALUE (bounds));
/* If either MIN or MAX involve a PLACEHOLDER_EXPR, we must
- surround them with a WITH_RECORD_EXPR giving EXPR as the
- OBJECT. */
- if (CONTAINS_PLACEHOLDER_P (min))
- min = build (WITH_RECORD_EXPR, TREE_TYPE (min), min, expr);
- if (CONTAINS_PLACEHOLDER_P (max))
- max = build (WITH_RECORD_EXPR, TREE_TYPE (max), max, expr);
+ substitute it from OBJECT. */
+ min = SUBSTITUTE_PLACEHOLDER_IN_EXPR (min, expr);
+ max = SUBSTITUTE_PLACEHOLDER_IN_EXPR (max, expr);
template_elts = tree_cons (TREE_CHAIN (field), max,
tree_cons (field, min, template_elts));
/* Build a VMS descriptor from a Mechanism_Type, which must specify
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
+ 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. */
switch (GET_MODE_BITSIZE (TYPE_MODE (type)))
{
case 8:
- dtype = TREE_UNSIGNED (type) ? 2 : 6;
+ dtype = TYPE_UNSIGNED (type) ? 2 : 6;
break;
case 16:
- dtype = TREE_UNSIGNED (type) ? 3 : 7;
+ dtype = TYPE_UNSIGNED (type) ? 3 : 7;
break;
case 32:
- dtype = TREE_UNSIGNED (type) ? 4 : 8;
+ dtype = TYPE_UNSIGNED (type) ? 4 : 8;
break;
case 64:
- dtype = TREE_UNSIGNED (type) ? 5 : 9;
+ dtype = TYPE_UNSIGNED (type) ? 5 : 9;
break;
case 128:
- dtype = TREE_UNSIGNED (type) ? 25 : 26;
+ dtype = TYPE_UNSIGNED (type) ? 25 : 26;
break;
}
break;
field_list
= chainon (field_list,
- make_descriptor_field ("POINTER",
- build_pointer_type (type),
- record_type,
- build1 (ADDR_EXPR,
- build_pointer_type (type),
- build (PLACEHOLDER_EXPR,
- type))));
+ make_descriptor_field
+ ("POINTER",
+ build_pointer_type_for_mode (type, SImode, false), record_type,
+ build1 (ADDR_EXPR,
+ build_pointer_type_for_mode (type, SImode, false),
+ build (PLACEHOLDER_EXPR, type))));
switch (mech)
{
for (i = 0, inner_type = type; i < ndim;
i++, inner_type = TREE_TYPE (inner_type))
tem = build (ARRAY_REF, TREE_TYPE (inner_type), tem,
- convert (TYPE_DOMAIN (inner_type), size_zero_node));
+ convert (TYPE_DOMAIN (inner_type), size_zero_node),
+ NULL_TREE, NULL_TREE);
field_list
= chainon (field_list,
make_descriptor_field
- ("A0", build_pointer_type (inner_type), record_type,
- build1 (ADDR_EXPR, build_pointer_type (inner_type), tem)));
+ ("A0",
+ build_pointer_type_for_mode (inner_type, SImode, false),
+ record_type,
+ build1 (ADDR_EXPR,
+ build_pointer_type_for_mode (inner_type, SImode,
+ false),
+ tem)));
/* Next come the addressing coefficients. */
tem = size_int (1);
post_error ("unsupported descriptor type for &", gnat_entity);
}
- finish_record_type (record_type, field_list, 0, 1);
- pushdecl (build_decl (TYPE_DECL, create_concat_name (gnat_entity, "DESC"),
- record_type));
+ finish_record_type (record_type, field_list, false, true);
+ create_type_decl (create_concat_name (gnat_entity, "DESC"), record_type,
+ NULL, true, false, gnat_entity);
return record_type;
}
finish_record_type (type,
chainon (chainon (NULL_TREE, template_field),
array_field),
- 0, 0);
+ false, false);
return type;
}
{
tree ptr = TYPE_POINTER_TO (old_type);
tree ref = TYPE_REFERENCE_TO (old_type);
+ tree ptr1, ref1;
tree type;
/* If this is the main variant, process all the other variants first. */
if (TYPE_MAIN_VARIANT (old_type) == old_type)
- for (type = TYPE_NEXT_VARIANT (old_type); type != 0;
+ for (type = TYPE_NEXT_VARIANT (old_type); type;
type = TYPE_NEXT_VARIANT (type))
update_pointer_to (type, new_type);
/* If no pointer or reference, we are done. */
- if (ptr == 0 && ref == 0)
+ if (!ptr && !ref)
return;
/* Merge the old type qualifiers in the new type.
/* Otherwise, first handle the simple case. */
if (TREE_CODE (new_type) != UNCONSTRAINED_ARRAY_TYPE)
{
- if (ptr != 0)
- TREE_TYPE (ptr) = new_type;
TYPE_POINTER_TO (new_type) = ptr;
-
- if (ref != 0)
- TREE_TYPE (ref) = new_type;
TYPE_REFERENCE_TO (new_type) = ref;
- if (ptr != 0 && TYPE_NAME (ptr) != 0
- && TREE_CODE (TYPE_NAME (ptr)) == TYPE_DECL
- && TREE_CODE (new_type) != ENUMERAL_TYPE)
- rest_of_decl_compilation (TYPE_NAME (ptr), NULL,
- global_bindings_p (), 0);
- if (ref != 0 && TYPE_NAME (ref) != 0
- && TREE_CODE (TYPE_NAME (ref)) == TYPE_DECL
- && TREE_CODE (new_type) != ENUMERAL_TYPE)
- rest_of_decl_compilation (TYPE_NAME (ref), NULL,
- global_bindings_p (), 0);
+ for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr))
+ for (ptr1 = TYPE_MAIN_VARIANT (ptr); ptr1;
+ ptr1 = TYPE_NEXT_VARIANT (ptr1))
+ {
+ TREE_TYPE (ptr1) = new_type;
+
+ if (TYPE_NAME (ptr1)
+ && TREE_CODE (TYPE_NAME (ptr1)) == TYPE_DECL
+ && TREE_CODE (new_type) != ENUMERAL_TYPE)
+ rest_of_decl_compilation (TYPE_NAME (ptr1),
+ global_bindings_p (), 0);
+ }
+
+ for (; ref; ref = TYPE_NEXT_PTR_TO (ref))
+ for (ref1 = TYPE_MAIN_VARIANT (ref); ref1;
+ ref1 = TYPE_NEXT_VARIANT (ref1))
+ {
+ TREE_TYPE (ref1) = new_type;
+
+ if (TYPE_NAME (ref1)
+ && TREE_CODE (TYPE_NAME (ref1)) == TYPE_DECL
+ && TREE_CODE (new_type) != ENUMERAL_TYPE)
+ rest_of_decl_compilation (TYPE_NAME (ref1),
+ global_bindings_p (), 0);
+ }
}
/* Now deal with the unconstrained array case. In this case the "pointer"
is actually a RECORD_TYPE where the types of both fields are
pointers to void. In that case, copy the field list from the
old type to the new one and update the fields' context. */
- else if (TREE_CODE (ptr) != RECORD_TYPE || ! TYPE_IS_FAT_POINTER_P (ptr))
- gigi_abort (412);
+ else if (TREE_CODE (ptr) != RECORD_TYPE || !TYPE_IS_FAT_POINTER_P (ptr))
+ abort ();
else
{
tree new_ref;
tree var;
+ SET_DECL_ORIGINAL_FIELD (TYPE_FIELDS (ptr),
+ TYPE_FIELDS (TYPE_POINTER_TO (new_type)));
+ SET_DECL_ORIGINAL_FIELD (TREE_CHAIN (TYPE_FIELDS (ptr)),
+ TREE_CHAIN (TYPE_FIELDS
+ (TYPE_POINTER_TO (new_type))));
+
TYPE_FIELDS (ptr) = TYPE_FIELDS (TYPE_POINTER_TO (new_type));
DECL_CONTEXT (TYPE_FIELDS (ptr)) = ptr;
DECL_CONTEXT (TREE_CHAIN (TYPE_FIELDS (ptr))) = ptr;
ptr_temp_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (ptr)));
new_ref = build (COMPONENT_REF, ptr_temp_type,
build (PLACEHOLDER_EXPR, ptr),
- TREE_CHAIN (TYPE_FIELDS (ptr)));
+ TREE_CHAIN (TYPE_FIELDS (ptr)), NULL_TREE);
update_pointer_to
(TREE_TYPE (TREE_TYPE (TYPE_FIELDS (ptr))),
else
expr = build1 (INDIRECT_REF, TREE_TYPE (etype), expr);
- template = build_component_ref (expr, NULL_TREE, fields, 0);
+ template = build_component_ref (expr, NULL_TREE, fields, false);
expr = build_unary_op (ADDR_EXPR, NULL_TREE,
build_component_ref (expr, NULL_TREE,
- TREE_CHAIN (fields), 0));
+ TREE_CHAIN (fields), false));
}
else
/* Otherwise, build the constructor for the template. */
static tree
convert_to_thin_pointer (tree type, tree expr)
{
- if (! TYPE_FAT_POINTER_P (TREE_TYPE (expr)))
+ if (!TYPE_FAT_POINTER_P (TREE_TYPE (expr)))
expr
= convert_to_fat_pointer
(TREE_TYPE (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type))), expr);
/* We get the pointer to the data and use a NOP_EXPR to make it the
proper GCC type. */
- expr
- = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (TREE_TYPE (expr)), 0);
+ expr = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (TREE_TYPE (expr)),
+ false);
expr = build1 (NOP_EXPR, type, expr);
return expr;
/* If EXPR is already the right type, we are done. */
if (type == etype)
return expr;
- /* If we're converting between two aggregate types that have the same main
- variant, just make a NOP_EXPR. */
- else if (AGGREGATE_TYPE_P (type)
- && TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
- return build1 (NOP_EXPR, type, expr);
- /* If EXPR is a WITH_RECORD_EXPR, do the conversion inside and then make a
- new one. */
- else if (TREE_CODE (expr) == WITH_RECORD_EXPR)
- return build (WITH_RECORD_EXPR, type,
- convert (type, TREE_OPERAND (expr, 0)),
- TREE_OPERAND (expr, 1));
/* If the input type has padding, remove it by doing a component reference
to the field. If the output type has padding, make a constructor
of variable size, do this as an unchecked conversion. */
else if (ecode == RECORD_TYPE && code == RECORD_TYPE
&& TYPE_IS_PADDING_P (type) && TYPE_IS_PADDING_P (etype)
- && (! TREE_CONSTANT (TYPE_SIZE (type))
- || ! TREE_CONSTANT (TYPE_SIZE (etype))))
+ && (!TREE_CONSTANT (TYPE_SIZE (type))
+ || !TREE_CONSTANT (TYPE_SIZE (etype))))
;
else if (ecode == RECORD_TYPE && TYPE_IS_PADDING_P (etype))
{
/* If we have just converted to this padded type, just get
the inner expression. */
if (TREE_CODE (expr) == CONSTRUCTOR
- && CONSTRUCTOR_ELTS (expr) != 0
+ && CONSTRUCTOR_ELTS (expr)
&& TREE_PURPOSE (CONSTRUCTOR_ELTS (expr)) == TYPE_FIELDS (etype))
return TREE_VALUE (CONSTRUCTOR_ELTS (expr));
else
- return convert (type, build_component_ref (expr, NULL_TREE,
- TYPE_FIELDS (etype), 0));
+ return convert (type,
+ build_component_ref (expr, NULL_TREE,
+ TYPE_FIELDS (etype), false));
}
else if (code == RECORD_TYPE && TYPE_IS_PADDING_P (type))
{
of variable size, remove the conversion to avoid the need for
variable-size temporaries. */
if (TREE_CODE (expr) == VIEW_CONVERT_EXPR
- && ! TREE_CONSTANT (TYPE_SIZE (type)))
+ && !TREE_CONSTANT (TYPE_SIZE (type)))
expr = TREE_OPERAND (expr, 0);
/* If we are just removing the padding from expr, convert the original
if (TREE_CODE (expr) == COMPONENT_REF
&& TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == RECORD_TYPE
&& TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (expr, 0)))
- && ! TREE_CONSTANT (TYPE_SIZE (type)))
+ && !TREE_CONSTANT (TYPE_SIZE (type)))
return convert (type, TREE_OPERAND (expr, 0));
/* If the result type is a padded type with a self-referentially-sized
unchecked converstion. */
else if (TREE_CODE (etype) == RECORD_TYPE
&& CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
- return unchecked_convert (type, expr, 0);
+ return unchecked_convert (type, expr, false);
else
return
/* If the input is a biased type, adjust first. */
if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype))
return convert (type, fold (build (PLUS_EXPR, TREE_TYPE (etype),
- fold (build1 (GNAT_NOP_EXPR,
+ fold (build1 (NOP_EXPR,
TREE_TYPE (etype), expr)),
TYPE_MIN_VALUE (etype))));
if (ecode == RECORD_TYPE && TYPE_LEFT_JUSTIFIED_MODULAR_P (etype)
&& code != UNCONSTRAINED_ARRAY_TYPE)
return convert (type, build_component_ref (expr, NULL_TREE,
- TYPE_FIELDS (etype), 0));
+ TYPE_FIELDS (etype), false));
/* If converting to a type that contains a template, convert to the data
type and then build the template. */
case ERROR_MARK:
return expr;
- case TRANSFORM_EXPR:
case NULL_EXPR:
/* Just set its type here. For TRANSFORM_EXPR, we will do the actual
conversion in gnat_expand_expr. NULL_EXPR does not represent
return expr;
case STRING_CST:
- case CONSTRUCTOR:
/* If we are converting a STRING_CST to another constrained array type,
- just make a new one in the proper type. Likewise for a
- CONSTRUCTOR. */
+ just make a new one in the proper type. */
if (code == ecode && AGGREGATE_TYPE_P (etype)
- && ! (TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST
- && TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST))
+ && !(TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST
+ && TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
+ && (TREE_CODE (expr) == STRING_CST
+ || get_alias_set (etype) == get_alias_set (type)))
{
expr = copy_node (expr);
TREE_TYPE (expr) = type;
}
break;
- case COMPONENT_REF:
- /* If we are converting between two aggregate types of the same
- kind, size, mode, and alignment, just make a new COMPONENT_REF.
- This avoid unneeded conversions which makes reference computations
- more complex. */
- if (code == ecode && TYPE_MODE (type) == TYPE_MODE (etype)
- && AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype)
- && TYPE_ALIGN (type) == TYPE_ALIGN (etype)
- && operand_equal_p (TYPE_SIZE (type), TYPE_SIZE (etype), 0))
- return build (COMPONENT_REF, type, TREE_OPERAND (expr, 0),
- TREE_OPERAND (expr, 1));
-
- break;
-
case UNCONSTRAINED_ARRAY_REF:
/* Convert this to the type of the inner array by getting the address of
the array from the template. */
expr = build_unary_op (INDIRECT_REF, NULL_TREE,
build_component_ref (TREE_OPERAND (expr, 0),
get_identifier ("P_ARRAY"),
- NULL_TREE, 0));
+ NULL_TREE, false));
etype = TREE_TYPE (expr);
ecode = TREE_CODE (etype);
break;
case VIEW_CONVERT_EXPR:
if (AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype)
- && ! TYPE_FAT_POINTER_P (type) && ! TYPE_FAT_POINTER_P (etype))
+ && !TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
return convert (type, TREE_OPERAND (expr, 0));
break;
|| TREE_CODE (type) == UNION_TYPE)
&& (TREE_CODE (etype) == RECORD_TYPE
|| TREE_CODE (etype) == UNION_TYPE)
- && ! TYPE_FAT_POINTER_P (type) && ! TYPE_FAT_POINTER_P (etype))
+ && !TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
return build_unary_op (INDIRECT_REF, NULL_TREE,
convert (build_pointer_type (type),
TREE_OPERAND (expr, 0)));
}
/* Check for converting to a pointer to an unconstrained array. */
- if (TYPE_FAT_POINTER_P (type) && ! TYPE_FAT_POINTER_P (etype))
+ if (TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
return convert_to_fat_pointer (type, expr);
- if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)
- || (code == INTEGER_CST && ecode == INTEGER_CST
- && (type == TREE_TYPE (etype) || etype == TREE_TYPE (type))))
+ /* If we're converting between two aggregate types that have the same main
+ variant, just make a VIEW_CONVER_EXPR. */
+ else if (AGGREGATE_TYPE_P (type)
+ && TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
+ return build1 (VIEW_CONVERT_EXPR, type, expr);
+
+ /* In all other cases of related types, make a NOP_EXPR. */
+ else if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)
+ || (code == INTEGER_CST && ecode == INTEGER_CST
+ && (type == TREE_TYPE (etype) || etype == TREE_TYPE (type))))
return fold (build1 (NOP_EXPR, type, expr));
switch (code)
case VOID_TYPE:
return build1 (CONVERT_EXPR, type, expr);
+ case BOOLEAN_TYPE:
+ return fold (build1 (NOP_EXPR, type, gnat_truthvalue_conversion (expr)));
+
case INTEGER_TYPE:
if (TYPE_HAS_ACTUAL_BOUNDS_P (type)
&& (ecode == ARRAY_TYPE || ecode == UNCONSTRAINED_ARRAY_TYPE
|| (ecode == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (etype))))
- return unchecked_convert (type, expr, 0);
+ return unchecked_convert (type, expr, false);
else if (TYPE_BIASED_REPRESENTATION_P (type))
return fold (build1 (CONVERT_EXPR, type,
fold (build (MINUS_EXPR, TREE_TYPE (type),
/* If converting to a thin pointer, handle specially. */
if (TYPE_THIN_POINTER_P (type)
- && TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)) != 0)
+ && TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)))
return convert_to_thin_pointer (type, expr);
/* If converting fat pointer to normal pointer, get the pointer to the
array and then convert it. */
else if (TYPE_FAT_POINTER_P (etype))
expr = build_component_ref (expr, get_identifier ("P_ARRAY"),
- NULL_TREE, 0);
+ NULL_TREE, false);
return fold (convert_to_pointer (type, expr));
return fold (convert_to_real (type, expr));
case RECORD_TYPE:
- if (TYPE_LEFT_JUSTIFIED_MODULAR_P (type) && ! AGGREGATE_TYPE_P (etype))
+ if (TYPE_LEFT_JUSTIFIED_MODULAR_P (type) && !AGGREGATE_TYPE_P (etype))
return
gnat_build_constructor
(type, tree_cons (TYPE_FIELDS (type),
/* In these cases, assume the front-end has validated the conversion.
If the conversion is valid, it will be a bit-wise conversion, so
it can be viewed as an unchecked conversion. */
- return unchecked_convert (type, expr, 0);
+ return unchecked_convert (type, expr, false);
case UNION_TYPE:
/* Just validate that the type is indeed that of a field
convert (TREE_TYPE (tem), expr));
}
- gigi_abort (413);
+ abort ();
case UNCONSTRAINED_ARRAY_TYPE:
/* If EXPR is a constrained array, take its address, convert it to a
build_unary_op (ADDR_EXPR,
NULL_TREE, expr)));
else
- gigi_abort (409);
+ abort ();
case COMPLEX_TYPE:
return fold (convert_to_complex (type, expr));
default:
- gigi_abort (410);
+ abort ();
}
}
\f
/* Remove all conversions that are done in EXP. This includes converting
from a padded type or to a left-justified modular type. If TRUE_ADDRESS
- is nonzero, always return the address of the containing object even if
+ is true, always return the address of the containing object even if
the address is not bit-aligned. */
tree
-remove_conversions (tree exp, int true_address)
+remove_conversions (tree exp, bool true_address)
{
switch (TREE_CODE (exp))
{
if (true_address
&& TREE_CODE (TREE_TYPE (exp)) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (TREE_TYPE (exp)))
- return remove_conversions (TREE_VALUE (CONSTRUCTOR_ELTS (exp)), 1);
+ return remove_conversions (TREE_VALUE (CONSTRUCTOR_ELTS (exp)), true);
break;
case COMPONENT_REF:
break;
case VIEW_CONVERT_EXPR: case NON_LVALUE_EXPR:
- case NOP_EXPR: case CONVERT_EXPR: case GNAT_NOP_EXPR:
+ case NOP_EXPR: case CONVERT_EXPR:
return remove_conversions (TREE_OPERAND (exp, 0), true_address);
default:
= build_unary_op (INDIRECT_REF, NULL_TREE,
build_component_ref (TREE_OPERAND (exp, 0),
get_identifier ("P_ARRAY"),
- NULL_TREE, 0));
+ NULL_TREE, false));
TREE_READONLY (new) = TREE_STATIC (new) = TREE_READONLY (exp);
return new;
}
(TREE_TYPE (TREE_TYPE (exp))))),
TREE_OPERAND (exp, 0));
- else if (code == WITH_RECORD_EXPR
- && (TREE_OPERAND (exp, 0)
- != (new = maybe_unconstrained_array
- (TREE_OPERAND (exp, 0)))))
- return build (WITH_RECORD_EXPR, TREE_TYPE (new), new,
- TREE_OPERAND (exp, 1));
-
case RECORD_TYPE:
/* If this is a padded type, convert to the unpadded type and see if
it contains a template. */
}
\f
/* Return an expression that does an unchecked converstion of EXPR to TYPE.
- If NOTRUNC_P is set, truncation operations should be suppressed. */
+ If NOTRUNC_P is true, truncation operations should be suppressed. */
tree
-unchecked_convert (tree type, tree expr, int notrunc_p)
+unchecked_convert (tree type, tree expr, bool notrunc_p)
{
tree etype = TREE_TYPE (expr);
if (etype == type)
return expr;
- /* If EXPR is a WITH_RECORD_EXPR, do the conversion inside and then make a
- new one. */
- if (TREE_CODE (expr) == WITH_RECORD_EXPR)
- return build (WITH_RECORD_EXPR, type,
- unchecked_convert (type, TREE_OPERAND (expr, 0), notrunc_p),
- TREE_OPERAND (expr, 1));
-
/* If both types types are integral just do a normal conversion.
Likewise for a conversion to an unconstrained array. */
if ((((INTEGRAL_TYPE_P (type)
- && ! (TREE_CODE (type) == INTEGER_TYPE
- && TYPE_VAX_FLOATING_POINT_P (type)))
+ && !(TREE_CODE (type) == INTEGER_TYPE
+ && TYPE_VAX_FLOATING_POINT_P (type)))
|| (POINTER_TYPE_P (type) && ! TYPE_THIN_POINTER_P (type))
|| (TREE_CODE (type) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (type)))
&& ((INTEGRAL_TYPE_P (etype)
- && ! (TREE_CODE (etype) == INTEGER_TYPE
- && TYPE_VAX_FLOATING_POINT_P (etype)))
- || (POINTER_TYPE_P (etype) && ! TYPE_THIN_POINTER_P (etype))
+ && !(TREE_CODE (etype) == INTEGER_TYPE
+ && TYPE_VAX_FLOATING_POINT_P (etype)))
+ || (POINTER_TYPE_P (etype) && !TYPE_THIN_POINTER_P (etype))
|| (TREE_CODE (etype) == RECORD_TYPE
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (etype))))
|| TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
TYPE_BIASED_REPRESENTATION_P (ntype) = 0;
TYPE_MAIN_VARIANT (ntype) = ntype;
- expr = build1 (GNAT_NOP_EXPR, ntype, expr);
+ expr = build1 (NOP_EXPR, ntype, expr);
}
if (TREE_CODE (type) == INTEGER_TYPE
expr = convert (rtype, expr);
if (type != rtype)
- expr = build1 (GNAT_NOP_EXPR, type, expr);
+ expr = build1 (NOP_EXPR, type, expr);
}
/* If we are converting TO an integral type whose precision is not the
same as its size, first unchecked convert to a record that contains
an object of the output type. Then extract the field. */
- else if (INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type) != 0
+ else if (INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type)
&& 0 != compare_tree_int (TYPE_RM_SIZE (type),
GET_MODE_BITSIZE (TYPE_MODE (type))))
{
/* Similarly for integral input type whose precision is not equal to its
size. */
- else if (INTEGRAL_TYPE_P (etype) && TYPE_RM_SIZE (etype) != 0
+ else if (INTEGRAL_TYPE_P (etype) && TYPE_RM_SIZE (etype)
&& 0 != compare_tree_int (TYPE_RM_SIZE (etype),
GET_MODE_BITSIZE (TYPE_MODE (etype))))
{
else
{
expr = maybe_unconstrained_array (expr);
+
+ /* There's no point in doing two unchecked conversions in a row. */
+ if (TREE_CODE (expr) == VIEW_CONVERT_EXPR)
+ expr = TREE_OPERAND (expr, 0);
+
etype = TREE_TYPE (expr);
expr = build1 (VIEW_CONVERT_EXPR, type, expr);
}
the result. We need not do this in the case where the input is
an integral type of the same precision and signedness or if the output
is a biased type or if both the input and output are unsigned. */
- if (! notrunc_p
- && INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type) != 0
- && ! (TREE_CODE (type) == INTEGER_TYPE
- && TYPE_BIASED_REPRESENTATION_P (type))
+ if (!notrunc_p
+ && INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type)
+ && !(TREE_CODE (type) == INTEGER_TYPE
+ && TYPE_BIASED_REPRESENTATION_P (type))
&& 0 != compare_tree_int (TYPE_RM_SIZE (type),
GET_MODE_BITSIZE (TYPE_MODE (type)))
- && ! (INTEGRAL_TYPE_P (etype)
- && TREE_UNSIGNED (type) == TREE_UNSIGNED (etype)
- && operand_equal_p (TYPE_RM_SIZE (type),
- (TYPE_RM_SIZE (etype) != 0
- ? TYPE_RM_SIZE (etype) : TYPE_SIZE (etype)),
- 0))
- && ! (TREE_UNSIGNED (type) && TREE_UNSIGNED (etype)))
+ && !(INTEGRAL_TYPE_P (etype)
+ && TYPE_UNSIGNED (type) == TYPE_UNSIGNED (etype)
+ && operand_equal_p (TYPE_RM_SIZE (type),
+ (TYPE_RM_SIZE (etype) != 0
+ ? TYPE_RM_SIZE (etype) : TYPE_SIZE (etype)),
+ 0))
+ && !(TYPE_UNSIGNED (type) && TYPE_UNSIGNED (etype)))
{
tree base_type = gnat_type_for_mode (TYPE_MODE (type),
- TREE_UNSIGNED (type));
+ TYPE_UNSIGNED (type));
tree shift_expr
= convert (base_type,
size_binop (MINUS_EXPR,
/* If the sizes of the types differ and this is an VIEW_CONVERT_EXPR,
show no longer constant. */
if (TREE_CODE (expr) == VIEW_CONVERT_EXPR
- && ! operand_equal_p (TYPE_SIZE_UNIT (type), TYPE_SIZE_UNIT (etype), 1))
+ && !operand_equal_p (TYPE_SIZE_UNIT (type), TYPE_SIZE_UNIT (etype),
+ OEP_ONLY_CONST))
TREE_CONSTANT (expr) = 0;
return expr;
OSDN Git Service
