* *
* C Implementation File *
* *
- * *
- * Copyright (C) 1992-2003, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2004, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
#include "ggc.h"
#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"
/* If nonzero, pretend we are allocating at global level. */
int force_global;
-/* Tree nodes for the various types and decls we create. */
+/* Tree nodes for the various types and decls we create. */
tree gnat_std_decls[(int) ADT_LAST];
/* Functions to call for each of the possible raise reasons. */
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
+/* 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.
Note that these types are only used when fold-const requests something
/* 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 PARAMS ((tree, tree, tree, int, int));
-static tree compute_related_constant PARAMS ((tree, tree));
-static tree split_plus PARAMS ((tree, tree *));
-static int value_zerop PARAMS ((tree));
-static tree float_type_for_size PARAMS ((int, enum machine_mode));
-static tree convert_to_fat_pointer PARAMS ((tree, tree));
-static tree convert_to_thin_pointer PARAMS ((tree, tree));
-static tree make_descriptor_field PARAMS ((const char *,tree, tree,
- tree));
+static void gnat_define_builtin (const char *, tree, int, const char *, bool);
+static void gnat_install_builtins (void);
+static tree merge_sizes (tree, tree, tree, bool, bool);
+static tree compute_related_constant (tree, tree);
+static tree split_plus (tree, tree *);
+static bool value_zerop (tree);
+static void gnat_gimplify_function (tree);
+static void gnat_finalize (tree);
+static tree 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 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. */
void
-init_gnat_to_gnu ()
+init_gnat_to_gnu (void)
{
- Node_Id gnat_node;
-
- associate_gnat_to_gnu = (tree *) ggc_alloc (max_gnat_nodes * sizeof (tree));
-
- for (gnat_node = 0; gnat_node < max_gnat_nodes; gnat_node++)
- associate_gnat_to_gnu[gnat_node] = NULL_TREE;
-
- pending_elaborations = build_tree_list (NULL_TREE, NULL_TREE);
+ associate_gnat_to_gnu
+ = (tree *) ggc_alloc_cleared (max_gnat_nodes * sizeof (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 (gnat_entity, gnu_decl, no_check)
- 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
+ means GNAT_ENTITY is defined twice, but occasionally is due to some
+ 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;
}
be elaborated only once, GNAT_ENTITY is really not an entity. */
tree
-get_gnu_tree (gnat_entity)
- Entity_Id gnat_entity;
+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
-present_gnu_tree (gnat_entity)
- Entity_Id gnat_entity;
+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
/* Return non-zero if we are currently in the global binding level. */
int
-global_bindings_p ()
-{
- 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 ()
-{
- return current_binding_level->names;
-}
-
-/* Nonzero if the current level needs to have a BLOCK made. */
-
-int
-kept_level_p ()
+global_bindings_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 (ignore)
- 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));
+
+ /* 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;
- *newlevel = clear_binding_level;
+ 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.
+/* Set SUPERCONTEXT of the BLOCK for the current binding level to FNDECL
+ and point FNDECL to this BLOCK. */
- 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.
-
- 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 (keep, reverse, functionbody)
- 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. */
void
-insert_block (block)
- tree block;
+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 (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 (decl)
- 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
front end has been run. */
void
-gnat_init_decl_processing ()
+gnat_init_decl_processing (void)
{
input_line = 0;
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 ptr_mode. Make this here since we need
+ 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 (ptr_mode), 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
+/* Create the predefined scalar types such as `integer_type_node' needed
in the gcc back-end and initialize the global binding level. */
void
-init_gigi_decls (long_long_float_type, exception_type)
- tree long_long_float_type, exception_type;
+init_gigi_decls (tree long_long_float_type, tree exception_type)
{
tree endlink, decl;
unsigned int i;
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
= create_subprog_decl (get_identifier ("__gnat_free"), NULL_TREE,
build_function_type (void_type_node,
tree_cons (NULL_TREE,
ptr_void_type_node,
endlink)),
- NULL_TREE, 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
(get_identifier ("system__soft_links__set_jmpbuf_address_soft"),
NULL_TREE,
- build_function_type (void_type_node,
+ 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
+ = create_subprog_decl (get_identifier ("__gnat_begin_handler"), NULL_TREE,
+ build_function_type (void_type_node,
+ tree_cons (NULL_TREE,
+ ptr_void_type_node,
+ endlink)),
+ NULL_TREE, false, true, true, NULL, Empty);
+
+ end_handler_decl
+ = create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE,
+ build_function_type (void_type_node,
+ tree_cons (NULL_TREE,
+ ptr_void_type_node,
+ endlink)),
+ NULL_TREE, false, true, true, NULL, Empty);
/* If in no exception handlers mode, all raise statements are redirected to
__gnat_last_chance_handler. No need to redefine raise_nodefer_decl, since
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. */
a jmpbuf. */
setjmp_decl
= create_subprog_decl
- (get_identifier ("setjmp"), NULL_TREE,
+ (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;
- main_identifier_node = get_identifier ("main");
-}
-\f
-/* This function is called indirectly from toplev.c to handle incomplete
- declarations, i.e. VAR_DECL nodes whose DECL_SIZE is zero. To be precise,
- compile_file in toplev.c makes an indirect call through the function pointer
- incomplete_decl_finalize_hook which is initialized to this routine in
- init_decl_processing. */
+ /* 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);
-void
-gnat_finish_incomplete_decl (dont_care)
- tree dont_care ATTRIBUTE_UNUSED;
-{
- gigi_abort (405);
+ 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 (record_type, fieldlist, has_rep, defer_debug)
- 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;
}
+ /* For all-repped records with a size specified, lay the QUAL_UNION_TYPE
+ out just like a UNION_TYPE, since the size will be fixed. */
+ else if (code == QUAL_UNION_TYPE)
+ code = UNION_TYPE;
}
else
{
}
/* At this point, the position and size of each field is known. It was
- either set before entry by a rep clause, or by laying out the type
- above. We now make a pass through the fields (in reverse order for
- QUAL_UNION_TYPEs) to compute the Ada size; the GCC size and alignment
- (for rep'ed records that are not padding types); and the mode (for
- rep'ed records). */
+ either set before entry by a rep clause, or by laying out the type above.
+
+ We now run a pass over the fields (in reverse order for QUAL_UNION_TYPEs)
+ to compute the Ada size; the GCC size and alignment (for rep'ed records
+ that are not padding types); and the mode (for rep'ed records). We also
+ clear the DECL_BIT_FIELD indication for the cases we know have not been
+ handled yet, and adjust DECL_NONADDRESSABLE_P accordingly. */
if (code == QUAL_UNION_TYPE)
fieldlist = nreverse (fieldlist);
for (field = fieldlist; field; field = TREE_CHAIN (field))
{
+ tree pos = bit_position (field);
+
tree type = TREE_TYPE (field);
tree this_size = DECL_SIZE (field);
tree this_size_unit = DECL_SIZE_UNIT (field);
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);
- if (has_rep && ! DECL_BIT_FIELD (field))
+ /* Clear DECL_BIT_FIELD for the cases layout_decl does not handle. */
+ if (DECL_BIT_FIELD (field) && !STRICT_ALIGNMENT
+ && value_factor_p (pos, BITS_PER_UNIT)
+ && operand_equal_p (this_size, TYPE_SIZE (type), 0))
+ DECL_BIT_FIELD (field) = 0;
+
+ /* If we still have DECL_BIT_FIELD set at this point, we know the field
+ is technically not addressable. Except that it can actually be
+ addressed if the field is BLKmode and happens to be properly
+ aligned. */
+ DECL_NONADDRESSABLE_P (field)
+ |= DECL_BIT_FIELD (field) && DECL_MODE (field) != BLKmode;
+
+ if (has_rep && !DECL_BIT_FIELD (field))
TYPE_ALIGN (record_type)
= MAX (TYPE_ALIGN (record_type), DECL_ALIGN (field));
QUAL_UNION_TYPE, we need to take into account the previous size in
the case of empty variants. */
ada_size
- = merge_sizes (ada_size, bit_position (field), this_ada_size,
+ = merge_sizes (ada_size, pos, this_ada_size,
TREE_CODE (type) == QUAL_UNION_TYPE, has_rep);
- size = merge_sizes (size, bit_position (field), this_size,
+ size = merge_sizes (size, pos, this_size,
TREE_CODE (type) == QUAL_UNION_TYPE, has_rep);
size_unit
= merge_sizes (size_unit, byte_position (field), this_size_unit,
/* 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);
-#ifdef ROUND_TYPE_SIZE
- size = ROUND_TYPE_SIZE (record_type, size, TYPE_ALIGN (record_type));
- size_unit = ROUND_TYPE_SIZE_UNIT (record_type, size_unit,
- TYPE_ALIGN (record_type) / BITS_PER_UNIT);
-#else
- size = round_up (size, TYPE_ALIGN (record_type));
- size_unit = round_up (size_unit, TYPE_ALIGN (record_type) / BITS_PER_UNIT);
-#endif
-
- if (has_rep
- && ! (TREE_CODE (record_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (record_type)
- && TREE_CODE (size) != INTEGER_CST
- && contains_placeholder_p (size)))
+ if (has_rep)
{
- TYPE_SIZE (record_type) = size;
- TYPE_SIZE_UNIT (record_type) = size_unit;
- }
+ 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)
+ = round_up (size_unit,
+ TYPE_ALIGN (record_type) / BITS_PER_UNIT);
+ }
- if (has_rep)
- compute_record_mode (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
that tells the debugger how the record is laid out. See
- exp_dbug.ads. */
- if (var_size)
+ 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 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
? "XVU" : "XVE");
tree last_pos = bitsize_zero_node;
tree old_field;
+ tree prev_old_field = 0;
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;
a boundary and they something was added. Check for the
first case first. If not, see if there is any evidence
of rounding. If so, round the last position and try
- again.
+ again.
If this is a union, the position can be taken as zero. */
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
pos = compute_related_constant (curpos,
round_up (last_pos, align));
}
+ else if (potential_alignment_gap (prev_old_field, old_field,
+ pos))
+ {
+ align = TYPE_ALIGN (field_type);
+ pos = compute_related_constant (curpos,
+ round_up (last_pos, align));
+ }
/* If we can't compute a position, set it to zero.
??? 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. */
== QUAL_UNION_TYPE)
? bitsize_zero_node
: DECL_SIZE (old_field));
+ prev_old_field = old_field;
}
TYPE_FIELDS (new_record_type)
We return an expression for the size. */
static tree
-merge_sizes (last_size, first_bit, size, special, has_rep)
- tree last_size;
- tree first_bit, 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)
{
- tree new = size_binop (PLUS_EXPR, first_bit, size);
-
+ new = size_binop (PLUS_EXPR, first_bit, size);
if (has_rep)
new = size_binop (MAX_EXPR, last_size, new);
-
- return new;
}
- return fold (build (COND_EXPR, type, TREE_OPERAND (size, 0),
- integer_zerop (TREE_OPERAND (size, 1))
- ? last_size : merge_sizes (last_size, first_bit,
- TREE_OPERAND (size, 1),
- 1, has_rep),
- integer_zerop (TREE_OPERAND (size, 2))
+ else
+ new = fold (build (COND_EXPR, type, TREE_OPERAND (size, 0),
+ integer_zerop (TREE_OPERAND (size, 1))
+ ? last_size : merge_sizes (last_size, first_bit,
+ TREE_OPERAND (size, 1),
+ 1, has_rep),
+ integer_zerop (TREE_OPERAND (size, 2))
? last_size : merge_sizes (last_size, first_bit,
TREE_OPERAND (size, 2),
1, has_rep)));
+
+ /* We don't need any NON_VALUE_EXPRs and they can confuse us (especially
+ when fed through substitute_in_expr) into thinking that a constant
+ size is not constant. */
+ while (TREE_CODE (new) == NON_LVALUE_EXPR)
+ new = TREE_OPERAND (new, 0);
+
+ return new;
}
/* Utility function of above to see if OP0 and OP1, both of SIZETYPE, are
related by the addition of a constant. Return that constant if so. */
static tree
-compute_related_constant (op0, op1)
- tree op0, op1;
+compute_related_constant (tree op0, tree op1)
{
tree op0_var, op1_var;
tree op0_con = split_plus (op0, &op0_var);
/* Utility function of above to split a tree OP which may be a sum, into a
constant part, which is returned, and a variable part, which is stored
- in *PVAR. *PVAR may be size_zero_node. All operations must be of
- sizetype. */
+ in *PVAR. *PVAR may be bitsize_zero_node. All operations must be of
+ bitsizetype. */
static tree
-split_plus (in, pvar)
- tree in;
- tree *pvar;
+split_plus (tree in, tree *pvar)
{
- tree result = bitsize_zero_node;
+ /* Strip NOPS in order to ease the tree traversal and maximize the
+ potential for constant or plus/minus discovery. We need to be careful
+ to always return and set *pvar to bitsizetype trees, but it's worth
+ the effort. */
+ STRIP_NOPS (in);
- while (TREE_CODE (in) == NON_LVALUE_EXPR)
- in = TREE_OPERAND (in, 0);
+ *pvar = convert (bitsizetype, in);
- *pvar = in;
if (TREE_CODE (in) == INTEGER_CST)
{
*pvar = bitsize_zero_node;
- return in;
+ return convert (bitsizetype, in);
}
else if (TREE_CODE (in) == PLUS_EXPR || TREE_CODE (in) == MINUS_EXPR)
{
tree lhs_con = split_plus (TREE_OPERAND (in, 0), &lhs_var);
tree rhs_con = split_plus (TREE_OPERAND (in, 1), &rhs_var);
- result = size_binop (PLUS_EXPR, result, lhs_con);
- result = size_binop (TREE_CODE (in), result, rhs_con);
-
if (lhs_var == TREE_OPERAND (in, 0)
&& rhs_var == TREE_OPERAND (in, 1))
return bitsize_zero_node;
*pvar = size_binop (TREE_CODE (in), lhs_var, rhs_var);
- return result;
+ return size_binop (TREE_CODE (in), lhs_con, rhs_con);
}
else
return bitsize_zero_node;
PARM_DECL nodes that are the subprogram arguments. CICO_LIST is the
copy-in/copy-out list to be stored into TYPE_CICO_LIST.
RETURNS_UNCONSTRAINED is nonzero if the function returns an unconstrained
- object. RETURNS_BY_REF is nonzero if the function returns by reference.
+ object. RETURNS_BY_REF is nonzero if the function returns by reference.
RETURNS_WITH_DSP is nonzero if the function is to return with a
depressed stack pointer. */
tree
-create_subprog_type (return_type, param_decl_list, cico_list,
- returns_unconstrained, returns_by_ref, returns_with_dsp)
- tree return_type;
- tree param_decl_list;
- tree cico_list;
- int returns_unconstrained, returns_by_ref, 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);
/* Return a copy of TYPE but safe to modify in any way. */
tree
-copy_type (type)
- tree type;
+copy_type (tree type)
{
tree new = copy_node (type);
TYPE_INDEX_TYPE is INDEX. */
tree
-create_index_type (min, max, index)
- tree min, max;
- tree index;
+create_index_type (tree min, tree max, tree index)
{
/* First build a type for the desired range. */
tree type = build_index_2_type (min, max);
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. */
+ string) and TYPE is a ..._TYPE node giving its data type.
+ ARTIFICIAL_P is true if this is a declaration that was generated
+ by the compiler. DEBUG_INFO_P is true if we need to write debugging
+ information about this type. GNAT_NODE is used for the position of
+ the decl. */
tree
-create_type_decl (type_name, type, attr_list, artificial_p, debug_info_p)
- 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
+ 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).
+ 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 (var_name, asm_name, type, var_init, const_flag, public_flag,
- extern_flag, static_flag, attr_list)
- 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;
- }
+ || (type_annotate_only && var_init && !TREE_CONSTANT (var_init)))
+ var_init = NULL_TREE;
- 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;
-
- 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 (field_name, field_type, record_type, packed, size, pos,
- addressable)
- tree field_name;
- tree field_type;
- tree record_type;
- int packed;
- tree size, 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.
- If it is a padding type where the inner field is of variable size, it
- must be at its natural alignment. Just handle the packed case here; we
- will disallow non-aligned rep clauses elsewhere. */
+ byte boundary since GCC cannot handle less-aligned BLKmode bitfields. */
if (packed && TYPE_MODE (field_type) == BLKmode)
- DECL_ALIGN (field_decl)
- = ((TREE_CODE (field_type) == RECORD_TYPE
- && TYPE_IS_PADDING_P (field_type)
- && ! TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (field_type))))
- ? TYPE_ALIGN (field_type) : BITS_PER_UNIT);
-
- /* If a size is specified, use it. Otherwise, see if we have a size
- to use that may differ from the natural size of the object. */
- if (size != 0)
+ DECL_ALIGN (field_decl) = BITS_PER_UNIT;
+
+ /* If a size is specified, use it. Otherwise, if the record type is packed
+ compute a size to use, which may differ from the object's natural size.
+ 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)
size = convert (bitsizetype, size);
- else if (packed)
+ else if (packed == 1)
{
- if (packed == 1 && ! operand_equal_p (rm_size (field_type),
- TYPE_SIZE (field_type), 0))
- size = rm_size (field_type);
+ size = rm_size (field_type);
/* For a constant size larger than MAX_FIXED_MODE_SIZE, round up to
- byte. */
- if (size != 0 && TREE_CODE (size) == INTEGER_CST
- && compare_tree_int (size, MAX_FIXED_MODE_SIZE) > 0)
- size = round_up (size, BITS_PER_UNIT);
+ byte. */
+ if (TREE_CODE (size) == INTEGER_CST
+ && compare_tree_int (size, MAX_FIXED_MODE_SIZE) > 0)
+ size = round_up (size, BITS_PER_UNIT);
}
/* Make a bitfield if a size is specified for two reasons: first if the size
differs from the natural size. Second, if the alignment is insufficient.
- There are a number of ways the latter can be true. But never make a
- bitfield if the type of the field has a nonconstant size. */
+ There are a number of ways the latter can be true.
- if (size != 0 && TREE_CODE (size) == INTEGER_CST
+ We never make a bitfield if the type of the field has a nonconstant size,
+ or if it is claimed to be addressable, because no such entity requiring
+ bitfield operations should reach here.
+
+ We do *preventively* make a bitfield when there might be the need for it
+ but we don't have all the necessary information to decide, as is the case
+ of a field with no specified position in a packed record.
+
+ 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 && TREE_CODE (size) == INTEGER_CST
&& TREE_CODE (TYPE_SIZE (field_type)) == INTEGER_CST
- && (! 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
if (must_pass_by_ref (field_type) || default_pass_by_ref (field_type))
addressable = 1;
- /* Mark the decl as nonaddressable if it either is indicated so semantically
- or if it is a bit field. */
- DECL_NONADDRESSABLE_P (field_decl)
- = ! addressable || DECL_BIT_FIELD (field_decl);
+ /* ??? For now, we say that any field of aggregate type is addressable
+ because the front end may take 'Reference of it. */
+ if (AGGREGATE_TYPE_P (field_type))
+ addressable = 1;
+
+ /* Mark the decl as nonaddressable if it is indicated so semantically,
+ meaning we won't ever attempt to take the address of the field.
+
+ It may also be "technically" nonaddressable, meaning that even if we
+ attempt to take the field's address we will actually get the address of a
+ 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;
return field_decl;
}
/* Subroutine of previous function: return nonzero if EXP, ignoring any side
effects, has the value of zero. */
-static int
-value_zerop (exp)
- tree exp;
+static bool
+value_zerop (tree exp)
{
if (TREE_CODE (exp) == COMPOUND_EXPR)
return value_zerop (TREE_OPERAND (exp, 1));
}
\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 (param_name, param_type, readonly)
- 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);
+ /* Honor targetm.calls.promote_prototypes(), as not doing so can
+ lead to various ABI violations. */
+ if (targetm.calls.promote_prototypes (param_type)
+ && (TREE_CODE (param_type) == INTEGER_TYPE
+ || TREE_CODE (param_type) == ENUMERAL_TYPE)
+ && TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node))
+ {
+ /* We have to be careful about biased types here. Make a subtype
+ of integer_type_node with the proper biasing. */
+ if (TREE_CODE (param_type) == INTEGER_TYPE
+ && TYPE_BIASED_REPRESENTATION_P (param_type))
+ {
+ param_type
+ = copy_type (build_range_type (integer_type_node,
+ TYPE_MIN_VALUE (param_type),
+ TYPE_MAX_VALUE (param_type)));
+
+ TYPE_BIASED_REPRESENTATION_P (param_type) = 1;
+ }
+ else
+ param_type = integer_type_node;
+ }
+
DECL_ARG_TYPE (param_decl) = param_type;
DECL_ARG_TYPE_AS_WRITTEN (param_decl) = param_type;
TREE_READONLY (param_decl) = readonly;
/* Given a DECL and ATTR_LIST, process the listed attributes. */
void
-process_attributes (decl, attr_list)
- tree decl;
- struct attrib *attr_list;
+process_attributes (tree decl, struct attrib *attr_list)
{
for (; attr_list; attr_list = attr_list->next)
switch (attr_list->type)
break;
case ATTR_LINK_SECTION:
-#ifdef ASM_OUTPUT_SECTION_NAME
- 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",
- attr_list->error_point);
-#endif
+ if (targetm.have_named_sections)
+ {
+ DECL_SECTION_NAME (decl)
+ = build_string (IDENTIFIER_LENGTH (attr_list->name),
+ IDENTIFIER_POINTER (attr_list->name));
+ }
+ else
+ post_error ("?section attributes are not supported for this target",
+ attr_list->error_point);
break;
}
}
\f
-/* Add some pending elaborations on the list. */
-
-void
-add_pending_elaborations (var_decl, var_init)
- 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 ()
-{
- /* 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 nonzero if there are pending elaborations. */
-
-int
-pending_elaborations_p ()
-{
- return TREE_CHAIN (pending_elaborations) != 0;
-}
+/* Return true if VALUE is a known to be a multiple of FACTOR, which must be
+ a power of 2. */
-/* Save a copy of the current pending elaboration list and make a new
- one. */
-
-void
-push_pending_elaborations ()
-{
- 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 ()
+static bool
+value_factor_p (tree value, HOST_WIDE_INT factor)
{
- struct e_stack *p = elist_stack;
+ if (host_integerp (value, 1))
+ return tree_low_cst (value, 1) % factor == 0;
- pending_elaborations = p->elab_list;
- elist_stack = p->next;
-}
-
-/* Return the current position in pending_elaborations so we can insert
- elaborations after that point. */
+ if (TREE_CODE (value) == MULT_EXPR)
+ return (value_factor_p (TREE_OPERAND (value, 0), factor)
+ || value_factor_p (TREE_OPERAND (value, 1), factor));
-tree
-get_elaboration_location ()
-{
- return tree_last (pending_elaborations);
+ return 0;
}
-/* Insert the current elaborations after ELAB, which is in some elaboration
- list. */
+/* Given 2 consecutive field decls PREV_FIELD and CURR_FIELD, return true
+ unless we can prove these 2 fields are laid out in such a way that no gap
+ exist between the end of PREV_FIELD and the begining of CURR_FIELD. OFFSET
+ is the distance in bits between the end of PREV_FIELD and the starting
+ position of CURR_FIELD. It is ignored if null. */
-void
-insert_elaboration_list (elab)
- tree elab;
+static bool
+potential_alignment_gap (tree prev_field, tree curr_field, tree offset)
{
- 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;
- }
+ /* If this is the first field of the record, there cannot be any gap */
+ if (!prev_field)
+ 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
+ there are other components at fixed positions after it (meaning there
+ 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 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);
+
+ /* 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
+ iff it is not multiple of the current field alignment. */
+ if (host_integerp (DECL_SIZE (prev_field), 1)
+ && host_integerp (bit_position (prev_field), 1))
+ return ((tree_low_cst (bit_position (prev_field), 1)
+ + tree_low_cst (DECL_SIZE (prev_field), 1))
+ % DECL_ALIGN (curr_field) != 0);
+
+ /* If both the position and size of the previous field are multiples
+ 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 false;
+
+ /* Fallback, return that there may be a potential gap */
+ return true;
}
/* Returns a LABEL_DECL node for LABEL_NAME. */
tree
-create_label_decl (label_name)
- tree label_name;
+create_label_decl (tree label_name)
{
tree label_decl = build_decl (LABEL_DECL, label_name, void_type_node);
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 (subprog_name, asm_name, subprog_type, param_decl_list,
- inline_flag, public_flag, extern_flag, attr_list)
- 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 (subprog_decl)
- tree subprog_decl;
+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, input_filename, input_line);
- 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 ()
+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;
-
- expand_function_end (input_filename, input_line, 0);
+ /* 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;
- /* 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 ();
+ /* We handle pending sizes via the elaboration of types, so we don't
+ need to save them. */
+ get_pending_sizes ();
- rest_of_compilation (current_function_decl);
+ /* Mark the RESULT_DECL as being in this subprogram. */
+ DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
- if (function_nesting_depth > 1)
- ggc_pop_context ();
+ DECL_SAVED_TREE (fndecl) = body;
-#if 0
- /* If we're sure this function is defined in this file then mark it
- as such */
- if (TREE_ASM_WRITTEN (current_function_decl))
- mark_fn_defined_in_this_file (current_function_decl);
-#endif
+ 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_SAVED_INSNS (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);
+}
+
+/* Convert FNDECL's code to GIMPLE and handle any nested functions. */
+
+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);
+}
- /* Similarly, discard DECL_RTL of the return value. */
- SET_DECL_RTL (DECL_RESULT (current_function_decl), 0);
+/* Give FNDECL and all its nested functions to cgraph for compilation. */
- /* 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_finalize (tree fndecl)
+{
+ struct cgraph_node *cgn;
- DECL_ARGUMENTS (current_function_decl) = 0;
- }
+ /* Finalize all nested functions now. */
+ cgn = cgraph_node (fndecl);
+ for (cgn = cgn->nested; cgn ; cgn = cgn->next_nested)
+ gnat_finalize (cgn->decl);
- /* 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;
+ 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 (name, type, function_code, class, library_name, attrs)
- const char *name;
- tree type;
- int function_code;
- enum built_in_class class;
- const char *library_name;
- tree attrs;
+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)
return decl;
}
-/* Return an integer type with the number of bits of precision given by
+/* Return an integer type with the number of bits of precision given by
PRECISION. UNSIGNEDP is nonzero if the type is unsigned; otherwise
it is a signed type. */
tree
-gnat_type_for_size (precision, unsignedp)
- unsigned precision;
- int unsignedp;
+gnat_type_for_size (unsigned precision, int unsignedp)
{
tree t;
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);
/* Likewise for floating-point types. */
static tree
-float_type_for_size (precision, mode)
- int precision;
- enum machine_mode mode;
+float_type_for_precision (int precision, enum machine_mode mode)
{
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);
an unsigned type; otherwise a signed type is returned. */
tree
-gnat_type_for_mode (mode, unsignedp)
- enum machine_mode mode;
- int unsignedp;
+gnat_type_for_mode (enum machine_mode mode, int unsignedp)
{
- if (GET_MODE_CLASS (mode) == MODE_FLOAT)
- return float_type_for_size (GET_MODE_BITSIZE (mode), mode);
+ 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);
}
/* Return the unsigned version of a TYPE_NODE, a scalar type. */
tree
-gnat_unsigned_type (type_node)
- tree type_node;
+gnat_unsigned_type (tree type_node)
{
tree type = gnat_type_for_size (TYPE_PRECISION (type_node), 1);
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)))
{
/* Return the signed version of a TYPE_NODE, a scalar type. */
tree
-gnat_signed_type (type_node)
- tree type_node;
+gnat_signed_type (tree type_node)
{
tree type = gnat_type_for_size (TYPE_PRECISION (type_node), 0);
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)))
{
UNSIGNEDP. */
tree
-gnat_signed_or_unsigned_type (unsignedp, type)
- int unsignedp;
- tree type;
+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 (exp, max_p)
- 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 abort since it is something we can't
- handle. */
- if (! contains_placeholder_p (exp))
- gigi_abort (406);
+ modify. Otherwise, we treat it like a variable. */
+ 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 (max_p && code == MIN_EXPR && TREE_OVERFLOW (lhs))
return rhs;
else if ((code == MINUS_EXPR || code == PLUS_EXPR)
- && (TREE_OVERFLOW (lhs)
+ && ((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.
Return a constructor for the template. */
tree
-build_template (template_type, array_type, expr)
- tree template_type;
- tree array_type;
- tree expr;
+build_template (tree template_type, tree array_type, tree expr)
{
tree template_elts = NULL_TREE;
tree bound_list = NULL_TREE;
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 (! TREE_CONSTANT (min) && contains_placeholder_p (min))
- min = build (WITH_RECORD_EXPR, TREE_TYPE (min), min, expr);
- if (! TREE_CONSTANT (max) && 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. */
tree
-build_vms_descriptor (type, mech, gnat_entity)
- tree type;
- Mechanism_Type mech;
- Entity_Id gnat_entity;
+build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
{
tree record_type = make_node (RECORD_TYPE);
tree field_list = 0;
case INTEGER_TYPE:
case ENUMERAL_TYPE:
if (TYPE_VAX_FLOATING_POINT_P (type))
- switch ((int) TYPE_DIGITS_VALUE (type))
+ switch (tree_low_cst (TYPE_DIGITS_VALUE (type), 1))
{
case 6:
dtype = 10;
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;
case COMPLEX_TYPE:
if (TREE_CODE (TREE_TYPE (type)) == INTEGER_TYPE
&& TYPE_VAX_FLOATING_POINT_P (type))
- switch ((int) TYPE_DIGITS_VALUE (type))
+ switch (tree_low_cst (TYPE_DIGITS_VALUE (type), 1))
{
case 6:
dtype = 12;
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)
{
case By_Descriptor_SB:
field_list
= chainon (field_list,
- make_descriptor_field
+ make_descriptor_field
("SB_L1", gnat_type_for_size (32, 1), record_type,
TREE_CODE (type) == ARRAY_TYPE
? TYPE_MIN_VALUE (TYPE_DOMAIN (type)) : size_zero_node));
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;
}
/* Utility routine for above code to make a field. */
static tree
-make_descriptor_field (name, type, rec_type, initial)
- const char *name;
- tree type;
- tree rec_type;
- tree initial;
+make_descriptor_field (const char *name, tree type,
+ tree rec_type, tree initial)
{
tree field
= create_field_decl (get_identifier (name), type, rec_type, 0, 0, 0, 0);
as the name of the record. */
tree
-build_unc_object_type (template_type, object_type, name)
- tree template_type;
- tree object_type;
- tree name;
+build_unc_object_type (tree template_type, tree object_type, tree name)
{
tree type = make_node (RECORD_TYPE);
tree template_field = create_field_decl (get_identifier ("BOUNDS"),
finish_record_type (type,
chainon (chainon (NULL_TREE, template_field),
array_field),
- 0, 0);
+ false, false);
return type;
}
if NEW is an UNCONSTRAINED_ARRAY_TYPE. */
void
-update_pointer_to (old_type, new_type)
- tree old_type;
- tree new_type;
+update_pointer_to (tree old_type, tree new_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. Otherwise, get the new type with
- the same qualifiers as the old type and see if it is the same as the old
- type. */
- if (ptr == 0 && ref == 0)
+ /* If no pointer or reference, we are done. */
+ if (!ptr && !ref)
return;
- new_type = build_qualified_type (new_type, TYPE_QUALS (old_type));
+ /* Merge the old type qualifiers in the new type.
+
+ Each old variant has qualifiers for specific reasons, and the new
+ designated type as well. Each set of qualifiers represents useful
+ information grabbed at some point, and merging the two simply unifies
+ these inputs into the final type description.
+
+ Consider for instance a volatile type frozen after an access to constant
+ type designating it. After the designated type freeze, we get here with a
+ volatile new_type and a dummy old_type with a readonly variant, created
+ when the access type was processed. We shall make a volatile and readonly
+ designated type, because that's what it really is.
+
+ We might also get here for a non-dummy old_type variant with different
+ qualifiers than the new_type ones, for instance in some cases of pointers
+ to private record type elaboration (see the comments around the call to
+ this routine from gnat_to_gnu_entity/E_Access_Type). We have to merge the
+ qualifiers in thoses cases too, to avoid accidentally discarding the
+ initial set, and will often end up with old_type == new_type then. */
+ new_type = build_qualified_type (new_type,
+ TYPE_QUALS (old_type)
+ | TYPE_QUALS (new_type));
+
+ /* If the new type and the old one are identical, there is nothing to
+ update. */
if (old_type == new_type)
return;
- /* First handle the simple case. */
+ /* 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
+ update_pointer_to
(TREE_TYPE (TREE_TYPE (TYPE_FIELDS (ptr))),
gnat_substitute_in_type (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (ptr))),
TREE_CHAIN (TYPE_FIELDS (ptr)), new_ref));
pointer. This involves making or finding a template. */
static tree
-convert_to_fat_pointer (type, expr)
- tree type;
- tree expr;
+convert_to_fat_pointer (tree type, tree expr)
{
tree template_type = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))));
tree template, template_addr;
else
expr = build1 (INDIRECT_REF, TREE_TYPE (etype), expr);
- template = build_component_ref (expr, NULL_TREE, fields);
+ 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)));
+ TREE_CHAIN (fields), false));
}
else
/* Otherwise, build the constructor for the template. */
template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template);
- /* The result is a CONSTRUCTOR for the fat pointer. */
- return
- gnat_build_constructor (type,
- tree_cons (TYPE_FIELDS (type), expr,
- tree_cons (TREE_CHAIN (TYPE_FIELDS (type)),
- template_addr, NULL_TREE)));
+ /* The result is a CONSTRUCTOR for the fat pointer.
+
+ If expr is an argument of a foreign convention subprogram, the type it
+ points to is directly the component type. In this case, the expression
+ type may not match the corresponding FIELD_DECL type at this point, so we
+ call "convert" here to fix that up if necessary. This type consistency is
+ required, for instance because it ensures that possible later folding of
+ component_refs against this constructor always yields something of the
+ same type as the initial reference.
+
+ Note that the call to "build_template" above is still fine, because it
+ will only refer to the provided template_type in this case. */
+ return
+ gnat_build_constructor
+ (type, tree_cons (TYPE_FIELDS (type),
+ convert (TREE_TYPE (TYPE_FIELDS (type)), expr),
+ tree_cons (TREE_CHAIN (TYPE_FIELDS (type)),
+ template_addr, NULL_TREE)));
}
\f
/* Convert to a thin pointer type, TYPE. The only thing we know how to convert
is not already a fat pointer. */
static tree
-convert_to_thin_pointer (type, expr)
- tree type;
- tree expr;
+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)));
+ expr = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (TREE_TYPE (expr)),
+ false);
expr = build1 (NOP_EXPR, type, expr);
return expr;
not permitted by the language being compiled. */
tree
-convert (type, expr)
- tree type, expr;
+convert (tree type, tree expr)
{
enum tree_code code = TREE_CODE (type);
tree etype = TREE_TYPE (expr);
if (type == etype)
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,
- 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
to build the record. If both input and output have padding and are
of variable size, do this as an unchecked conversion. */
- if (ecode == RECORD_TYPE && code == RECORD_TYPE
+ 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)));
+ 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
field and the expression type is a record, do this as an
unchecked converstion. */
- else if (TREE_CODE (DECL_SIZE (TYPE_FIELDS (type))) != INTEGER_CST
- && contains_placeholder_p (DECL_SIZE (TYPE_FIELDS (type)))
- && TREE_CODE (etype) == RECORD_TYPE)
- return unchecked_convert (type, expr);
+ else if (TREE_CODE (etype) == RECORD_TYPE
+ && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
+ 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)));
+ TYPE_FIELDS (etype), false));
- /* If converting a type that does not contain a template into one
- that does, convert to the data type and then build the template. */
- if (code == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (type)
- && ! (ecode == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (etype)))
+ /* If converting to a type that contains a template, convert to the data
+ type and then build the template. */
+ if (code == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (type))
{
tree obj_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)));
+ /* If the source already has a template, get a reference to the
+ associated array only, as we are going to rebuild a template
+ for the target type anyway. */
+ expr = maybe_unconstrained_array (expr);
+
return
gnat_build_constructor
(type,
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
and actual value, so no conversion is needed. */
+ expr = copy_node (expr);
TREE_TYPE (expr) = type;
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));
+ 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;
case INDIRECT_REF:
/* If both types are record types, just convert the pointer and
- make a new INDIRECT_REF.
+ make a new INDIRECT_REF.
??? Disable this for now since it causes problems with the
code in build_binary_op for MODIFY_EXPR which wants to
|| 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))
- return unchecked_convert (type, expr);
+ && (ecode == ARRAY_TYPE || ecode == UNCONSTRAINED_ARRAY_TYPE
+ || (ecode == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (etype))))
+ 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);
+ 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);
+ return unchecked_convert (type, expr, false);
case UNION_TYPE:
/* Just validate that the type is indeed that of a field
of the type. Then make the simple conversion. */
for (tem = TYPE_FIELDS (type); tem; tem = TREE_CHAIN (tem))
- if (TREE_TYPE (tem) == etype)
- return build1 (CONVERT_EXPR, type, expr);
+ {
+ if (TREE_TYPE (tem) == etype)
+ return build1 (CONVERT_EXPR, type, expr);
+ else if (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE
+ && (TYPE_LEFT_JUSTIFIED_MODULAR_P (TREE_TYPE (tem))
+ || TYPE_IS_PADDING_P (TREE_TYPE (tem)))
+ && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype)
+ return build1 (CONVERT_EXPR, type,
+ 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 (exp, true_address)
- 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:
likewise return an expression pointing to the underlying array. */
tree
-maybe_unconstrained_array (exp)
- tree exp;
+maybe_unconstrained_array (tree exp)
{
enum tree_code code = TREE_CODE (exp);
tree new;
= build_unary_op (INDIRECT_REF, NULL_TREE,
build_component_ref (TREE_OPERAND (exp, 0),
get_identifier ("P_ARRAY"),
- NULL_TREE));
+ 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 (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp)))
+ /* If this is a padded type, convert to the unpadded type and see if
+ it contains a template. */
+ if (TYPE_IS_PADDING_P (TREE_TYPE (exp)))
{
- new
- = build_component_ref (exp, NULL_TREE,
- TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))));
+ new = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp);
if (TREE_CODE (TREE_TYPE (new)) == RECORD_TYPE
- && TYPE_IS_PADDING_P (TREE_TYPE (new)))
- new = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (new))), new);
-
- return new;
+ && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new)))
+ return
+ build_component_ref (new, NULL_TREE,
+ TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new))),
+ 0);
}
+ else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp)))
+ return
+ build_component_ref (exp, NULL_TREE,
+ TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))), 0);
break;
default:
return exp;
}
\f
-/* Return an expression that does an unchecked converstion of EXPR to TYPE. */
+/* Return an expression that does an unchecked converstion of EXPR to TYPE.
+ If NOTRUNC_P is true, truncation operations should be suppressed. */
tree
-unchecked_convert (type, expr)
- tree type;
- tree expr;
+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)),
- 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))))
{
tree rec_type = make_node (RECORD_TYPE);
- tree field = create_field_decl (get_identifier ("OBJ"), type,
+ tree field = create_field_decl (get_identifier ("OBJ"), type,
rec_type, 1, 0, 0, 0);
TYPE_FIELDS (rec_type) = field;
layout_type (rec_type);
- expr = unchecked_convert (rec_type, expr);
- expr = build_component_ref (expr, NULL_TREE, field);
+ expr = unchecked_convert (rec_type, expr, notrunc_p);
+ expr = build_component_ref (expr, NULL_TREE, field, 0);
}
/* 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))))
{
layout_type (rec_type);
expr = gnat_build_constructor (rec_type, build_tree_list (field, expr));
- expr = unchecked_convert (type, expr);
+ expr = unchecked_convert (type, expr, notrunc_p);
}
/* We have a special case when we are converting between two
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 (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
