Moved to gcc-interface.
From-SVN: r138260
This commit is contained in:
Arnaud Charlet
parent
54dfd46bff
commit
68c989b06f
@ -1,81 +0,0 @@
|
||||
/****************************************************************************
|
||||
* *
|
||||
* GNAT COMPILER COMPONENTS *
|
||||
* *
|
||||
* GNAT-SPECIFIC GCC TREE CODES *
|
||||
* *
|
||||
* Specification *
|
||||
* *
|
||||
* Copyright (C) 1992-2007, Free Software Foundation, Inc. *
|
||||
* *
|
||||
* GNAT is free software; you can redistribute it and/or modify it under *
|
||||
* terms of the GNU General Public License as published by the Free Soft- *
|
||||
* ware Foundation; either version 3, or (at your option) any later ver- *
|
||||
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
|
||||
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
|
||||
* for more details. You should have received a copy of the GNU General *
|
||||
* Public License along with GCC; see the file COPYING3. If not see *
|
||||
* <http://www.gnu.org/licenses/>. *
|
||||
* *
|
||||
* GNAT was originally developed by the GNAT team at New York University. *
|
||||
* Extensive contributions were provided by Ada Core Technologies Inc. *
|
||||
* *
|
||||
****************************************************************************/
|
||||
|
||||
/* A type that is an unconstrained array itself. This node is never passed
|
||||
to GCC. TREE_TYPE is the type of the fat pointer and TYPE_OBJECT_RECORD_TYPE
|
||||
is the type of a record containing the template and data. */
|
||||
|
||||
DEFTREECODE (UNCONSTRAINED_ARRAY_TYPE, "unconstrained_array_type", tcc_type, 0)
|
||||
|
||||
/* A reference to an unconstrained array. This node only exists as an
|
||||
intermediate node during the translation of a GNAT tree to a GCC tree;
|
||||
it is never passed to GCC. The only field used is operand 0, which
|
||||
is the fat pointer object. */
|
||||
|
||||
DEFTREECODE (UNCONSTRAINED_ARRAY_REF, "unconstrained_array_ref",
|
||||
tcc_reference, 1)
|
||||
|
||||
/* An expression that returns an RTL suitable for its type. Operand 0
|
||||
is an expression to be evaluated for side effects only. */
|
||||
DEFTREECODE (NULL_EXPR, "null_expr", tcc_expression, 1)
|
||||
|
||||
/* Same as ADDR_EXPR, except that if the operand represents a bit field,
|
||||
return the address of the byte containing the bit. This is used
|
||||
for the 'Address attribute and never shows up in the tree. */
|
||||
DEFTREECODE (ATTR_ADDR_EXPR, "attr_addr_expr", tcc_reference, 1)
|
||||
|
||||
/* Here are the tree codes for the statement types known to Ada. These
|
||||
must be at the end of this file to allow IS_ADA_STMT to work. */
|
||||
|
||||
/* This is how record_code_position and insert_code_for work. The former
|
||||
makes this tree node, whose operand is a statement. The latter inserts
|
||||
the actual statements into this node. Gimplification consists of
|
||||
just returning the inner statement. */
|
||||
DEFTREECODE (STMT_STMT, "stmt_stmt", tcc_statement, 1)
|
||||
|
||||
/* A loop. LOOP_STMT_TOP_COND and LOOP_STMT_BOT_COND are the tests to exit a
|
||||
loop at the top and bottom, respectively. LOOP_STMT_UPDATE is the statement
|
||||
to update the loop iterator at the continue point. LOOP_STMT_BODY are the
|
||||
statements in the body of the loop. LOOP_STMT_LABEL points to the LABEL_DECL
|
||||
of the end label of the loop. */
|
||||
DEFTREECODE (LOOP_STMT, "loop_stmt", tcc_statement, 5)
|
||||
|
||||
/* Conditionally exit a loop. EXIT_STMT_COND is the condition, which, if
|
||||
true, will cause the loop to be exited. If no condition is specified,
|
||||
the loop is unconditionally exited. EXIT_STMT_LABEL is the end label
|
||||
corresponding to the loop to exit. */
|
||||
DEFTREECODE (EXIT_STMT, "exit_stmt", tcc_statement, 2)
|
||||
|
||||
/* A exception region. REGION_STMT_BODY is the statement to be executed
|
||||
inside the region. REGION_STMT_HANDLE is a statement that represents
|
||||
the exception handlers (usually a BLOCK_STMT of HANDLE_STMTs).
|
||||
REGION_STMT_BLOCK is the BLOCK node for the declarative region, if any. */
|
||||
DEFTREECODE (REGION_STMT, "region_stmt", tcc_statement, 3)
|
||||
|
||||
/* An exception handler. HANDLER_STMT_ARG is the value to pass to
|
||||
expand_start_catch, HANDLER_STMT_LIST is the list of statements for the
|
||||
handler itself, and HANDLER_STMT_BLOCK is the BLOCK node for this
|
||||
binding. */
|
||||
DEFTREECODE (HANDLER_STMT, "handler_stmt", tcc_statement, 3)
|
||||
@ -1,321 +0,0 @@
|
||||
/****************************************************************************
|
||||
* *
|
||||
* GNAT COMPILER COMPONENTS *
|
||||
* *
|
||||
* A D A - T R E E *
|
||||
* *
|
||||
* C Header File *
|
||||
* *
|
||||
* Copyright (C) 1992-2008, Free Software Foundation, Inc. *
|
||||
* *
|
||||
* GNAT is free software; you can redistribute it and/or modify it under *
|
||||
* terms of the GNU General Public License as published by the Free Soft- *
|
||||
* ware Foundation; either version 3, or (at your option) any later ver- *
|
||||
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
|
||||
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
|
||||
* for more details. You should have received a copy of the GNU General *
|
||||
* Public License along with GCC; see the file COPYING3. If not see *
|
||||
* <http://www.gnu.org/licenses/>. *
|
||||
* *
|
||||
* GNAT was originally developed by the GNAT team at New York University. *
|
||||
* Extensive contributions were provided by Ada Core Technologies Inc. *
|
||||
* *
|
||||
****************************************************************************/
|
||||
|
||||
/* Ada uses the lang_decl and lang_type fields to hold a tree. */
|
||||
union lang_tree_node
|
||||
GTY((desc ("0"),
|
||||
chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.t)")))
|
||||
{
|
||||
union tree_node GTY((tag ("0"))) t;
|
||||
};
|
||||
struct lang_decl GTY(()) {tree t; };
|
||||
struct lang_type GTY(()) {tree t; };
|
||||
|
||||
/* Define macros to get and set the tree in TYPE_ and DECL_LANG_SPECIFIC. */
|
||||
#define GET_TYPE_LANG_SPECIFIC(NODE) \
|
||||
(TYPE_LANG_SPECIFIC (NODE) ? TYPE_LANG_SPECIFIC (NODE)->t : NULL_TREE)
|
||||
#define SET_TYPE_LANG_SPECIFIC(NODE, X) \
|
||||
(TYPE_LANG_SPECIFIC (NODE) \
|
||||
= (TYPE_LANG_SPECIFIC (NODE) \
|
||||
? TYPE_LANG_SPECIFIC (NODE) : GGC_NEW (struct lang_type))) \
|
||||
->t = X;
|
||||
|
||||
#define GET_DECL_LANG_SPECIFIC(NODE) \
|
||||
(DECL_LANG_SPECIFIC (NODE) ? DECL_LANG_SPECIFIC (NODE)->t : NULL_TREE)
|
||||
#define SET_DECL_LANG_SPECIFIC(NODE, VALUE) \
|
||||
(DECL_LANG_SPECIFIC (NODE) \
|
||||
= (DECL_LANG_SPECIFIC (NODE) \
|
||||
? DECL_LANG_SPECIFIC (NODE) : GGC_NEW (struct lang_decl))) \
|
||||
->t = VALUE;
|
||||
|
||||
/* Flags added to GCC type nodes. */
|
||||
|
||||
/* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this is a
|
||||
record being used as a fat pointer (only true for RECORD_TYPE). */
|
||||
#define TYPE_IS_FAT_POINTER_P(NODE) \
|
||||
TYPE_LANG_FLAG_0 (RECORD_OR_UNION_CHECK (NODE))
|
||||
|
||||
#define TYPE_FAT_POINTER_P(NODE) \
|
||||
(TREE_CODE (NODE) == RECORD_TYPE && TYPE_IS_FAT_POINTER_P (NODE))
|
||||
|
||||
/* For integral types and array types, nonzero if this is a packed array type
|
||||
used for bit-packed types. Such types should not be extended to a larger
|
||||
size or validated against a specified size. */
|
||||
#define TYPE_PACKED_ARRAY_TYPE_P(NODE) TYPE_LANG_FLAG_0 (NODE)
|
||||
|
||||
#define TYPE_IS_PACKED_ARRAY_TYPE_P(NODE) \
|
||||
((TREE_CODE (NODE) == INTEGER_TYPE || TREE_CODE (NODE) == ARRAY_TYPE) \
|
||||
&& TYPE_PACKED_ARRAY_TYPE_P (NODE))
|
||||
|
||||
/* For INTEGER_TYPE, nonzero if this is a modular type with a modulus that
|
||||
is not equal to two to the power of its mode's size. */
|
||||
#define TYPE_MODULAR_P(NODE) TYPE_LANG_FLAG_1 (INTEGER_TYPE_CHECK (NODE))
|
||||
|
||||
/* For ARRAY_TYPE, nonzero if this type corresponds to a dimension of
|
||||
an Ada array other than the first. */
|
||||
#define TYPE_MULTI_ARRAY_P(NODE) TYPE_LANG_FLAG_1 (ARRAY_TYPE_CHECK (NODE))
|
||||
|
||||
/* For FUNCTION_TYPE, nonzero if this denotes a function returning an
|
||||
unconstrained array or record. */
|
||||
#define TYPE_RETURNS_UNCONSTRAINED_P(NODE) \
|
||||
TYPE_LANG_FLAG_1 (FUNCTION_TYPE_CHECK (NODE))
|
||||
|
||||
/* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this denotes
|
||||
a justified modular type (will only be true for RECORD_TYPE). */
|
||||
#define TYPE_JUSTIFIED_MODULAR_P(NODE) \
|
||||
TYPE_LANG_FLAG_1 (RECORD_OR_UNION_CHECK (NODE))
|
||||
|
||||
/* Nonzero in an arithmetic subtype if this is a subtype not known to the
|
||||
front-end. */
|
||||
#define TYPE_EXTRA_SUBTYPE_P(NODE) TYPE_LANG_FLAG_2 (NODE)
|
||||
|
||||
/* Nonzero for composite types if this is a by-reference type. */
|
||||
#define TYPE_BY_REFERENCE_P(NODE) TYPE_LANG_FLAG_2 (NODE)
|
||||
|
||||
/* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this is the
|
||||
type for an object whose type includes its template in addition to
|
||||
its value (only true for RECORD_TYPE). */
|
||||
#define TYPE_CONTAINS_TEMPLATE_P(NODE) \
|
||||
TYPE_LANG_FLAG_3 (RECORD_OR_UNION_CHECK (NODE))
|
||||
|
||||
/* For INTEGER_TYPE, nonzero if this really represents a VAX
|
||||
floating-point type. */
|
||||
#define TYPE_VAX_FLOATING_POINT_P(NODE) \
|
||||
TYPE_LANG_FLAG_3 (INTEGER_TYPE_CHECK (NODE))
|
||||
|
||||
/* True if NODE is a thin pointer. */
|
||||
#define TYPE_THIN_POINTER_P(NODE) \
|
||||
(POINTER_TYPE_P (NODE) \
|
||||
&& TREE_CODE (TREE_TYPE (NODE)) == RECORD_TYPE \
|
||||
&& TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (NODE)))
|
||||
|
||||
/* True if TYPE is either a fat or thin pointer to an unconstrained
|
||||
array. */
|
||||
#define TYPE_FAT_OR_THIN_POINTER_P(NODE) \
|
||||
(TYPE_FAT_POINTER_P (NODE) || TYPE_THIN_POINTER_P (NODE))
|
||||
|
||||
/* For INTEGER_TYPEs, nonzero if the type has a biased representation. */
|
||||
#define TYPE_BIASED_REPRESENTATION_P(NODE) \
|
||||
TYPE_LANG_FLAG_4 (INTEGER_TYPE_CHECK (NODE))
|
||||
|
||||
/* For ARRAY_TYPEs, nonzero if the array type has Convention_Fortran. */
|
||||
#define TYPE_CONVENTION_FORTRAN_P(NODE) \
|
||||
TYPE_LANG_FLAG_4 (ARRAY_TYPE_CHECK (NODE))
|
||||
|
||||
/* For FUNCTION_TYPEs, nonzero if the function returns by reference. */
|
||||
#define TYPE_RETURNS_BY_REF_P(NODE) \
|
||||
TYPE_LANG_FLAG_4 (FUNCTION_TYPE_CHECK (NODE))
|
||||
|
||||
/* For VOID_TYPE, ENUMERAL_TYPE, UNION_TYPE, and RECORD_TYPE, nonzero if this
|
||||
is a dummy type, made to correspond to a private or incomplete type. */
|
||||
#define TYPE_DUMMY_P(NODE) TYPE_LANG_FLAG_4 (NODE)
|
||||
|
||||
/* True if TYPE is such a dummy type. */
|
||||
#define TYPE_IS_DUMMY_P(NODE) \
|
||||
((TREE_CODE (NODE) == VOID_TYPE || TREE_CODE (NODE) == RECORD_TYPE \
|
||||
|| TREE_CODE (NODE) == UNION_TYPE || TREE_CODE (NODE) == ENUMERAL_TYPE) \
|
||||
&& TYPE_DUMMY_P (NODE))
|
||||
|
||||
/* For FUNCTION_TYPEs, nonzero if function returns by being passed a pointer
|
||||
to a place to store its result. */
|
||||
#define TYPE_RETURNS_BY_TARGET_PTR_P(NODE) \
|
||||
TYPE_LANG_FLAG_5 (FUNCTION_TYPE_CHECK (NODE))
|
||||
|
||||
/* For an INTEGER_TYPE, nonzero if TYPE_ACTUAL_BOUNDS is present. */
|
||||
#define TYPE_HAS_ACTUAL_BOUNDS_P(NODE) \
|
||||
TYPE_LANG_FLAG_5 (INTEGER_TYPE_CHECK (NODE))
|
||||
|
||||
/* For a RECORD_TYPE, nonzero if this was made just to supply needed
|
||||
padding or alignment. */
|
||||
#define TYPE_IS_PADDING_P(NODE) TYPE_LANG_FLAG_5 (RECORD_TYPE_CHECK (NODE))
|
||||
|
||||
/* True if TYPE can alias any other types. */
|
||||
#define TYPE_UNIVERSAL_ALIASING_P(NODE) TYPE_LANG_FLAG_6 (NODE)
|
||||
|
||||
/* This field is only defined for FUNCTION_TYPE nodes. If the Ada
|
||||
subprogram contains no parameters passed by copy in/copy out then this
|
||||
field is 0. Otherwise it points to a list of nodes used to specify the
|
||||
return values of the out (or in out) parameters that qualify to be passed
|
||||
by copy in copy out. It is a CONSTRUCTOR. For a full description of the
|
||||
cico parameter passing mechanism refer to the routine gnat_to_gnu_entity. */
|
||||
#define TYPE_CI_CO_LIST(NODE) TYPE_LANG_SLOT_1 (FUNCTION_TYPE_CHECK (NODE))
|
||||
|
||||
/* For an INTEGER_TYPE with TYPE_MODULAR_P, this is the value of the
|
||||
modulus. */
|
||||
#define TYPE_MODULUS(NODE) GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
|
||||
#define SET_TYPE_MODULUS(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
|
||||
|
||||
/* For an INTEGER_TYPE that is the TYPE_DOMAIN of some ARRAY_TYPE, points to
|
||||
the type corresponding to the Ada index type. */
|
||||
#define TYPE_INDEX_TYPE(NODE) \
|
||||
GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
|
||||
#define SET_TYPE_INDEX_TYPE(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
|
||||
|
||||
/* For an INTEGER_TYPE with TYPE_VAX_FLOATING_POINT_P, stores the
|
||||
Digits_Value. */
|
||||
#define TYPE_DIGITS_VALUE(NODE) \
|
||||
GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
|
||||
#define SET_TYPE_DIGITS_VALUE(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
|
||||
|
||||
/* For numeric types, stores the RM_Size of the type. */
|
||||
#define TYPE_RM_SIZE_NUM(NODE) TYPE_LANG_SLOT_1 (NUMERICAL_TYPE_CHECK (NODE))
|
||||
|
||||
#define TYPE_RM_SIZE(NODE) \
|
||||
(INTEGRAL_TYPE_P (NODE) || TREE_CODE (NODE) == REAL_TYPE \
|
||||
? TYPE_RM_SIZE_NUM (NODE) : 0)
|
||||
|
||||
/* For a RECORD_TYPE that is a fat pointer, point to the type for the
|
||||
unconstrained object. Likewise for a RECORD_TYPE that is pointed
|
||||
to by a thin pointer. */
|
||||
#define TYPE_UNCONSTRAINED_ARRAY(NODE) \
|
||||
GET_TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE))
|
||||
#define SET_TYPE_UNCONSTRAINED_ARRAY(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE), X)
|
||||
|
||||
/* For other RECORD_TYPEs and all UNION_TYPEs and QUAL_UNION_TYPEs, the Ada
|
||||
size of the object. This differs from the GCC size in that it does not
|
||||
include any rounding up to the alignment of the type. */
|
||||
#define TYPE_ADA_SIZE(NODE) \
|
||||
GET_TYPE_LANG_SPECIFIC (RECORD_OR_UNION_CHECK (NODE))
|
||||
#define SET_TYPE_ADA_SIZE(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (RECORD_OR_UNION_CHECK (NODE), X)
|
||||
|
||||
/* For an INTEGER_TYPE with TYPE_HAS_ACTUAL_BOUNDS_P or an ARRAY_TYPE, this is
|
||||
the index type that should be used when the actual bounds are required for
|
||||
a template. This is used in the case of packed arrays. */
|
||||
#define TYPE_ACTUAL_BOUNDS(NODE) \
|
||||
GET_TYPE_LANG_SPECIFIC (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE))
|
||||
#define SET_TYPE_ACTUAL_BOUNDS(NODE, X) \
|
||||
SET_TYPE_LANG_SPECIFIC (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE), X)
|
||||
|
||||
/* In an UNCONSTRAINED_ARRAY_TYPE, points to the record containing both
|
||||
the template and object.
|
||||
|
||||
??? We also put this on an ENUMERAL_TYPE that's dummy. Technically,
|
||||
this is a conflict on the minval field, but there doesn't seem to be
|
||||
simple fix, so we'll live with this kludge for now. */
|
||||
#define TYPE_OBJECT_RECORD_TYPE(NODE) \
|
||||
(TREE_CHECK2 ((NODE), UNCONSTRAINED_ARRAY_TYPE, ENUMERAL_TYPE)->type.minval)
|
||||
|
||||
/* Nonzero in a FUNCTION_DECL that represents a stubbed function
|
||||
discriminant. */
|
||||
#define DECL_STUBBED_P(NODE) DECL_LANG_FLAG_0 (FUNCTION_DECL_CHECK (NODE))
|
||||
|
||||
/* Nonzero in a VAR_DECL if it is guaranteed to be constant after having
|
||||
been elaborated and TREE_READONLY is not set on it. */
|
||||
#define DECL_READONLY_ONCE_ELAB(NODE) DECL_LANG_FLAG_0 (VAR_DECL_CHECK (NODE))
|
||||
|
||||
/* Nonzero if this decl is always used by reference; i.e., an INDIRECT_REF
|
||||
is needed to access the object. */
|
||||
#define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE)
|
||||
|
||||
/* Nonzero in a FIELD_DECL that is a dummy built for some internal reason. */
|
||||
#define DECL_INTERNAL_P(NODE) DECL_LANG_FLAG_3 (FIELD_DECL_CHECK (NODE))
|
||||
|
||||
/* Nonzero if this decl is a PARM_DECL for an Ada array being passed to a
|
||||
foreign convention subprogram. */
|
||||
#define DECL_BY_COMPONENT_PTR_P(NODE) DECL_LANG_FLAG_3 (PARM_DECL_CHECK (NODE))
|
||||
|
||||
/* Nonzero in a FUNCTION_DECL that corresponds to an elaboration procedure. */
|
||||
#define DECL_ELABORATION_PROC_P(NODE) \
|
||||
DECL_LANG_FLAG_3 (FUNCTION_DECL_CHECK (NODE))
|
||||
|
||||
/* Nonzero if this is a decl for a pointer that points to something which
|
||||
is readonly. Used mostly for fat pointers. */
|
||||
#define DECL_POINTS_TO_READONLY_P(NODE) DECL_LANG_FLAG_4 (NODE)
|
||||
|
||||
/* Nonzero in a FIELD_DECL if there was a record rep clause. */
|
||||
#define DECL_HAS_REP_P(NODE) DECL_LANG_FLAG_5 (FIELD_DECL_CHECK (NODE))
|
||||
|
||||
/* Nonzero in a PARM_DECL if we are to pass by descriptor. */
|
||||
#define DECL_BY_DESCRIPTOR_P(NODE) DECL_LANG_FLAG_5 (PARM_DECL_CHECK (NODE))
|
||||
|
||||
/* Nonzero in a VAR_DECL if it is a pointer renaming a global object. */
|
||||
#define DECL_RENAMING_GLOBAL_P(NODE) DECL_LANG_FLAG_5 (VAR_DECL_CHECK (NODE))
|
||||
|
||||
/* In a CONST_DECL, points to a VAR_DECL that is allocatable to
|
||||
memory. Used when a scalar constant is aliased or has its
|
||||
address taken. */
|
||||
#define DECL_CONST_CORRESPONDING_VAR(NODE) \
|
||||
GET_DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE))
|
||||
#define SET_DECL_CONST_CORRESPONDING_VAR(NODE, X) \
|
||||
SET_DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE), X)
|
||||
|
||||
/* In a FIELD_DECL, points to the FIELD_DECL that was the ultimate
|
||||
source of the decl. */
|
||||
#define DECL_ORIGINAL_FIELD(NODE) \
|
||||
GET_DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE))
|
||||
#define SET_DECL_ORIGINAL_FIELD(NODE, X) \
|
||||
SET_DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE), X)
|
||||
|
||||
/* In a VAR_DECL, points to the object being renamed if the VAR_DECL is a
|
||||
renaming pointer, otherwise 0. Note that this object is guaranteed to
|
||||
be protected against multiple evaluations. */
|
||||
#define DECL_RENAMED_OBJECT(NODE) \
|
||||
GET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE))
|
||||
#define SET_DECL_RENAMED_OBJECT(NODE, X) \
|
||||
SET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE), X)
|
||||
|
||||
/* In a TYPE_DECL, points to the parallel type if any, otherwise 0. */
|
||||
#define DECL_PARALLEL_TYPE(NODE) \
|
||||
GET_DECL_LANG_SPECIFIC (TYPE_DECL_CHECK (NODE))
|
||||
#define SET_DECL_PARALLEL_TYPE(NODE, X) \
|
||||
SET_DECL_LANG_SPECIFIC (TYPE_DECL_CHECK (NODE), X)
|
||||
|
||||
/* In a FUNCTION_DECL, points to the stub associated with the function
|
||||
if any, otherwise 0. */
|
||||
#define DECL_FUNCTION_STUB(NODE) \
|
||||
GET_DECL_LANG_SPECIFIC (FUNCTION_DECL_CHECK (NODE))
|
||||
#define SET_DECL_FUNCTION_STUB(NODE, X) \
|
||||
SET_DECL_LANG_SPECIFIC (FUNCTION_DECL_CHECK (NODE), X)
|
||||
|
||||
/* In a FIELD_DECL corresponding to a discriminant, contains the
|
||||
discriminant number. */
|
||||
#define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE))
|
||||
|
||||
/* Define fields and macros for statements.
|
||||
|
||||
Start by defining which tree codes are used for statements. */
|
||||
#define IS_STMT(NODE) (STATEMENT_CLASS_P (NODE))
|
||||
#define IS_ADA_STMT(NODE) (IS_STMT (NODE) \
|
||||
&& TREE_CODE (NODE) >= STMT_STMT)
|
||||
|
||||
#define STMT_STMT_STMT(NODE) TREE_OPERAND_CHECK_CODE (NODE, STMT_STMT, 0)
|
||||
#define LOOP_STMT_TOP_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 0)
|
||||
#define LOOP_STMT_BOT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 1)
|
||||
#define LOOP_STMT_UPDATE(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 2)
|
||||
#define LOOP_STMT_BODY(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 3)
|
||||
#define LOOP_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 4)
|
||||
#define EXIT_STMT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 0)
|
||||
#define EXIT_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 1)
|
||||
#define REGION_STMT_BODY(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 0)
|
||||
#define REGION_STMT_HANDLE(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 1)
|
||||
#define REGION_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 2)
|
||||
#define HANDLER_STMT_ARG(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 0)
|
||||
#define HANDLER_STMT_LIST(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 1)
|
||||
#define HANDLER_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE(NODE, HANDLER_STMT, 2)
|
||||
@ -1,80 +0,0 @@
|
||||
/****************************************************************************
|
||||
* *
|
||||
* GNAT COMPILER COMPONENTS *
|
||||
* *
|
||||
* A D A *
|
||||
* *
|
||||
* C Header File *
|
||||
* *
|
||||
* Copyright (C) 1992-2008, Free Software Foundation, Inc. *
|
||||
* *
|
||||
* GNAT is free software; you can redistribute it and/or modify it under *
|
||||
* terms of the GNU General Public License as published by the Free Soft- *
|
||||
* ware Foundation; either version 2, or (at your option) any later ver- *
|
||||
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
|
||||
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
|
||||
* for more details. You should have received a copy of the GNU General *
|
||||
* Public License distributed with GNAT; see file COPYING. If not, write *
|
||||
* to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
|
||||
* Boston, MA 02110-1301, USA. *
|
||||
* *
|
||||
* As a special exception, if you link this file with other files to *
|
||||
* produce an executable, this file does not by itself cause the resulting *
|
||||
* executable to be covered by the GNU General Public License. This except- *
|
||||
* ion does not however invalidate any other reasons why the executable *
|
||||
* file might be covered by the GNU Public License. *
|
||||
* *
|
||||
* GNAT was originally developed by the GNAT team at New York University. *
|
||||
* Extensive contributions were provided by Ada Core Technologies Inc. *
|
||||
* *
|
||||
****************************************************************************/
|
||||
|
||||
/* This file contains some standard macros for performing Ada-like
|
||||
operations. These are used to aid in the translation of other headers. */
|
||||
|
||||
#ifndef GCC_ADA_H
|
||||
#define GCC_ADA_H
|
||||
|
||||
/* Inlined functions in header are preceded by INLINE, which is normally set
|
||||
to extern inline for GCC, but may be set to static for use in standard
|
||||
ANSI-C. */
|
||||
|
||||
#ifndef INLINE
|
||||
#ifdef __GNUC__
|
||||
#define INLINE static inline
|
||||
#else
|
||||
#define INLINE static
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Define a macro to concatenate two strings. Write it for ANSI C and
|
||||
for traditional C. */
|
||||
|
||||
#ifdef __STDC__
|
||||
#define CAT(A,B) A##B
|
||||
#else
|
||||
#define _ECHO(A) A
|
||||
#define CAT(A,B) ECHO(A)B
|
||||
#endif
|
||||
|
||||
/* The following macro definition simulates the effect of a declaration of
|
||||
a subtype, where the first two parameters give the name of the type and
|
||||
subtype, and the third and fourth parameters give the subtype range. The
|
||||
effect is to compile a typedef defining the subtype as a synonym for the
|
||||
type, together with two constants defining the end points. */
|
||||
|
||||
#define SUBTYPE(SUBTYPE,TYPE,FIRST,LAST) \
|
||||
typedef TYPE SUBTYPE; \
|
||||
enum { CAT (SUBTYPE,__First) = FIRST, \
|
||||
CAT (SUBTYPE,__Last) = LAST };
|
||||
|
||||
/* The following definitions provide the equivalent of the Ada IN and NOT IN
|
||||
operators, assuming that the subtype involved has been defined using the
|
||||
SUBTYPE macro defined above. */
|
||||
|
||||
#define IN(VALUE,SUBTYPE) \
|
||||
(((VALUE) >= (SUBTYPE) CAT (SUBTYPE,__First)) \
|
||||
&& ((VALUE) <= (SUBTYPE) CAT (SUBTYPE,__Last)))
|
||||
|
||||
#endif
|
||||
142
gcc/ada/cuintp.c
142
gcc/ada/cuintp.c
@ -1,142 +0,0 @@
|
||||
/****************************************************************************
|
||||
* *
|
||||
* GNAT COMPILER COMPONENTS *
|
||||
* *
|
||||
* C U I N T P *
|
||||
* *
|
||||
* C Implementation File *
|
||||
* *
|
||||
* Copyright (C) 1992-2008, Free Software Foundation, Inc. *
|
||||
* *
|
||||
* GNAT is free software; you can redistribute it and/or modify it under *
|
||||
* terms of the GNU General Public License as published by the Free Soft- *
|
||||
* ware Foundation; either version 3, or (at your option) any later ver- *
|
||||
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
|
||||
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
|
||||
* for more details. You should have received a copy of the GNU General *
|
||||
* Public License along with GCC; see the file COPYING3. If not see *
|
||||
* <http://www.gnu.org/licenses/>. *
|
||||
* *
|
||||
* GNAT was originally developed by the GNAT team at New York University. *
|
||||
* Extensive contributions were provided by Ada Core Technologies Inc. *
|
||||
* *
|
||||
****************************************************************************/
|
||||
|
||||
/* This file corresponds to the Ada package body Uintp. It was created
|
||||
manually from the files uintp.ads and uintp.adb. */
|
||||
|
||||
#include "config.h"
|
||||
#include "system.h"
|
||||
#include "coretypes.h"
|
||||
#include "tm.h"
|
||||
#include "tree.h"
|
||||
#include "ada.h"
|
||||
#include "types.h"
|
||||
#include "uintp.h"
|
||||
#include "atree.h"
|
||||
#include "elists.h"
|
||||
#include "nlists.h"
|
||||
#include "stringt.h"
|
||||
#include "fe.h"
|
||||
#include "gigi.h"
|
||||
#include "ada-tree.h"
|
||||
|
||||
/* Universal integers are represented by the Uint type which is an index into
|
||||
the Uints_Ptr table containing Uint_Entry values. A Uint_Entry contains an
|
||||
index and length for getting the "digits" of the universal integer from the
|
||||
Udigits_Ptr table.
|
||||
|
||||
For efficiency, this method is used only for integer values larger than the
|
||||
constant Uint_Bias. If a Uint is less than this constant, then it contains
|
||||
the integer value itself. The origin of the Uints_Ptr table is adjusted so
|
||||
that a Uint value of Uint_Bias indexes the first element.
|
||||
|
||||
First define a utility function that operates like build_int_cst for
|
||||
integral types and does a conversion to floating-point for real types. */
|
||||
|
||||
static tree
|
||||
build_cst_from_int (tree type, HOST_WIDE_INT low)
|
||||
{
|
||||
if (TREE_CODE (type) == REAL_TYPE)
|
||||
return convert (type, build_int_cst (NULL_TREE, low));
|
||||
else
|
||||
return build_int_cst_type (type, low);
|
||||
}
|
||||
|
||||
/* Similar to UI_To_Int, but return a GCC INTEGER_CST or REAL_CST node,
|
||||
depending on whether TYPE is an integral or real type. Overflow is tested
|
||||
by the constant-folding used to build the node. TYPE is the GCC type of
|
||||
the resulting node. */
|
||||
|
||||
tree
|
||||
UI_To_gnu (Uint Input, tree type)
|
||||
{
|
||||
tree gnu_ret;
|
||||
|
||||
/* We might have a TYPE with biased representation and be passed an
|
||||
unbiased value that doesn't fit. We always use an unbiased type able
|
||||
to hold any such possible value for intermediate computations, and
|
||||
then rely on a conversion back to TYPE to perform the bias adjustment
|
||||
when need be. */
|
||||
|
||||
int biased_type_p
|
||||
= (TREE_CODE (type) == INTEGER_TYPE
|
||||
&& TYPE_BIASED_REPRESENTATION_P (type));
|
||||
|
||||
tree comp_type = biased_type_p ? get_base_type (type) : type;
|
||||
|
||||
if (Input <= Uint_Direct_Last)
|
||||
gnu_ret = build_cst_from_int (comp_type, Input - Uint_Direct_Bias);
|
||||
else
|
||||
{
|
||||
Int Idx = Uints_Ptr[Input].Loc;
|
||||
Pos Length = Uints_Ptr[Input].Length;
|
||||
Int First = Udigits_Ptr[Idx];
|
||||
tree gnu_base;
|
||||
|
||||
gcc_assert (Length > 0);
|
||||
|
||||
/* The computations we perform below always require a type at least as
|
||||
large as an integer not to overflow. REAL types are always fine, but
|
||||
INTEGER or ENUMERAL types we are handed may be too short. We use a
|
||||
base integer type node for the computations in this case and will
|
||||
convert the final result back to the incoming type later on.
|
||||
The base integer precision must be superior than 16. */
|
||||
|
||||
if (TREE_CODE (comp_type) != REAL_TYPE
|
||||
&& TYPE_PRECISION (comp_type) < TYPE_PRECISION (long_integer_type_node))
|
||||
{
|
||||
comp_type = long_integer_type_node;
|
||||
gcc_assert (TYPE_PRECISION (comp_type) > 16);
|
||||
}
|
||||
|
||||
gnu_base = build_cst_from_int (comp_type, Base);
|
||||
|
||||
gnu_ret = build_cst_from_int (comp_type, First);
|
||||
if (First < 0)
|
||||
for (Idx++, Length--; Length; Idx++, Length--)
|
||||
gnu_ret = fold_build2 (MINUS_EXPR, comp_type,
|
||||
fold_build2 (MULT_EXPR, comp_type,
|
||||
gnu_ret, gnu_base),
|
||||
build_cst_from_int (comp_type,
|
||||
Udigits_Ptr[Idx]));
|
||||
else
|
||||
for (Idx++, Length--; Length; Idx++, Length--)
|
||||
gnu_ret = fold_build2 (PLUS_EXPR, comp_type,
|
||||
fold_build2 (MULT_EXPR, comp_type,
|
||||
gnu_ret, gnu_base),
|
||||
build_cst_from_int (comp_type,
|
||||
Udigits_Ptr[Idx]));
|
||||
}
|
||||
|
||||
gnu_ret = convert (type, gnu_ret);
|
||||
|
||||
/* We don't need any NOP_EXPR or NON_LVALUE_EXPR on GNU_RET. */
|
||||
while ((TREE_CODE (gnu_ret) == NOP_EXPR
|
||||
|| TREE_CODE (gnu_ret) == NON_LVALUE_EXPR)
|
||||
&& TREE_TYPE (TREE_OPERAND (gnu_ret, 0)) == TREE_TYPE (gnu_ret))
|
||||
gnu_ret = TREE_OPERAND (gnu_ret, 0);
|
||||
|
||||
return gnu_ret;
|
||||
}
|
||||
7648
gcc/ada/decl.c
7648
gcc/ada/decl.c
File diff suppressed because it is too large
Load Diff
@ -1,40 +0,0 @@
|
||||
/****************************************************************************
|
||||
* *
|
||||
* GNAT COMPILER COMPONENTS *
|
||||
* *
|
||||
* D E F T A R G *
|
||||
* *
|
||||
* Body *
|
||||
* *
|
||||
* Copyright (C) 1992-2003 Free Software Foundation, Inc. *
|
||||
* *
|
||||
* GNAT is free software; you can redistribute it and/or modify it under *
|
||||
* terms of the GNU General Public License as published by the Free Soft- *
|
||||
* ware Foundation; either version 2, or (at your option) any later ver- *
|
||||
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
|
||||
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
|
||||
* for more details. You should have received a copy of the GNU General *
|
||||
* Public License distributed with GNAT; see file COPYING. If not, write *
|
||||
* to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
|
||||
* Boston, MA 02110-1301, USA. *
|
||||
* *
|
||||
* As a special exception, if you link this file with other files to *
|
||||
* produce an executable, this file does not by itself cause the resulting *
|
||||
* executable to be covered by the GNU General Public License. This except- *
|
||||
* ion does not however invalidate any other reasons why the executable *
|
||||
* file might be covered by the GNU Public License. *
|
||||
* *
|
||||
* GNAT was originally developed by the GNAT team at New York University. *
|
||||
* Extensive contributions were provided by Ada Core Technologies Inc. *
|
||||
* *
|
||||
****************************************************************************/
|
||||
|
||||
/* Include a default definition for TARGET_FLAGS for gnatpsta. */
|
||||
|
||||
#include "config.h"
|
||||
#include "system.h"
|
||||
#include "coretypes.h"
|
||||
#include "tm.h"
|
||||
|
||||
int target_flags = TARGET_DEFAULT;
|
||||
905
gcc/ada/gigi.h
905
gcc/ada/gigi.h
@ -1,905 +0,0 @@
|
||||
/****************************************************************************
|
||||
* *
|
||||
* GNAT COMPILER COMPONENTS *
|
||||
* *
|
||||
* G I G I *
|
||||
* *
|
||||
* C Header File *
|
||||
* *
|
||||
* Copyright (C) 1992-2008, Free Software Foundation, Inc. *
|
||||
* *
|
||||
* GNAT is free software; you can redistribute it and/or modify it under *
|
||||
* terms of the GNU General Public License as published by the Free Soft- *
|
||||
* ware Foundation; either version 2, or (at your option) any later ver- *
|
||||
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
|
||||
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
|
||||
* for more details. You should have received a copy of the GNU General *
|
||||
* Public License distributed with GNAT; see file COPYING. If not, write *
|
||||
* to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
|
||||
* Boston, MA 02110-1301, USA. *
|
||||
* *
|
||||
* As a special exception, if you link this file with other files to *
|
||||
* produce an executable, this file does not by itself cause the resulting *
|
||||
* executable to be covered by the GNU General Public License. This except- *
|
||||
* ion does not however invalidate any other reasons why the executable *
|
||||
* file might be covered by the GNU Public License. *
|
||||
* *
|
||||
* GNAT was originally developed by the GNAT team at New York University. *
|
||||
* Extensive contributions were provided by Ada Core Technologies Inc. *
|
||||
* *
|
||||
****************************************************************************/
|
||||
|
||||
/* Declare all functions and types used by gigi. */
|
||||
|
||||
/* The largest alignment, in bits, that is needed for using the widest
|
||||
move instruction. */
|
||||
extern unsigned int largest_move_alignment;
|
||||
|
||||
/* Compute the alignment of the largest mode that can be used for copying
|
||||
objects. */
|
||||
extern void gnat_compute_largest_alignment (void);
|
||||
|
||||
/* GNU_TYPE is a type. Determine if it should be passed by reference by
|
||||
default. */
|
||||
extern bool default_pass_by_ref (tree gnu_type);
|
||||
|
||||
/* GNU_TYPE is the type of a subprogram parameter. Determine from the type
|
||||
if it should be passed by reference. */
|
||||
extern bool must_pass_by_ref (tree gnu_type);
|
||||
|
||||
/* Initialize DUMMY_NODE_TABLE. */
|
||||
extern void init_dummy_type (void);
|
||||
|
||||
/* Given GNAT_ENTITY, an entity in the incoming GNAT tree, return a
|
||||
GCC type corresponding to that entity. GNAT_ENTITY is assumed to
|
||||
refer to an Ada type. */
|
||||
extern tree gnat_to_gnu_type (Entity_Id gnat_entity);
|
||||
|
||||
/* Given GNAT_ENTITY, a GNAT defining identifier node, which denotes some Ada
|
||||
entity, this routine returns the equivalent GCC tree for that entity
|
||||
(an ..._DECL node) and associates the ..._DECL node with the input GNAT
|
||||
defining identifier.
|
||||
|
||||
If GNAT_ENTITY is a variable or a constant declaration, GNU_EXPR gives its
|
||||
initial value (in GCC tree form). This is optional for variables.
|
||||
For renamed entities, GNU_EXPR gives the object being renamed.
|
||||
|
||||
DEFINITION is nonzero if this call is intended for a definition. This is
|
||||
used for separate compilation where it necessary to know whether an
|
||||
external declaration or a definition should be created if the GCC equivalent
|
||||
was not created previously. The value of 1 is normally used for a nonzero
|
||||
DEFINITION, but a value of 2 is used in special circumstances, defined in
|
||||
the code. */
|
||||
extern tree gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
|
||||
int definition);
|
||||
|
||||
/* Similar, but if the returned value is a COMPONENT_REF, return the
|
||||
FIELD_DECL. */
|
||||
extern tree gnat_to_gnu_field_decl (Entity_Id gnat_entity);
|
||||
|
||||
/* Wrap up compilation of T, a TYPE_DECL, possibly deferring it. */
|
||||
extern void rest_of_type_decl_compilation (tree t);
|
||||
|
||||
/* Start a new statement group chained to the previous group. */
|
||||
extern void start_stmt_group (void);
|
||||
|
||||
/* Add GNU_STMT to the current BLOCK_STMT node. */
|
||||
extern void add_stmt (tree gnu_stmt);
|
||||
|
||||
/* Similar, but set the location of GNU_STMT to that of GNAT_NODE. */
|
||||
extern void add_stmt_with_node (tree gnu_stmt, Node_Id gnat_node);
|
||||
|
||||
/* Return code corresponding to the current code group. It is normally
|
||||
a STATEMENT_LIST, but may also be a BIND_EXPR or TRY_FINALLY_EXPR if
|
||||
BLOCK or cleanups were set. */
|
||||
extern tree end_stmt_group (void);
|
||||
|
||||
/* Set the BLOCK node corresponding to the current code group to GNU_BLOCK. */
|
||||
extern void set_block_for_group (tree);
|
||||
|
||||
/* Add a declaration statement for GNU_DECL to the current BLOCK_STMT node.
|
||||
Get SLOC from GNAT_ENTITY. */
|
||||
extern void add_decl_expr (tree gnu_decl, Entity_Id gnat_entity);
|
||||
|
||||
/* Mark nodes rooted at *TP with TREE_VISITED and types as having their
|
||||
sized gimplified. We use this to indicate all variable sizes and
|
||||
positions in global types may not be shared by any subprogram. */
|
||||
extern void mark_visited (tree *);
|
||||
|
||||
/* Finalize any From_With_Type incomplete types. We do this after processing
|
||||
our compilation unit and after processing its spec, if this is a body. */
|
||||
extern void finalize_from_with_types (void);
|
||||
|
||||
/* Return the equivalent type to be used for GNAT_ENTITY, if it's a
|
||||
kind of type (such E_Task_Type) that has a different type which Gigi
|
||||
uses for its representation. If the type does not have a special type
|
||||
for its representation, return GNAT_ENTITY. If a type is supposed to
|
||||
exist, but does not, abort unless annotating types, in which case
|
||||
return Empty. If GNAT_ENTITY is Empty, return Empty. */
|
||||
extern Entity_Id Gigi_Equivalent_Type (Entity_Id);
|
||||
|
||||
/* Given GNAT_ENTITY, elaborate all expressions that are required to
|
||||
be elaborated at the point of its definition, but do nothing else. */
|
||||
extern void elaborate_entity (Entity_Id gnat_entity);
|
||||
|
||||
/* Mark GNAT_ENTITY as going out of scope at this point. Recursively mark
|
||||
any entities on its entity chain similarly. */
|
||||
extern void mark_out_of_scope (Entity_Id gnat_entity);
|
||||
|
||||
/* Make a dummy type corresponding to GNAT_TYPE. */
|
||||
extern tree make_dummy_type (Entity_Id gnat_type);
|
||||
|
||||
/* 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
|
||||
record is guaranteed to get. */
|
||||
extern tree make_aligning_type (tree type, unsigned int align, tree size,
|
||||
unsigned int base_align, int room);
|
||||
|
||||
/* Ensure that TYPE has SIZE and ALIGN. Make and return a new padded type
|
||||
if needed. We have already verified that SIZE and TYPE are large enough.
|
||||
|
||||
GNAT_ENTITY and NAME_TRAILER are used to name the resulting record and
|
||||
to issue a warning.
|
||||
|
||||
IS_USER_TYPE is true if we must be sure we complete the original type.
|
||||
|
||||
DEFINITION is true if this type is being defined.
|
||||
|
||||
SAME_RM_SIZE is true if the RM_Size of the resulting type is to be
|
||||
set to its TYPE_SIZE; otherwise, it's set to the RM_Size of the original
|
||||
type. */
|
||||
extern tree maybe_pad_type (tree type, tree size, unsigned int align,
|
||||
Entity_Id gnat_entity, const char *name_trailer,
|
||||
bool is_user_type, bool definition,
|
||||
bool same_rm_size);
|
||||
|
||||
/* Given a GNU tree and a GNAT list of choices, generate an expression to test
|
||||
the value passed against the list of choices. */
|
||||
extern tree choices_to_gnu (tree operand, Node_Id choices);
|
||||
|
||||
/* Given a type T, a FIELD_DECL F, and a replacement value R, return a new
|
||||
type with all size expressions that contain F updated by replacing F
|
||||
with R. If F is NULL_TREE, always make a new RECORD_TYPE, even if
|
||||
nothing has changed. */
|
||||
extern tree substitute_in_type (tree t, tree f, tree r);
|
||||
|
||||
/* Return the "RM size" of GNU_TYPE. This is the actual number of bits
|
||||
needed to represent the object. */
|
||||
extern tree rm_size (tree gnu_type);
|
||||
|
||||
/* Given GNU_ID, an IDENTIFIER_NODE containing a name, and SUFFIX, a
|
||||
string, return a new IDENTIFIER_NODE that is the concatenation of
|
||||
the name in GNU_ID and SUFFIX. */
|
||||
extern tree concat_id_with_name (tree gnu_id, const char *suffix);
|
||||
|
||||
/* Return the name to be used for GNAT_ENTITY. If a type, create a
|
||||
fully-qualified name, possibly with type information encoding.
|
||||
Otherwise, return the name. */
|
||||
extern tree get_entity_name (Entity_Id gnat_entity);
|
||||
|
||||
/* Return a name for GNAT_ENTITY concatenated with two underscores and
|
||||
SUFFIX. */
|
||||
extern tree create_concat_name (Entity_Id gnat_entity, const char *suffix);
|
||||
|
||||
/* 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 */
|
||||
extern const char *ref_filename;
|
||||
|
||||
/* This structure must be kept synchronized with Call_Back_End. */
|
||||
struct File_Info_Type
|
||||
{
|
||||
File_Name_Type File_Name;
|
||||
Nat Num_Source_Lines;
|
||||
};
|
||||
|
||||
/* This is the main program of the back-end. It sets up all the table
|
||||
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 String_Entry *strings_ptr,
|
||||
Char_Code *strings_chars_ptr,
|
||||
struct List_Header *list_headers_ptr,
|
||||
Nat number_file,
|
||||
struct File_Info_Type *file_info_ptr,
|
||||
Entity_Id standard_integer,
|
||||
Entity_Id standard_long_long_float,
|
||||
Entity_Id standard_exception_type,
|
||||
Int gigi_operating_mode);
|
||||
|
||||
/* GNAT_NODE is the root of some GNAT tree. Return the root of the
|
||||
GCC tree corresponding to that GNAT tree. Normally, no code is generated;
|
||||
we just return an equivalent tree which is used elsewhere to generate
|
||||
code. */
|
||||
extern tree gnat_to_gnu (Node_Id gnat_node);
|
||||
|
||||
/* GNU_STMT is a statement. We generate code for that statement. */
|
||||
extern void gnat_expand_stmt (tree gnu_stmt);
|
||||
|
||||
/* ??? missing documentation */
|
||||
extern int gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p,
|
||||
gimple_seq *post_p ATTRIBUTE_UNUSED);
|
||||
|
||||
/* Do the processing for the declaration of a GNAT_ENTITY, a type. If
|
||||
a separate Freeze node exists, delay the bulk of the processing. Otherwise
|
||||
make a GCC type for GNAT_ENTITY and set up the correspondence. */
|
||||
extern void process_type (Entity_Id gnat_entity);
|
||||
|
||||
/* Convert SLOC into LOCUS. Return true if SLOC corresponds to a source code
|
||||
location and false if it doesn't. In the former case, set the Gigi global
|
||||
variable REF_FILENAME to the simple debug file name as given by sinput. */
|
||||
extern bool Sloc_to_locus (Source_Ptr Sloc, location_t *locus);
|
||||
|
||||
/* 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. */
|
||||
extern void post_error (const char *, Node_Id);
|
||||
|
||||
/* 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, 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 n);
|
||||
|
||||
/* 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, 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);
|
||||
|
||||
/* 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;
|
||||
|
||||
/* 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"
|
||||
|
||||
/* Data structures used to represent attributes. */
|
||||
|
||||
enum attr_type
|
||||
{
|
||||
ATTR_MACHINE_ATTRIBUTE,
|
||||
ATTR_LINK_ALIAS,
|
||||
ATTR_LINK_SECTION,
|
||||
ATTR_LINK_CONSTRUCTOR,
|
||||
ATTR_LINK_DESTRUCTOR,
|
||||
ATTR_WEAK_EXTERNAL
|
||||
};
|
||||
|
||||
struct attrib
|
||||
{
|
||||
struct attrib *next;
|
||||
enum attr_type type;
|
||||
tree name;
|
||||
tree args;
|
||||
Node_Id error_point;
|
||||
};
|
||||
|
||||
/* Table of machine-independent internal attributes. */
|
||||
extern const struct attribute_spec gnat_internal_attribute_table[];
|
||||
|
||||
/* Define the entries in the standard data array. */
|
||||
enum standard_datatypes
|
||||
{
|
||||
/* Various standard data types and nodes. */
|
||||
ADT_longest_float_type,
|
||||
ADT_void_type_decl,
|
||||
|
||||
/* The type of an exception. */
|
||||
ADT_except_type,
|
||||
|
||||
/* Type declaration node <==> typedef void *T */
|
||||
ADT_ptr_void_type,
|
||||
|
||||
/* Function type declaration -- void T() */
|
||||
ADT_void_ftype,
|
||||
|
||||
/* Type declaration node <==> typedef void *T() */
|
||||
ADT_ptr_void_ftype,
|
||||
|
||||
/* Type declaration node <==> typedef virtual void *T() */
|
||||
ADT_fdesc_type,
|
||||
|
||||
/* Null pointer for above type */
|
||||
ADT_null_fdesc,
|
||||
|
||||
/* 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. */
|
||||
ADT_malloc_decl,
|
||||
ADT_malloc32_decl,
|
||||
|
||||
/* Likewise for freeing memory. */
|
||||
ADT_free_decl,
|
||||
|
||||
/* Types and decls used by our temporary exception mechanism. See
|
||||
init_gigi_decls for details. */
|
||||
ADT_jmpbuf_type,
|
||||
ADT_jmpbuf_ptr_type,
|
||||
ADT_get_jmpbuf_decl,
|
||||
ADT_set_jmpbuf_decl,
|
||||
ADT_get_excptr_decl,
|
||||
ADT_setjmp_decl,
|
||||
ADT_longjmp_decl,
|
||||
ADT_update_setjmp_buf_decl,
|
||||
ADT_raise_nodefer_decl,
|
||||
ADT_begin_handler_decl,
|
||||
ADT_end_handler_decl,
|
||||
ADT_others_decl,
|
||||
ADT_all_others_decl,
|
||||
ADT_LAST};
|
||||
|
||||
extern GTY(()) tree gnat_std_decls[(int) ADT_LAST];
|
||||
extern GTY(()) tree gnat_raise_decls[(int) LAST_REASON_CODE + 1];
|
||||
|
||||
#define longest_float_type_node gnat_std_decls[(int) ADT_longest_float_type]
|
||||
#define void_type_decl_node gnat_std_decls[(int) ADT_void_type_decl]
|
||||
#define except_type_node gnat_std_decls[(int) ADT_except_type]
|
||||
#define ptr_void_type_node gnat_std_decls[(int) ADT_ptr_void_type]
|
||||
#define void_ftype gnat_std_decls[(int) ADT_void_ftype]
|
||||
#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 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 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]
|
||||
#define set_jmpbuf_decl gnat_std_decls[(int) ADT_set_jmpbuf_decl]
|
||||
#define get_excptr_decl gnat_std_decls[(int) ADT_get_excptr_decl]
|
||||
#define setjmp_decl gnat_std_decls[(int) ADT_setjmp_decl]
|
||||
#define longjmp_decl gnat_std_decls[(int) ADT_longjmp_decl]
|
||||
#define update_setjmp_buf_decl gnat_std_decls[(int) ADT_update_setjmp_buf_decl]
|
||||
#define raise_nodefer_decl gnat_std_decls[(int) ADT_raise_nodefer_decl]
|
||||
#define begin_handler_decl gnat_std_decls[(int) ADT_begin_handler_decl]
|
||||
#define others_decl gnat_std_decls[(int) ADT_others_decl]
|
||||
#define all_others_decl gnat_std_decls[(int) ADT_all_others_decl]
|
||||
#define end_handler_decl gnat_std_decls[(int) ADT_end_handler_decl]
|
||||
|
||||
/* Routines expected by the gcc back-end. They must have exactly the same
|
||||
prototype and names as below. */
|
||||
|
||||
/* Returns nonzero if we are currently in the global binding level. */
|
||||
extern int global_bindings_p (void);
|
||||
|
||||
/* Enter and exit a new binding level. */
|
||||
extern void gnat_pushlevel (void);
|
||||
extern void gnat_poplevel (void);
|
||||
|
||||
/* Set SUPERCONTEXT of the BLOCK for the current binding level to FNDECL
|
||||
and point FNDECL to this BLOCK. */
|
||||
extern void set_current_block_context (tree fndecl);
|
||||
|
||||
/* Set the jmpbuf_decl for the current binding level to DECL. */
|
||||
extern void set_block_jmpbuf_decl (tree decl);
|
||||
|
||||
/* Get the setjmp_decl, if any, for the current binding level. */
|
||||
extern tree get_block_jmpbuf_decl (void);
|
||||
|
||||
/* Records a ..._DECL node DECL as belonging to the current lexical scope
|
||||
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 init_gigi_decls (tree long_long_float_type, tree exception_type);
|
||||
extern void gnat_init_gcc_eh (void);
|
||||
|
||||
/* Return an integer type with the number of bits of precision given by
|
||||
PRECISION. UNSIGNEDP is nonzero if the type is unsigned; otherwise
|
||||
it is a signed type. */
|
||||
extern tree gnat_type_for_size (unsigned precision, int unsignedp);
|
||||
|
||||
/* Return a data type that has machine mode MODE. UNSIGNEDP selects
|
||||
an unsigned type; otherwise a signed type is returned. */
|
||||
extern tree gnat_type_for_mode (enum machine_mode mode, int unsignedp);
|
||||
|
||||
/* Emit debug info for all global variable declarations. */
|
||||
extern void gnat_write_global_declarations (void);
|
||||
|
||||
/* Return the unsigned version of a TYPE_NODE, a scalar type. */
|
||||
extern tree gnat_unsigned_type (tree type_node);
|
||||
|
||||
/* Return the signed version of a TYPE_NODE, a scalar type. */
|
||||
extern tree gnat_signed_type (tree type_node);
|
||||
|
||||
/* Return 1 if the types T1 and T2 are compatible, i.e. if they can be
|
||||
transparently converted to each other. */
|
||||
extern int gnat_types_compatible_p (tree t1, tree t2);
|
||||
|
||||
/* Create an expression whose value is that of EXPR,
|
||||
converted to type TYPE. The TREE_TYPE of the value
|
||||
is always TYPE. This function implements all reasonable
|
||||
conversions; callers should filter out those that are
|
||||
not permitted by the language being compiled. */
|
||||
extern tree convert (tree type, tree expr);
|
||||
|
||||
/* Routines created solely for the tree translator's sake. Their prototypes
|
||||
can be changed as desired. */
|
||||
|
||||
/* GNAT_ENTITY is a GNAT tree node for a defining identifier.
|
||||
GNU_DECL is the GCC tree which is to be associated with
|
||||
GNAT_ENTITY. Such gnu tree node is always an ..._DECL node.
|
||||
If NO_CHECK is nonzero, the latter check is suppressed.
|
||||
If GNU_DECL is zero, a previous association is to be reset. */
|
||||
extern void save_gnu_tree (Entity_Id gnat_entity, tree gnu_decl,
|
||||
bool no_check);
|
||||
|
||||
/* GNAT_ENTITY is a GNAT tree node for a defining identifier.
|
||||
Return the ..._DECL node that was associated with it. If there is no tree
|
||||
node associated with GNAT_ENTITY, abort. */
|
||||
extern tree get_gnu_tree (Entity_Id gnat_entity);
|
||||
|
||||
/* Return nonzero if a GCC tree has been associated with GNAT_ENTITY. */
|
||||
extern bool present_gnu_tree (Entity_Id gnat_entity);
|
||||
|
||||
/* Initialize tables for above routines. */
|
||||
extern void init_gnat_to_gnu (void);
|
||||
|
||||
/* Given a record type RECORD_TYPE and a chain of FIELD_DECL nodes FIELDLIST,
|
||||
finish constructing the record or union type. If REP_LEVEL is zero, this
|
||||
record has no representation clause and so will be entirely laid out here.
|
||||
If REP_LEVEL is one, this record has a representation clause and has been
|
||||
laid out already; only set the sizes and alignment. If REP_LEVEL is two,
|
||||
this record is derived from a parent record and thus inherits its layout;
|
||||
only make a pass on the fields to finalize them. If DO_NOT_FINALIZE is
|
||||
true, the record type is expected to be modified afterwards so it will
|
||||
not be sent to the back-end for finalization. */
|
||||
extern void finish_record_type (tree record_type, tree fieldlist,
|
||||
int rep_level, bool do_not_finalize);
|
||||
|
||||
/* Wrap up compilation of RECORD_TYPE, i.e. most notably output all
|
||||
the debug information associated with it. It need not be invoked
|
||||
directly in most cases since finish_record_type takes care of doing
|
||||
so, unless explicitly requested not to through DO_NOT_FINALIZE. */
|
||||
extern void rest_of_record_type_compilation (tree record_type);
|
||||
|
||||
/* Append PARALLEL_TYPE on the chain of parallel types for decl. */
|
||||
extern void add_parallel_type (tree decl, tree parallel_type);
|
||||
|
||||
/* Return the parallel type associated to a type, if any. */
|
||||
extern tree get_parallel_type (tree type);
|
||||
|
||||
/* Returns a FUNCTION_TYPE node. RETURN_TYPE is the type returned by the
|
||||
subprogram. If it is void_type_node, then we are dealing with a procedure,
|
||||
otherwise we are dealing with a function. PARAM_DECL_LIST is a list of
|
||||
PARM_DECL nodes that are the subprogram arguments. CICO_LIST is the
|
||||
copy-in/copy-out list to be stored into TYPE_CI_CO_LIST.
|
||||
RETURNS_UNCONSTRAINED is true if the function returns an unconstrained
|
||||
object. RETURNS_BY_REF is true if the function returns by reference.
|
||||
RETURNS_BY_TARGET_PTR is true if the function is to be passed (as its
|
||||
first parameter) the address of the place to copy its result. */
|
||||
extern tree create_subprog_type (tree return_type, tree param_decl_list,
|
||||
tree cico_list, bool returns_unconstrained,
|
||||
bool returns_by_ref,
|
||||
bool returns_by_target_ptr);
|
||||
|
||||
/* Return a copy of TYPE, but safe to modify in any way. */
|
||||
extern tree copy_type (tree type);
|
||||
|
||||
/* Return an INTEGER_TYPE of SIZETYPE with range MIN to MAX and whose
|
||||
TYPE_INDEX_TYPE is INDEX. GNAT_NODE is used for the position of
|
||||
the decl. */
|
||||
extern tree create_index_type (tree min, tree max, tree index,
|
||||
Node_Id gnat_node);
|
||||
|
||||
/* Return a TYPE_DECL node. TYPE_NAME gives the name of the type (a character
|
||||
string) and TYPE is a ..._TYPE node giving its data type.
|
||||
ARTIFICIAL_P is true if this is a declaration that was generated
|
||||
by the compiler. DEBUG_INFO_P is true if we need to write debugging
|
||||
information about this type. GNAT_NODE is used for the position of
|
||||
the decl. */
|
||||
extern tree create_type_decl (tree type_name, tree type,
|
||||
struct attrib *attr_list,
|
||||
bool artificial_p, bool debug_info_p,
|
||||
Node_Id gnat_node);
|
||||
|
||||
/* Return a VAR_DECL or CONST_DECL node.
|
||||
|
||||
VAR_NAME gives the name of the variable. ASM_NAME is its assembler name
|
||||
(if provided). TYPE is its data type (a GCC ..._TYPE node). VAR_INIT is
|
||||
the GCC tree for an optional initial expression; NULL_TREE if none.
|
||||
|
||||
CONST_FLAG is true if this variable is constant, in which case we might
|
||||
return a CONST_DECL node unless CONST_DECL_ALLOWED_P is false.
|
||||
|
||||
PUBLIC_FLAG is true if this definition is to be made visible outside of
|
||||
the current compilation unit. This flag should be set when processing the
|
||||
variable definitions in a package specification.
|
||||
|
||||
EXTERN_FLAG is nonzero when processing an external variable declaration (as
|
||||
opposed to a definition: no storage is to be allocated for the variable).
|
||||
|
||||
STATIC_FLAG is only relevant when not at top level. In that case
|
||||
it indicates whether to always allocate storage to the variable.
|
||||
|
||||
GNAT_NODE is used for the position of the decl. */
|
||||
tree
|
||||
create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
|
||||
bool const_flag, bool public_flag, bool extern_flag,
|
||||
bool static_flag, bool const_decl_allowed_p,
|
||||
struct attrib *attr_list, Node_Id gnat_node);
|
||||
|
||||
/* Wrapper around create_var_decl_1 for cases where we don't care whether
|
||||
a VAR or a CONST decl node is created. */
|
||||
#define create_var_decl(var_name, asm_name, type, var_init, \
|
||||
const_flag, public_flag, extern_flag, \
|
||||
static_flag, attr_list, gnat_node) \
|
||||
create_var_decl_1 (var_name, asm_name, type, var_init, \
|
||||
const_flag, public_flag, extern_flag, \
|
||||
static_flag, true, attr_list, gnat_node)
|
||||
|
||||
/* Wrapper around create_var_decl_1 for cases where a VAR_DECL node is
|
||||
required. The primary intent is for DECL_CONST_CORRESPONDING_VARs, which
|
||||
must be VAR_DECLs and on which we want TREE_READONLY set to have them
|
||||
possibly assigned to a readonly data section. */
|
||||
#define create_true_var_decl(var_name, asm_name, type, var_init, \
|
||||
const_flag, public_flag, extern_flag, \
|
||||
static_flag, attr_list, gnat_node) \
|
||||
create_var_decl_1 (var_name, asm_name, type, var_init, \
|
||||
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 a global renaming pointer. */
|
||||
void record_global_renaming_pointer (tree);
|
||||
|
||||
/* Invalidate the global renaming pointers. */
|
||||
void invalidate_global_renaming_pointers (void);
|
||||
|
||||
/* Returns a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its
|
||||
type, and RECORD_TYPE is the type of the parent. PACKED is nonzero if
|
||||
this field is in a record type with a "pragma pack". If SIZE is nonzero
|
||||
it is the specified size for this field. If POS is nonzero, it is the bit
|
||||
position. If ADDRESSABLE is nonzero, it means we are allowed to take
|
||||
the address of this field for aliasing purposes. */
|
||||
extern tree create_field_decl (tree field_name, tree field_type,
|
||||
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
|
||||
readonly (either an In parameter or an address of a pass-by-ref
|
||||
parameter). */
|
||||
extern tree create_param_decl (tree param_name, tree param_type,
|
||||
bool readonly);
|
||||
|
||||
/* Returns a FUNCTION_DECL node. SUBPROG_NAME is the name of the subprogram,
|
||||
ASM_NAME is its assembler name, SUBPROG_TYPE is its type (a FUNCTION_TYPE
|
||||
node), PARAM_DECL_LIST is the list of the subprogram arguments (a list of
|
||||
PARM_DECL nodes chained through the TREE_CHAIN field).
|
||||
|
||||
INLINE_FLAG, PUBLIC_FLAG, EXTERN_FLAG, and ATTR_LIST are used to set the
|
||||
appropriate fields in the FUNCTION_DECL. GNAT_NODE gives the location. */
|
||||
extern tree create_subprog_decl (tree subprog_name, tree asm_name,
|
||||
tree subprog_type, tree param_decl_list,
|
||||
bool inlinee_flag, bool public_flag,
|
||||
bool extern_flag,
|
||||
struct attrib *attr_list, Node_Id gnat_node);
|
||||
|
||||
/* Returns a LABEL_DECL node for LABEL_NAME. */
|
||||
extern tree create_label_decl (tree label_name);
|
||||
|
||||
/* Set up the framework for generating code for SUBPROG_DECL, a subprogram
|
||||
body. This routine needs to be invoked before processing the declarations
|
||||
appearing in the subprogram. */
|
||||
extern void begin_subprog_body (tree subprog_decl);
|
||||
|
||||
/* Finish the definition of the current subprogram BODY and compile it all the
|
||||
way to assembler language output. ELAB_P tells if this is called for an
|
||||
elaboration routine, to be entirely discarded if empty. */
|
||||
extern void end_subprog_body (tree body, bool elab_p);
|
||||
|
||||
/* Build a template of type TEMPLATE_TYPE from the array bounds of ARRAY_TYPE.
|
||||
EXPR is an expression that we can use to locate any PLACEHOLDER_EXPRs.
|
||||
Return a constructor for the template. */
|
||||
extern tree build_template (tree template_type, tree array_type, tree expr);
|
||||
|
||||
/* Build a VMS descriptor from a Mechanism_Type, which must specify
|
||||
a descriptor type, and the GCC type of an object. Each FIELD_DECL
|
||||
in the type contains in its DECL_INITIAL the expression to use when
|
||||
a constructor is made for the type. GNAT_ENTITY is a gnat node used
|
||||
to print out an error message if the mechanism cannot be applied to
|
||||
an object of that type and also for the name. */
|
||||
extern tree build_vms_descriptor (tree type, Mechanism_Type mech,
|
||||
Entity_Id gnat_entity);
|
||||
|
||||
/* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG
|
||||
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 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);
|
||||
|
||||
/* 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);
|
||||
|
||||
/* Shift the component offsets within an unconstrained object TYPE to make it
|
||||
suitable for use as a designated type for thin pointers. */
|
||||
extern void shift_unc_components_for_thin_pointers (tree type);
|
||||
|
||||
/* Update anything previously pointing to OLD_TYPE to point to NEW_TYPE. In
|
||||
the normal case this is just two adjustments, but we have more to do
|
||||
if NEW is an UNCONSTRAINED_ARRAY_TYPE. */
|
||||
extern void update_pointer_to (tree old_type, tree new_type);
|
||||
|
||||
/* EXP is an expression for the size of an object. If this size contains
|
||||
discriminant references, replace them with the maximum (if MAX_P) or
|
||||
minimum (if !MAX_P) possible value of the discriminant. */
|
||||
extern tree max_size (tree exp, bool max_p);
|
||||
|
||||
/* Remove all conversions that are done in EXP. This includes converting
|
||||
from a padded type or to a left-justified modular type. If TRUE_ADDRESS
|
||||
is true, always return the address of the containing object even if
|
||||
the address is not bit-aligned. */
|
||||
extern tree remove_conversions (tree exp, bool true_address);
|
||||
|
||||
/* If EXP's type is an UNCONSTRAINED_ARRAY_TYPE, return an expression that
|
||||
refers to the underlying array. If its type has TYPE_CONTAINS_TEMPLATE_P,
|
||||
likewise return an expression pointing to the underlying array. */
|
||||
extern tree maybe_unconstrained_array (tree exp);
|
||||
|
||||
/* Return an expression that does an unchecked conversion of EXPR to TYPE.
|
||||
If NOTRUNC_P is true, truncation operations should be suppressed. */
|
||||
extern tree unchecked_convert (tree type, tree expr, bool notrunc_p);
|
||||
|
||||
/* Return the appropriate GCC tree code for the specified GNAT type,
|
||||
the latter being a record type as predicated by Is_Record_Type. */
|
||||
extern enum tree_code tree_code_for_record_type (Entity_Id);
|
||||
|
||||
/* Return true if GNU_TYPE is suitable as the type of a non-aliased
|
||||
component of an aggregate type. */
|
||||
extern bool type_for_nonaliased_component_p (tree);
|
||||
|
||||
/* Prepare expr to be an argument of a TRUTH_NOT_EXPR or other logical
|
||||
operation.
|
||||
|
||||
This preparation consists of taking the ordinary
|
||||
representation of an expression EXPR and producing a valid tree
|
||||
boolean expression describing whether EXPR is nonzero. We could
|
||||
simply always do build_binary_op (NE_EXPR, expr, integer_zero_node, 1),
|
||||
but we optimize comparisons, &&, ||, and !.
|
||||
|
||||
The resulting type should always be the same as the input type.
|
||||
This function is simpler than the corresponding C version since
|
||||
the only possible operands will be things of Boolean type. */
|
||||
extern tree gnat_truthvalue_conversion (tree expr);
|
||||
|
||||
/* Return the base type of TYPE. */
|
||||
extern tree get_base_type (tree type);
|
||||
|
||||
/* EXP is a GCC tree representing an address. See if we can find how
|
||||
strictly the object at that address is aligned. Return that alignment
|
||||
strictly the object at that address is aligned. Return that alignment
|
||||
in bits. If we don't know anything about the alignment, return 0. */
|
||||
extern unsigned int known_alignment (tree exp);
|
||||
|
||||
/* Return true if VALUE is a multiple of FACTOR. FACTOR must be a power
|
||||
of 2. */
|
||||
extern bool value_factor_p (tree value, HOST_WIDE_INT factor);
|
||||
|
||||
/* Make a binary operation of kind OP_CODE. RESULT_TYPE is the type
|
||||
desired for the result. Usually the operation is to be performed
|
||||
in that type. For MODIFY_EXPR and ARRAY_REF, RESULT_TYPE may be 0
|
||||
in which case the type to be used will be derived from the operands. */
|
||||
extern tree build_binary_op (enum tree_code op_code, tree retult_type,
|
||||
tree left_operand, tree right_operand);
|
||||
|
||||
/* Similar, but make unary operation. */
|
||||
extern tree build_unary_op (enum tree_code op_code, tree result_type,
|
||||
tree operand);
|
||||
|
||||
/* Similar, but for COND_EXPR. */
|
||||
extern tree build_cond_expr (tree result_type, tree condition_operand,
|
||||
tree true_operand, tree false_operand);
|
||||
|
||||
/* Similar, but for RETURN_EXPR. */
|
||||
extern tree build_return_expr (tree result_decl, tree ret_val);
|
||||
|
||||
/* Build a CALL_EXPR to call FUNDECL with one argument, ARG. Return
|
||||
the CALL_EXPR. */
|
||||
extern tree build_call_1_expr (tree fundecl, tree arg);
|
||||
|
||||
/* Build a CALL_EXPR to call FUNDECL with two argument, ARG1 & ARG2. Return
|
||||
the CALL_EXPR. */
|
||||
extern tree build_call_2_expr (tree fundecl, tree arg1, tree arg2);
|
||||
|
||||
/* Likewise to call FUNDECL with no arguments. */
|
||||
extern tree build_call_0_expr (tree fundecl);
|
||||
|
||||
/* Call a function that raises an exception and pass the line number and file
|
||||
name, if requested. MSG says which exception function to call.
|
||||
|
||||
GNAT_NODE is the gnat node conveying the source location for which the
|
||||
error should be signaled, or Empty in which case the error is signaled on
|
||||
the current ref_file_name/input_line.
|
||||
|
||||
KIND says which kind of exception this is for
|
||||
(N_Raise_{Constraint,Storage,Program}_Error). */
|
||||
extern tree build_call_raise (int msg, Node_Id gnat_node, char kind);
|
||||
|
||||
/* Return a CONSTRUCTOR of TYPE whose list is LIST. This is not the
|
||||
same as build_constructor in the language-independent tree.c. */
|
||||
extern tree gnat_build_constructor (tree type, tree list);
|
||||
|
||||
/* Return a COMPONENT_REF to access a field that is given by COMPONENT,
|
||||
an IDENTIFIER_NODE giving the name of the field, FIELD, a FIELD_DECL,
|
||||
for the field, or both. Don't fold the result if NO_FOLD_P. */
|
||||
extern tree build_component_ref (tree record_variable, tree component,
|
||||
tree field, bool no_fold_p);
|
||||
|
||||
/* Build a GCC tree to call an allocation or deallocation function.
|
||||
If GNU_OBJ is nonzero, it is an object to deallocate. Otherwise,
|
||||
generate an allocator.
|
||||
|
||||
GNU_SIZE is the size of the object and ALIGN is the alignment.
|
||||
GNAT_PROC, if present is a procedure to call and GNAT_POOL is the
|
||||
storage pool to use. If not preset, malloc and free will be used. */
|
||||
extern tree build_call_alloc_dealloc (tree gnu_obj, tree gnu_size,
|
||||
unsigned align, Entity_Id gnat_proc,
|
||||
Entity_Id gnat_pool, Node_Id gnat_node);
|
||||
|
||||
/* Build a GCC tree to correspond to allocating an object of TYPE whose
|
||||
initial value if INIT, if INIT is nonzero. Convert the expression to
|
||||
RESULT_TYPE, which must be some type of pointer. Return the tree.
|
||||
GNAT_PROC and GNAT_POOL optionally give the procedure to call and
|
||||
the storage pool to use. GNAT_NODE is used to provide an error
|
||||
location for restriction violations messages. If IGNORE_INIT_TYPE is
|
||||
true, ignore the type of INIT for the purpose of determining the size;
|
||||
this will cause the maximum size to be allocated if TYPE is of
|
||||
self-referential size. */
|
||||
extern tree build_allocator (tree type, tree init, tree result_type,
|
||||
Entity_Id gnat_proc, Entity_Id gnat_pool,
|
||||
Node_Id gnat_node, bool);
|
||||
|
||||
/* Fill in a VMS descriptor for EXPR and return a constructor for it.
|
||||
GNAT_FORMAL is how we find the descriptor record. */
|
||||
|
||||
extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal);
|
||||
|
||||
/* Indicate that we need to make the address of EXPR_NODE and it therefore
|
||||
should not be allocated in a register. Return true if successful. */
|
||||
extern bool gnat_mark_addressable (tree expr_node);
|
||||
|
||||
/* Implementation of the builtin_function langhook. */
|
||||
extern tree gnat_builtin_function (tree decl);
|
||||
|
||||
/* Search the chain of currently reachable declarations for a builtin
|
||||
FUNCTION_DECL node corresponding to function NAME (an IDENTIFIER_NODE).
|
||||
Return the first node found, if any, or NULL_TREE otherwise. */
|
||||
extern tree builtin_decl_for (tree name);
|
||||
|
||||
/* This function is called by the front end to enumerate all the supported
|
||||
modes for the machine. We pass a function which is called back with
|
||||
the following integer parameters:
|
||||
|
||||
FLOAT_P nonzero if this represents a floating-point mode
|
||||
COMPLEX_P nonzero is this represents a complex mode
|
||||
COUNT count of number of items, nonzero for vector mode
|
||||
PRECISION number of bits in data representation
|
||||
MANTISSA number of bits in mantissa, if FP and known, else zero.
|
||||
SIZE number of bits used to store data
|
||||
ALIGN number of bits to which mode is aligned. */
|
||||
extern void enumerate_modes (void (*f) (int, int, int, int, int, int,
|
||||
unsigned int));
|
||||
|
||||
/* These are temporary function to deal with recent GCC changes related to
|
||||
FP type sizes and precisions. */
|
||||
extern int fp_prec_to_size (int prec);
|
||||
extern int fp_size_to_prec (int size);
|
||||
|
||||
/* These functions return the basic data type sizes and related parameters
|
||||
about the target machine. */
|
||||
|
||||
extern Pos get_target_bits_per_unit (void);
|
||||
extern Pos get_target_bits_per_word (void);
|
||||
extern Pos get_target_char_size (void);
|
||||
extern Pos get_target_wchar_t_size (void);
|
||||
extern Pos get_target_short_size (void);
|
||||
extern Pos get_target_int_size (void);
|
||||
extern Pos get_target_long_size (void);
|
||||
extern Pos get_target_long_long_size (void);
|
||||
extern Pos get_target_float_size (void);
|
||||
extern Pos get_target_double_size (void);
|
||||
extern Pos get_target_long_double_size (void);
|
||||
extern Pos get_target_pointer_size (void);
|
||||
extern Pos get_target_maximum_alignment (void);
|
||||
extern Pos get_target_default_allocator_alignment (void);
|
||||
extern Pos get_target_maximum_default_alignment (void);
|
||||
extern Pos get_target_maximum_allowed_alignment (void);
|
||||
extern Nat get_float_words_be (void);
|
||||
extern Nat get_words_be (void);
|
||||
extern Nat get_bytes_be (void);
|
||||
extern Nat get_bits_be (void);
|
||||
extern Nat get_strict_alignment (void);
|
||||
@ -1,48 +0,0 @@
|
||||
/****************************************************************************
|
||||
* *
|
||||
* GNAT COMPILER COMPONENTS *
|
||||
* *
|
||||
* L A N G - S P E C S *
|
||||
* *
|
||||
* C Header File *
|
||||
* *
|
||||
* Copyright (C) 1992-2008, Free Software Foundation, Inc. *
|
||||
* *
|
||||
* GNAT is free software; you can redistribute it and/or modify it under *
|
||||
* terms of the GNU General Public License as published by the Free Soft- *
|
||||
* ware Foundation; either version 3, or (at your option) any later ver- *
|
||||
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
|
||||
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
|
||||
* for more details. You should have received a copy of the GNU General *
|
||||
* Public License along with GCC; see the file COPYING3. If not see *
|
||||
* <http://www.gnu.org/licenses/>. *
|
||||
* *
|
||||
* GNAT was originally developed by the GNAT team at New York University. *
|
||||
* Extensive contributions were provided by Ada Core Technologies Inc. *
|
||||
* *
|
||||
****************************************************************************/
|
||||
|
||||
/* This is the contribution to the `default_compilers' array in gcc.c for
|
||||
GNAT. */
|
||||
|
||||
{".ads", "@ada", 0, 0, 0},
|
||||
{".adb", "@ada", 0, 0, 0},
|
||||
{"@ada",
|
||||
"\
|
||||
%{pg:%{fomit-frame-pointer:%e-pg and -fomit-frame-pointer are incompatible}}\
|
||||
%{!S:%{!c:%e-c or -S required for Ada}}\
|
||||
gnat1 %{I*} %{k8:-gnatk8} %{Wall:-gnatwa} %{w:-gnatws} %{!Q:-quiet}\
|
||||
%{nostdinc*} %{nostdlib*}\
|
||||
-dumpbase %{.adb:%b.adb}%{.ads:%b.ads}%{!.adb:%{!.ads:%b.ada}}\
|
||||
%{O*} %{W*} %{w} %{p} %{pg:-p} %{a} %{f*} %{d*} %{g*&m*} "
|
||||
#if defined(TARGET_VXWORKS_RTP)
|
||||
"%{fRTS=rtp:-mrtp} "
|
||||
#endif
|
||||
#if CONFIG_DUAL_EXCEPTIONS
|
||||
"%{fRTS=sjlj:-fsjlj} "
|
||||
#endif
|
||||
"%1 %{!S:%{o*:%w%*-gnatO}} \
|
||||
%i %{S:%W{o*}%{!o*:-o %b.s}} \
|
||||
%{gnatc*|gnats*: -o %j} %{-param*} \
|
||||
%{!gnatc*:%{!gnats*:%(invoke_as)}}", 0, 0, 0},
|
||||
102
gcc/ada/lang.opt
102
gcc/ada/lang.opt
@ -1,102 +0,0 @@
|
||||
; Options for the Ada front end.
|
||||
; Copyright (C) 2003, 2007 Free Software Foundation, Inc.
|
||||
;
|
||||
; This file is part of GCC.
|
||||
;
|
||||
; GCC is free software; you can redistribute it and/or modify it under
|
||||
; the terms of the GNU General Public License as published by the Free
|
||||
; Software Foundation; either version 3, or (at your option) any later
|
||||
; version.
|
||||
;
|
||||
; GCC is distributed in the hope that it will be useful, but WITHOUT ANY
|
||||
; WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
||||
; for more details.
|
||||
;
|
||||
; You should have received a copy of the GNU General Public License
|
||||
; along with GCC; see the file COPYING3. If not see
|
||||
; <http://www.gnu.org/licenses/>.
|
||||
|
||||
|
||||
; See the GCC internals manual for a description of this file's format.
|
||||
|
||||
; Please try to keep this file in ASCII collating order.
|
||||
|
||||
Language
|
||||
Ada
|
||||
|
||||
I
|
||||
Ada Joined Separate
|
||||
; Documented for C
|
||||
|
||||
Wall
|
||||
Ada
|
||||
; Documented for C
|
||||
|
||||
Wmissing-prototypes
|
||||
Ada
|
||||
; Documented for C
|
||||
|
||||
Wstrict-prototypes
|
||||
Ada
|
||||
; Documented for C
|
||||
|
||||
Wwrite-strings
|
||||
Ada
|
||||
; Documented for C
|
||||
|
||||
Wlong-long
|
||||
Ada
|
||||
; Documented for C
|
||||
|
||||
Wvariadic-macros
|
||||
Ada
|
||||
; Documented for C
|
||||
|
||||
Wold-style-definition
|
||||
Ada
|
||||
; Documented for C
|
||||
|
||||
Wmissing-format-attribute
|
||||
Ada
|
||||
; Documented for C
|
||||
|
||||
Woverlength-strings
|
||||
Ada
|
||||
; Documented for C
|
||||
|
||||
nostdinc
|
||||
Ada RejectNegative
|
||||
; Don't look for source files
|
||||
|
||||
nostdlib
|
||||
Ada
|
||||
; Don't look for object files
|
||||
|
||||
feliminate-unused-debug-types
|
||||
Ada
|
||||
; Effect documented for C - intercepted for Ada to force the associated flag
|
||||
; not to be set by default, as it currently eliminates unreferenced parallel
|
||||
; types we need for encoding descriptions to the debugger.
|
||||
|
||||
fRTS=
|
||||
Ada Joined RejectNegative
|
||||
; Selects the runtime
|
||||
|
||||
gdwarf+
|
||||
Ada
|
||||
; Explicit request for dwarf debug info with GNAT specific extensions.
|
||||
|
||||
gant
|
||||
Ada Joined Undocumented
|
||||
; Catches typos
|
||||
|
||||
gnatO
|
||||
Ada Separate
|
||||
; Sets name of output ALI file (internal switch)
|
||||
|
||||
gnat
|
||||
Ada Joined
|
||||
-gnat<options> Specify options to GNAT
|
||||
|
||||
; This comment is to ensure we retain the blank line above.
|
||||
876
gcc/ada/misc.c
876
gcc/ada/misc.c
@ -1,876 +0,0 @@
|
||||
/****************************************************************************
|
||||
* *
|
||||
* GNAT COMPILER COMPONENTS *
|
||||
* *
|
||||
* M I S C *
|
||||
* *
|
||||
* C Implementation File *
|
||||
* *
|
||||
* Copyright (C) 1992-2008, Free Software Foundation, Inc. *
|
||||
* *
|
||||
* GNAT is free software; you can redistribute it and/or modify it under *
|
||||
* terms of the GNU General Public License as published by the Free Soft- *
|
||||
* ware Foundation; either version 2, or (at your option) any later ver- *
|
||||
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
|
||||
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
|
||||
* for more details. You should have received a copy of the GNU General *
|
||||
* Public License distributed with GNAT; see file COPYING. If not, write *
|
||||
* to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
|
||||
* Boston, MA 02110-1301, USA. *
|
||||
* *
|
||||
* As a special exception, if you link this file with other files to *
|
||||
* produce an executable, this file does not by itself cause the resulting *
|
||||
* executable to be covered by the GNU General Public License. This except- *
|
||||
* ion does not however invalidate any other reasons why the executable *
|
||||
* file might be covered by the GNU Public License. *
|
||||
* *
|
||||
* GNAT was originally developed by the GNAT team at New York University. *
|
||||
* Extensive contributions were provided by Ada Core Technologies Inc. *
|
||||
* *
|
||||
****************************************************************************/
|
||||
|
||||
/* This file contains parts of the compiler that are required for interfacing
|
||||
with GCC but otherwise do nothing and parts of Gigi that need to know
|
||||
about RTL. */
|
||||
|
||||
#include "config.h"
|
||||
#include "system.h"
|
||||
#include "coretypes.h"
|
||||
#include "tm.h"
|
||||
#include "tree.h"
|
||||
#include "real.h"
|
||||
#include "rtl.h"
|
||||
#include "diagnostic.h"
|
||||
#include "expr.h"
|
||||
#include "libfuncs.h"
|
||||
#include "ggc.h"
|
||||
#include "flags.h"
|
||||
#include "debug.h"
|
||||
#include "cgraph.h"
|
||||
#include "tree-inline.h"
|
||||
#include "insn-codes.h"
|
||||
#include "insn-flags.h"
|
||||
#include "insn-config.h"
|
||||
#include "optabs.h"
|
||||
#include "recog.h"
|
||||
#include "toplev.h"
|
||||
#include "output.h"
|
||||
#include "except.h"
|
||||
#include "tm_p.h"
|
||||
#include "langhooks.h"
|
||||
#include "langhooks-def.h"
|
||||
#include "target.h"
|
||||
|
||||
#include "ada.h"
|
||||
#include "types.h"
|
||||
#include "atree.h"
|
||||
#include "elists.h"
|
||||
#include "namet.h"
|
||||
#include "nlists.h"
|
||||
#include "stringt.h"
|
||||
#include "uintp.h"
|
||||
#include "fe.h"
|
||||
#include "sinfo.h"
|
||||
#include "einfo.h"
|
||||
#include "ada-tree.h"
|
||||
#include "gigi.h"
|
||||
#include "adadecode.h"
|
||||
#include "opts.h"
|
||||
#include "options.h"
|
||||
|
||||
extern FILE *asm_out_file;
|
||||
|
||||
/* The largest alignment, in bits, that is needed for using the widest
|
||||
move instruction. */
|
||||
unsigned int largest_move_alignment;
|
||||
|
||||
static bool gnat_init (void);
|
||||
static void gnat_finish_incomplete_decl (tree);
|
||||
static unsigned int gnat_init_options (unsigned int, const char **);
|
||||
static int gnat_handle_option (size_t, const char *, int);
|
||||
static bool gnat_post_options (const char **);
|
||||
static alias_set_type gnat_get_alias_set (tree);
|
||||
static void gnat_print_decl (FILE *, tree, int);
|
||||
static void gnat_print_type (FILE *, tree, int);
|
||||
static const char *gnat_printable_name (tree, int);
|
||||
static const char *gnat_dwarf_name (tree, int);
|
||||
static tree gnat_return_tree (tree);
|
||||
static int gnat_eh_type_covers (tree, tree);
|
||||
static void gnat_parse_file (int);
|
||||
static rtx gnat_expand_expr (tree, rtx, enum machine_mode, int,
|
||||
rtx *);
|
||||
static void internal_error_function (const char *, va_list *);
|
||||
static tree gnat_type_max_size (const_tree);
|
||||
|
||||
/* Definitions for our language-specific hooks. */
|
||||
|
||||
#undef LANG_HOOKS_NAME
|
||||
#define LANG_HOOKS_NAME "GNU Ada"
|
||||
#undef LANG_HOOKS_IDENTIFIER_SIZE
|
||||
#define LANG_HOOKS_IDENTIFIER_SIZE sizeof (struct tree_identifier)
|
||||
#undef LANG_HOOKS_INIT
|
||||
#define LANG_HOOKS_INIT gnat_init
|
||||
#undef LANG_HOOKS_INIT_OPTIONS
|
||||
#define LANG_HOOKS_INIT_OPTIONS gnat_init_options
|
||||
#undef LANG_HOOKS_HANDLE_OPTION
|
||||
#define LANG_HOOKS_HANDLE_OPTION gnat_handle_option
|
||||
#undef LANG_HOOKS_POST_OPTIONS
|
||||
#define LANG_HOOKS_POST_OPTIONS gnat_post_options
|
||||
#undef LANG_HOOKS_PARSE_FILE
|
||||
#define LANG_HOOKS_PARSE_FILE gnat_parse_file
|
||||
#undef LANG_HOOKS_HASH_TYPES
|
||||
#define LANG_HOOKS_HASH_TYPES false
|
||||
#undef LANG_HOOKS_GETDECLS
|
||||
#define LANG_HOOKS_GETDECLS lhd_return_null_tree_v
|
||||
#undef LANG_HOOKS_PUSHDECL
|
||||
#define LANG_HOOKS_PUSHDECL gnat_return_tree
|
||||
#undef LANG_HOOKS_WRITE_GLOBALS
|
||||
#define LANG_HOOKS_WRITE_GLOBALS gnat_write_global_declarations
|
||||
#undef LANG_HOOKS_FINISH_INCOMPLETE_DECL
|
||||
#define LANG_HOOKS_FINISH_INCOMPLETE_DECL gnat_finish_incomplete_decl
|
||||
#undef LANG_HOOKS_GET_ALIAS_SET
|
||||
#define LANG_HOOKS_GET_ALIAS_SET gnat_get_alias_set
|
||||
#undef LANG_HOOKS_EXPAND_EXPR
|
||||
#define LANG_HOOKS_EXPAND_EXPR gnat_expand_expr
|
||||
#undef LANG_HOOKS_MARK_ADDRESSABLE
|
||||
#define LANG_HOOKS_MARK_ADDRESSABLE gnat_mark_addressable
|
||||
#undef LANG_HOOKS_PRINT_DECL
|
||||
#define LANG_HOOKS_PRINT_DECL gnat_print_decl
|
||||
#undef LANG_HOOKS_PRINT_TYPE
|
||||
#define LANG_HOOKS_PRINT_TYPE gnat_print_type
|
||||
#undef LANG_HOOKS_TYPE_MAX_SIZE
|
||||
#define LANG_HOOKS_TYPE_MAX_SIZE gnat_type_max_size
|
||||
#undef LANG_HOOKS_DECL_PRINTABLE_NAME
|
||||
#define LANG_HOOKS_DECL_PRINTABLE_NAME gnat_printable_name
|
||||
#undef LANG_HOOKS_DWARF_NAME
|
||||
#define LANG_HOOKS_DWARF_NAME gnat_dwarf_name
|
||||
#undef LANG_HOOKS_GIMPLIFY_EXPR
|
||||
#define LANG_HOOKS_GIMPLIFY_EXPR gnat_gimplify_expr
|
||||
#undef LANG_HOOKS_TYPE_FOR_MODE
|
||||
#define LANG_HOOKS_TYPE_FOR_MODE gnat_type_for_mode
|
||||
#undef LANG_HOOKS_TYPE_FOR_SIZE
|
||||
#define LANG_HOOKS_TYPE_FOR_SIZE gnat_type_for_size
|
||||
#undef LANG_HOOKS_TYPES_COMPATIBLE_P
|
||||
#define LANG_HOOKS_TYPES_COMPATIBLE_P gnat_types_compatible_p
|
||||
#undef LANG_HOOKS_ATTRIBUTE_TABLE
|
||||
#define LANG_HOOKS_ATTRIBUTE_TABLE gnat_internal_attribute_table
|
||||
#undef LANG_HOOKS_BUILTIN_FUNCTION
|
||||
#define LANG_HOOKS_BUILTIN_FUNCTION gnat_builtin_function
|
||||
|
||||
const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
|
||||
|
||||
/* How much we want of our DWARF extensions. Some of our dwarf+ extensions
|
||||
are incompatible with regular GDB versions, so we must make sure to only
|
||||
produce them on explicit request. This is eventually reflected into the
|
||||
use_gnu_debug_info_extensions common flag for later processing. */
|
||||
|
||||
static int gnat_dwarf_extensions = 0;
|
||||
|
||||
/* Command-line argc and argv.
|
||||
These variables are global, since they are imported and used in
|
||||
back_end.adb */
|
||||
|
||||
unsigned int save_argc;
|
||||
const char **save_argv;
|
||||
|
||||
/* gnat standard argc argv */
|
||||
|
||||
extern int gnat_argc;
|
||||
extern char **gnat_argv;
|
||||
|
||||
|
||||
/* Declare functions we use as part of startup. */
|
||||
extern void __gnat_initialize (void *);
|
||||
extern void __gnat_install_SEH_handler (void *);
|
||||
extern void adainit (void);
|
||||
extern void _ada_gnat1drv (void);
|
||||
|
||||
/* The parser for the language. For us, we process the GNAT tree. */
|
||||
|
||||
static void
|
||||
gnat_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
|
||||
{
|
||||
int seh[2];
|
||||
|
||||
/* Call the target specific initializations. */
|
||||
__gnat_initialize (NULL);
|
||||
|
||||
/* ??? Call the SEH initialization routine. This is to workaround
|
||||
a bootstrap path problem. The call below should be removed at some
|
||||
point and the SEH pointer passed to __gnat_initialize() above. */
|
||||
__gnat_install_SEH_handler((void *)seh);
|
||||
|
||||
/* Call the front-end elaboration procedures. */
|
||||
adainit ();
|
||||
|
||||
/* Call the front end. */
|
||||
_ada_gnat1drv ();
|
||||
|
||||
/* We always have a single compilation unit in Ada. */
|
||||
cgraph_finalize_compilation_unit ();
|
||||
}
|
||||
|
||||
/* Decode all the language specific options that cannot be decoded by GCC.
|
||||
The option decoding phase of GCC calls this routine on the flags that
|
||||
it cannot decode. This routine returns the number of consecutive arguments
|
||||
from ARGV that it successfully decoded; 0 indicates failure. */
|
||||
|
||||
static int
|
||||
gnat_handle_option (size_t scode, const char *arg, int value)
|
||||
{
|
||||
const struct cl_option *option = &cl_options[scode];
|
||||
enum opt_code code = (enum opt_code) scode;
|
||||
char *q;
|
||||
|
||||
if (arg == NULL && (option->flags & (CL_JOINED | CL_SEPARATE)))
|
||||
{
|
||||
error ("missing argument to \"-%s\"", option->opt_text);
|
||||
return 1;
|
||||
}
|
||||
|
||||
switch (code)
|
||||
{
|
||||
case OPT_I:
|
||||
q = XNEWVEC (char, sizeof("-I") + strlen (arg));
|
||||
strcpy (q, "-I");
|
||||
strcat (q, arg);
|
||||
gnat_argv[gnat_argc] = q;
|
||||
gnat_argc++;
|
||||
break;
|
||||
|
||||
case OPT_Wall:
|
||||
set_Wunused (value);
|
||||
|
||||
/* We save the value of warn_uninitialized, since if they put
|
||||
-Wuninitialized on the command line, we need to generate a
|
||||
warning about not using it without also specifying -O. */
|
||||
if (warn_uninitialized != 1)
|
||||
warn_uninitialized = (value ? 2 : 0);
|
||||
break;
|
||||
|
||||
/* These are used in the GCC Makefile. */
|
||||
case OPT_Wmissing_prototypes:
|
||||
case OPT_Wstrict_prototypes:
|
||||
case OPT_Wwrite_strings:
|
||||
case OPT_Wlong_long:
|
||||
case OPT_Wvariadic_macros:
|
||||
case OPT_Wold_style_definition:
|
||||
case OPT_Wmissing_format_attribute:
|
||||
case OPT_Woverlength_strings:
|
||||
break;
|
||||
|
||||
/* This is handled by the front-end. */
|
||||
case OPT_nostdinc:
|
||||
break;
|
||||
|
||||
case OPT_nostdlib:
|
||||
gnat_argv[gnat_argc] = xstrdup ("-nostdlib");
|
||||
gnat_argc++;
|
||||
break;
|
||||
|
||||
case OPT_feliminate_unused_debug_types:
|
||||
/* We arrange for post_option to be able to only set the corresponding
|
||||
flag to 1 when explicitly requested by the user. We expect the
|
||||
default flag value to be either 0 or positive, and expose a positive
|
||||
-f as a negative value to post_option. */
|
||||
flag_eliminate_unused_debug_types = -value;
|
||||
break;
|
||||
|
||||
case OPT_fRTS_:
|
||||
gnat_argv[gnat_argc] = xstrdup ("-fRTS");
|
||||
gnat_argc++;
|
||||
break;
|
||||
|
||||
case OPT_gant:
|
||||
warning (0, "%<-gnat%> misspelled as %<-gant%>");
|
||||
|
||||
/* ... fall through ... */
|
||||
|
||||
case OPT_gnat:
|
||||
/* Recopy the switches without the 'gnat' prefix. */
|
||||
gnat_argv[gnat_argc] = XNEWVEC (char, strlen (arg) + 2);
|
||||
gnat_argv[gnat_argc][0] = '-';
|
||||
strcpy (gnat_argv[gnat_argc] + 1, arg);
|
||||
gnat_argc++;
|
||||
break;
|
||||
|
||||
case OPT_gnatO:
|
||||
gnat_argv[gnat_argc] = xstrdup ("-O");
|
||||
gnat_argc++;
|
||||
gnat_argv[gnat_argc] = xstrdup (arg);
|
||||
gnat_argc++;
|
||||
break;
|
||||
|
||||
case OPT_gdwarf_:
|
||||
gnat_dwarf_extensions ++;
|
||||
break;
|
||||
|
||||
default:
|
||||
gcc_unreachable ();
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Initialize for option processing. */
|
||||
|
||||
static unsigned int
|
||||
gnat_init_options (unsigned int argc, const char **argv)
|
||||
{
|
||||
/* Initialize gnat_argv with save_argv size. */
|
||||
gnat_argv = (char **) xmalloc ((argc + 1) * sizeof (argv[0]));
|
||||
gnat_argv[0] = xstrdup (argv[0]); /* name of the command */
|
||||
gnat_argc = 1;
|
||||
|
||||
save_argc = argc;
|
||||
save_argv = argv;
|
||||
|
||||
/* Uninitialized really means uninitialized in Ada. */
|
||||
flag_zero_initialized_in_bss = 0;
|
||||
|
||||
return CL_Ada;
|
||||
}
|
||||
|
||||
/* Post-switch processing. */
|
||||
|
||||
bool
|
||||
gnat_post_options (const char **pfilename ATTRIBUTE_UNUSED)
|
||||
{
|
||||
/* ??? The warning machinery is outsmarted by Ada. */
|
||||
warn_unused_parameter = 0;
|
||||
|
||||
/* Force eliminate_unused_debug_types to 0 unless an explicit positive
|
||||
-f has been passed. This forces the default to 0 for Ada, which might
|
||||
differ from the common default. */
|
||||
if (flag_eliminate_unused_debug_types < 0)
|
||||
flag_eliminate_unused_debug_types = 1;
|
||||
else
|
||||
flag_eliminate_unused_debug_types = 0;
|
||||
|
||||
/* Reflect the explicit request of DWARF extensions into the common
|
||||
flag for use by later passes. */
|
||||
if (write_symbols == DWARF2_DEBUG)
|
||||
use_gnu_debug_info_extensions = gnat_dwarf_extensions > 0;
|
||||
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Here is the function to handle the compiler error processing in GCC. */
|
||||
|
||||
static void
|
||||
internal_error_function (const char *msgid, va_list *ap)
|
||||
{
|
||||
text_info tinfo;
|
||||
char *buffer, *p, *loc;
|
||||
String_Template temp, temp_loc;
|
||||
Fat_Pointer fp, fp_loc;
|
||||
expanded_location s;
|
||||
|
||||
/* Reset the pretty-printer. */
|
||||
pp_clear_output_area (global_dc->printer);
|
||||
|
||||
/* Format the message into the pretty-printer. */
|
||||
tinfo.format_spec = msgid;
|
||||
tinfo.args_ptr = ap;
|
||||
tinfo.err_no = errno;
|
||||
pp_format_verbatim (global_dc->printer, &tinfo);
|
||||
|
||||
/* Extract a (writable) pointer to the formatted text. */
|
||||
buffer = (char*) pp_formatted_text (global_dc->printer);
|
||||
|
||||
/* Go up to the first newline. */
|
||||
for (p = buffer; *p; p++)
|
||||
if (*p == '\n')
|
||||
{
|
||||
*p = '\0';
|
||||
break;
|
||||
}
|
||||
|
||||
temp.Low_Bound = 1;
|
||||
temp.High_Bound = p - buffer;
|
||||
fp.Bounds = &temp;
|
||||
fp.Array = buffer;
|
||||
|
||||
s = expand_location (input_location);
|
||||
if (flag_show_column && s.column != 0)
|
||||
asprintf (&loc, "%s:%d:%d", s.file, s.line, s.column);
|
||||
else
|
||||
asprintf (&loc, "%s:%d", s.file, s.line);
|
||||
temp_loc.Low_Bound = 1;
|
||||
temp_loc.High_Bound = strlen (loc);
|
||||
fp_loc.Bounds = &temp_loc;
|
||||
fp_loc.Array = loc;
|
||||
|
||||
Current_Error_Node = error_gnat_node;
|
||||
Compiler_Abort (fp, -1, fp_loc);
|
||||
}
|
||||
|
||||
/* Perform all the initialization steps that are language-specific. */
|
||||
|
||||
static bool
|
||||
gnat_init (void)
|
||||
{
|
||||
/* Performs whatever initialization steps needed by the language-dependent
|
||||
lexical analyzer. */
|
||||
gnat_init_decl_processing ();
|
||||
|
||||
/* Add the input filename as the last argument. */
|
||||
gnat_argv[gnat_argc] = (char *) main_input_filename;
|
||||
gnat_argc++;
|
||||
gnat_argv[gnat_argc] = 0;
|
||||
|
||||
global_dc->internal_error = &internal_error_function;
|
||||
|
||||
/* Show that REFERENCE_TYPEs are internal and should be Pmode. */
|
||||
internal_reference_types ();
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
/* This function is called indirectly from toplev.c to handle incomplete
|
||||
declarations, i.e. VAR_DECL nodes whose DECL_SIZE is zero. To be precise,
|
||||
compile_file in toplev.c makes an indirect call through the function pointer
|
||||
incomplete_decl_finalize_hook which is initialized to this routine in
|
||||
init_decl_processing. */
|
||||
|
||||
static void
|
||||
gnat_finish_incomplete_decl (tree dont_care ATTRIBUTE_UNUSED)
|
||||
{
|
||||
gcc_unreachable ();
|
||||
}
|
||||
|
||||
/* Compute the alignment of the largest mode that can be used for copying
|
||||
objects. */
|
||||
|
||||
void
|
||||
gnat_compute_largest_alignment (void)
|
||||
{
|
||||
enum machine_mode mode;
|
||||
|
||||
for (mode = GET_CLASS_NARROWEST_MODE (MODE_INT); mode != VOIDmode;
|
||||
mode = GET_MODE_WIDER_MODE (mode))
|
||||
if (optab_handler (mov_optab, mode)->insn_code != CODE_FOR_nothing)
|
||||
largest_move_alignment = MIN (BIGGEST_ALIGNMENT,
|
||||
MAX (largest_move_alignment,
|
||||
GET_MODE_ALIGNMENT (mode)));
|
||||
}
|
||||
|
||||
/* If we are using the GCC mechanism to process exception handling, we
|
||||
have to register the personality routine for Ada and to initialize
|
||||
various language dependent hooks. */
|
||||
|
||||
void
|
||||
gnat_init_gcc_eh (void)
|
||||
{
|
||||
#ifdef DWARF2_UNWIND_INFO
|
||||
/* lang_dependent_init already called dwarf2out_frame_init if true. */
|
||||
int dwarf2out_frame_initialized = dwarf2out_do_frame ();
|
||||
#endif
|
||||
|
||||
/* We shouldn't do anything if the No_Exceptions_Handler pragma is set,
|
||||
though. This could for instance lead to the emission of tables with
|
||||
references to symbols (such as the Ada eh personality routine) within
|
||||
libraries we won't link against. */
|
||||
if (No_Exception_Handlers_Set ())
|
||||
return;
|
||||
|
||||
/* Tell GCC we are handling cleanup actions through exception propagation.
|
||||
This opens possibilities that we don't take advantage of yet, but is
|
||||
nonetheless necessary to ensure that fixup code gets assigned to the
|
||||
right exception regions. */
|
||||
using_eh_for_cleanups ();
|
||||
|
||||
eh_personality_libfunc = init_one_libfunc (USING_SJLJ_EXCEPTIONS
|
||||
? "__gnat_eh_personality_sj"
|
||||
: "__gnat_eh_personality");
|
||||
lang_eh_type_covers = gnat_eh_type_covers;
|
||||
lang_eh_runtime_type = gnat_return_tree;
|
||||
default_init_unwind_resume_libfunc ();
|
||||
|
||||
/* Turn on -fexceptions and -fnon-call-exceptions. The first one triggers
|
||||
the generation of the necessary exception runtime tables. The second one
|
||||
is useful for two reasons: 1/ we map some asynchronous signals like SEGV
|
||||
to exceptions, so we need to ensure that the insns which can lead to such
|
||||
signals are correctly attached to the exception region they pertain to,
|
||||
2/ Some calls to pure subprograms are handled as libcall blocks and then
|
||||
marked as "cannot trap" if the flag is not set (see emit_libcall_block).
|
||||
We should not let this be since it is possible for such calls to actually
|
||||
raise in Ada. */
|
||||
flag_exceptions = 1;
|
||||
flag_non_call_exceptions = 1;
|
||||
|
||||
init_eh ();
|
||||
#ifdef DWARF2_UNWIND_INFO
|
||||
if (!dwarf2out_frame_initialized && dwarf2out_do_frame ())
|
||||
dwarf2out_frame_init ();
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Language hooks, first one to print language-specific items in a DECL. */
|
||||
|
||||
static void
|
||||
gnat_print_decl (FILE *file, tree node, int indent)
|
||||
{
|
||||
switch (TREE_CODE (node))
|
||||
{
|
||||
case CONST_DECL:
|
||||
print_node (file, "const_corresponding_var",
|
||||
DECL_CONST_CORRESPONDING_VAR (node), indent + 4);
|
||||
break;
|
||||
|
||||
case FIELD_DECL:
|
||||
print_node (file, "original_field", DECL_ORIGINAL_FIELD (node),
|
||||
indent + 4);
|
||||
break;
|
||||
|
||||
case VAR_DECL:
|
||||
print_node (file, "renamed_object", DECL_RENAMED_OBJECT (node),
|
||||
indent + 4);
|
||||
break;
|
||||
|
||||
default:
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
gnat_print_type (FILE *file, tree node, int indent)
|
||||
{
|
||||
switch (TREE_CODE (node))
|
||||
{
|
||||
case FUNCTION_TYPE:
|
||||
print_node (file, "ci_co_list", TYPE_CI_CO_LIST (node), indent + 4);
|
||||
break;
|
||||
|
||||
case ENUMERAL_TYPE:
|
||||
print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
|
||||
break;
|
||||
|
||||
case INTEGER_TYPE:
|
||||
if (TYPE_MODULAR_P (node))
|
||||
print_node (file, "modulus", TYPE_MODULUS (node), indent + 4);
|
||||
else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
|
||||
print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
|
||||
indent + 4);
|
||||
else if (TYPE_VAX_FLOATING_POINT_P (node))
|
||||
;
|
||||
else
|
||||
print_node (file, "index type", TYPE_INDEX_TYPE (node), indent + 4);
|
||||
|
||||
print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
|
||||
break;
|
||||
|
||||
case ARRAY_TYPE:
|
||||
print_node (file,"actual bounds", TYPE_ACTUAL_BOUNDS (node), indent + 4);
|
||||
break;
|
||||
|
||||
case RECORD_TYPE:
|
||||
if (TYPE_IS_FAT_POINTER_P (node) || TYPE_CONTAINS_TEMPLATE_P (node))
|
||||
print_node (file, "unconstrained array",
|
||||
TYPE_UNCONSTRAINED_ARRAY (node), indent + 4);
|
||||
else
|
||||
print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
|
||||
break;
|
||||
|
||||
case UNION_TYPE:
|
||||
case QUAL_UNION_TYPE:
|
||||
print_node (file, "Ada size", TYPE_ADA_SIZE (node), indent + 4);
|
||||
break;
|
||||
|
||||
default:
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
static const char *
|
||||
gnat_dwarf_name (tree t, int verbosity ATTRIBUTE_UNUSED)
|
||||
{
|
||||
gcc_assert (DECL_P (t));
|
||||
|
||||
return (const char *) IDENTIFIER_POINTER (DECL_NAME (t));
|
||||
}
|
||||
|
||||
static const char *
|
||||
gnat_printable_name (tree decl, int verbosity)
|
||||
{
|
||||
const char *coded_name = IDENTIFIER_POINTER (DECL_NAME (decl));
|
||||
char *ada_name = (char *) ggc_alloc (strlen (coded_name) * 2 + 60);
|
||||
|
||||
__gnat_decode (coded_name, ada_name, 0);
|
||||
|
||||
if (verbosity == 2)
|
||||
{
|
||||
Set_Identifier_Casing (ada_name, (char *) DECL_SOURCE_FILE (decl));
|
||||
ada_name = Name_Buffer;
|
||||
}
|
||||
|
||||
return (const char *) ada_name;
|
||||
}
|
||||
|
||||
/* Expands GNAT-specific GCC tree nodes. The only ones we support
|
||||
here are and NULL_EXPR. */
|
||||
|
||||
static rtx
|
||||
gnat_expand_expr (tree exp, rtx target, enum machine_mode tmode,
|
||||
int modifier, rtx *alt_rtl)
|
||||
{
|
||||
tree type = TREE_TYPE (exp);
|
||||
tree new;
|
||||
|
||||
/* Update EXP to be the new expression to expand. */
|
||||
switch (TREE_CODE (exp))
|
||||
{
|
||||
#if 0
|
||||
case ALLOCATE_EXPR:
|
||||
return
|
||||
allocate_dynamic_stack_space
|
||||
(expand_expr (TREE_OPERAND (exp, 0), NULL_RTX, TYPE_MODE (sizetype),
|
||||
EXPAND_NORMAL),
|
||||
NULL_RTX, tree_low_cst (TREE_OPERAND (exp, 1), 1));
|
||||
#endif
|
||||
|
||||
case UNCONSTRAINED_ARRAY_REF:
|
||||
/* If we are evaluating just for side-effects, just evaluate our
|
||||
operand. Otherwise, abort since this code should never appear
|
||||
in a tree to be evaluated (objects aren't unconstrained). */
|
||||
if (target == const0_rtx || TREE_CODE (type) == VOID_TYPE)
|
||||
return expand_expr (TREE_OPERAND (exp, 0), const0_rtx,
|
||||
VOIDmode, modifier);
|
||||
|
||||
/* ... fall through ... */
|
||||
|
||||
default:
|
||||
gcc_unreachable ();
|
||||
}
|
||||
|
||||
return expand_expr_real (new, target, tmode, modifier, alt_rtl);
|
||||
}
|
||||
|
||||
/* Do nothing (return the tree node passed). */
|
||||
|
||||
static tree
|
||||
gnat_return_tree (tree t)
|
||||
{
|
||||
return t;
|
||||
}
|
||||
|
||||
/* Return true if type A catches type B. Callback for flow analysis from
|
||||
the exception handling part of the back-end. */
|
||||
|
||||
static int
|
||||
gnat_eh_type_covers (tree a, tree b)
|
||||
{
|
||||
/* a catches b if they represent the same exception id or if a
|
||||
is an "others".
|
||||
|
||||
??? integer_zero_node for "others" is hardwired in too many places
|
||||
currently. */
|
||||
return (a == b || a == integer_zero_node);
|
||||
}
|
||||
|
||||
/* Get the alias set corresponding to a type or expression. */
|
||||
|
||||
static alias_set_type
|
||||
gnat_get_alias_set (tree type)
|
||||
{
|
||||
/* If this is a padding type, use the type of the first field. */
|
||||
if (TREE_CODE (type) == RECORD_TYPE
|
||||
&& TYPE_IS_PADDING_P (type))
|
||||
return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
|
||||
|
||||
/* If the type is an unconstrained array, use the type of the
|
||||
self-referential array we make. */
|
||||
else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
|
||||
return
|
||||
get_alias_set (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (type)))));
|
||||
|
||||
/* If the type can alias any other types, return the alias set 0. */
|
||||
else if (TYPE_P (type)
|
||||
&& TYPE_UNIVERSAL_ALIASING_P (TYPE_MAIN_VARIANT (type)))
|
||||
return 0;
|
||||
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* GNU_TYPE is a type. Return its maximum size in bytes, if known,
|
||||
as a constant when possible. */
|
||||
|
||||
static tree
|
||||
gnat_type_max_size (const_tree gnu_type)
|
||||
{
|
||||
/* First see what we can get from TYPE_SIZE_UNIT, which might not
|
||||
be constant even for simple expressions if it has already been
|
||||
elaborated and possibly replaced by a VAR_DECL. */
|
||||
tree max_unitsize = max_size (TYPE_SIZE_UNIT (gnu_type), true);
|
||||
|
||||
/* If we don't have a constant, see what we can get from TYPE_ADA_SIZE,
|
||||
which should stay untouched. */
|
||||
if (!host_integerp (max_unitsize, 1)
|
||||
&& (TREE_CODE (gnu_type) == RECORD_TYPE
|
||||
|| TREE_CODE (gnu_type) == UNION_TYPE
|
||||
|| TREE_CODE (gnu_type) == QUAL_UNION_TYPE)
|
||||
&& TYPE_ADA_SIZE (gnu_type))
|
||||
{
|
||||
tree max_adasize = max_size (TYPE_ADA_SIZE (gnu_type), true);
|
||||
|
||||
/* If we have succeeded in finding a constant, round it up to the
|
||||
type's alignment and return the result in units. */
|
||||
if (host_integerp (max_adasize, 1))
|
||||
max_unitsize
|
||||
= size_binop (CEIL_DIV_EXPR,
|
||||
round_up (max_adasize, TYPE_ALIGN (gnu_type)),
|
||||
bitsize_unit_node);
|
||||
}
|
||||
|
||||
return max_unitsize;
|
||||
}
|
||||
|
||||
/* GNU_TYPE is a type. Determine if it should be passed by reference by
|
||||
default. */
|
||||
|
||||
bool
|
||||
default_pass_by_ref (tree gnu_type)
|
||||
{
|
||||
/* We pass aggregates by reference if they are sufficiently large. The
|
||||
choice of constant here is somewhat arbitrary. We also pass by
|
||||
reference if the target machine would either pass or return by
|
||||
reference. Strictly speaking, we need only check the return if this
|
||||
is an In Out parameter, but it's probably best to err on the side of
|
||||
passing more things by reference. */
|
||||
|
||||
if (pass_by_reference (NULL, TYPE_MODE (gnu_type), gnu_type, 1))
|
||||
return true;
|
||||
|
||||
if (targetm.calls.return_in_memory (gnu_type, NULL_TREE))
|
||||
return true;
|
||||
|
||||
if (AGGREGATE_TYPE_P (gnu_type)
|
||||
&& (!host_integerp (TYPE_SIZE (gnu_type), 1)
|
||||
|| 0 < compare_tree_int (TYPE_SIZE (gnu_type),
|
||||
8 * TYPE_ALIGN (gnu_type))))
|
||||
return true;
|
||||
|
||||
return false;
|
||||
}
|
||||
|
||||
/* GNU_TYPE is the type of a subprogram parameter. Determine from the type if
|
||||
it should be passed by reference. */
|
||||
|
||||
bool
|
||||
must_pass_by_ref (tree gnu_type)
|
||||
{
|
||||
/* We pass only unconstrained objects, those required by the language
|
||||
to be passed by reference, and objects of variable size. The latter
|
||||
is more efficient, avoids problems with variable size temporaries,
|
||||
and does not produce compatibility problems with C, since C does
|
||||
not have such objects. */
|
||||
return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
|
||||
|| (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
|
||||
|| (TYPE_SIZE (gnu_type)
|
||||
&& TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST));
|
||||
}
|
||||
|
||||
/* This function is called by the front end to enumerate all the supported
|
||||
modes for the machine. We pass a function which is called back with
|
||||
the following integer parameters:
|
||||
|
||||
FLOAT_P nonzero if this represents a floating-point mode
|
||||
COMPLEX_P nonzero is this represents a complex mode
|
||||
COUNT count of number of items, nonzero for vector mode
|
||||
PRECISION number of bits in data representation
|
||||
MANTISSA number of bits in mantissa, if FP and known, else zero.
|
||||
SIZE number of bits used to store data
|
||||
ALIGN number of bits to which mode is aligned. */
|
||||
|
||||
void
|
||||
enumerate_modes (void (*f) (int, int, int, int, int, int, unsigned int))
|
||||
{
|
||||
enum machine_mode i;
|
||||
|
||||
for (i = 0; i < NUM_MACHINE_MODES; i++)
|
||||
{
|
||||
enum machine_mode j;
|
||||
bool float_p = 0;
|
||||
bool complex_p = 0;
|
||||
bool vector_p = 0;
|
||||
bool skip_p = 0;
|
||||
int mantissa = 0;
|
||||
enum machine_mode inner_mode = i;
|
||||
|
||||
switch (GET_MODE_CLASS (i))
|
||||
{
|
||||
case MODE_INT:
|
||||
break;
|
||||
case MODE_FLOAT:
|
||||
float_p = 1;
|
||||
break;
|
||||
case MODE_COMPLEX_INT:
|
||||
complex_p = 1;
|
||||
inner_mode = GET_MODE_INNER (i);
|
||||
break;
|
||||
case MODE_COMPLEX_FLOAT:
|
||||
float_p = 1;
|
||||
complex_p = 1;
|
||||
inner_mode = GET_MODE_INNER (i);
|
||||
break;
|
||||
case MODE_VECTOR_INT:
|
||||
vector_p = 1;
|
||||
inner_mode = GET_MODE_INNER (i);
|
||||
break;
|
||||
case MODE_VECTOR_FLOAT:
|
||||
float_p = 1;
|
||||
vector_p = 1;
|
||||
inner_mode = GET_MODE_INNER (i);
|
||||
break;
|
||||
default:
|
||||
skip_p = 1;
|
||||
}
|
||||
|
||||
/* Skip this mode if it's one the front end doesn't need to know about
|
||||
(e.g., the CC modes) or if there is no add insn for that mode (or
|
||||
any wider mode), meaning it is not supported by the hardware. If
|
||||
this a complex or vector mode, we care about the inner mode. */
|
||||
for (j = inner_mode; j != VOIDmode; j = GET_MODE_WIDER_MODE (j))
|
||||
if (optab_handler (add_optab, j)->insn_code != CODE_FOR_nothing)
|
||||
break;
|
||||
|
||||
if (float_p)
|
||||
{
|
||||
const struct real_format *fmt = REAL_MODE_FORMAT (inner_mode);
|
||||
|
||||
mantissa = fmt->p;
|
||||
}
|
||||
|
||||
if (!skip_p && j != VOIDmode)
|
||||
(*f) (float_p, complex_p, vector_p ? GET_MODE_NUNITS (i) : 0,
|
||||
GET_MODE_BITSIZE (i), mantissa,
|
||||
GET_MODE_SIZE (i) * BITS_PER_UNIT, GET_MODE_ALIGNMENT (i));
|
||||
}
|
||||
}
|
||||
|
||||
int
|
||||
fp_prec_to_size (int prec)
|
||||
{
|
||||
enum machine_mode mode;
|
||||
|
||||
for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
|
||||
mode = GET_MODE_WIDER_MODE (mode))
|
||||
if (GET_MODE_PRECISION (mode) == prec)
|
||||
return GET_MODE_BITSIZE (mode);
|
||||
|
||||
gcc_unreachable ();
|
||||
}
|
||||
|
||||
int
|
||||
fp_size_to_prec (int size)
|
||||
{
|
||||
enum machine_mode mode;
|
||||
|
||||
for (mode = GET_CLASS_NARROWEST_MODE (MODE_FLOAT); mode != VOIDmode;
|
||||
mode = GET_MODE_WIDER_MODE (mode))
|
||||
if (GET_MODE_BITSIZE (mode) == size)
|
||||
return GET_MODE_PRECISION (mode);
|
||||
|
||||
gcc_unreachable ();
|
||||
}
|
||||
@ -1,230 +0,0 @@
|
||||
/****************************************************************************
|
||||
* *
|
||||
* GNAT COMPILER COMPONENTS *
|
||||
* *
|
||||
* T A R G T Y P S *
|
||||
* *
|
||||
* Body *
|
||||
* *
|
||||
* Copyright (C) 1992-2007, Free Software Foundation, Inc. *
|
||||
* *
|
||||
* GNAT is free software; you can redistribute it and/or modify it under *
|
||||
* terms of the GNU General Public License as published by the Free Soft- *
|
||||
* ware Foundation; either version 2, or (at your option) any later ver- *
|
||||
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
|
||||
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
|
||||
* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
|
||||
* for more details. You should have received a copy of the GNU General *
|
||||
* Public License distributed with GNAT; see file COPYING. If not, write *
|
||||
* to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
|
||||
* Boston, MA 02110-1301, USA. *
|
||||
* *
|
||||
* As a special exception, if you link this file with other files to *
|
||||
* produce an executable, this file does not by itself cause the resulting *
|
||||
* executable to be covered by the GNU General Public License. This except- *
|
||||
* ion does not however invalidate any other reasons why the executable *
|
||||
* file might be covered by the GNU Public License. *
|
||||
* *
|
||||
* GNAT was originally developed by the GNAT team at New York University. *
|
||||
* Extensive contributions were provided by Ada Core Technologies Inc. *
|
||||
* *
|
||||
****************************************************************************/
|
||||
|
||||
/* Functions for retrieving target types. See Ada package Get_Targ */
|
||||
|
||||
#include "config.h"
|
||||
#include "system.h"
|
||||
#include "coretypes.h"
|
||||
#include "tm.h"
|
||||
#include "tree.h"
|
||||
#include "real.h"
|
||||
#include "rtl.h"
|
||||
#include "ada.h"
|
||||
#include "types.h"
|
||||
#include "atree.h"
|
||||
#include "elists.h"
|
||||
#include "namet.h"
|
||||
#include "nlists.h"
|
||||
#include "snames.h"
|
||||
#include "stringt.h"
|
||||
#include "uintp.h"
|
||||
#include "urealp.h"
|
||||
#include "fe.h"
|
||||
#include "sinfo.h"
|
||||
#include "einfo.h"
|
||||
#include "ada-tree.h"
|
||||
#include "gigi.h"
|
||||
|
||||
/* If we don't have a specific size for Ada's equivalent of `long', use that
|
||||
of C. */
|
||||
#ifndef ADA_LONG_TYPE_SIZE
|
||||
#define ADA_LONG_TYPE_SIZE LONG_TYPE_SIZE
|
||||
#endif
|
||||
|
||||
#ifndef WIDEST_HARDWARE_FP_SIZE
|
||||
#define WIDEST_HARDWARE_FP_SIZE LONG_DOUBLE_TYPE_SIZE
|
||||
#endif
|
||||
|
||||
/* The following provide a functional interface for the front end Ada code
|
||||
to determine the sizes that are used for various C types. */
|
||||
|
||||
Pos
|
||||
get_target_bits_per_unit (void)
|
||||
{
|
||||
return BITS_PER_UNIT;
|
||||
}
|
||||
|
||||
Pos
|
||||
get_target_bits_per_word (void)
|
||||
{
|
||||
return BITS_PER_WORD;
|
||||
}
|
||||
|
||||
Pos
|
||||
get_target_char_size (void)
|
||||
{
|
||||
return CHAR_TYPE_SIZE;
|
||||
}
|
||||
|
||||
Pos
|
||||
get_target_wchar_t_size (void)
|
||||
{
|
||||
/* We never want wide characters less than "short" in Ada. */
|
||||
return MAX (SHORT_TYPE_SIZE, WCHAR_TYPE_SIZE);
|
||||
}
|
||||
|
||||
Pos
|
||||
get_target_short_size (void)
|
||||
{
|
||||
return SHORT_TYPE_SIZE;
|
||||
}
|
||||
|
||||
Pos
|
||||
get_target_int_size (void)
|
||||
{
|
||||
return INT_TYPE_SIZE;
|
||||
}
|
||||
|
||||
Pos
|
||||
get_target_long_size (void)
|
||||
{
|
||||
return ADA_LONG_TYPE_SIZE;
|
||||
}
|
||||
|
||||
Pos
|
||||
get_target_long_long_size (void)
|
||||
{
|
||||
return LONG_LONG_TYPE_SIZE;
|
||||
}
|
||||
|
||||
Pos
|
||||
get_target_float_size (void)
|
||||
{
|
||||
return fp_prec_to_size (FLOAT_TYPE_SIZE);
|
||||
}
|
||||
|
||||
Pos
|
||||
get_target_double_size (void)
|
||||
{
|
||||
return fp_prec_to_size (DOUBLE_TYPE_SIZE);
|
||||
}
|
||||
|
||||
Pos
|
||||
get_target_long_double_size (void)
|
||||
{
|
||||
return fp_prec_to_size (WIDEST_HARDWARE_FP_SIZE);
|
||||
}
|
||||
|
||||
|
||||
Pos
|
||||
get_target_pointer_size (void)
|
||||
{
|
||||
return POINTER_SIZE;
|
||||
}
|
||||
|
||||
/* Alignment related values, mapped to attributes for functional and
|
||||
documentation purposes. */
|
||||
|
||||
/* Standard'Maximum_Default_Alignment. Maximum alignment that the compiler
|
||||
might choose by default for a type or object.
|
||||
|
||||
Stricter alignment requests trigger gigi's aligning_type circuitry for
|
||||
stack objects or objects allocated by the default allocator. */
|
||||
|
||||
Pos
|
||||
get_target_maximum_default_alignment (void)
|
||||
{
|
||||
return BIGGEST_ALIGNMENT / BITS_PER_UNIT;
|
||||
}
|
||||
|
||||
/* Standard'Default_Allocator_Alignment. Alignment guaranteed to be honored
|
||||
by the default allocator (System.Memory.Alloc or malloc if we have no
|
||||
run-time library at hand).
|
||||
|
||||
Stricter alignment requests trigger gigi's aligning_type circuitry for
|
||||
objects allocated by the default allocator. */
|
||||
|
||||
Pos
|
||||
get_target_default_allocator_alignment (void)
|
||||
{
|
||||
/* ??? Need a way to get info about __gnat_malloc from here (whether
|
||||
it is handy and what alignment it honors). */
|
||||
|
||||
return MALLOC_ABI_ALIGNMENT / BITS_PER_UNIT;
|
||||
}
|
||||
|
||||
/* Standard'Maximum_Allowed_Alignment. Maximum alignment that we may
|
||||
accept for any type or object. */
|
||||
|
||||
#ifndef MAX_OFILE_ALIGNMENT
|
||||
#define MAX_OFILE_ALIGNMENT BIGGEST_ALIGNMENT
|
||||
#endif
|
||||
|
||||
Pos
|
||||
get_target_maximum_allowed_alignment (void)
|
||||
{
|
||||
return MAX_OFILE_ALIGNMENT / BITS_PER_UNIT;
|
||||
}
|
||||
|
||||
/* Standard'Maximum_Alignment. The single attribute initially made
|
||||
available, now a synonym of Standard'Maximum_Default_Alignment. */
|
||||
|
||||
Pos
|
||||
get_target_maximum_alignment (void)
|
||||
{
|
||||
return get_target_maximum_default_alignment ();
|
||||
}
|
||||
|
||||
#ifndef FLOAT_WORDS_BIG_ENDIAN
|
||||
#define FLOAT_WORDS_BIG_ENDIAN WORDS_BIG_ENDIAN
|
||||
#endif
|
||||
|
||||
Nat
|
||||
get_float_words_be (void)
|
||||
{
|
||||
return FLOAT_WORDS_BIG_ENDIAN;
|
||||
}
|
||||
|
||||
Nat
|
||||
get_words_be (void)
|
||||
{
|
||||
return WORDS_BIG_ENDIAN;
|
||||
}
|
||||
|
||||
Nat
|
||||
get_bytes_be (void)
|
||||
{
|
||||
return BYTES_BIG_ENDIAN;
|
||||
}
|
||||
|
||||
Nat
|
||||
get_bits_be (void)
|
||||
{
|
||||
return BITS_BIG_ENDIAN;
|
||||
}
|
||||
|
||||
Nat
|
||||
get_strict_alignment (void)
|
||||
{
|
||||
return STRICT_ALIGNMENT;
|
||||
}
|
||||
7091
gcc/ada/trans.c
7091
gcc/ada/trans.c
File diff suppressed because it is too large
Load Diff
4895
gcc/ada/utils.c
4895
gcc/ada/utils.c
File diff suppressed because it is too large
Load Diff
2219
gcc/ada/utils2.c
2219
gcc/ada/utils2.c
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user