+2010-04-09 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/gigi.h (gnat_mark_addressable): Rename parameter.
+ * gcc-interface/decl.c (maybe_variable): Do not set TREE_STATIC on _REF
+ node. Use the type of the operand to set TREE_READONLY.
+ * gcc-interface/trans.c (Identifier_to_gnu): Do not set TREE_STATIC on
+ _REF node. Do not overwrite TREE_READONLY.
+ (call_to_gnu): Rename local variable and fix various nits. In the
+ copy-in/copy-out case, build the SAVE_EXPR manually.
+ (convert_with_check): Call protect_multiple_eval in lieu of save_expr
+ and fold the computations.
+ (protect_multiple_eval): Always save entire fat pointers.
+ (maybe_stabilize_reference): Minor tweaks.
+ (gnat_stabilize_reference_1): Likewise. Do not deal with tcc_constant,
+ tcc_type and tcc_statement.
+ * gcc-interface/utils.c (convert_to_fat_pointer): Call
+ protect_multiple_eval in lieu of save_expr.
+ (convert): Minor tweaks.
+ (maybe_unconstrained_array): Do not set TREE_STATIC on _REF node.
+ (builtin_type_for_size): Call gnat_type_for_size directly.
+ * gcc-interface/utils2.c (contains_save_expr_p): Delete.
+ (contains_null_expr): Likewise
+ (gnat_build_constructor): Do not call it.
+ (compare_arrays): Deal with all side-effects, use protect_multiple_eval
+ instead of gnat_stabilize_reference to protect the operands.
+ (nonbinary_modular_operation): Call protect_multiple_eval in lieu of
+ save_expr.
+ (maybe_wrap_malloc): Likewise.
+ (build_allocator): Likewise.
+ (build_unary_op) <INDIRECT_REF>: Do not set TREE_STATIC on _REF node.
+ (gnat_mark_addressable): Rename parameter.
+
2010-04-08 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/ada-tree.h (TYPE_RETURNS_UNCONSTRAINED_P): Rename into.
tree gnu_result
= build1 (UNCONSTRAINED_ARRAY_REF, TREE_TYPE (gnu_operand),
variable_size (TREE_OPERAND (gnu_operand, 0)));
-
- TREE_READONLY (gnu_result) = TREE_STATIC (gnu_result)
- = TYPE_READONLY (TREE_TYPE (TREE_TYPE (gnu_operand)));
+ TREE_READONLY (gnu_result) = TYPE_READONLY (TREE_TYPE (gnu_operand));
return gnu_result;
}
#define MARK_VISITED(EXP) \
do { \
- if((EXP) && !CONSTANT_CLASS_P (EXP)) \
+ if((EXP) && !TREE_CONSTANT (EXP)) \
mark_visited (EXP); \
} while (0)
/* Get the unpadded version of a GNAT type. */
extern tree get_unpadded_type (Entity_Id gnat_entity);
+/* Called when we need to protect a variable object using a save_expr. */
+extern tree maybe_variable (tree gnu_operand);
+
/* Create a record type that contains a SIZE bytes long field of TYPE with a
starting bit position so that it is aligned to ALIGN bits, and leaving at
least ROOM bytes free before the field. BASE_ALIGN is the alignment the
the name followed by "___" and the specified suffix. */
extern tree concat_name (tree gnu_name, const char *suffix);
-/* Highest number in the front-end node table. */
-extern int max_gnat_nodes;
-
-/* Current node being treated, in case abort called. */
-extern Node_Id error_gnat_node;
-
-/* True when gigi is being called on an analyzed but unexpanded
- tree, and the only purpose of the call is to properly annotate
- types with representation information. */
+/* If true, then gigi is being called on an analyzed but unexpanded tree, and
+ the only purpose of the call is to properly annotate types with
+ representation information. */
extern bool type_annotate_only;
-/* Current file name without path. */
+/* Current file name without path */
extern const char *ref_filename;
/* This structure must be kept synchronized with Call_Back_End. */
};
/* This is the main program of the back-end. It sets up all the table
- structures and then generates code. */
-extern void gigi (Node_Id gnat_root, int max_gnat_node,
- int number_name ATTRIBUTE_UNUSED,
+ structures and then generates code.
+
+ ??? Needs parameter descriptions */
+
+extern void gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
struct Node *nodes_ptr, Node_Id *next_node_ptr,
Node_Id *prev_node_ptr, struct Elist_Header *elists_ptr,
struct Elmt_Item *elmts_ptr,
struct File_Info_Type *file_info_ptr,
Entity_Id standard_boolean,
Entity_Id standard_integer,
- Entity_Id standard_character,
Entity_Id standard_long_long_float,
Entity_Id standard_exception_type,
Int gigi_operating_mode);
/* Post an error message. MSG is the error message, properly annotated.
NODE is the node at which to post the error and the node to use for the
- '&' substitution. */
+ "&" substitution. */
extern void post_error (const char *msg, Node_Id node);
-/* Similar to post_error, but NODE is the node at which to post the error and
- ENT is the node to use for the '&' substitution. */
+/* Similar, but NODE is the node at which to post the error and ENT
+ is the node to use for the "&" substitution. */
extern void post_error_ne (const char *msg, Node_Id node, Entity_Id ent);
-/* Similar to post_error_ne, but NUM is the number to use for the '^'. */
+/* Similar, but NODE is the node at which to post the error, ENT is the node
+ to use for the "&" substitution, and N is the number to use for the ^. */
extern void post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent,
- int num);
+ int n);
-/* Similar to post_error_ne, but T is a GCC tree representing the number to
- write. If T represents a constant, the text inside curly brackets in
- MSG will be output (presumably including a '^'). Otherwise it will not
- be output and the text inside square brackets will be output instead. */
+/* Similar to post_error_ne_num, but T is a GCC tree representing the number
+ to write. If the tree represents a constant that fits within a
+ host integer, the text inside curly brackets in MSG will be output
+ (presumably including a '^'). Otherwise that text will not be output
+ and the text inside square brackets will be output instead. */
extern void post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent,
tree t);
-/* Similar to post_error_ne_tree, but NUM is a second integer to write. */
+/* Similar to post_error_ne_tree, except that NUM is a second
+ integer to write in the message. */
extern void post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent,
tree t, int num);
+/* Protect EXP from multiple evaluation. This may make a SAVE_EXPR. */
+extern tree protect_multiple_eval (tree exp);
+
/* Return a label to branch to for the exception type in KIND or NULL_TREE
if none. */
extern tree get_exception_label (char kind);
+/* Current node being treated, in case gigi_abort or Check_Elaboration_Code
+ called. */
+extern Node_Id error_gnat_node;
+
+/* This is equivalent to stabilize_reference in tree.c, but we know how to
+ handle our own nodes and we take extra arguments. FORCE says whether to
+ force evaluation of everything. We set SUCCESS to true unless we walk
+ through something we don't know how to stabilize. */
+extern tree maybe_stabilize_reference (tree ref, bool force, bool *success);
+
+/* Highest number in the front-end node table. */
+extern int max_gnat_nodes;
+
/* If nonzero, pretend we are allocating at global level. */
extern int force_global;
types whose size is greater or equal to 64 bits, or 0 if this alignment
is not specifically capped. */
extern int double_scalar_alignment;
+
+/* Standard data type sizes. Most of these are not used. */
+
+#ifndef CHAR_TYPE_SIZE
+#define CHAR_TYPE_SIZE BITS_PER_UNIT
+#endif
+
+#ifndef SHORT_TYPE_SIZE
+#define SHORT_TYPE_SIZE (BITS_PER_UNIT * MIN ((UNITS_PER_WORD + 1) / 2, 2))
+#endif
+
+#ifndef INT_TYPE_SIZE
+#define INT_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef LONG_TYPE_SIZE
+#define LONG_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef LONG_LONG_TYPE_SIZE
+#define LONG_LONG_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+#ifndef FLOAT_TYPE_SIZE
+#define FLOAT_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#ifndef DOUBLE_TYPE_SIZE
+#define DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+#ifndef LONG_DOUBLE_TYPE_SIZE
+#define LONG_DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2)
+#endif
+
+/* The choice of SIZE_TYPE here is very problematic. We need a signed
+ type whose bit width is Pmode. Assume "long" is such a type here. */
+#undef SIZE_TYPE
+#define SIZE_TYPE "long int"
\f
/* Data structures used to represent attributes. */
/* Type declaration node <==> typedef virtual void *T() */
ADT_fdesc_type,
- /* Null pointer for above type. */
+ /* Null pointer for above type */
ADT_null_fdesc,
- /* Value 1 in signed bitsizetype. */
- ADT_sbitsize_one_node,
-
- /* Value BITS_PER_UNIT in signed bitsizetype. */
- ADT_sbitsize_unit_node,
-
/* Function declaration nodes for run-time functions for allocating memory.
Ada allocators cause calls to these functions to be generated. Malloc32
is used only on 64bit systems needing to allocate 32bit memory. */
/* Likewise for freeing memory. */
ADT_free_decl,
- /* Function decl node for 64-bit multiplication with overflow checking. */
+ /* Function decl node for 64-bit multiplication with overflow checking */
ADT_mulv64_decl,
- /* Identifier for the name of the _Parent field in tagged record types. */
- ADT_parent_name_id,
-
- /* Identifier for the name of the Exception_Data type. */
- ADT_exception_data_name_id,
-
/* Types and decls used by our temporary exception mechanism. See
init_gigi_decls for details. */
ADT_jmpbuf_type,
#define ptr_void_ftype gnat_std_decls[(int) ADT_ptr_void_ftype]
#define fdesc_type_node gnat_std_decls[(int) ADT_fdesc_type]
#define null_fdesc_node gnat_std_decls[(int) ADT_null_fdesc]
-#define sbitsize_one_node gnat_std_decls[(int) ADT_sbitsize_one_node]
-#define sbitsize_unit_node gnat_std_decls[(int) ADT_sbitsize_unit_node]
#define malloc_decl gnat_std_decls[(int) ADT_malloc_decl]
#define malloc32_decl gnat_std_decls[(int) ADT_malloc32_decl]
#define free_decl gnat_std_decls[(int) ADT_free_decl]
#define mulv64_decl gnat_std_decls[(int) ADT_mulv64_decl]
-#define parent_name_id gnat_std_decls[(int) ADT_parent_name_id]
-#define exception_data_name_id gnat_std_decls[(int) ADT_exception_data_name_id]
#define jmpbuf_type gnat_std_decls[(int) ADT_jmpbuf_type]
#define jmpbuf_ptr_type gnat_std_decls[(int) ADT_jmpbuf_ptr_type]
#define get_jmpbuf_decl gnat_std_decls[(int) ADT_get_jmpbuf_decl]
and uses GNAT_NODE for location information. */
extern void gnat_pushdecl (tree decl, Node_Id gnat_node);
+extern void gnat_init_decl_processing (void);
extern void gnat_init_gcc_eh (void);
extern void gnat_install_builtins (void);
const_flag, public_flag, extern_flag, \
static_flag, false, attr_list, gnat_node)
+/* Given a DECL and ATTR_LIST, apply the listed attributes. */
+extern void process_attributes (tree decl, struct attrib *attr_list);
+
/* Record DECL as a global renaming pointer. */
extern void record_global_renaming_pointer (tree decl);
extern void invalidate_global_renaming_pointers (void);
/* Return a FIELD_DECL node. FIELD_NAME is the field's name, FIELD_TYPE is
- its type and RECORD_TYPE is the type of the enclosing record. If SIZE is
- nonzero, it is the specified size of the field. If POS is nonzero, it is
- the bit position. PACKED is 1 if the enclosing record is packed, -1 if it
- has Component_Alignment of Storage_Unit. If ADDRESSABLE is nonzero, it
+ its type and RECORD_TYPE is the type of the enclosing record. PACKED is
+ 1 if the enclosing record is packed, -1 if it has Component_Alignment of
+ Storage_Unit. If SIZE is nonzero, it is the specified size of the field.
+ If POS is nonzero, it is the bit position. If ADDRESSABLE is nonzero, it
means we are allowed to take the address of the field; if it is negative,
we should not make a bitfield, which is used by make_aligning_type. */
extern tree create_field_decl (tree field_name, tree field_type,
- tree record_type, tree size, tree pos,
- int packed, int addressable);
+ tree record_type, int packed, tree size,
+ tree pos, int addressable);
/* Returns a PARM_DECL node. PARAM_NAME is the name of the parameter,
PARAM_TYPE is its type. READONLY is true if the parameter is
and the GNAT node GNAT_SUBPROG. */
extern void build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog);
-/* Build a type to be used to represent an aliased object whose nominal type
- is an unconstrained array. This consists of a RECORD_TYPE containing a
- field of TEMPLATE_TYPE and a field of OBJECT_TYPE, which is an ARRAY_TYPE.
- If ARRAY_TYPE is that of an unconstrained array, this is used to represent
- an arbitrary unconstrained object. Use NAME as the name of the record.
- DEBUG_INFO_P is true if we need to write debug information for the type. */
+/* Build a type to be used to represent an aliased object whose nominal
+ type is an unconstrained array. This consists of a RECORD_TYPE containing
+ a field of TEMPLATE_TYPE and a field of OBJECT_TYPE, which is an
+ ARRAY_TYPE. If ARRAY_TYPE is that of the unconstrained array, this
+ is used to represent an arbitrary unconstrained object. Use NAME
+ as the name of the record. */
extern tree build_unc_object_type (tree template_type, tree object_type,
- tree name, bool debug_info_p);
+ tree name);
/* Same as build_unc_object_type, but taking a thin or fat pointer type
instead of the template type. */
extern tree build_unc_object_type_from_ptr (tree thin_fat_ptr_type,
- tree object_type, tree name,
- bool debug_info_p);
+ tree object_type, tree name);
/* Shift the component offsets within an unconstrained object TYPE to make it
suitable for use as a designated type for thin pointers. */
should not be allocated in a register. Returns true if successful. */
extern bool gnat_mark_addressable (tree t);
-/* Save EXP for later use or reuse. This is equivalent to save_expr in tree.c
- but we know how to handle our own nodes. */
-extern tree gnat_save_expr (tree exp);
-
-/* Protect EXP for immediate reuse. This is a variant of gnat_save_expr that
- is optimized under the assumption that EXP's value doesn't change before
- its subsequent reuse(s) except through its potential reevaluation. */
-extern tree gnat_protect_expr (tree exp);
-
-/* This is equivalent to stabilize_reference in tree.c but we know how to
- handle our own nodes and we take extra arguments. FORCE says whether to
- force evaluation of everything. We set SUCCESS to true unless we walk
- through something we don't know how to stabilize. */
-extern tree gnat_stabilize_reference (tree ref, bool force, bool *success);
-
/* Implementation of the builtin_function langhook. */
extern tree gnat_builtin_function (tree decl);
|| (TREE_CODE (gnu_result) == PARM_DECL
&& DECL_BY_COMPONENT_PTR_P (gnu_result))))
{
- bool ro = DECL_POINTS_TO_READONLY_P (gnu_result);
+ const bool read_only = DECL_POINTS_TO_READONLY_P (gnu_result);
tree renamed_obj;
if (TREE_CODE (gnu_result) == PARM_DECL
we can reference the renamed object directly, since the renamed
expression has been protected against multiple evaluations. */
else if (TREE_CODE (gnu_result) == VAR_DECL
- && (renamed_obj = DECL_RENAMED_OBJECT (gnu_result)) != 0
- && (! DECL_RENAMING_GLOBAL_P (gnu_result)
+ && (renamed_obj = DECL_RENAMED_OBJECT (gnu_result))
+ && (!DECL_RENAMING_GLOBAL_P (gnu_result)
|| global_bindings_p ()))
gnu_result = renamed_obj;
else
gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
- TREE_READONLY (gnu_result) = TREE_STATIC (gnu_result) = ro;
+ if (read_only)
+ TREE_READONLY (gnu_result) = 1;
}
/* The GNAT tree has the type of a function as the type of its result. Also
static tree
call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
{
- tree gnu_result;
/* The GCC node corresponding to the GNAT subprogram name. This can either
be a FUNCTION_DECL node if we are dealing with a standard subprogram call,
or an indirect reference expression (an INDIRECT_REF node) pointing to a
subprogram. */
- tree gnu_subprog_node = gnat_to_gnu (Name (gnat_node));
+ tree gnu_subprog = gnat_to_gnu (Name (gnat_node));
/* The FUNCTION_TYPE node giving the GCC type of the subprogram. */
- tree gnu_subprog_type = TREE_TYPE (gnu_subprog_node);
- tree gnu_subprog_addr
- = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_subprog_node);
+ tree gnu_subprog_type = TREE_TYPE (gnu_subprog);
+ tree gnu_subprog_addr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_subprog);
Entity_Id gnat_formal;
Node_Id gnat_actual;
tree gnu_actual_list = NULL_TREE;
tree gnu_name_list = NULL_TREE;
tree gnu_before_list = NULL_TREE;
tree gnu_after_list = NULL_TREE;
- tree gnu_subprog_call;
+ tree gnu_call;
gcc_assert (TREE_CODE (gnu_subprog_type) == FUNCTION_TYPE);
- /* If we are calling a stubbed function, make this into a raise of
- Program_Error. Elaborate all our args first. */
- if (TREE_CODE (gnu_subprog_node) == FUNCTION_DECL
- && DECL_STUBBED_P (gnu_subprog_node))
+ /* If we are calling a stubbed function, raise Program_Error, but Elaborate
+ all our args first. */
+ if (TREE_CODE (gnu_subprog) == FUNCTION_DECL && DECL_STUBBED_P (gnu_subprog))
{
+ tree call_expr = build_call_raise (PE_Stubbed_Subprogram_Called,
+ gnat_node, N_Raise_Program_Error);
+
for (gnat_actual = First_Actual (gnat_node);
Present (gnat_actual);
gnat_actual = Next_Actual (gnat_actual))
add_stmt (gnat_to_gnu (gnat_actual));
- {
- tree call_expr
- = build_call_raise (PE_Stubbed_Subprogram_Called, gnat_node,
- N_Raise_Program_Error);
+ if (Nkind (gnat_node) == N_Function_Call && !gnu_target)
+ {
+ *gnu_result_type_p = TREE_TYPE (gnu_subprog_type);
+ return build1 (NULL_EXPR, TREE_TYPE (gnu_subprog_type), call_expr);
+ }
- if (Nkind (gnat_node) == N_Function_Call && !gnu_target)
- {
- *gnu_result_type_p = TREE_TYPE (gnu_subprog_type);
- return build1 (NULL_EXPR, *gnu_result_type_p, call_expr);
- }
- else
- return call_expr;
- }
+ return call_expr;
}
/* The only way we can be making a call via an access type is if Name is an
explicit dereference. In that case, get the list of formal args from the
- type the access type is pointing to. Otherwise, get the formals from
+ type the access type is pointing to. Otherwise, get the formals from the
entity being called. */
if (Nkind (Name (gnat_node)) == N_Explicit_Dereference)
gnat_formal = First_Formal_With_Extras (Etype (Name (gnat_node)));
else if (Nkind (Name (gnat_node)) == N_Attribute_Reference)
/* Assume here that this must be 'Elab_Body or 'Elab_Spec. */
- gnat_formal = 0;
+ gnat_formal = Empty;
else
gnat_formal = First_Formal_With_Extras (Entity (Name (gnat_node)));
- /* Create the list of the actual parameters as GCC expects it, namely a chain
- of TREE_LIST nodes in which the TREE_VALUE field of each node is a
- parameter-expression and the TREE_PURPOSE field is null. Skip Out
- parameters not passed by reference and don't need to be copied in. */
+ /* Create the list of the actual parameters as GCC expects it, namely a
+ chain of TREE_LIST nodes in which the TREE_VALUE field of each node
+ is an expression and the TREE_PURPOSE field is null. But skip Out
+ parameters not passed by reference and that need not be copied in. */
for (gnat_actual = First_Actual (gnat_node);
Present (gnat_actual);
gnat_formal = Next_Formal_With_Extras (gnat_formal),
gnat_actual = Next_Actual (gnat_actual))
{
- tree gnu_formal
- = (present_gnu_tree (gnat_formal)
- ? get_gnu_tree (gnat_formal) : NULL_TREE);
+ tree gnu_formal = present_gnu_tree (gnat_formal)
+ ? get_gnu_tree (gnat_formal) : NULL_TREE;
tree gnu_formal_type = gnat_to_gnu_type (Etype (gnat_formal));
/* We must suppress conversions that can cause the creation of a
temporary in the Out or In Out case because we need the real
&& Ekind (gnat_formal) != E_In_Parameter)
|| (Nkind (gnat_actual) == N_Type_Conversion
&& Is_Composite_Type (Underlying_Type (Etype (gnat_formal)))));
- Node_Id gnat_name = (suppress_type_conversion
- ? Expression (gnat_actual) : gnat_actual);
+ Node_Id gnat_name = suppress_type_conversion
+ ? Expression (gnat_actual) : gnat_actual;
tree gnu_name = gnat_to_gnu (gnat_name), gnu_name_type;
tree gnu_actual;
/* If it's possible we may need to use this expression twice, make sure
- that any side-effects are handled via SAVE_EXPRs. Likewise if we need
+ that any side-effects are handled via SAVE_EXPRs; likewise if we need
to force side-effects before the call.
??? This is more conservative than we need since we don't need to do
this for pass-by-ref with no conversion. */
post_error
("misaligned actual cannot be passed by reference", gnat_actual);
- /* For users of Starlet we issue a warning because the
- interface apparently assumes that by-ref parameters
- outlive the procedure invocation. The code still
- will not work as intended, but we cannot do much
- better since other low-level parts of the back-end
- would allocate temporaries at will because of the
- misalignment if we did not do so here. */
+ /* For users of Starlet we issue a warning because the interface
+ apparently assumes that by-ref parameters outlive the procedure
+ invocation. The code still will not work as intended, but we
+ cannot do much better since low-level parts of the back-end
+ would allocate temporaries at will because of the misalignment
+ if we did not do so here. */
else if (Is_Valued_Procedure (Entity (Name (gnat_node))))
{
post_error
gnu_name = convert (gnu_name_type, gnu_name);
/* Make a SAVE_EXPR to both properly account for potential side
- effects and handle the creation of a temporary copy. Special
- code in gnat_gimplify_expr ensures that the same temporary is
- used as the object and copied back after the call if needed. */
+ effects and handle the creation of a temporary. Special code
+ in gnat_gimplify_expr ensures that the same temporary is used
+ as the object and copied back after the call if needed. */
gnu_name = build1 (SAVE_EXPR, TREE_TYPE (gnu_name), gnu_name);
TREE_SIDE_EFFECTS (gnu_name) = 1;
- /* Set up to move the copy back to the original. */
+ /* Set up to move the copy back to the original if needed. */
if (Ekind (gnat_formal) != E_In_Parameter)
{
tree stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_copy,
/* We may have suppressed a conversion to the Etype of the actual
since the parent is a procedure call. So put it back here.
??? We use the reverse order compared to the case above because
- of an awkward interaction with the check and actually don't put
- back the conversion at all if a check is emitted. This is also
- done for the conversion to the formal's type just below. */
+ of an awkward interaction with the check. */
if (TREE_CODE (gnu_actual) != SAVE_EXPR)
gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)),
gnu_actual);
gnu_name);
/* If we have not saved a GCC object for the formal, it means it is an
- Out parameter not passed by reference and that does not need to be
- copied in. Otherwise, look at the PARM_DECL to see if it is passed by
- reference. */
+ Out parameter not passed by reference and that need not be copied in.
+ Otherwise, first see if the PARM_DECL is passed by reference. */
if (gnu_formal
&& TREE_CODE (gnu_formal) == PARM_DECL
&& DECL_BY_REF_P (gnu_formal))
&& TREE_CODE (gnu_formal) == PARM_DECL
&& DECL_BY_DESCRIPTOR_P (gnu_formal))
{
- /* If arg is 'Null_Parameter, pass zero descriptor. */
+ /* If this is 'Null_Parameter, pass a zero descriptor. */
if ((TREE_CODE (gnu_actual) == INDIRECT_REF
|| TREE_CODE (gnu_actual) == UNCONSTRAINED_ARRAY_REF)
&& TREE_PRIVATE (gnu_actual))
- gnu_actual = convert (DECL_ARG_TYPE (get_gnu_tree (gnat_formal)),
- integer_zero_node);
+ gnu_actual
+ = convert (DECL_ARG_TYPE (gnu_formal), integer_zero_node);
else
gnu_actual = build_unary_op (ADDR_EXPR, NULL_TREE,
fill_vms_descriptor (gnu_actual,
}
else
{
- tree gnu_actual_size = TYPE_SIZE (TREE_TYPE (gnu_actual));
+ tree gnu_size;
if (Ekind (gnat_formal) != E_In_Parameter)
gnu_name_list = tree_cons (NULL_TREE, gnu_name, gnu_name_list);
- if (!gnu_formal || TREE_CODE (gnu_formal) != PARM_DECL)
+ if (!(gnu_formal && TREE_CODE (gnu_formal) == PARM_DECL))
continue;
/* If this is 'Null_Parameter, pass a zero even though we are
dereferencing it. */
- else if (TREE_CODE (gnu_actual) == INDIRECT_REF
- && TREE_PRIVATE (gnu_actual)
- && host_integerp (gnu_actual_size, 1)
- && 0 >= compare_tree_int (gnu_actual_size,
- BITS_PER_WORD))
+ if (TREE_CODE (gnu_actual) == INDIRECT_REF
+ && TREE_PRIVATE (gnu_actual)
+ && (gnu_size = TYPE_SIZE (TREE_TYPE (gnu_actual)))
+ && TREE_CODE (gnu_size) == INTEGER_CST
+ && compare_tree_int (gnu_size, BITS_PER_WORD) <= 0)
gnu_actual
= unchecked_convert (DECL_ARG_TYPE (gnu_formal),
convert (gnat_type_for_size
- (tree_low_cst (gnu_actual_size, 1),
- 1),
+ (TREE_INT_CST_LOW (gnu_size), 1),
integer_zero_node),
false);
else
gnu_actual_list = tree_cons (NULL_TREE, gnu_actual, gnu_actual_list);
}
- gnu_subprog_call = build_call_list (TREE_TYPE (gnu_subprog_type),
- gnu_subprog_addr,
- nreverse (gnu_actual_list));
- set_expr_location_from_node (gnu_subprog_call, gnat_node);
+ gnu_call = build_call_list (TREE_TYPE (gnu_subprog_type), gnu_subprog_addr,
+ nreverse (gnu_actual_list));
+ set_expr_location_from_node (gnu_call, gnat_node);
/* If it's a function call, the result is the call expression unless a target
is specified, in which case we copy the result into the target and return
the assignment statement. */
if (Nkind (gnat_node) == N_Function_Call)
{
- gnu_result = gnu_subprog_call;
+ tree gnu_result = gnu_call;
enum tree_code op_code;
/* If the function returns an unconstrained array or by direct reference,
{
tree gnu_name;
- gnu_subprog_call = save_expr (gnu_subprog_call);
+ /* The call sequence must contain one and only one call, even though
+ the function is const or pure. So force a SAVE_EXPR. */
+ gnu_call = build1 (SAVE_EXPR, TREE_TYPE (gnu_call), gnu_call);
+ TREE_SIDE_EFFECTS (gnu_call) = 1;
gnu_name_list = nreverse (gnu_name_list);
/* If any of the names had side-effects, ensure they are all
evaluated before the call. */
- for (gnu_name = gnu_name_list; gnu_name;
+ for (gnu_name = gnu_name_list;
+ gnu_name;
gnu_name = TREE_CHAIN (gnu_name))
if (TREE_SIDE_EFFECTS (TREE_VALUE (gnu_name)))
append_to_statement_list (TREE_VALUE (gnu_name),
either the result of the function if there is only a single such
parameter or the appropriate field from the record returned. */
tree gnu_result
- = length == 1 ? gnu_subprog_call
- : build_component_ref (gnu_subprog_call, NULL_TREE,
+ = length == 1
+ ? gnu_call
+ : build_component_ref (gnu_call, NULL_TREE,
TREE_PURPOSE (scalar_return_list),
false);
/* If the result is a padded type, remove the padding. */
if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)))
- gnu_result = convert (TREE_TYPE (TYPE_FIELDS
- (TREE_TYPE (gnu_result))),
- gnu_result);
+ gnu_result
+ = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_result))),
+ gnu_result);
/* If the actual is a type conversion, the real target object is
denoted by the inner Expression and we need to convert the
scalar_return_list = TREE_CHAIN (scalar_return_list);
gnu_name_list = TREE_CHAIN (gnu_name_list);
}
- }
+ }
else
- append_to_statement_list (gnu_subprog_call, &gnu_before_list);
+ append_to_statement_list (gnu_call, &gnu_before_list);
append_to_statement_list (gnu_after_list, &gnu_before_list);
+
return gnu_before_list;
}
\f
&& !truncatep)
{
REAL_VALUE_TYPE half_minus_pred_half, pred_half;
- tree gnu_conv, gnu_zero, gnu_comp, gnu_saved_result, calc_type;
+ tree gnu_conv, gnu_zero, gnu_comp, calc_type;
tree gnu_pred_half, gnu_add_pred_half, gnu_subtract_pred_half;
const struct real_format *fmt;
gnu_pred_half = build_real (calc_type, pred_half);
/* If the input is strictly negative, subtract this value
- and otherwise add it from the input. For 0.5, the result
+ and otherwise add it from the input. For 0.5, the result
is exactly between 1.0 and the machine number preceding 1.0
- (for calc_type). Since the last bit of 1.0 is even, this 0.5
+ (for calc_type). Since the last bit of 1.0 is even, this 0.5
will round to 1.0, while all other number with an absolute
- value less than 0.5 round to 0.0. For larger numbers exactly
+ value less than 0.5 round to 0.0. For larger numbers exactly
halfway between integers, rounding will always be correct as
the true mathematical result will be closer to the higher
- integer compared to the lower one. So, this constant works
+ integer compared to the lower one. So, this constant works
for all floating-point numbers.
The reason to use the same constant with subtract/add instead
conversion of the input to the calc_type (if necessary). */
gnu_zero = convert (gnu_in_basetype, integer_zero_node);
- gnu_saved_result = save_expr (gnu_result);
- gnu_conv = convert (calc_type, gnu_saved_result);
- gnu_comp = build2 (GE_EXPR, integer_type_node,
- gnu_saved_result, gnu_zero);
+ gnu_result = protect_multiple_eval (gnu_result);
+ gnu_conv = convert (calc_type, gnu_result);
+ gnu_comp
+ = fold_build2 (GE_EXPR, integer_type_node, gnu_result, gnu_zero);
gnu_add_pred_half
- = build2 (PLUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
+ = fold_build2 (PLUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
gnu_subtract_pred_half
- = build2 (MINUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
- gnu_result = build3 (COND_EXPR, calc_type, gnu_comp,
- gnu_add_pred_half, gnu_subtract_pred_half);
+ = fold_build2 (MINUS_EXPR, calc_type, gnu_conv, gnu_pred_half);
+ gnu_result = fold_build3 (COND_EXPR, calc_type, gnu_comp,
+ gnu_add_pred_half, gnu_subtract_pred_half);
}
if (TREE_CODE (gnu_base_type) == INTEGER_TYPE
else
gnu_result = convert (gnu_base_type, gnu_result);
- /* Finally, do the range check if requested. Note that if the
- result type is a modular type, the range check is actually
- an overflow check. */
-
+ /* Finally, do the range check if requested. Note that if the result type
+ is a modular type, the range check is actually an overflow check. */
if (rangep
|| (TREE_CODE (gnu_base_type) == INTEGER_TYPE
&& TYPE_MODULAR_P (gnu_base_type) && overflowp))
protect_multiple_eval (tree exp)
{
tree type = TREE_TYPE (exp);
+ enum tree_code code = TREE_CODE (exp);
/* If EXP has no side effects, we theoritically don't need to do anything.
However, we may be recursively passed more and more complex expressions
Similarly, if we're indirectly referencing something, we only
need to protect the address since the data itself can't change
in these situations. */
- if (TREE_CODE (exp) == NON_LVALUE_EXPR
- || CONVERT_EXPR_P (exp)
- || TREE_CODE (exp) == VIEW_CONVERT_EXPR
- || TREE_CODE (exp) == INDIRECT_REF
- || TREE_CODE (exp) == UNCONSTRAINED_ARRAY_REF)
- return build1 (TREE_CODE (exp), type,
- protect_multiple_eval (TREE_OPERAND (exp, 0)));
+ if (code == NON_LVALUE_EXPR
+ || CONVERT_EXPR_CODE_P (code)
+ || code == VIEW_CONVERT_EXPR
+ || code == INDIRECT_REF
+ || code == UNCONSTRAINED_ARRAY_REF)
+ return build1 (code, type, protect_multiple_eval (TREE_OPERAND (exp, 0)));
+
+ /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
+ This may be more efficient, but will also allow us to more easily find
+ the match for the PLACEHOLDER_EXPR. */
+ if (code == COMPONENT_REF
+ && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
+ return build3 (code, type, protect_multiple_eval (TREE_OPERAND (exp, 0)),
+ TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
/* If this is a fat pointer or something that can be placed in a register,
just make a SAVE_EXPR. Likewise for a CALL_EXPR as large objects are
directly be filled by the callee. */
if (TYPE_IS_FAT_POINTER_P (type)
|| TYPE_MODE (type) != BLKmode
- || TREE_CODE (exp) == CALL_EXPR)
+ || code == CALL_EXPR)
return save_expr (exp);
/* Otherwise reference, protect the address and dereference. */
return ref;
}
- TREE_READONLY (result) = TREE_READONLY (ref);
-
- /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS attached to the initial
- expression may not be sustained across some paths, such as the way via
- build1 for INDIRECT_REF. We re-populate those flags here for the general
- case, which is consistent with the GCC version of this routine.
+ /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS set on the initial expression
+ may not be sustained across some paths, such as the way via build1 for
+ INDIRECT_REF. We reset those flags here in the general case, which is
+ consistent with the GCC version of this routine.
Special care should be taken regarding TREE_SIDE_EFFECTS, because some
- paths introduce side effects where there was none initially (e.g. calls
- to save_expr), and we also want to keep track of that. */
-
- TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
+ paths introduce side-effects where there was none initially (e.g. if a
+ SAVE_EXPR is built) and we also want to keep track of that. */
+ TREE_READONLY (result) = TREE_READONLY (ref);
TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref);
+ TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
return result;
}
-/* Wrapper around maybe_stabilize_reference, for common uses without
- lvalue restrictions and without need to examine the success
- indication. */
+/* Wrapper around maybe_stabilize_reference, for common uses without lvalue
+ restrictions and without the need to examine the success indication. */
static tree
gnat_stabilize_reference (tree ref, bool force)
to a const array but whose index contains side-effects. But we can
ignore things that are actual constant or that already have been
handled by this function. */
-
if (TREE_CONSTANT (e) || code == SAVE_EXPR)
return e;
switch (TREE_CODE_CLASS (code))
{
case tcc_exceptional:
- case tcc_type:
case tcc_declaration:
case tcc_comparison:
- case tcc_statement:
case tcc_expression:
case tcc_reference:
case tcc_vl_exp:
us to more easily find the match for the PLACEHOLDER_EXPR. */
if (code == COMPONENT_REF
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
- result = build3 (COMPONENT_REF, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0),
- force),
- TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
+ result
+ = build3 (code, type,
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
+ TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
+ /* If the expression has side-effects, then encase it in a SAVE_EXPR
+ so that it will only be evaluated once. */
+ /* The tcc_reference and tcc_comparison classes could be handled as
+ below, but it is generally faster to only evaluate them once. */
else if (TREE_SIDE_EFFECTS (e) || force)
return save_expr (e);
else
return e;
break;
- case tcc_constant:
- /* Constants need no processing. In fact, we should never reach
- here. */
- return e;
-
case tcc_binary:
/* Recursively stabilize each operand. */
- result = build2 (code, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 1),
- force));
+ result
+ = build2 (code, type,
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force));
break;
case tcc_unary:
/* Recursively stabilize each operand. */
- result = build1 (code, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0),
- force));
+ result
+ = build1 (code, type,
+ gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force));
break;
default:
gcc_unreachable ();
}
+ /* See similar handling in maybe_stabilize_reference. */
TREE_READONLY (result) = TREE_READONLY (e);
-
- TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
+ TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
+
return result;
}
\f
static tree convert_to_thin_pointer (tree, tree);
static tree make_descriptor_field (const char *,tree, tree, tree);
static bool potential_alignment_gap (tree, tree, tree);
-static void process_attributes (tree, struct attrib *);
\f
/* Initialize the association of GNAT nodes to GCC trees. */
TYPE_DUMMY_P (gnu_type) = 1;
TYPE_STUB_DECL (gnu_type)
= create_type_stub_decl (TYPE_NAME (gnu_type), gnu_type);
- if (Is_By_Reference_Type (gnat_type))
- TREE_ADDRESSABLE (gnu_type) = 1;
+ if (AGGREGATE_TYPE_P (gnu_type))
+ TYPE_BY_REFERENCE_P (gnu_type) = Is_By_Reference_Type (gnat_type);
SET_DUMMY_NODE (gnat_underlying, gnu_type);
return ((force_global || !current_function_decl) ? -1 : 0);
}
-/* Enter a new binding level. */
+/* Enter a new binding level. */
void
gnat_pushlevel (void)
if (current_binding_level)
BLOCK_SUPERCONTEXT (newlevel->block) = current_binding_level->block;
- BLOCK_VARS (newlevel->block) = NULL_TREE;
- BLOCK_SUBBLOCKS (newlevel->block) = NULL_TREE;
+ 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 active levels. */
+ /* Add this level to the front of the chain (stack) of levels that are
+ active. */
newlevel->chain = current_binding_level;
newlevel->jmpbuf_decl = NULL_TREE;
current_binding_level = newlevel;
{
BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
DECL_INITIAL (fndecl) = current_binding_level->block;
- set_block_for_group (current_binding_level->block);
}
/* Set the jmpbuf_decl for the current binding level to DECL. */
return current_binding_level->jmpbuf_decl;
}
-/* Exit a binding level. Set any BLOCK into the current code group. */
+/* Exit a binding level. Set any BLOCK into the current code group. */
void
gnat_poplevel (void)
/* 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. */
+ 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)
}
}
\f
+/* Do little here. Set up the standard declarations later after the
+ front end has been run. */
+
+void
+gnat_init_decl_processing (void)
+{
+ /* Make the binding_level structure for global names. */
+ current_function_decl = 0;
+ current_binding_level = 0;
+ free_binding_level = 0;
+ gnat_pushlevel ();
+
+ build_common_tree_nodes (true, true);
+
+ /* In Ada, we use a signed type for SIZETYPE. Use the signed type
+ corresponding to the width of Pmode. In most cases when ptr_mode
+ and Pmode differ, C will use the width of ptr_mode for SIZETYPE.
+ But we get far better code using the width of Pmode. */
+ size_type_node = gnat_type_for_mode (Pmode, 0);
+ set_sizetype (size_type_node);
+
+ /* In Ada, we use an unsigned 8-bit type for the default boolean type. */
+ boolean_type_node = make_unsigned_type (8);
+ TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE);
+ SET_TYPE_RM_MAX_VALUE (boolean_type_node,
+ build_int_cst (boolean_type_node, 1));
+ SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1));
+
+ build_common_tree_nodes_2 (0);
+ boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
+
+ ptr_void_type_node = build_pointer_type (void_type_node);
+}
+\f
/* Record TYPE as a builtin type for Ada. NAME is the name of the type. */
void
align = tree_low_cst (TREE_OPERAND (curpos, 1), 1);
/* An offset which is a bitwise AND with a negative power of 2
- means an alignment corresponding to this power of 2. Note
- that, as sizetype is sign-extended but nonetheless unsigned,
- we don't directly use tree_int_cst_sgn. */
+ means an alignment corresponding to this power of 2. */
offset = remove_conversions (offset, true);
if (TREE_CODE (offset) == BIT_AND_EXPR
&& host_integerp (TREE_OPERAND (offset, 1), 0)
- && TREE_INT_CST_HIGH (TREE_OPERAND (offset, 1)) < 0)
+ && tree_int_cst_sgn (TREE_OPERAND (offset, 1)) < 0)
{
unsigned int pow
= - tree_low_cst (TREE_OPERAND (offset, 1), 0);
field_name = concat_name (field_name, suffix);
}
- new_field
- = create_field_decl (field_name, field_type, new_record_type,
- DECL_SIZE (old_field), pos, 0, 0);
+ new_field = create_field_decl (field_name, field_type,
+ new_record_type, 0,
+ DECL_SIZE (old_field), pos, 0);
TREE_CHAIN (new_field) = TYPE_FIELDS (new_record_type);
TYPE_FIELDS (new_record_type) = new_field;
TYPE_DECL, type_name, type);
DECL_ARTIFICIAL (type_decl) = artificial_p;
-
- /* Add this decl to the current binding level. */
gnat_pushdecl (type_decl, gnat_node);
-
process_attributes (type_decl, attr_list);
/* If we're naming the type, equate the TYPE_STUB_DECL to the name.
!= null_pointer_node)
DECL_IGNORED_P (var_decl) = 1;
+ if (TREE_CODE (var_decl) == VAR_DECL)
+ {
+ 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. */
gnat_pushdecl (var_decl, gnat_node);
if (TREE_SIDE_EFFECTS (var_decl))
TREE_ADDRESSABLE (var_decl) = 1;
- if (TREE_CODE (var_decl) == VAR_DECL)
+ if (TREE_CODE (var_decl) != CONST_DECL)
{
- if (asm_name)
- SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
- process_attributes (var_decl, attr_list);
if (global_bindings_p ())
rest_of_decl_compilation (var_decl, true, 0);
}
}
/* Return a FIELD_DECL node. FIELD_NAME is the field's name, FIELD_TYPE is
- its type and RECORD_TYPE is the type of the enclosing record. If SIZE is
- nonzero, it is the specified size of the field. If POS is nonzero, it is
- the bit position. PACKED is 1 if the enclosing record is packed, -1 if it
- has Component_Alignment of Storage_Unit. If ADDRESSABLE is nonzero, it
+ its type and RECORD_TYPE is the type of the enclosing record. PACKED is
+ 1 if the enclosing record is packed, -1 if it has Component_Alignment of
+ Storage_Unit. If SIZE is nonzero, it is the specified size of the field.
+ If POS is nonzero, it is the bit position. If ADDRESSABLE is nonzero, it
means we are allowed to take the address of the field; if it is negative,
we should not make a bitfield, which is used by make_aligning_type. */
tree
create_field_decl (tree field_name, tree field_type, tree record_type,
- tree size, tree pos, int packed, int addressable)
+ int packed, tree size, tree pos, int addressable)
{
tree field_decl = build_decl (input_location,
FIELD_DECL, field_name, field_type);
\f
/* Given a DECL and ATTR_LIST, process the listed attributes. */
-static void
+void
process_attributes (tree decl, struct attrib *attr_list)
{
for (; attr_list; attr_list = attr_list->next)
switch (attr_list->type)
{
case ATTR_MACHINE_ATTRIBUTE:
- input_location = DECL_SOURCE_LOCATION (decl);
decl_attributes (&decl, tree_cons (attr_list->name, attr_list->args,
NULL_TREE),
ATTR_FLAG_TYPE_IN_PLACE);
DECL_NAME (subprog_decl) = main_identifier_node;
}
+ process_attributes (subprog_decl, attr_list);
+
/* Add this decl to the current binding level. */
gnat_pushdecl (subprog_decl, gnat_node);
- process_attributes (subprog_decl, attr_list);
-
/* Output the assembler code and/or RTL for the declaration. */
rest_of_decl_compilation (subprog_decl, global_bindings_p (), 0);
{
tree param_decl;
- announce_function (subprog_decl);
-
current_function_decl = subprog_decl;
+ announce_function (subprog_decl);
/* Enter a new binding level and show that all the parameters belong to
this function. */
gnat_pushlevel ();
-
for (param_decl = DECL_ARGUMENTS (subprog_decl); param_decl;
param_decl = TREE_CHAIN (param_decl))
DECL_CONTEXT (param_decl) = subprog_decl;
/* 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) = NULL_TREE;
+ BLOCK_VARS (current_binding_level->block) = 0;
BLOCK_SUPERCONTEXT (current_binding_level->block) = fndecl;
DECL_INITIAL (fndecl) = current_binding_level->block;
gnat_poplevel ();
DECL_SAVED_TREE (fndecl) = body;
current_function_decl = DECL_CONTEXT (fndecl);
+ set_cfun (NULL);
/* We cannot track the location of errors past this point. */
error_gnat_node = Empty;
if (code == COMPOUND_EXPR)
return max_size (TREE_OPERAND (exp, 1), max_p);
+ /* Calculate "(A ? B : C) - D" as "A ? B - D : C - D" which
+ may provide a tighter bound on max_size. */
+ if (code == MINUS_EXPR
+ && TREE_CODE (TREE_OPERAND (exp, 0)) == COND_EXPR)
+ {
+ tree lhs = fold_build2 (MINUS_EXPR, type,
+ TREE_OPERAND (TREE_OPERAND (exp, 0), 1),
+ TREE_OPERAND (exp, 1));
+ tree rhs = fold_build2 (MINUS_EXPR, type,
+ TREE_OPERAND (TREE_OPERAND (exp, 0), 2),
+ TREE_OPERAND (exp, 1));
+ return fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type,
+ max_size (lhs, max_p),
+ max_size (rhs, max_p));
+ }
+
{
tree lhs = max_size (TREE_OPERAND (exp, 0), max_p);
tree rhs = max_size (TREE_OPERAND (exp, 1),
In that case, if one side overflows, return the other.
sizetype is signed, but we know sizes are non-negative.
Likewise, handle a MINUS_EXPR or PLUS_EXPR with the LHS
- overflowing and the RHS a variable. */
+ overflowing or the maximum possible value and the RHS
+ a variable. */
if (max_p
&& code == MIN_EXPR
&& TREE_CODE (rhs) == INTEGER_CST
&& TREE_OVERFLOW (lhs))
return rhs;
else if ((code == MINUS_EXPR || code == PLUS_EXPR)
- && TREE_CODE (lhs) == INTEGER_CST
- && TREE_OVERFLOW (lhs)
+ && ((TREE_CODE (lhs) == INTEGER_CST
+ && TREE_OVERFLOW (lhs))
+ || operand_equal_p (lhs, TYPE_MAX_VALUE (type), 0))
&& !TREE_CONSTANT (rhs))
return lhs;
else
return gnat_build_constructor (template_type, nreverse (template_elts));
}
\f
-/* Build a 32-bit 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 an entity used to print out an error
- message if the mechanism cannot be applied to an object of that type and
- also for the name. */
+/* Build a 32bit 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 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_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
break;
}
- /* Make the type for a descriptor for VMS. The first four fields are the
- same for all types. */
- field_list
- = chainon (field_list,
- make_descriptor_field ("LENGTH", gnat_type_for_size (16, 1),
- record_type,
- size_in_bytes
- ((mech == By_Descriptor_A
- || mech == By_Short_Descriptor_A)
- ? inner_type : type)));
- field_list
- = chainon (field_list,
- make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
- record_type, size_int (dtype)));
+ /* Make the type for a descriptor for VMS. The first four fields
+ are the same for all types. */
+
field_list
= chainon (field_list,
- make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
- record_type, size_int (klass)));
+ make_descriptor_field
+ ("LENGTH", gnat_type_for_size (16, 1), record_type,
+ size_in_bytes ((mech == By_Descriptor_A ||
+ mech == By_Short_Descriptor_A)
+ ? inner_type : type)));
+
+ field_list = chainon (field_list,
+ make_descriptor_field ("DTYPE",
+ gnat_type_for_size (8, 1),
+ record_type, size_int (dtype)));
+ field_list = chainon (field_list,
+ make_descriptor_field ("CLASS",
+ gnat_type_for_size (8, 1),
+ record_type, size_int (klass)));
/* Of course this will crash at run-time if the address space is not
within the low 32 bits, but there is nothing else we can do. */
field_list
= chainon (field_list,
- make_descriptor_field ("POINTER", pointer32_type, record_type,
- build_unary_op (ADDR_EXPR,
- pointer32_type,
- build0 (PLACEHOLDER_EXPR,
- type))));
+ make_descriptor_field
+ ("POINTER", pointer32_type, record_type,
+ build_unary_op (ADDR_EXPR,
+ pointer32_type,
+ build0 (PLACEHOLDER_EXPR, type))));
switch (mech)
{
return record_type;
}
-/* Build a 64-bit 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 an entity used to print out an error
- message if the mechanism cannot be applied to an object of that type and
- also for the name. */
+/* Build a 64bit 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 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 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
break;
}
- /* Make the type for a 64-bit descriptor for VMS. The first six fields
+ /* Make the type for a 64bit descriptor for VMS. The first six fields
are the same for all types. */
+
+ field_list64 = chainon (field_list64,
+ make_descriptor_field ("MBO",
+ gnat_type_for_size (16, 1),
+ record64_type, size_int (1)));
+
+ field_list64 = chainon (field_list64,
+ make_descriptor_field ("DTYPE",
+ gnat_type_for_size (8, 1),
+ record64_type, size_int (dtype)));
+ field_list64 = chainon (field_list64,
+ make_descriptor_field ("CLASS",
+ gnat_type_for_size (8, 1),
+ record64_type, size_int (klass)));
+
+ field_list64 = chainon (field_list64,
+ make_descriptor_field ("MBMO",
+ gnat_type_for_size (32, 1),
+ record64_type, ssize_int (-1)));
+
field_list64
= chainon (field_list64,
- make_descriptor_field ("MBO", gnat_type_for_size (16, 1),
- record64_type, size_int (1)));
- field_list64
- = chainon (field_list64,
- make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
- record64_type, size_int (dtype)));
- field_list64
- = chainon (field_list64,
- make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
- record64_type, size_int (klass)));
- field_list64
- = chainon (field_list64,
- make_descriptor_field ("MBMO", gnat_type_for_size (32, 1),
- record64_type, ssize_int (-1)));
- field_list64
- = chainon (field_list64,
- make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1),
- record64_type,
- size_in_bytes (mech == By_Descriptor_A
- ? inner_type : type)));
+ make_descriptor_field
+ ("LENGTH", gnat_type_for_size (64, 1), record64_type,
+ size_in_bytes (mech == By_Descriptor_A ? inner_type : type)));
pointer64_type = build_pointer_type_for_mode (type, DImode, false);
field_list64
= chainon (field_list64,
- make_descriptor_field ("POINTER", pointer64_type,
- record64_type,
- build_unary_op (ADDR_EXPR,
- pointer64_type,
- build0 (PLACEHOLDER_EXPR,
- type))));
+ make_descriptor_field
+ ("POINTER", pointer64_type, record64_type,
+ build_unary_op (ADDR_EXPR,
+ pointer64_type,
+ build0 (PLACEHOLDER_EXPR, type))));
switch (mech)
{
tree rec_type, tree initial)
{
tree field
- = create_field_decl (get_identifier (name), type, rec_type, NULL_TREE,
- NULL_TREE, 0, 0);
+ = create_field_decl (get_identifier (name), type, rec_type, 0, 0, 0, 0);
DECL_INITIAL (field) = initial;
return field;
/* The CLASS field is the 3rd field in the descriptor. */
tree klass = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
/* The POINTER field is the 6th field in the descriptor. */
- tree pointer = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (klass)));
+ tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (klass)));
/* Retrieve the value of the POINTER field. */
tree gnu_expr64
- = build3 (COMPONENT_REF, TREE_TYPE (pointer), desc, pointer, NULL_TREE);
+ = build3 (COMPONENT_REF, TREE_TYPE (pointer64), desc, pointer64, NULL_TREE);
if (POINTER_TYPE_P (gnu_type))
return convert (gnu_type, gnu_expr64);
int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
tree lfield, ufield;
- /* Convert POINTER to the pointer-to-array type. */
+ /* Convert POINTER to the type of the P_ARRAY field. */
gnu_expr64 = convert (p_array_type, gnu_expr64);
switch (iklass)
/* Test that we really have a SB descriptor, like DEC Ada. */
t = build3 (COMPONENT_REF, TREE_TYPE (klass), desc, klass, NULL);
u = convert (TREE_TYPE (klass), DECL_INITIAL (klass));
- u = build_binary_op (EQ_EXPR, boolean_type_node, t, u);
+ u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
/* If so, there is already a template in the descriptor and
it is located right after the POINTER field. The fields are
64bits so they must be repacked. */
- t = TREE_CHAIN (pointer);
+ t = TREE_CHAIN (pointer64);
lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield);
case 4: /* Class A */
/* The AFLAGS field is the 3rd field after the pointer in the
descriptor. */
- t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer)));
+ t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer64)));
aflags = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
/* The DIMCT field is the next field in the descriptor after
aflags. */
/* Raise CONSTRAINT_ERROR if either more than 1 dimension
or FL_COEFF or FL_BOUNDS not set. */
u = build_int_cst (TREE_TYPE (aflags), 192);
- u = build_binary_op (TRUTH_OR_EXPR, boolean_type_node,
- build_binary_op (NE_EXPR, boolean_type_node,
+ u = build_binary_op (TRUTH_OR_EXPR, integer_type_node,
+ build_binary_op (NE_EXPR, integer_type_node,
dimct,
convert (TREE_TYPE (dimct),
size_one_node)),
- build_binary_op (NE_EXPR, boolean_type_node,
+ build_binary_op (NE_EXPR, integer_type_node,
build2 (BIT_AND_EXPR,
TREE_TYPE (aflags),
aflags, u),
/* See the head comment of build_vms_descriptor. */
int iklass = TREE_INT_CST_LOW (DECL_INITIAL (klass));
- /* Convert POINTER to the pointer-to-array type. */
+ /* Convert POINTER to the type of the P_ARRAY field. */
gnu_expr32 = convert (p_array_type, gnu_expr32);
switch (iklass)
/* Test that we really have a SB descriptor, like DEC Ada. */
t = build3 (COMPONENT_REF, TREE_TYPE (klass), desc, klass, NULL);
u = convert (TREE_TYPE (klass), DECL_INITIAL (klass));
- u = build_binary_op (EQ_EXPR, boolean_type_node, t, u);
+ u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
/* If so, there is already a template in the descriptor and
it is located right after the POINTER field. */
t = TREE_CHAIN (pointer);
/* Raise CONSTRAINT_ERROR if either more than 1 dimension
or FL_COEFF or FL_BOUNDS not set. */
u = build_int_cst (TREE_TYPE (aflags), 192);
- u = build_binary_op (TRUTH_OR_EXPR, boolean_type_node,
- build_binary_op (NE_EXPR, boolean_type_node,
+ u = build_binary_op (TRUTH_OR_EXPR, integer_type_node,
+ build_binary_op (NE_EXPR, integer_type_node,
dimct,
convert (TREE_TYPE (dimct),
size_one_node)),
- build_binary_op (NE_EXPR, boolean_type_node,
+ build_binary_op (NE_EXPR, integer_type_node,
build2 (BIT_AND_EXPR,
TREE_TYPE (aflags),
aflags, u),
mbo = build3 (COMPONENT_REF, TREE_TYPE (mbo), desc, mbo, NULL_TREE);
mbmo = build3 (COMPONENT_REF, TREE_TYPE (mbmo), desc, mbmo, NULL_TREE);
is64bit
- = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node,
- build_binary_op (EQ_EXPR, boolean_type_node,
+ = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
+ build_binary_op (EQ_EXPR, integer_type_node,
convert (integer_type_node, mbo),
integer_one_node),
- build_binary_op (EQ_EXPR, boolean_type_node,
+ build_binary_op (EQ_EXPR, integer_type_node,
convert (integer_type_node, mbmo),
integer_minus_one_node));
build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
{
tree gnu_subprog_type, gnu_subprog_addr, gnu_subprog_call;
- tree gnu_stub_param, gnu_arg_types, gnu_param;
+ tree gnu_stub_param, gnu_param_list, gnu_arg_types, gnu_param;
tree gnu_stub_decl = DECL_FUNCTION_STUB (gnu_subprog);
tree gnu_body;
- VEC(tree,gc) *gnu_param_vec = NULL;
gnu_subprog_type = TREE_TYPE (gnu_subprog);
+ gnu_param_list = NULL_TREE;
begin_subprog_body (gnu_stub_decl);
gnat_pushlevel ();
else
gnu_param = gnu_stub_param;
- VEC_safe_push (tree, gc, gnu_param_vec, gnu_param);
+ gnu_param_list = tree_cons (NULL_TREE, gnu_param, gnu_param_list);
}
gnu_body = end_stmt_group ();
/* Invoke the internal subprogram. */
gnu_subprog_addr = build1 (ADDR_EXPR, build_pointer_type (gnu_subprog_type),
gnu_subprog);
- gnu_subprog_call = build_call_vec (TREE_TYPE (gnu_subprog_type),
- gnu_subprog_addr, gnu_param_vec);
+ gnu_subprog_call = build_call_list (TREE_TYPE (gnu_subprog_type),
+ gnu_subprog_addr,
+ nreverse (gnu_param_list));
/* Propagate the return value, if any. */
if (VOID_TYPE_P (TREE_TYPE (gnu_subprog_type)))
end_subprog_body (gnu_body);
}
\f
-/* Build a type to be used to represent an aliased object whose nominal type
- is an unconstrained array. This consists of a RECORD_TYPE containing a
- field of TEMPLATE_TYPE and a field of OBJECT_TYPE, which is an ARRAY_TYPE.
- If ARRAY_TYPE is that of an unconstrained array, this is used to represent
- an arbitrary unconstrained object. Use NAME as the name of the record.
- DEBUG_INFO_P is true if we need to write debug information for the type. */
+/* Build a type to be used to represent an aliased object whose nominal
+ type is an unconstrained array. This consists of a RECORD_TYPE containing
+ a field of TEMPLATE_TYPE and a field of OBJECT_TYPE, which is an
+ ARRAY_TYPE. If ARRAY_TYPE is that of the unconstrained array, this
+ is used to represent an arbitrary unconstrained object. Use NAME
+ as the name of the record. */
tree
-build_unc_object_type (tree template_type, tree object_type, tree name,
- bool debug_info_p)
+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"), template_type, type,
- NULL_TREE, NULL_TREE, 0, 1);
- tree array_field
- = create_field_decl (get_identifier ("ARRAY"), object_type, type,
- NULL_TREE, NULL_TREE, 0, 1);
+ tree template_field = create_field_decl (get_identifier ("BOUNDS"),
+ template_type, type, 0, 0, 0, 1);
+ tree array_field = create_field_decl (get_identifier ("ARRAY"), object_type,
+ type, 0, 0, 0, 1);
TYPE_NAME (type) = name;
TYPE_CONTAINS_TEMPLATE_P (type) = 1;
- TREE_CHAIN (template_field) = array_field;
- finish_record_type (type, template_field, 0, true);
-
- /* Declare it now since it will never be declared otherwise. This is
- necessary to ensure that its subtrees are properly marked. */
- create_type_decl (name, type, NULL, true, debug_info_p, Empty);
+ finish_record_type (type,
+ chainon (chainon (NULL_TREE, template_field),
+ array_field),
+ 0, true);
return type;
}
tree
build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type,
- tree name, bool debug_info_p)
+ tree name)
{
tree template_type;
= (TYPE_IS_FAT_POINTER_P (thin_fat_ptr_type)
? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (thin_fat_ptr_type))))
: TREE_TYPE (TYPE_FIELDS (TREE_TYPE (thin_fat_ptr_type))));
-
- return
- build_unc_object_type (template_type, object_type, name, debug_info_p);
+ return build_unc_object_type (template_type, object_type, name);
}
/* Shift the component offsets within an unconstrained object TYPE to make it
{
tree ptr = TYPE_POINTER_TO (old_type);
tree ref = TYPE_REFERENCE_TO (old_type);
- tree t;
+ 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 (t = TYPE_NEXT_VARIANT (old_type); t; t = TYPE_NEXT_VARIANT (t))
- update_pointer_to (t, new_type);
+ for (type = TYPE_NEXT_VARIANT (old_type); type;
+ type = TYPE_NEXT_VARIANT (type))
+ update_pointer_to (type, new_type);
/* If no pointers and no references, we are done. */
if (!ptr && !ref)
/* Otherwise, first handle the simple case. */
if (TREE_CODE (new_type) != UNCONSTRAINED_ARRAY_TYPE)
{
- tree new_ptr, new_ref;
-
- /* If pointer or reference already points to new type, nothing to do.
- This can happen as update_pointer_to can be invoked multiple times
- on the same couple of types because of the type variants. */
- if ((ptr && TREE_TYPE (ptr) == new_type)
- || (ref && TREE_TYPE (ref) == new_type))
- return;
-
- /* Chain PTR and its variants at the end. */
- new_ptr = TYPE_POINTER_TO (new_type);
- if (new_ptr)
- {
- while (TYPE_NEXT_PTR_TO (new_ptr))
- new_ptr = TYPE_NEXT_PTR_TO (new_ptr);
- TYPE_NEXT_PTR_TO (new_ptr) = ptr;
- }
- else
- TYPE_POINTER_TO (new_type) = ptr;
+ TYPE_POINTER_TO (new_type) = ptr;
+ TYPE_REFERENCE_TO (new_type) = ref;
- /* Now adjust them. */
for (; ptr; ptr = TYPE_NEXT_PTR_TO (ptr))
- for (t = TYPE_MAIN_VARIANT (ptr); t; t = TYPE_NEXT_VARIANT (t))
- TREE_TYPE (t) = new_type;
-
- /* Chain REF and its variants at the end. */
- new_ref = TYPE_REFERENCE_TO (new_type);
- if (new_ref)
- {
- while (TYPE_NEXT_REF_TO (new_ref))
- new_ref = TYPE_NEXT_REF_TO (new_ref);
- TYPE_NEXT_REF_TO (new_ref) = ref;
- }
- else
- TYPE_REFERENCE_TO (new_type) = ref;
+ for (ptr1 = TYPE_MAIN_VARIANT (ptr); ptr1;
+ ptr1 = TYPE_NEXT_VARIANT (ptr1))
+ TREE_TYPE (ptr1) = new_type;
- /* Now adjust them. */
for (; ref; ref = TYPE_NEXT_REF_TO (ref))
- for (t = TYPE_MAIN_VARIANT (ref); t; t = TYPE_NEXT_VARIANT (t))
- TREE_TYPE (t) = new_type;
+ for (ref1 = TYPE_MAIN_VARIANT (ref); ref1;
+ ref1 = TYPE_NEXT_VARIANT (ref1))
+ TREE_TYPE (ref1) = new_type;
}
- /* Now deal with the unconstrained array case. In this case the pointer
- is actually a record where both fields are pointers to dummy nodes.
+ /* Now deal with the unconstrained array case. In this case the "pointer"
+ is actually a RECORD_TYPE where both fields are pointers to dummy nodes.
Turn them into pointers to the correct types using update_pointer_to. */
+ else if (!TYPE_IS_FAT_POINTER_P (ptr))
+ gcc_unreachable ();
+
else
{
- tree new_ptr = TYPE_MAIN_VARIANT (TYPE_POINTER_TO (new_type));
tree new_obj_rec = TYPE_OBJECT_RECORD_TYPE (new_type);
- tree array_field, bounds_field, new_ref, last;
-
- gcc_assert (TYPE_IS_FAT_POINTER_P (ptr));
-
- /* If PTR already points to new type, nothing to do. This can happen
- since update_pointer_to can be invoked multiple times on the same
- couple of types because of the type variants. */
- if (TYPE_UNCONSTRAINED_ARRAY (ptr) == new_type)
- return;
-
- array_field = TYPE_FIELDS (ptr);
- bounds_field = TREE_CHAIN (array_field);
+ tree array_field = TYPE_FIELDS (ptr);
+ tree bounds_field = TREE_CHAIN (TYPE_FIELDS (ptr));
+ tree new_ptr = TYPE_POINTER_TO (new_type);
+ tree new_ref;
+ tree var;
/* Make pointers to the dummy template point to the real template. */
update_pointer_to
(TREE_TYPE (TREE_TYPE (bounds_field)),
TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (new_ptr)))));
- /* The references to the template bounds present in the array type use
- the bounds field of NEW_PTR through a PLACEHOLDER_EXPR. Since we
- are going to merge PTR in NEW_PTR, we must rework these references
- to use the bounds field of PTR instead. */
+ /* The references to the template bounds present in the array type
+ are made through a PLACEHOLDER_EXPR of type NEW_PTR. Since we
+ are updating PTR to make it a full replacement for NEW_PTR as
+ pointer to NEW_TYPE, we must rework the PLACEHOLDER_EXPR so as
+ to make it of type PTR. */
new_ref = build3 (COMPONENT_REF, TREE_TYPE (bounds_field),
- build0 (PLACEHOLDER_EXPR, new_ptr),
+ build0 (PLACEHOLDER_EXPR, ptr),
bounds_field, NULL_TREE);
/* Create the new array for the new PLACEHOLDER_EXPR and make pointers
substitute_in_type (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (new_ptr))),
TREE_CHAIN (TYPE_FIELDS (new_ptr)), new_ref));
- /* Merge PTR in NEW_PTR. */
- DECL_FIELD_CONTEXT (array_field) = new_ptr;
- DECL_FIELD_CONTEXT (bounds_field) = new_ptr;
- for (t = new_ptr; t; last = t, t = TYPE_NEXT_VARIANT (t))
- TYPE_FIELDS (t) = TYPE_FIELDS (ptr);
-
- /* Chain PTR and its variants at the end. */
- TYPE_NEXT_VARIANT (last) = TYPE_MAIN_VARIANT (ptr);
-
- /* Now adjust them. */
- for (t = TYPE_MAIN_VARIANT (ptr); t; t = TYPE_NEXT_VARIANT (t))
- {
- TYPE_MAIN_VARIANT (t) = new_ptr;
- SET_TYPE_UNCONSTRAINED_ARRAY (t, new_type);
- }
+ /* Make PTR the pointer to NEW_TYPE. */
+ TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type)
+ = TREE_TYPE (new_type) = ptr;
/* And show the original pointer NEW_PTR to the debugger. This is the
counterpart of the equivalent processing in gnat_pushdecl when the
- unconstrained array type is frozen after access types to it. */
- if (TYPE_NAME (ptr) && TREE_CODE (TYPE_NAME (ptr)) == TYPE_DECL)
+ unconstrained array type is frozen after access types to it. Note
+ that update_pointer_to can be invoked multiple times on the same
+ couple of types because of the type variants. */
+ if (TYPE_NAME (ptr)
+ && TREE_CODE (TYPE_NAME (ptr)) == TYPE_DECL
+ && !DECL_ORIGINAL_TYPE (TYPE_NAME (ptr)))
{
DECL_ORIGINAL_TYPE (TYPE_NAME (ptr)) = new_ptr;
DECL_ARTIFICIAL (TYPE_NAME (ptr)) = 0;
}
+ for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var))
+ SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type);
/* Now handle updating the allocation record, what the thin pointer
points to. Update all pointers from the old record into the new
one, update the type of the array field, and recompute the size. */
update_pointer_to (TYPE_OBJECT_RECORD_TYPE (old_type), new_obj_rec);
+
TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (new_obj_rec)))
= TREE_TYPE (TREE_TYPE (array_field));
we let layout_type work it out. This will reset the field offsets to
what they would be in a regular record, so we shift them back to what
we want them to be for a thin pointer designated type afterwards. */
- DECL_SIZE (TYPE_FIELDS (new_obj_rec)) = NULL_TREE;
- DECL_SIZE (TREE_CHAIN (TYPE_FIELDS (new_obj_rec))) = NULL_TREE;
- TYPE_SIZE (new_obj_rec) = NULL_TREE;
+ DECL_SIZE (TYPE_FIELDS (new_obj_rec)) = 0;
+ DECL_SIZE (TREE_CHAIN (TYPE_FIELDS (new_obj_rec))) = 0;
+ TYPE_SIZE (new_obj_rec) = 0;
layout_type (new_obj_rec);
+
shift_unc_components_for_thin_pointers (new_obj_rec);
/* We are done, at last. */
{
tree fields = TYPE_FIELDS (TREE_TYPE (etype));
- expr = gnat_protect_expr (expr);
+ expr = protect_multiple_eval (expr);
if (TREE_CODE (expr) == ADDR_EXPR)
expr = TREE_OPERAND (expr, 0);
else
tree
convert (tree type, tree expr)
{
+ enum tree_code code = TREE_CODE (type);
tree etype = TREE_TYPE (expr);
enum tree_code ecode = TREE_CODE (etype);
- enum tree_code code = TREE_CODE (type);
- /* If the expression is already of the right type, we are done. */
- if (etype == type)
+ /* If EXPR is already the right type, we are done. */
+ if (type == etype)
return expr;
/* If both input and output have padding and are of variable size, do this
/* If the inner type is of self-referential size and the expression type
is a record, do this as an unchecked conversion. But first pad the
expression if possible to have the same size on both sides. */
- if (ecode == RECORD_TYPE
+ if (TREE_CODE (etype) == RECORD_TYPE
&& CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
{
if (TREE_CONSTANT (TYPE_SIZE (etype)))
final conversion as an unchecked conversion, again to avoid the need
for some variable-sized temporaries. If valid, this conversion is
very likely purely technical and without real effects. */
- if (ecode == ARRAY_TYPE
+ if (TREE_CODE (etype) == ARRAY_TYPE
&& TREE_CODE (TREE_TYPE (TYPE_FIELDS (type))) == ARRAY_TYPE
&& !TREE_CONSTANT (TYPE_SIZE (etype))
&& !TREE_CONSTANT (TYPE_SIZE (type)))
return expr;
}
- /* Likewise for a conversion between original and packable version, or
- conversion between types of the same size and with the same list of
- fields, but we have to work harder to preserve type consistency. */
+ /* Likewise for a conversion between original and packable version, but
+ we have to work harder in order to preserve type consistency. */
if (code == ecode
&& code == RECORD_TYPE
- && (TYPE_NAME (type) == TYPE_NAME (etype)
- || tree_int_cst_equal (TYPE_SIZE (type), TYPE_SIZE (etype))))
-
+ && TYPE_NAME (type) == TYPE_NAME (etype))
{
VEC(constructor_elt,gc) *e = CONSTRUCTOR_ELTS (expr);
unsigned HOST_WIDE_INT len = VEC_length (constructor_elt, e);
FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value)
{
- constructor_elt *elt;
- /* We expect only simple constructors. */
- if (!SAME_FIELD_P (index, efield))
- break;
- /* The field must be the same. */
- if (!SAME_FIELD_P (efield, field))
+ constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL);
+ /* We expect only simple constructors. Otherwise, punt. */
+ if (!(index == efield || index == DECL_ORIGINAL_FIELD (efield)))
break;
- elt = VEC_quick_push (constructor_elt, v, NULL);
elt->index = field;
elt->value = convert (TREE_TYPE (field), value);
case UNCONSTRAINED_ARRAY_REF:
/* Convert this to the type of the inner array by getting the address of
the array from the template. */
- expr = TREE_OPERAND (expr, 0);
expr = build_unary_op (INDIRECT_REF, NULL_TREE,
- build_component_ref (expr, NULL_TREE,
- TYPE_FIELDS
- (TREE_TYPE (expr)),
- false));
+ build_component_ref (TREE_OPERAND (expr, 0),
+ get_identifier ("P_ARRAY"),
+ NULL_TREE, false));
etype = TREE_TYPE (expr);
ecode = TREE_CODE (etype);
break;
}
break;
+ case INDIRECT_REF:
+ /* If both types are record types, just convert the pointer and
+ 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
+ strip off conversions. But that code really is a mess and
+ we need to do this a much better way some time. */
+ if (0
+ && (TREE_CODE (type) == RECORD_TYPE
+ || TREE_CODE (type) == UNION_TYPE)
+ && (TREE_CODE (etype) == RECORD_TYPE
+ || TREE_CODE (etype) == UNION_TYPE)
+ && !TYPE_IS_FAT_POINTER_P (type) && !TYPE_IS_FAT_POINTER_P (etype))
+ return build_unary_op (INDIRECT_REF, NULL_TREE,
+ convert (build_pointer_type (type),
+ TREE_OPERAND (expr, 0)));
+ break;
+
default:
break;
}
etype)))
return build1 (VIEW_CONVERT_EXPR, type, expr);
- /* If we are converting between tagged types, try to upcast properly. */
- else if (ecode == RECORD_TYPE && code == RECORD_TYPE
- && TYPE_ALIGN_OK (etype) && TYPE_ALIGN_OK (type))
- {
- tree child_etype = etype;
- do {
- tree field = TYPE_FIELDS (child_etype);
- if (DECL_NAME (field) == parent_name_id && TREE_TYPE (field) == type)
- return build_component_ref (expr, NULL_TREE, field, false);
- child_etype = TREE_TYPE (field);
- } while (TREE_CODE (child_etype) == RECORD_TYPE);
- }
-
/* In all other cases of related types, make a NOP_EXPR. */
- else if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
+ 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_convert (type, expr);
switch (code)
tree bit_diff
= size_diffop (bit_position (TYPE_FIELDS (TREE_TYPE (etype))),
bit_position (TYPE_FIELDS (TREE_TYPE (type))));
- tree byte_diff
- = size_binop (CEIL_DIV_EXPR, bit_diff, sbitsize_unit_node);
+ tree byte_diff = size_binop (CEIL_DIV_EXPR, bit_diff,
+ sbitsize_int (BITS_PER_UNIT));
+
expr = build1 (NOP_EXPR, type, expr);
TREE_CONSTANT (expr) = TREE_CONSTANT (TREE_OPERAND (expr, 0));
if (integer_zerop (byte_diff))
/* If converting fat pointer to normal pointer, get the pointer to the
array and then convert it. */
else if (TYPE_IS_FAT_POINTER_P (etype))
- expr
- = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (etype), false);
+ expr = build_component_ref (expr, get_identifier ("P_ARRAY"),
+ NULL_TREE, false);
return fold (convert_to_pointer (type, expr));
}
\f
/* If EXP's type is an UNCONSTRAINED_ARRAY_TYPE, return an expression that
- refers to the underlying array. If it has TYPE_CONTAINS_TEMPLATE_P,
+ refers to the underlying array. If its type has TYPE_CONTAINS_TEMPLATE_P,
likewise return an expression pointing to the underlying array. */
tree
case UNCONSTRAINED_ARRAY_TYPE:
if (code == UNCONSTRAINED_ARRAY_REF)
{
- new_exp = TREE_OPERAND (exp, 0);
new_exp
= build_unary_op (INDIRECT_REF, NULL_TREE,
- build_component_ref (new_exp, NULL_TREE,
- TYPE_FIELDS
- (TREE_TYPE (new_exp)),
- false));
+ build_component_ref (TREE_OPERAND (exp, 0),
+ get_identifier ("P_ARRAY"),
+ NULL_TREE, false));
TREE_READONLY (new_exp) = TREE_READONLY (exp);
return new_exp;
}
build_component_ref (new_exp, NULL_TREE,
TREE_CHAIN
(TYPE_FIELDS (TREE_TYPE (new_exp))),
- false);
+ 0);
}
else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp)))
return
build_component_ref (exp, NULL_TREE,
- TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))),
- false);
+ TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))), 0);
break;
default:
unchecked_convert (tree type, tree expr, bool notrunc_p)
{
tree etype = TREE_TYPE (expr);
- enum tree_code ecode = TREE_CODE (etype);
- enum tree_code code = TREE_CODE (type);
- /* If the expression is already of the right type, we are done. */
+ /* If the expression is already the right type, we are done. */
if (etype == type)
return expr;
/* If both types types are integral just do a normal conversion.
Likewise for a conversion to an unconstrained array. */
if ((((INTEGRAL_TYPE_P (type)
- && !(code == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (type)))
+ && !(TREE_CODE (type) == INTEGER_TYPE
+ && TYPE_VAX_FLOATING_POINT_P (type)))
|| (POINTER_TYPE_P (type) && ! TYPE_IS_THIN_POINTER_P (type))
- || (code == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (type)))
+ || (TREE_CODE (type) == RECORD_TYPE
+ && TYPE_JUSTIFIED_MODULAR_P (type)))
&& ((INTEGRAL_TYPE_P (etype)
- && !(ecode == INTEGER_TYPE && TYPE_VAX_FLOATING_POINT_P (etype)))
+ && !(TREE_CODE (etype) == INTEGER_TYPE
+ && TYPE_VAX_FLOATING_POINT_P (etype)))
|| (POINTER_TYPE_P (etype) && !TYPE_IS_THIN_POINTER_P (etype))
- || (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype))))
- || code == UNCONSTRAINED_ARRAY_TYPE)
+ || (TREE_CODE (etype) == RECORD_TYPE
+ && TYPE_JUSTIFIED_MODULAR_P (etype))))
+ || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
{
- if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype))
+ if (TREE_CODE (etype) == INTEGER_TYPE
+ && TYPE_BIASED_REPRESENTATION_P (etype))
{
tree ntype = copy_type (etype);
TYPE_BIASED_REPRESENTATION_P (ntype) = 0;
expr = build1 (NOP_EXPR, ntype, expr);
}
- if (code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
+ if (TREE_CODE (type) == INTEGER_TYPE
+ && TYPE_BIASED_REPRESENTATION_P (type))
{
tree rtype = copy_type (type);
TYPE_BIASED_REPRESENTATION_P (rtype) = 0;
GET_MODE_BITSIZE (TYPE_MODE (type))))
{
tree rec_type = make_node (RECORD_TYPE);
- tree field = create_field_decl (get_identifier ("OBJ"), type, rec_type,
- NULL_TREE, NULL_TREE, 1, 0);
+ 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, notrunc_p);
- expr = build_component_ref (expr, NULL_TREE, field, false);
+ expr = build_component_ref (expr, NULL_TREE, field, 0);
}
/* Similarly if we are converting from an integral type whose precision
GET_MODE_BITSIZE (TYPE_MODE (etype))))
{
tree rec_type = make_node (RECORD_TYPE);
- tree field = create_field_decl (get_identifier ("OBJ"), etype, rec_type,
- NULL_TREE, NULL_TREE, 1, 0);
+ tree field
+ = create_field_decl (get_identifier ("OBJ"), etype, rec_type,
+ 1, 0, 0, 0);
TYPE_FIELDS (rec_type) = field;
layout_type (rec_type);
/* We have a special case when we are converting between two unconstrained
array types. In that case, take the address, convert the fat pointer
types, and dereference. */
- else if (ecode == code && code == UNCONSTRAINED_ARRAY_TYPE)
+ else if (TREE_CODE (etype) == UNCONSTRAINED_ARRAY_TYPE
+ && TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
expr = build_unary_op (INDIRECT_REF, NULL_TREE,
build1 (VIEW_CONVERT_EXPR, TREE_TYPE (type),
build_unary_op (ADDR_EXPR, NULL_TREE,
/* Another special case is when we are converting to a vector type from its
representative array type; this a regular conversion. */
- else if (code == VECTOR_TYPE
- && ecode == ARRAY_TYPE
+ else if (TREE_CODE (type) == VECTOR_TYPE
+ && TREE_CODE (etype) == ARRAY_TYPE
&& gnat_types_compatible_p (TYPE_REPRESENTATIVE_ARRAY (type),
etype))
expr = convert (type, expr);
{
expr = maybe_unconstrained_array (expr);
etype = TREE_TYPE (expr);
- ecode = TREE_CODE (etype);
if (can_fold_for_view_convert_p (expr))
expr = fold_build1 (VIEW_CONVERT_EXPR, type, expr);
else
is a biased type or if both the input and output are unsigned. */
if (!notrunc_p
&& INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type)
- && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (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)
0))
&& !(TYPE_UNSIGNED (type) && TYPE_UNSIGNED (etype)))
{
- tree base_type
- = gnat_type_for_mode (TYPE_MODE (type), TYPE_UNSIGNED (type));
+ tree base_type = gnat_type_for_mode (TYPE_MODE (type),
+ TYPE_UNSIGNED (type));
tree shift_expr
= convert (base_type,
size_binop (MINUS_EXPR,
static void
install_builtin_elementary_types (void)
{
- signed_size_type_node = gnat_signed_type (size_type_node);
+ signed_size_type_node = size_type_node;
pid_type_node = integer_type_node;
void_list_node = build_void_list_node ();
if (!argument
|| TREE_CODE (TREE_VALUE (argument)) == VOID_TYPE)
{
- error ("nonnull argument with out-of-range operand number "
- "(argument %lu, operand %lu)",
+ error ("nonnull argument with out-of-range operand number (argument %lu, operand %lu)",
(unsigned long) attr_arg_num, (unsigned long) arg_num);
*no_add_attrs = true;
return NULL_TREE;
if (TREE_CODE (TREE_VALUE (argument)) != POINTER_TYPE)
{
- error ("nonnull argument references non-pointer operand "
- "(argument %lu, operand %lu)",
+ error ("nonnull argument references non-pointer operand (argument %lu, operand %lu)",
(unsigned long) attr_arg_num, (unsigned long) arg_num);
*no_add_attrs = true;
return NULL_TREE;
static tree
compare_arrays (tree result_type, tree a1, tree a2)
{
- tree result = convert (result_type, boolean_true_node);
- tree a1_is_null = convert (result_type, boolean_false_node);
- tree a2_is_null = convert (result_type, boolean_false_node);
tree t1 = TREE_TYPE (a1);
tree t2 = TREE_TYPE (a2);
+ tree result = convert (result_type, integer_one_node);
+ tree a1_is_null = convert (result_type, integer_zero_node);
+ tree a2_is_null = convert (result_type, integer_zero_node);
bool a1_side_effects_p = TREE_SIDE_EFFECTS (a1);
bool a2_side_effects_p = TREE_SIDE_EFFECTS (a2);
bool length_zero_p = false;
/* If either operand has side-effects, they have to be evaluated only once
in spite of the multiple references to the operand in the comparison. */
if (a1_side_effects_p)
- a1 = gnat_protect_expr (a1);
+ a1 = protect_multiple_eval (a1);
if (a2_side_effects_p)
- a2 = gnat_protect_expr (a2);
+ a2 = protect_multiple_eval (a2);
/* Process each dimension separately and compare the lengths. If any
- dimension has a length known to be zero, set LENGTH_ZERO_P to true
- in order to suppress the comparison of the data at the end. */
+ dimension has a size known to be zero, set SIZE_ZERO_P to 1 to
+ suppress the comparison of the data. */
while (TREE_CODE (t1) == ARRAY_TYPE && TREE_CODE (t2) == ARRAY_TYPE)
{
tree lb1 = TYPE_MIN_VALUE (TYPE_DOMAIN (t1));
tree ub1 = TYPE_MAX_VALUE (TYPE_DOMAIN (t1));
tree lb2 = TYPE_MIN_VALUE (TYPE_DOMAIN (t2));
tree ub2 = TYPE_MAX_VALUE (TYPE_DOMAIN (t2));
- tree length1 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub1, lb1),
- size_one_node);
- tree length2 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub2, lb2),
- size_one_node);
+ tree bt = get_base_type (TREE_TYPE (lb1));
+ tree length1 = fold_build2 (MINUS_EXPR, bt, ub1, lb1);
+ tree length2 = fold_build2 (MINUS_EXPR, bt, ub2, lb2);
tree comparison, this_a1_is_null, this_a2_is_null;
+ tree nbt, tem;
+ bool btem;
/* If the length of the first array is a constant, swap our operands
- unless the length of the second array is the constant zero. */
- if (TREE_CODE (length1) == INTEGER_CST && !integer_zerop (length2))
+ unless the length of the second array is the constant zero.
+ Note that we have set the `length' values to the length - 1. */
+ if (TREE_CODE (length1) == INTEGER_CST
+ && !integer_zerop (fold_build2 (PLUS_EXPR, bt, length2,
+ convert (bt, integer_one_node))))
{
- tree tem;
- bool btem;
-
tem = a1, a1 = a2, a2 = tem;
tem = t1, t1 = t2, t2 = tem;
tem = lb1, lb1 = lb2, lb2 = tem;
a2_side_effects_p = btem;
}
- /* If the length of the second array is the constant zero, we can just
- use the original stored bounds for the first array and see whether
- last < first holds. */
- if (integer_zerop (length2))
+ /* If the length of this dimension in the second array is the constant
+ zero, we can just go inside the original bounds for the first
+ array and see if last < first. */
+ if (integer_zerop (fold_build2 (PLUS_EXPR, bt, length2,
+ convert (bt, integer_one_node))))
{
- length_zero_p = true;
-
- ub1 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
- lb1 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
+ tree ub = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
+ tree lb = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
- comparison = build_binary_op (LT_EXPR, result_type, ub1, lb1);
+ comparison = build_binary_op (LT_EXPR, result_type, ub, lb);
comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
- if (EXPR_P (comparison))
- SET_EXPR_LOCATION (comparison, input_location);
+ length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
+ length_zero_p = true;
this_a1_is_null = comparison;
- this_a2_is_null = convert (result_type, boolean_true_node);
+ this_a2_is_null = convert (result_type, integer_one_node);
}
- /* Otherwise, if the length is some other constant value, we know that
- this dimension in the second array cannot be superflat, so we can
- just use its length computed from the actual stored bounds. */
+ /* If the length is some other constant value, we know that the
+ this dimension in the first array cannot be superflat, so we
+ can just use its length from the actual stored bounds. */
else if (TREE_CODE (length2) == INTEGER_CST)
{
- tree bt;
-
ub1 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
lb1 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
- /* Note that we know that UB2 and LB2 are constant and hence
- cannot contain a PLACEHOLDER_EXPR. */
ub2 = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2)));
lb2 = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2)));
- bt = get_base_type (TREE_TYPE (ub1));
+ nbt = get_base_type (TREE_TYPE (ub1));
comparison
= build_binary_op (EQ_EXPR, result_type,
- build_binary_op (MINUS_EXPR, bt, ub1, lb1),
- build_binary_op (MINUS_EXPR, bt, ub2, lb2));
+ build_binary_op (MINUS_EXPR, nbt, ub1, lb1),
+ build_binary_op (MINUS_EXPR, nbt, ub2, lb2));
+
+ /* Note that we know that UB2 and LB2 are constant and hence
+ cannot contain a PLACEHOLDER_EXPR. */
+
comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
- if (EXPR_P (comparison))
- SET_EXPR_LOCATION (comparison, input_location);
+ length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
this_a1_is_null = build_binary_op (LT_EXPR, result_type, ub1, lb1);
- if (EXPR_P (this_a1_is_null))
- SET_EXPR_LOCATION (this_a1_is_null, input_location);
-
- this_a2_is_null = convert (result_type, boolean_false_node);
+ this_a2_is_null = convert (result_type, integer_zero_node);
}
- /* Otherwise, compare the computed lengths. */
+ /* Otherwise compare the computed lengths. */
else
{
length1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (length1, a1);
comparison
= build_binary_op (EQ_EXPR, result_type, length1, length2);
- if (EXPR_P (comparison))
- SET_EXPR_LOCATION (comparison, input_location);
-
- /* If the length expression is of the form (cond ? val : 0), assume
- that cond is equivalent to (length != 0). That's guaranteed by
- construction of the array types in gnat_to_gnu_entity. */
- if (TREE_CODE (length1) == COND_EXPR
- && integer_zerop (TREE_OPERAND (length1, 2)))
- this_a1_is_null = invert_truthvalue (TREE_OPERAND (length1, 0));
- else
- this_a1_is_null = build_binary_op (EQ_EXPR, result_type, length1,
- size_zero_node);
- if (EXPR_P (this_a1_is_null))
- SET_EXPR_LOCATION (this_a1_is_null, input_location);
-
- /* Likewise for the second array. */
- if (TREE_CODE (length2) == COND_EXPR
- && integer_zerop (TREE_OPERAND (length2, 2)))
- this_a2_is_null = invert_truthvalue (TREE_OPERAND (length2, 0));
- else
- this_a2_is_null = build_binary_op (EQ_EXPR, result_type, length2,
- size_zero_node);
- if (EXPR_P (this_a2_is_null))
- SET_EXPR_LOCATION (this_a2_is_null, input_location);
+
+ this_a1_is_null
+ = build_binary_op (LT_EXPR, result_type, length1,
+ convert (bt, integer_zero_node));
+ this_a2_is_null
+ = build_binary_op (LT_EXPR, result_type, length2,
+ convert (bt, integer_zero_node));
}
- /* Append expressions for this dimension to the final expressions. */
result = build_binary_op (TRUTH_ANDIF_EXPR, result_type,
result, comparison);
a1_is_null = build_binary_op (TRUTH_ORIF_EXPR, result_type,
this_a1_is_null, a1_is_null);
-
a2_is_null = build_binary_op (TRUTH_ORIF_EXPR, result_type,
this_a2_is_null, a2_is_null);
t2 = TREE_TYPE (t2);
}
- /* Unless the length of some dimension is known to be zero, compare the
+ /* Unless the size of some bound is known to be zero, compare the
data in the array. */
if (!length_zero_p)
{
tree type = find_common_type (TREE_TYPE (a1), TREE_TYPE (a2));
- tree comparison;
if (type)
{
a2 = convert (type, a2);
}
- comparison = fold_build2 (EQ_EXPR, result_type, a1, a2);
- if (EXPR_P (comparison))
- SET_EXPR_LOCATION (comparison, input_location);
-
- result
- = build_binary_op (TRUTH_ANDIF_EXPR, result_type, result, comparison);
+ result = build_binary_op (TRUTH_ANDIF_EXPR, result_type, result,
+ fold_build2 (EQ_EXPR, result_type, a1, a2));
}
/* The result is also true if both sizes are zero. */
/* For subtraction, add the modulus back if we are negative. */
else if (op_code == MINUS_EXPR)
{
- result = gnat_protect_expr (result);
+ result = protect_multiple_eval (result);
result = fold_build3 (COND_EXPR, op_type,
- fold_build2 (LT_EXPR, boolean_type_node, result,
+ fold_build2 (LT_EXPR, integer_type_node, result,
convert (op_type, integer_zero_node)),
fold_build2 (PLUS_EXPR, op_type, result, modulus),
result);
/* For the other operations, subtract the modulus if we are >= it. */
else
{
- result = gnat_protect_expr (result);
+ result = protect_multiple_eval (result);
result = fold_build3 (COND_EXPR, op_type,
- fold_build2 (GE_EXPR, boolean_type_node,
+ fold_build2 (GE_EXPR, integer_type_node,
result, modulus),
fold_build2 (MINUS_EXPR, op_type,
result, modulus),
modulus = NULL_TREE;
break;
- case TRUTH_ANDIF_EXPR:
- case TRUTH_ORIF_EXPR:
- case TRUTH_AND_EXPR:
- case TRUTH_OR_EXPR:
- case TRUTH_XOR_EXPR:
-#ifdef ENABLE_CHECKING
- gcc_assert (TREE_CODE (get_base_type (result_type)) == BOOLEAN_TYPE);
-#endif
- operation_type = left_base_type;
- left_operand = convert (operation_type, left_operand);
- right_operand = convert (operation_type, right_operand);
- break;
-
case GE_EXPR:
case LE_EXPR:
case GT_EXPR:
case LT_EXPR:
+ gcc_assert (!POINTER_TYPE_P (left_type));
+
+ /* ... fall through ... */
+
case EQ_EXPR:
case NE_EXPR:
-#ifdef ENABLE_CHECKING
- gcc_assert (TREE_CODE (get_base_type (result_type)) == BOOLEAN_TYPE);
-#endif
/* If either operand is a NULL_EXPR, just return a new one. */
if (TREE_CODE (left_operand) == NULL_EXPR)
return build2 (op_code, result_type,
modulus = NULL_TREE;
break;
+ case PREINCREMENT_EXPR:
+ case PREDECREMENT_EXPR:
+ case POSTINCREMENT_EXPR:
+ case POSTDECREMENT_EXPR:
+ /* These operations are not used anymore. */
+ gcc_unreachable ();
+
case LSHIFT_EXPR:
case RSHIFT_EXPR:
case LROTATE_EXPR:
break;
case TRUTH_NOT_EXPR:
-#ifdef ENABLE_CHECKING
- gcc_assert (TREE_CODE (get_base_type (result_type)) == BOOLEAN_TYPE);
-#endif
+ gcc_assert (result_type == base_type);
result = invert_truthvalue (operand);
break;
TREE_TYPE (result) = type = build_pointer_type (type);
break;
- case COMPOUND_EXPR:
- /* Fold a compound expression if it has unconstrained array type
- since the middle-end cannot handle it. But we don't it in the
- general case because it may introduce aliasing issues if the
- first operand is an indirect assignment and the second operand
- the corresponding address, e.g. for an allocator. */
- if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
- {
- result = build_unary_op (ADDR_EXPR, result_type,
- TREE_OPERAND (operand, 1));
- result = build2 (COMPOUND_EXPR, TREE_TYPE (result),
- TREE_OPERAND (operand, 0), result);
- break;
- }
- goto common;
-
case ARRAY_REF:
case ARRAY_RANGE_REF:
case COMPONENT_REF:
case BIT_FIELD_REF:
- /* If this is for 'Address, find the address of the prefix and add
- the offset to the field. Otherwise, do this the normal way. */
+ /* If this is for 'Address, find the address of the prefix and
+ add the offset to the field. Otherwise, do this the normal
+ way. */
if (op_code == ATTR_ADDR_EXPR)
{
HOST_WIDE_INT bitsize;
if (!offset)
offset = size_zero_node;
+ if (bitpos % BITS_PER_UNIT != 0)
+ post_error
+ ("taking address of object not aligned on storage unit?",
+ error_gnat_node);
+
offset = size_binop (PLUS_EXPR, offset,
size_int (bitpos / BITS_PER_UNIT));
operand = convert (type, operand);
}
+ if (type != error_mark_node)
+ operation_type = build_pointer_type (type);
+
gnat_mark_addressable (operand);
- result = build_fold_addr_expr (operand);
+ result = fold_build1 (ADDR_EXPR, operation_type, operand);
}
TREE_CONSTANT (result) = staticp (operand) || TREE_CONSTANT (operand);
break;
case INDIRECT_REF:
- /* If we want to refer to an unconstrained array, use the appropriate
- expression to do so. This will never survive down to the back-end.
- But if TYPE is a thin pointer, first convert to a fat pointer. */
+ /* If we want to refer to an entire unconstrained array,
+ make up an expression to do so. This will never survive to
+ the backend. If TYPE is a thin pointer, first convert the
+ operand to a fat pointer. */
if (TYPE_IS_THIN_POINTER_P (type)
&& TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (type)))
{
TREE_READONLY (result)
= TYPE_READONLY (TYPE_UNCONSTRAINED_ARRAY (type));
}
-
- /* If we are dereferencing an ADDR_EXPR, return its operand. */
else if (TREE_CODE (operand) == ADDR_EXPR)
result = TREE_OPERAND (operand, 0);
- /* Otherwise, build and fold the indirect reference. */
else
{
- result = build_fold_indirect_ref (operand);
+ result = fold_build1 (op_code, TREE_TYPE (type), operand);
TREE_READONLY (result) = TYPE_READONLY (TREE_TYPE (type));
}
result = fold_build3 (COND_EXPR, operation_type,
fold_build2 (NE_EXPR,
- boolean_type_node,
+ integer_type_node,
operand,
convert
(operation_type,
true_operand = convert (result_type, true_operand);
false_operand = convert (result_type, false_operand);
- /* If the result type is unconstrained, take the address of the operands and
- then dereference the result. Likewise if the result type is passed by
- reference, but this is natively handled in the gimplifier. */
+ /* If the result type is unconstrained, take the address of the operands
+ and then dereference our result. */
if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE
|| CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type)))
{
= (gnat_node != Empty && Sloc (gnat_node) != No_Location)
? Get_Logical_Line_Number (Sloc(gnat_node)) : input_line;
- TREE_TYPE (filename) = build_array_type (unsigned_char_type_node,
- build_index_type (size_int (len)));
+ TREE_TYPE (filename)
+ = build_array_type (char_type_node, build_index_type (size_int (len)));
return
build_call_2_expr (fndecl,
- build1 (ADDR_EXPR,
- build_pointer_type (unsigned_char_type_node),
+ build1 (ADDR_EXPR, build_pointer_type (char_type_node),
filename),
build_int_cst (NULL_TREE, line_number));
}
tree new_field;
/* First loop thru normal components. */
+
for (new_field = TYPE_FIELDS (record_type); new_field;
new_field = TREE_CHAIN (new_field))
- if (SAME_FIELD_P (field, new_field))
+ if (field == new_field
+ || DECL_ORIGINAL_FIELD (new_field) == field
+ || new_field == DECL_ORIGINAL_FIELD (field)
+ || (DECL_ORIGINAL_FIELD (field)
+ && (DECL_ORIGINAL_FIELD (field)
+ == DECL_ORIGINAL_FIELD (new_field))))
break;
/* Next, loop thru DECL_INTERNAL_P components if we haven't found
the component in the first search. Doing this search in 2 steps
is required to avoiding hidden homonymous fields in the
_Parent field. */
+
if (!new_field)
for (new_field = TYPE_FIELDS (record_type); new_field;
new_field = TREE_CHAIN (new_field))
{
/* Latch malloc's return value and get a pointer to the aligning field
first. */
- tree storage_ptr = gnat_protect_expr (malloc_ptr);
+ tree storage_ptr = protect_multiple_eval (malloc_ptr);
tree aligning_record_addr
= convert (build_pointer_type (aligning_type), storage_ptr);
tree aligning_field
= build_component_ref (aligning_record, NULL_TREE,
- TYPE_FIELDS (aligning_type), false);
+ TYPE_FIELDS (aligning_type), 0);
tree aligning_field_addr
= build_unary_op (ADDR_EXPR, NULL_TREE, aligning_field);
{
tree storage_type
= build_unc_object_type_from_ptr (result_type, type,
- get_identifier ("ALLOC"), false);
+ get_identifier ("ALLOC"));
tree template_type = TREE_TYPE (TYPE_FIELDS (storage_type));
tree storage_ptr_type = build_pointer_type (storage_type);
tree storage;
storage = build_call_alloc_dealloc (NULL_TREE, size, storage_type,
gnat_proc, gnat_pool, gnat_node);
- storage = convert (storage_ptr_type, gnat_protect_expr (storage));
+ storage = convert (storage_ptr_type, protect_multiple_eval (storage));
if (TYPE_IS_PADDING_P (type))
{
build_component_ref
(build_unary_op (INDIRECT_REF, NULL_TREE,
convert (storage_ptr_type, storage)),
- NULL_TREE, TYPE_FIELDS (storage_type), false),
+ NULL_TREE, TYPE_FIELDS (storage_type), 0),
build_template (template_type, type, NULL_TREE)),
convert (result_type, convert (storage_ptr_type, storage)));
}
and return the address with a COMPOUND_EXPR. */
if (init)
{
- result = gnat_protect_expr (result);
+ result = protect_multiple_eval (result);
result
= build2 (COMPOUND_EXPR, TREE_TYPE (result),
build_binary_op
tree
fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
{
+ tree field;
tree parm_decl = get_gnu_tree (gnat_formal);
+ tree const_list = NULL_TREE;
tree record_type = TREE_TYPE (TREE_TYPE (parm_decl));
- tree const_list = NULL_TREE, field;
- const bool do_range_check
- = strcmp ("MBO",
+ int do_range_check =
+ strcmp ("MBO",
IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type))));
expr = maybe_unconstrained_array (expr);
SUBSTITUTE_PLACEHOLDER_IN_EXPR
(DECL_INITIAL (field), expr));
- /* Check to ensure that only 32-bit pointers are passed in
- 32-bit descriptors */
- if (do_range_check
- && strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), "POINTER") == 0)
+ /* Check to ensure that only 32bit pointers are passed in
+ 32bit descriptors */
+ if (do_range_check &&
+ strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), "POINTER") == 0)
{
- tree pointer64type
- = build_pointer_type_for_mode (void_type_node, DImode, false);
+ tree pointer64type =
+ build_pointer_type_for_mode (void_type_node, DImode, false);
tree addr64expr = build_unary_op (ADDR_EXPR, pointer64type, expr);
- tree malloc64low
- = build_int_cstu (long_integer_type_node, 0x80000000);
+ tree malloc64low =
+ build_int_cstu (long_integer_type_node, 0x80000000);
add_stmt (build3 (COND_EXPR, void_type_node,
- build_binary_op (GE_EXPR, boolean_type_node,
+ build_binary_op (GE_EXPR, long_integer_type_node,
convert (long_integer_type_node,
addr64expr),
malloc64low),
- build_call_raise (CE_Range_Check_Failed,
- gnat_actual,
+ build_call_raise (CE_Range_Check_Failed, gnat_actual,
N_Raise_Constraint_Error),
NULL_TREE));
}
t = TREE_OPERAND (t, 0);
break;
- case COMPOUND_EXPR:
- t = TREE_OPERAND (t, 1);
- break;
-
case CONSTRUCTOR:
TREE_ADDRESSABLE (t) = 1;
return true;
return true;
}
}
-\f
-/* Save EXP for later use or reuse. This is equivalent to save_expr in tree.c
- but we know how to handle our own nodes. */
-
-tree
-gnat_save_expr (tree exp)
-{
- tree type = TREE_TYPE (exp);
- enum tree_code code = TREE_CODE (exp);
-
- if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
- return exp;
-
- if (code == UNCONSTRAINED_ARRAY_REF)
- {
- tree t = build1 (code, type, gnat_save_expr (TREE_OPERAND (exp, 0)));
- TREE_READONLY (t) = TYPE_READONLY (type);
- return t;
- }
-
- /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
- This may be more efficient, but will also allow us to more easily find
- the match for the PLACEHOLDER_EXPR. */
- if (code == COMPONENT_REF
- && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
- return build3 (code, type, gnat_save_expr (TREE_OPERAND (exp, 0)),
- TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
-
- return save_expr (exp);
-}
-
-/* Protect EXP for immediate reuse. This is a variant of gnat_save_expr that
- is optimized under the assumption that EXP's value doesn't change before
- its subsequent reuse(s) except through its potential reevaluation. */
-
-tree
-gnat_protect_expr (tree exp)
-{
- tree type = TREE_TYPE (exp);
- enum tree_code code = TREE_CODE (exp);
-
- if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
- return exp;
-
- /* If EXP has no side effects, we theoritically don't need to do anything.
- However, we may be recursively passed more and more complex expressions
- involving checks which will be reused multiple times and eventually be
- unshared for gimplification; in order to avoid a complexity explosion
- at that point, we protect any expressions more complex than a simple
- arithmetic expression. */
- if (!TREE_SIDE_EFFECTS (exp))
- {
- tree inner = skip_simple_arithmetic (exp);
- if (!EXPR_P (inner) || REFERENCE_CLASS_P (inner))
- return exp;
- }
-
- /* If this is a conversion, protect what's inside the conversion. */
- if (code == NON_LVALUE_EXPR
- || CONVERT_EXPR_CODE_P (code)
- || code == VIEW_CONVERT_EXPR)
- return build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)));
-
- /* If we're indirectly referencing something, we only need to protect the
- address since the data itself can't change in these situations. */
- if (code == INDIRECT_REF || code == UNCONSTRAINED_ARRAY_REF)
- {
- tree t = build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)));
- TREE_READONLY (t) = TYPE_READONLY (type);
- return t;
- }
-
- /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
- This may be more efficient, but will also allow us to more easily find
- the match for the PLACEHOLDER_EXPR. */
- if (code == COMPONENT_REF
- && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
- return build3 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)),
- TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
-
- /* If this is a fat pointer or something that can be placed in a register,
- just make a SAVE_EXPR. Likewise for a CALL_EXPR as large objects are
- returned via invisible reference in most ABIs so the temporary will
- directly be filled by the callee. */
- if (TYPE_IS_FAT_POINTER_P (type)
- || TYPE_MODE (type) != BLKmode
- || code == CALL_EXPR)
- return save_expr (exp);
-
- /* Otherwise reference, protect the address and dereference. */
- return
- build_unary_op (INDIRECT_REF, type,
- save_expr (build_unary_op (ADDR_EXPR,
- build_reference_type (type),
- exp)));
-}
-
-/* This is equivalent to stabilize_reference_1 in tree.c but we take an extra
- argument to force evaluation of everything. */
-
-static tree
-gnat_stabilize_reference_1 (tree e, bool force)
-{
- enum tree_code code = TREE_CODE (e);
- tree type = TREE_TYPE (e);
- tree result;
-
- /* We cannot ignore const expressions because it might be a reference
- to a const array but whose index contains side-effects. But we can
- ignore things that are actual constant or that already have been
- handled by this function. */
- if (TREE_CONSTANT (e) || code == SAVE_EXPR)
- return e;
-
- switch (TREE_CODE_CLASS (code))
- {
- case tcc_exceptional:
- case tcc_declaration:
- case tcc_comparison:
- case tcc_expression:
- case tcc_reference:
- case tcc_vl_exp:
- /* If this is a COMPONENT_REF of a fat pointer, save the entire
- fat pointer. This may be more efficient, but will also allow
- us to more easily find the match for the PLACEHOLDER_EXPR. */
- if (code == COMPONENT_REF
- && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
- result
- = build3 (code, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
- TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
- /* If the expression has side-effects, then encase it in a SAVE_EXPR
- so that it will only be evaluated once. */
- /* The tcc_reference and tcc_comparison classes could be handled as
- below, but it is generally faster to only evaluate them once. */
- else if (TREE_SIDE_EFFECTS (e) || force)
- return save_expr (e);
- else
- return e;
- break;
-
- case tcc_binary:
- /* Recursively stabilize each operand. */
- result
- = build2 (code, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force));
- break;
-
- case tcc_unary:
- /* Recursively stabilize each operand. */
- result
- = build1 (code, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force));
- break;
-
- default:
- gcc_unreachable ();
- }
-
- /* See similar handling in gnat_stabilize_reference. */
- TREE_READONLY (result) = TREE_READONLY (e);
- TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
- TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
-
- return result;
-}
-
-/* This is equivalent to stabilize_reference in tree.c but we know how to
- handle our own nodes and we take extra arguments. FORCE says whether to
- force evaluation of everything. We set SUCCESS to true unless we walk
- through something we don't know how to stabilize. */
-
-tree
-gnat_stabilize_reference (tree ref, bool force, bool *success)
-{
- tree type = TREE_TYPE (ref);
- enum tree_code code = TREE_CODE (ref);
- tree result;
-
- /* Assume we'll success unless proven otherwise. */
- if (success)
- *success = true;
-
- switch (code)
- {
- case CONST_DECL:
- case VAR_DECL:
- case PARM_DECL:
- case RESULT_DECL:
- /* No action is needed in this case. */
- return ref;
-
- case ADDR_EXPR:
- CASE_CONVERT:
- case FLOAT_EXPR:
- case FIX_TRUNC_EXPR:
- case VIEW_CONVERT_EXPR:
- result
- = build1 (code, type,
- gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
- success));
- break;
-
- case INDIRECT_REF:
- case UNCONSTRAINED_ARRAY_REF:
- result = build1 (code, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
- force));
- break;
-
- case COMPONENT_REF:
- result = build3 (COMPONENT_REF, type,
- gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
- success),
- TREE_OPERAND (ref, 1), NULL_TREE);
- break;
-
- case BIT_FIELD_REF:
- result = build3 (BIT_FIELD_REF, type,
- gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
- success),
- gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
- force),
- gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2),
- force));
- break;
-
- case ARRAY_REF:
- case ARRAY_RANGE_REF:
- result = build4 (code, type,
- gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
- success),
- gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
- force),
- NULL_TREE, NULL_TREE);
- break;
-
- case CALL_EXPR:
- result = gnat_stabilize_reference_1 (ref, force);
- break;
-
- case COMPOUND_EXPR:
- result = build2 (COMPOUND_EXPR, type,
- gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
- success),
- gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
- force));
- break;
-
- case CONSTRUCTOR:
- /* Constructors with 1 element are used extensively to formally
- convert objects to special wrapping types. */
- if (TREE_CODE (type) == RECORD_TYPE
- && VEC_length (constructor_elt, CONSTRUCTOR_ELTS (ref)) == 1)
- {
- tree index
- = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->index;
- tree value
- = VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->value;
- result
- = build_constructor_single (type, index,
- gnat_stabilize_reference_1 (value,
- force));
- }
- else
- {
- if (success)
- *success = false;
- return ref;
- }
- break;
-
- case ERROR_MARK:
- ref = error_mark_node;
-
- /* ... fall through to failure ... */
-
- /* If arg isn't a kind of lvalue we recognize, make no change.
- Caller should recognize the error for an invalid lvalue. */
- default:
- if (success)
- *success = false;
- return ref;
- }
-
- /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS set on the initial expression
- may not be sustained across some paths, such as the way via build1 for
- INDIRECT_REF. We reset those flags here in the general case, which is
- consistent with the GCC version of this routine.
-
- Special care should be taken regarding TREE_SIDE_EFFECTS, because some
- paths introduce side-effects where there was none initially (e.g. if a
- SAVE_EXPR is built) and we also want to keep track of that. */
- TREE_READONLY (result) = TREE_READONLY (ref);
- TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref);
- TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
-
- return result;
-}
OSDN Git Service
