gnat_rm.texi: Document new mechanism Short_Descriptor.

2008-08-01  Doug Rupp  <rupp@adacore.com>

	* gnat_rm.texi: Document new mechanism Short_Descriptor.
	
	* types.ads (Mechanism_Type): Modify range for new Short_Descriptor
	mechanism values.

	* sem_prag.adb (Set_Mechanism_Value): Enhance for Short_Descriptor
	mechanism and Short_Descriptor mechanism values.

	* snames.adb (preset_names): Add short_descriptor entry.

	* snames.ads: Add Name_Short_Descriptor.

	* types.h: Add new By_Short_Descriptor mechanism values.

	* sem_mech.adb (Set_Mechanism_Value): Enhance for Short_Descriptor
	mechanism and Short_Descriptor mechanism values.

	* sem_mech.ads (Mechanism_Type): Add new By_Short_Descriptor mechanism
	values.
	(Descriptor_Codes): Modify range for new mechanism values.

	* treepr.adb (Print_Entity_Enfo): Handle new By_Short_Descriptor
	mechanism values.

	* gcc-interface/decl.c (gnat_to_gnu_entity): Handle By_Short_Descriptor.
	(gnat_to_gnu_param): Handle By_Short_Descriptor.

	* gcc-interface/gigi.h (build_vms_descriptor64): Remove prototype.
	(build_vms_descriptor32): New prototype.
	(fill_vms_descriptor): Remove unneeded gnat_actual parameter.

	* gcc-interface/trans.c (call_to_gnu): Removed unneeded gnat_actual
	argument in call fill_vms_descriptor.

	* gcc-interface/utils.c (build_vms_descriptor32): Renamed from
	build_vms_descriptor and enhanced to hande Short_Descriptor mechanism.
	(build_vms_descriptor): Renamed from build_vms_descriptor64. 
	(convert_vms_descriptor32): New function.
	(convert_vms_descriptor64): New function.
	(convert_vms_descriptor): Rewrite to handle both 32bit and 64bit
	descriptors.

	* gcc-interface/utils2.c (fill_vms_descriptor): Revert previous changes,
	no longer needed.

From-SVN: r138473
This commit is contained in:
Doug Rupp 2008-08-01 09:56:20 +02:00 committed by Arnaud Charlet
parent 73f0dc7a66
commit d628c01538
14 changed files with 907 additions and 519 deletions

View File

@ -3872,6 +3872,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
;
else if (By_Descriptor_Last <= mech && mech <= By_Descriptor)
mech = By_Descriptor;
else if (By_Short_Descriptor_Last <= mech &&
mech <= By_Short_Descriptor)
mech = By_Short_Descriptor;
else if (mech > 0)
{
if (TREE_CODE (gnu_param_type) == UNCONSTRAINED_ARRAY_TYPE
@ -3913,7 +3918,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= chainon (gnu_param, gnu_stub_param_list);
/* Change By_Descriptor parameter to By_Reference for
the internal version of an exported subprogram. */
if (mech == By_Descriptor)
if (mech == By_Descriptor || mech == By_Short_Descriptor)
{
gnu_param
= gnat_to_gnu_param (gnat_param, By_Reference,
@ -4828,11 +4833,11 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
/* VMS descriptors are themselves passed by reference.
Build both a 32bit and 64bit descriptor, one of which will be chosen
in fill_vms_descriptor based on the allocator size */
in fill_vms_descriptor. */
if (mech == By_Descriptor)
{
gnu_param_type_alt
= build_pointer_type (build_vms_descriptor64 (gnu_param_type,
= build_pointer_type (build_vms_descriptor32 (gnu_param_type,
Mechanism (gnat_param),
gnat_subprog));
gnu_param_type
@ -4840,6 +4845,15 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
Mechanism (gnat_param),
gnat_subprog));
}
else if (mech == By_Short_Descriptor)
{
gnu_param_type_alt = NULL_TREE;
gnu_param_type
= build_pointer_type (build_vms_descriptor32 (gnu_param_type,
Mechanism (gnat_param),
gnat_subprog));
}
/* Arrays are passed as pointers to element type for foreign conventions. */
else if (foreign
@ -4920,6 +4934,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
&& !by_ref
&& (by_return
|| (mech != By_Descriptor
&& mech != By_Short_Descriptor
&& !POINTER_TYPE_P (gnu_param_type)
&& !AGGREGATE_TYPE_P (gnu_param_type)))
&& !(Is_Array_Type (Etype (gnat_param))
@ -4931,11 +4946,12 @@ gnat_to_gnu_param (Entity_Id gnat_param, Mechanism_Type mech,
ro_param || by_ref || by_component_ptr);
DECL_BY_REF_P (gnu_param) = by_ref;
DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor);
DECL_BY_DESCRIPTOR_P (gnu_param) = (mech == By_Descriptor ||
mech == By_Short_Descriptor);
DECL_POINTS_TO_READONLY_P (gnu_param)
= (ro_param && (by_ref || by_component_ptr));
/* Save the 64bit descriptor for later. */
/* Save the alternate descriptor for later. */
SET_DECL_PARM_ALT (gnu_param, gnu_param_type_alt);
/* If no Mechanism was specified, indicate what we're using, then

View File

@ -683,7 +683,7 @@ extern void end_subprog_body (tree body, bool elab_p);
Return a constructor for the template. */
extern tree build_template (tree template_type, tree array_type, tree expr);
/* Build a 32bit VMS descriptor from a Mechanism_Type, which must specify
/* Build a 64bit VMS descriptor from a Mechanism_Type, which must specify
a descriptor type, and the GCC type of an object. Each FIELD_DECL
in the type contains in its DECL_INITIAL the expression to use when
a constructor is made for the type. GNAT_ENTITY is a gnat node used
@ -692,8 +692,8 @@ extern tree build_template (tree template_type, tree array_type, tree expr);
extern tree build_vms_descriptor (tree type, Mechanism_Type mech,
Entity_Id gnat_entity);
/* Build a 64bit VMS descriptor from a Mechanism_Type. See above. */
extern tree build_vms_descriptor64 (tree type, Mechanism_Type mech,
/* Build a 32bit VMS descriptor from a Mechanism_Type. See above. */
extern tree build_vms_descriptor32 (tree type, Mechanism_Type mech,
Entity_Id gnat_entity);
/* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG
@ -853,9 +853,8 @@ extern tree build_allocator (tree type, tree init, tree result_type,
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. GNAT_ACTUAL is how we
find the size of the allocator. */
extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual);
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. */

View File

@ -2392,8 +2392,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
else
gnu_actual = build_unary_op (ADDR_EXPR, NULL_TREE,
fill_vms_descriptor (gnu_actual,
gnat_formal,
gnat_actual));
gnat_formal));
}
else
{
@ -5910,7 +5909,7 @@ build_unary_op_trapv (enum tree_code code,
{
gcc_assert ((code == NEGATE_EXPR) || (code == ABS_EXPR));
operand = save_expr (operand);
operand = protect_multiple_eval (operand);
return emit_check (build_binary_op (EQ_EXPR, integer_type_node,
operand, TYPE_MIN_VALUE (gnu_type)),
@ -5929,8 +5928,8 @@ build_binary_op_trapv (enum tree_code code,
tree left,
tree right)
{
tree lhs = save_expr (left);
tree rhs = save_expr (right);
tree lhs = protect_multiple_eval (left);
tree rhs = protect_multiple_eval (right);
tree type_max = TYPE_MAX_VALUE (gnu_type);
tree type_min = TYPE_MIN_VALUE (gnu_type);
tree gnu_expr;

View File

@ -2659,7 +2659,7 @@ build_template (tree template_type, tree array_type, tree expr)
an object of that type and also for the name. */
tree
build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
{
tree record_type = make_node (RECORD_TYPE);
tree pointer32_type;
@ -2689,7 +2689,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
idx_arr = (tree *) alloca (ndim * sizeof (tree));
if (mech != By_Descriptor_NCA
if (mech != By_Descriptor_NCA && mech != By_Short_Descriptor_NCA
&& TREE_CODE (type) == ARRAY_TYPE && TYPE_CONVENTION_FORTRAN_P (type))
for (i = ndim - 1, inner_type = type;
i >= 0;
@ -2775,16 +2775,21 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
switch (mech)
{
case By_Descriptor_A:
case By_Short_Descriptor_A:
class = 4;
break;
case By_Descriptor_NCA:
case By_Short_Descriptor_NCA:
class = 10;
break;
case By_Descriptor_SB:
case By_Short_Descriptor_SB:
class = 15;
break;
case By_Descriptor:
case By_Short_Descriptor:
case By_Descriptor_S:
case By_Short_Descriptor_S:
default:
class = 1;
break;
@ -2797,7 +2802,9 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
= chainon (field_list,
make_descriptor_field
("LENGTH", gnat_type_for_size (16, 1), record_type,
size_in_bytes (mech == By_Descriptor_A ? inner_type : type)));
size_in_bytes ((mech == By_Descriptor_A ||
mech == By_Short_Descriptor_A)
? inner_type : type)));
field_list = chainon (field_list,
make_descriptor_field ("DTYPE",
@ -2823,10 +2830,13 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
switch (mech)
{
case By_Descriptor:
case By_Short_Descriptor:
case By_Descriptor_S:
case By_Short_Descriptor_S:
break;
case By_Descriptor_SB:
case By_Short_Descriptor_SB:
field_list
= chainon (field_list,
make_descriptor_field
@ -2842,7 +2852,9 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
break;
case By_Descriptor_A:
case By_Short_Descriptor_A:
case By_Descriptor_NCA:
case By_Short_Descriptor_NCA:
field_list = chainon (field_list,
make_descriptor_field ("SCALE",
gnat_type_for_size (8, 1),
@ -2859,7 +2871,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
= chainon (field_list,
make_descriptor_field
("AFLAGS", gnat_type_for_size (8, 1), record_type,
size_int (mech == By_Descriptor_NCA
size_int ((mech == By_Descriptor_NCA ||
mech == By_Short_Descriptor_NCA)
? 0
/* Set FL_COLUMN, FL_COEFF, and FL_BOUNDS. */
: (TREE_CODE (type) == ARRAY_TYPE
@ -2910,7 +2923,8 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
TYPE_MIN_VALUE (idx_arr[i])),
size_int (1)));
fname[0] = (mech == By_Descriptor_NCA ? 'S' : 'M');
fname[0] = ((mech == By_Descriptor_NCA ||
mech == By_Short_Descriptor_NCA) ? 'S' : 'M');
fname[1] = '0' + i, fname[2] = 0;
field_list
= chainon (field_list,
@ -2918,7 +2932,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
gnat_type_for_size (32, 1),
record_type, idx_length));
if (mech == By_Descriptor_NCA)
if (mech == By_Descriptor_NCA || mech == By_Short_Descriptor_NCA)
tem = idx_length;
}
@ -2962,7 +2976,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
an object of that type and also for the name. */
tree
build_vms_descriptor64 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
{
tree record64_type = make_node (RECORD_TYPE);
tree pointer64_type;
@ -3283,12 +3297,160 @@ make_descriptor_field (const char *name, tree type,
return field;
}
/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a regular
pointer or fat pointer type. GNAT_SUBPROG is the subprogram to which
the VMS descriptor is passed. */
/* Convert GNU_EXPR, a pointer to a 64bit VMS descriptor, to GNU_TYPE, a
regular pointer or fat pointer type. GNAT_SUBPROG is the subprogram to
which the VMS descriptor is passed. */
static tree
convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
convert_vms_descriptor64 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
{
tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
/* The CLASS field is the 3rd field in the descriptor. */
tree class = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (desc_type)));
/* The POINTER field is the 6th field in the descriptor. */
tree pointer64 = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (class)));
/* Retrieve the value of the POINTER field. */
tree gnu_expr64
= build3 (COMPONENT_REF, TREE_TYPE (pointer64), desc, pointer64, NULL_TREE);
if (POINTER_TYPE_P (gnu_type))
return convert (gnu_type, gnu_expr64);
else if (TYPE_FAT_POINTER_P (gnu_type))
{
tree p_array_type = TREE_TYPE (TYPE_FIELDS (gnu_type));
tree p_bounds_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (gnu_type)));
tree template_type = TREE_TYPE (p_bounds_type);
tree min_field = TYPE_FIELDS (template_type);
tree max_field = TREE_CHAIN (TYPE_FIELDS (template_type));
tree template, template_addr, aflags, dimct, t, u;
/* See the head comment of build_vms_descriptor. */
int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class));
tree lfield, ufield;
/* Convert POINTER to the type of the P_ARRAY field. */
gnu_expr64 = convert (p_array_type, gnu_expr64);
switch (iclass)
{
case 1: /* Class S */
case 15: /* Class SB */
/* Build {1, LENGTH} template; LENGTH64 is the 5th field. */
t = TREE_CHAIN (TREE_CHAIN (class));
t = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
t = tree_cons (min_field,
convert (TREE_TYPE (min_field), integer_one_node),
tree_cons (max_field,
convert (TREE_TYPE (max_field), t),
NULL_TREE));
template = gnat_build_constructor (template_type, t);
template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template);
/* For class S, we are done. */
if (iclass == 1)
break;
/* Test that we really have a SB descriptor, like DEC Ada. */
t = build3 (COMPONENT_REF, TREE_TYPE (class), desc, class, NULL);
u = convert (TREE_TYPE (class), DECL_INITIAL (class));
u = build_binary_op (EQ_EXPR, integer_type_node, t, u);
/* If so, there is already a template in the descriptor and
it is located right after the POINTER field. The fields are
64bits so they must be repacked. */
t = TREE_CHAIN (pointer64);
lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield);
t = TREE_CHAIN (t);
ufield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
ufield = convert
(TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield);
/* Build the template in the form of a constructor. */
t = tree_cons (TYPE_FIELDS (template_type), lfield,
tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
ufield, NULL_TREE));
template = gnat_build_constructor (template_type, t);
/* Otherwise use the {1, LENGTH} template we build above. */
template_addr = build3 (COND_EXPR, p_bounds_type, u,
build_unary_op (ADDR_EXPR, p_bounds_type,
template),
template_addr);
break;
case 4: /* Class A */
/* The AFLAGS field is the 3rd field after the pointer in the
descriptor. */
t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (pointer64)));
aflags = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
/* The DIMCT field is the next field in the descriptor after
aflags. */
t = TREE_CHAIN (t);
dimct = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
/* Raise CONSTRAINT_ERROR if either more than 1 dimension
or FL_COEFF or FL_BOUNDS not set. */
u = build_int_cst (TREE_TYPE (aflags), 192);
u = build_binary_op (TRUTH_OR_EXPR, integer_type_node,
build_binary_op (NE_EXPR, integer_type_node,
dimct,
convert (TREE_TYPE (dimct),
size_one_node)),
build_binary_op (NE_EXPR, integer_type_node,
build2 (BIT_AND_EXPR,
TREE_TYPE (aflags),
aflags, u),
u));
/* There is already a template in the descriptor and it is located
in block 3. The fields are 64bits so they must be repacked. */
t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN
(t)))));
lfield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
lfield = convert (TREE_TYPE (TYPE_FIELDS (template_type)), lfield);
t = TREE_CHAIN (t);
ufield = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
ufield = convert
(TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (template_type))), ufield);
/* Build the template in the form of a constructor. */
t = tree_cons (TYPE_FIELDS (template_type), lfield,
tree_cons (TREE_CHAIN (TYPE_FIELDS (template_type)),
ufield, NULL_TREE));
template = gnat_build_constructor (template_type, t);
template = build3 (COND_EXPR, p_bounds_type, u,
build_call_raise (CE_Length_Check_Failed, Empty,
N_Raise_Constraint_Error),
template);
template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template);
break;
case 10: /* Class NCA */
default:
post_error ("unsupported descriptor type for &", gnat_subprog);
template_addr = integer_zero_node;
break;
}
/* Build the fat pointer in the form of a constructor. */
t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr64,
tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)),
template_addr, NULL_TREE));
return gnat_build_constructor (gnu_type, t);
}
else
gcc_unreachable ();
}
/* Convert GNU_EXPR, a pointer to a 32bit VMS descriptor, to GNU_TYPE, a
regular pointer or fat pointer type. GNAT_SUBPROG is the subprogram to
which the VMS descriptor is passed. */
static tree
convert_vms_descriptor32 (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
{
tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
@ -3298,11 +3460,11 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
tree pointer = TREE_CHAIN (class);
/* Retrieve the value of the POINTER field. */
gnu_expr
tree gnu_expr32
= build3 (COMPONENT_REF, TREE_TYPE (pointer), desc, pointer, NULL_TREE);
if (POINTER_TYPE_P (gnu_type))
return convert (gnu_type, gnu_expr);
return convert (gnu_type, gnu_expr32);
else if (TYPE_FAT_POINTER_P (gnu_type))
{
@ -3316,7 +3478,7 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
int iclass = TREE_INT_CST_LOW (DECL_INITIAL (class));
/* Convert POINTER to the type of the P_ARRAY field. */
gnu_expr = convert (p_array_type, gnu_expr);
gnu_expr32 = convert (p_array_type, gnu_expr32);
switch (iclass)
{
@ -3372,14 +3534,14 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
TREE_TYPE (aflags),
aflags, u),
u));
add_stmt (build3 (COND_EXPR, void_type_node, u,
build_call_raise (CE_Length_Check_Failed, Empty,
N_Raise_Constraint_Error),
NULL_TREE));
/* There is already a template in the descriptor and it is
located at the start of block 3 (12th field). */
t = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (t))));
template = build3 (COMPONENT_REF, TREE_TYPE (t), desc, t, NULL_TREE);
template = build3 (COND_EXPR, p_bounds_type, u,
build_call_raise (CE_Length_Check_Failed, Empty,
N_Raise_Constraint_Error),
template);
template_addr = build_unary_op (ADDR_EXPR, p_bounds_type, template);
break;
@ -3391,9 +3553,10 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
}
/* Build the fat pointer in the form of a constructor. */
t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr,
t = tree_cons (TYPE_FIELDS (gnu_type), gnu_expr32,
tree_cons (TREE_CHAIN (TYPE_FIELDS (gnu_type)),
template_addr, NULL_TREE));
return gnat_build_constructor (gnu_type, t);
}
@ -3401,6 +3564,56 @@ convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
gcc_unreachable ();
}
/* Convert GNU_EXPR, a pointer to a VMS descriptor, to GNU_TYPE, a
regular pointer or fat pointer type. GNAT_SUBPROG is the subprogram to
which the VMS descriptor is passed. */
static tree
convert_vms_descriptor (tree gnu_type, tree gnu_expr, Entity_Id gnat_subprog)
{
tree desc_type = TREE_TYPE (TREE_TYPE (gnu_expr));
tree desc = build1 (INDIRECT_REF, desc_type, gnu_expr);
tree mbo = TYPE_FIELDS (desc_type);
const char *mbostr = IDENTIFIER_POINTER (DECL_NAME (mbo));
tree mbmo = TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (mbo)));
tree is64bit;
tree save_type = TREE_TYPE (gnu_expr);
tree gnu_expr32, gnu_expr64;
if (strcmp (mbostr, "MBO") != 0)
/* If the field name is not MBO, it must be 32bit and no alternate */
return convert_vms_descriptor32 (gnu_type, gnu_expr, gnat_subprog);
/* Otherwise primary must be 64bit and alternate 32bit */
/* Test for 64bit descriptor */
mbo = build3 (COMPONENT_REF, TREE_TYPE (mbo), desc, mbo, NULL_TREE);
mbmo = build3 (COMPONENT_REF, TREE_TYPE (mbmo), desc, mbmo, NULL_TREE);
is64bit = build_binary_op (TRUTH_ANDIF_EXPR, integer_type_node,
build_binary_op (EQ_EXPR, integer_type_node,
convert (integer_type_node, mbo),
integer_one_node),
build_binary_op (EQ_EXPR, integer_type_node,
convert (integer_type_node, mbmo),
integer_minus_one_node));
gnu_expr64 = convert_vms_descriptor64 (gnu_type, gnu_expr,
gnat_subprog);
/* Convert 32bit alternate. Hack alert ??? */
TREE_TYPE (gnu_expr) = DECL_PARM_ALT (gnu_expr);
gnu_expr32 = convert_vms_descriptor32 (gnu_type, gnu_expr,
gnat_subprog);
TREE_TYPE (gnu_expr) = save_type;
if (POINTER_TYPE_P (gnu_type))
return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
else if (TYPE_FAT_POINTER_P (gnu_type))
return build3 (COND_EXPR, gnu_type, is64bit, gnu_expr64, gnu_expr32);
else
gcc_unreachable ();
}
/* Build a stub for the subprogram specified by the GCC tree GNU_SUBPROG
and the GNAT node GNAT_SUBPROG. */

View File

@ -2156,37 +2156,13 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
alternate 64bit descriptor. */
tree
fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
fill_vms_descriptor (tree expr, Entity_Id gnat_formal)
{
tree field;
tree parm_decl = get_gnu_tree (gnat_formal);
tree const_list = NULL_TREE;
int size;
tree record_type;
/* A string literal will always be in 32bit space on VMS. Where
will it be on other 64bit systems???
An identifier's allocation may be unknown at compile time.
An explicit dereference could be either in 32bit or 64bit space.
Don't know about other possibilities, so assume unknown which
will result in fetching the 64bit descriptor. ??? */
if (Nkind (gnat_actual) == N_String_Literal)
size = 32;
else if (Nkind (gnat_actual) == N_Identifier)
size = UI_To_Int (Esize (Etype (gnat_actual)));
else if (Nkind (gnat_actual) == N_Explicit_Dereference)
size = UI_To_Int (Esize (Etype (Prefix (gnat_actual))));
else
size = 0;
/* If size is unknown, make it POINTER_SIZE */
if (size == 0)
size = POINTER_SIZE;
/* If size is 64bits grab the alternate 64bit descriptor. */
if (size == 64)
TREE_TYPE (parm_decl) = DECL_PARM_ALT (parm_decl);
record_type = TREE_TYPE (TREE_TYPE (parm_decl));
expr = maybe_unconstrained_array (expr);
gnat_mark_addressable (expr);

View File

@ -1852,6 +1852,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
@end smallexample
@ -1884,6 +1885,9 @@ anonymous access parameter.
@cindex OpenVMS
@cindex Passing by descriptor
Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
The default behavior for Export_Function is to accept either 64bit or
32bit descriptors unless short_descriptor is specified, then only 32bit
descriptors are accepted.
@cindex Suppressing external name
Special treatment is given if the EXTERNAL is an explicit null
@ -1953,6 +1957,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
@end smallexample
@ -1970,6 +1975,9 @@ pragma that specifies the desired foreign convention.
@cindex OpenVMS
@cindex Passing by descriptor
Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
The default behavior for Export_Procedure is to accept either 64bit or
32bit descriptors unless short_descriptor is specified, then only 32bit
descriptors are accepted.
@cindex Suppressing external name
Special treatment is given if the EXTERNAL is an explicit null
@ -2035,6 +2043,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a
@end smallexample
@ -2057,6 +2066,9 @@ pragma that specifies the desired foreign convention.
@cindex OpenVMS
@cindex Passing by descriptor
Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
The default behavior for Export_Valued_Procedure is to accept either 64bit or
32bit descriptors unless short_descriptor is specified, then only 32bit
descriptors are accepted.
@cindex Suppressing external name
Special treatment is given if the EXTERNAL is an explicit null
@ -2483,6 +2495,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
@end smallexample
@ -2516,6 +2529,8 @@ is used.
@cindex OpenVMS
@cindex Passing by descriptor
Passing by descriptor is supported only on the OpenVMS ports of GNAT@.
The default behavior for Import_Function is to pass a 64bit descriptor
unless short_descriptor is specified, then a 32bit descriptor is passed.
@code{First_Optional_Parameter} applies only to OpenVMS ports of GNAT@.
It specifies that the designated parameter and all following parameters
@ -2589,6 +2604,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
@end smallexample
@ -2635,6 +2651,7 @@ MECHANISM_NAME ::=
Value
| Reference
| Descriptor [([Class =>] CLASS_NAME)]
| Short_Descriptor [([Class =>] CLASS_NAME)]
CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
@end smallexample

View File

@ -69,7 +69,7 @@ package body Sem_Mech is
("mechanism for & has already been set", Mech_Name, Ent);
end if;
-- MECHANISM_NAME ::= value | reference | descriptor
-- MECHANISM_NAME ::= value | reference | descriptor | short_descriptor
if Nkind (Mech_Name) = N_Identifier then
if Chars (Mech_Name) = Name_Value then
@ -85,6 +85,11 @@ package body Sem_Mech is
Set_Mechanism_With_Checks (Ent, By_Descriptor, Mech_Name);
return;
elsif Chars (Mech_Name) = Name_Short_Descriptor then
Check_VMS (Mech_Name);
Set_Mechanism_With_Checks (Ent, By_Short_Descriptor, Mech_Name);
return;
elsif Chars (Mech_Name) = Name_Copy then
Error_Msg_N
("bad mechanism name, Value assumed", Mech_Name);
@ -95,7 +100,8 @@ package body Sem_Mech is
return;
end if;
-- MECHANISM_NAME ::= descriptor (CLASS_NAME)
-- MECHANISM_NAME ::= descriptor (CLASS_NAME) |
-- short_descriptor (CLASS_NAME)
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
-- Note: this form is parsed as an indexed component
@ -104,14 +110,16 @@ package body Sem_Mech is
Class := First (Expressions (Mech_Name));
if Nkind (Prefix (Mech_Name)) /= N_Identifier
or else Chars (Prefix (Mech_Name)) /= Name_Descriptor
or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else
Chars (Prefix (Mech_Name)) = Name_Short_Descriptor)
or else Present (Next (Class))
then
Bad_Mechanism;
return;
end if;
-- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME)
-- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) |
-- short_descriptor (Class => CLASS_NAME)
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
-- Note: this form is parsed as a function call
@ -121,7 +129,8 @@ package body Sem_Mech is
Param := First (Parameter_Associations (Mech_Name));
if Nkind (Name (Mech_Name)) /= N_Identifier
or else Chars (Name (Mech_Name)) /= Name_Descriptor
or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else
Chars (Name (Mech_Name)) = Name_Short_Descriptor)
or else Present (Next (Param))
or else No (Selector_Name (Param))
or else Chars (Selector_Name (Param)) /= Name_Class
@ -145,27 +154,76 @@ package body Sem_Mech is
Bad_Class;
return;
elsif Chars (Class) = Name_UBS then
elsif Chars (Name (Mech_Name)) = Name_Descriptor
and then Chars (Class) = Name_UBS
then
Set_Mechanism_With_Checks (Ent, By_Descriptor_UBS, Mech_Name);
elsif Chars (Class) = Name_UBSB then
elsif Chars (Name (Mech_Name)) = Name_Descriptor
and then Chars (Class) = Name_UBSB
then
Set_Mechanism_With_Checks (Ent, By_Descriptor_UBSB, Mech_Name);
elsif Chars (Class) = Name_UBA then
elsif Chars (Name (Mech_Name)) = Name_Descriptor
and then Chars (Class) = Name_UBA
then
Set_Mechanism_With_Checks (Ent, By_Descriptor_UBA, Mech_Name);
elsif Chars (Class) = Name_S then
elsif Chars (Name (Mech_Name)) = Name_Descriptor
and then Chars (Class) = Name_S
then
Set_Mechanism_With_Checks (Ent, By_Descriptor_S, Mech_Name);
elsif Chars (Class) = Name_SB then
elsif Chars (Name (Mech_Name)) = Name_Descriptor
and then Chars (Class) = Name_SB
then
Set_Mechanism_With_Checks (Ent, By_Descriptor_SB, Mech_Name);
elsif Chars (Class) = Name_A then
elsif Chars (Name (Mech_Name)) = Name_Descriptor
and then Chars (Class) = Name_A
then
Set_Mechanism_With_Checks (Ent, By_Descriptor_A, Mech_Name);
elsif Chars (Class) = Name_NCA then
elsif Chars (Name (Mech_Name)) = Name_Descriptor
and then Chars (Class) = Name_NCA
then
Set_Mechanism_With_Checks (Ent, By_Descriptor_NCA, Mech_Name);
elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
and then Chars (Class) = Name_UBS
then
Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBS, Mech_Name);
elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
and then Chars (Class) = Name_UBSB
then
Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBSB, Mech_Name);
elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
and then Chars (Class) = Name_UBA
then
Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_UBA, Mech_Name);
elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
and then Chars (Class) = Name_S
then
Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_S, Mech_Name);
elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
and then Chars (Class) = Name_SB
then
Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_SB, Mech_Name);
elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
and then Chars (Class) = Name_A
then
Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_A, Mech_Name);
elsif Chars (Name (Mech_Name)) = Name_Short_Descriptor
and then Chars (Class) = Name_NCA
then
Set_Mechanism_With_Checks (Ent, By_Short_Descriptor_NCA, Mech_Name);
else
Bad_Class;
return;

View File

@ -95,6 +95,14 @@ package Sem_Mech is
By_Descriptor_SB : constant Mechanism_Type := -8;
By_Descriptor_A : constant Mechanism_Type := -9;
By_Descriptor_NCA : constant Mechanism_Type := -10;
By_Short_Descriptor : constant Mechanism_Type := -11;
By_Short_Descriptor_UBS : constant Mechanism_Type := -12;
By_Short_Descriptor_UBSB : constant Mechanism_Type := -13;
By_Short_Descriptor_UBA : constant Mechanism_Type := -14;
By_Short_Descriptor_S : constant Mechanism_Type := -15;
By_Short_Descriptor_SB : constant Mechanism_Type := -16;
By_Short_Descriptor_A : constant Mechanism_Type := -17;
By_Short_Descriptor_NCA : constant Mechanism_Type := -18;
-- These values are used only in OpenVMS ports of GNAT. Pass by descriptor
-- is forced, as described in the OpenVMS ABI. The suffix indicates the
-- descriptor type:
@ -113,7 +121,7 @@ package Sem_Mech is
-- type based on the Ada type in accordance with the OpenVMS ABI.
subtype Descriptor_Codes is Mechanism_Type
range By_Descriptor_NCA .. By_Descriptor;
range By_Short_Descriptor_NCA .. By_Descriptor;
-- Subtype including all descriptor mechanisms
-- All the above special values are non-positive. Positive values for

View File

@ -4622,6 +4622,7 @@ package body Sem_Prag is
procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id) is
Class : Node_Id;
Param : Node_Id;
Mech_Name_Id : Name_Id;
procedure Bad_Class;
-- Signal bad descriptor class name
@ -4655,7 +4656,8 @@ package body Sem_Prag is
("mechanism for & has already been set", Mech_Name, Ent);
end if;
-- MECHANISM_NAME ::= value | reference | descriptor
-- MECHANISM_NAME ::= value | reference | descriptor |
-- short_descriptor
if Nkind (Mech_Name) = N_Identifier then
if Chars (Mech_Name) = Name_Value then
@ -4671,6 +4673,11 @@ package body Sem_Prag is
Set_Mechanism (Ent, By_Descriptor);
return;
elsif Chars (Mech_Name) = Name_Short_Descriptor then
Check_VMS (Mech_Name);
Set_Mechanism (Ent, By_Short_Descriptor);
return;
elsif Chars (Mech_Name) = Name_Copy then
Error_Pragma_Arg
("bad mechanism name, Value assumed", Mech_Name);
@ -4679,22 +4686,28 @@ package body Sem_Prag is
Bad_Mechanism;
end if;
-- MECHANISM_NAME ::= descriptor (CLASS_NAME)
-- MECHANISM_NAME ::= descriptor (CLASS_NAME) |
-- short_descriptor (CLASS_NAME)
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
-- Note: this form is parsed as an indexed component
elsif Nkind (Mech_Name) = N_Indexed_Component then
Class := First (Expressions (Mech_Name));
if Nkind (Prefix (Mech_Name)) /= N_Identifier
or else Chars (Prefix (Mech_Name)) /= Name_Descriptor
or else Present (Next (Class))
or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else
Chars (Prefix (Mech_Name)) = Name_Short_Descriptor)
or else Present (Next (Class))
then
Bad_Mechanism;
else
Mech_Name_Id := Chars (Prefix (Mech_Name));
end if;
-- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME)
-- MECHANISM_NAME ::= descriptor (Class => CLASS_NAME) |
-- short_descriptor (Class => CLASS_NAME)
-- CLASS_NAME ::= ubs | ubsb | uba | s | sb | a | nca
-- Note: this form is parsed as a function call
@ -4704,7 +4717,8 @@ package body Sem_Prag is
Param := First (Parameter_Associations (Mech_Name));
if Nkind (Name (Mech_Name)) /= N_Identifier
or else Chars (Name (Mech_Name)) /= Name_Descriptor
or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else
Chars (Name (Mech_Name)) = Name_Short_Descriptor)
or else Present (Next (Param))
or else No (Selector_Name (Param))
or else Chars (Selector_Name (Param)) /= Name_Class
@ -4712,6 +4726,7 @@ package body Sem_Prag is
Bad_Mechanism;
else
Class := Explicit_Actual_Parameter (Param);
Mech_Name_Id := Chars (Name (Mech_Name));
end if;
else
@ -4725,27 +4740,76 @@ package body Sem_Prag is
if Nkind (Class) /= N_Identifier then
Bad_Class;
elsif Chars (Class) = Name_UBS then
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_UBS
then
Set_Mechanism (Ent, By_Descriptor_UBS);
elsif Chars (Class) = Name_UBSB then
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_UBSB
then
Set_Mechanism (Ent, By_Descriptor_UBSB);
elsif Chars (Class) = Name_UBA then
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_UBA
then
Set_Mechanism (Ent, By_Descriptor_UBA);
elsif Chars (Class) = Name_S then
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_S
then
Set_Mechanism (Ent, By_Descriptor_S);
elsif Chars (Class) = Name_SB then
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_SB
then
Set_Mechanism (Ent, By_Descriptor_SB);
elsif Chars (Class) = Name_A then
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_A
then
Set_Mechanism (Ent, By_Descriptor_A);
elsif Chars (Class) = Name_NCA then
elsif Mech_Name_Id = Name_Descriptor
and then Chars (Class) = Name_NCA
then
Set_Mechanism (Ent, By_Descriptor_NCA);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_UBS
then
Set_Mechanism (Ent, By_Short_Descriptor_UBS);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_UBSB
then
Set_Mechanism (Ent, By_Short_Descriptor_UBSB);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_UBA
then
Set_Mechanism (Ent, By_Short_Descriptor_UBA);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_S
then
Set_Mechanism (Ent, By_Short_Descriptor_S);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_SB
then
Set_Mechanism (Ent, By_Short_Descriptor_SB);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_A
then
Set_Mechanism (Ent, By_Short_Descriptor_A);
elsif Mech_Name_Id = Name_Short_Descriptor
and then Chars (Class) = Name_NCA
then
Set_Mechanism (Ent, By_Short_Descriptor_NCA);
else
Bad_Class;
end if;

View File

@ -415,6 +415,7 @@ package body Snames is
"secondary_stack_size#" &
"section#" &
"semaphore#" &
"short_descriptor#" &
"simple_barriers#" &
"spec_file_name#" &
"state#" &

View File

@ -643,28 +643,29 @@ package Snames is
Name_Secondary_Stack_Size : constant Name_Id := N + 354;
Name_Section : constant Name_Id := N + 355;
Name_Semaphore : constant Name_Id := N + 356;
Name_Simple_Barriers : constant Name_Id := N + 357;
Name_Spec_File_Name : constant Name_Id := N + 358;
Name_State : constant Name_Id := N + 359;
Name_Static : constant Name_Id := N + 360;
Name_Stack_Size : constant Name_Id := N + 361;
Name_Subunit_File_Name : constant Name_Id := N + 362;
Name_Task_Stack_Size_Default : constant Name_Id := N + 363;
Name_Task_Type : constant Name_Id := N + 364;
Name_Time_Slicing_Enabled : constant Name_Id := N + 365;
Name_Top_Guard : constant Name_Id := N + 366;
Name_UBA : constant Name_Id := N + 367;
Name_UBS : constant Name_Id := N + 368;
Name_UBSB : constant Name_Id := N + 369;
Name_Unit_Name : constant Name_Id := N + 370;
Name_Unknown : constant Name_Id := N + 371;
Name_Unrestricted : constant Name_Id := N + 372;
Name_Uppercase : constant Name_Id := N + 373;
Name_User : constant Name_Id := N + 374;
Name_VAX_Float : constant Name_Id := N + 375;
Name_VMS : constant Name_Id := N + 376;
Name_Vtable_Ptr : constant Name_Id := N + 377;
Name_Working_Storage : constant Name_Id := N + 378;
Name_Short_Descriptor : constant Name_Id := N + 357;
Name_Simple_Barriers : constant Name_Id := N + 358;
Name_Spec_File_Name : constant Name_Id := N + 359;
Name_State : constant Name_Id := N + 360;
Name_Static : constant Name_Id := N + 361;
Name_Stack_Size : constant Name_Id := N + 362;
Name_Subunit_File_Name : constant Name_Id := N + 363;
Name_Task_Stack_Size_Default : constant Name_Id := N + 364;
Name_Task_Type : constant Name_Id := N + 365;
Name_Time_Slicing_Enabled : constant Name_Id := N + 366;
Name_Top_Guard : constant Name_Id := N + 367;
Name_UBA : constant Name_Id := N + 368;
Name_UBS : constant Name_Id := N + 369;
Name_UBSB : constant Name_Id := N + 370;
Name_Unit_Name : constant Name_Id := N + 371;
Name_Unknown : constant Name_Id := N + 372;
Name_Unrestricted : constant Name_Id := N + 373;
Name_Uppercase : constant Name_Id := N + 374;
Name_User : constant Name_Id := N + 375;
Name_VAX_Float : constant Name_Id := N + 376;
Name_VMS : constant Name_Id := N + 377;
Name_Vtable_Ptr : constant Name_Id := N + 378;
Name_Working_Storage : constant Name_Id := N + 379;
-- Names of recognized attributes. The entries with the comment "Ada 83"
-- are attributes that are defined in Ada 83, but not in Ada 95. These
@ -678,175 +679,175 @@ package Snames is
-- The entries marked VMS are recognized only in OpenVMS implementations
-- of GNAT, and are treated as illegal in all other contexts.
First_Attribute_Name : constant Name_Id := N + 379;
Name_Abort_Signal : constant Name_Id := N + 379; -- GNAT
Name_Access : constant Name_Id := N + 380;
Name_Address : constant Name_Id := N + 381;
Name_Address_Size : constant Name_Id := N + 382; -- GNAT
Name_Aft : constant Name_Id := N + 383;
Name_Alignment : constant Name_Id := N + 384;
Name_Asm_Input : constant Name_Id := N + 385; -- GNAT
Name_Asm_Output : constant Name_Id := N + 386; -- GNAT
Name_AST_Entry : constant Name_Id := N + 387; -- VMS
Name_Bit : constant Name_Id := N + 388; -- GNAT
Name_Bit_Order : constant Name_Id := N + 389;
Name_Bit_Position : constant Name_Id := N + 390; -- GNAT
Name_Body_Version : constant Name_Id := N + 391;
Name_Callable : constant Name_Id := N + 392;
Name_Caller : constant Name_Id := N + 393;
Name_Code_Address : constant Name_Id := N + 394; -- GNAT
Name_Component_Size : constant Name_Id := N + 395;
Name_Compose : constant Name_Id := N + 396;
Name_Constrained : constant Name_Id := N + 397;
Name_Count : constant Name_Id := N + 398;
Name_Default_Bit_Order : constant Name_Id := N + 399; -- GNAT
Name_Definite : constant Name_Id := N + 400;
Name_Delta : constant Name_Id := N + 401;
Name_Denorm : constant Name_Id := N + 402;
Name_Digits : constant Name_Id := N + 403;
Name_Elaborated : constant Name_Id := N + 404; -- GNAT
Name_Emax : constant Name_Id := N + 405; -- Ada 83
Name_Enabled : constant Name_Id := N + 406; -- GNAT
Name_Enum_Rep : constant Name_Id := N + 407; -- GNAT
Name_Enum_Val : constant Name_Id := N + 408; -- GNAT
Name_Epsilon : constant Name_Id := N + 409; -- Ada 83
Name_Exponent : constant Name_Id := N + 410;
Name_External_Tag : constant Name_Id := N + 411;
Name_Fast_Math : constant Name_Id := N + 412; -- GNAT
Name_First : constant Name_Id := N + 413;
Name_First_Bit : constant Name_Id := N + 414;
Name_Fixed_Value : constant Name_Id := N + 415; -- GNAT
Name_Fore : constant Name_Id := N + 416;
Name_Has_Access_Values : constant Name_Id := N + 417; -- GNAT
Name_Has_Discriminants : constant Name_Id := N + 418; -- GNAT
Name_Has_Tagged_Values : constant Name_Id := N + 419; -- GNAT
Name_Identity : constant Name_Id := N + 420;
Name_Img : constant Name_Id := N + 421; -- GNAT
Name_Integer_Value : constant Name_Id := N + 422; -- GNAT
Name_Invalid_Value : constant Name_Id := N + 423; -- GNAT
Name_Large : constant Name_Id := N + 424; -- Ada 83
Name_Last : constant Name_Id := N + 425;
Name_Last_Bit : constant Name_Id := N + 426;
Name_Leading_Part : constant Name_Id := N + 427;
Name_Length : constant Name_Id := N + 428;
Name_Machine_Emax : constant Name_Id := N + 429;
Name_Machine_Emin : constant Name_Id := N + 430;
Name_Machine_Mantissa : constant Name_Id := N + 431;
Name_Machine_Overflows : constant Name_Id := N + 432;
Name_Machine_Radix : constant Name_Id := N + 433;
Name_Machine_Rounding : constant Name_Id := N + 434; -- Ada 05
Name_Machine_Rounds : constant Name_Id := N + 435;
Name_Machine_Size : constant Name_Id := N + 436; -- GNAT
Name_Mantissa : constant Name_Id := N + 437; -- Ada 83
Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 438;
Name_Maximum_Alignment : constant Name_Id := N + 439; -- GNAT
Name_Mechanism_Code : constant Name_Id := N + 440; -- GNAT
Name_Mod : constant Name_Id := N + 441; -- Ada 05
Name_Model_Emin : constant Name_Id := N + 442;
Name_Model_Epsilon : constant Name_Id := N + 443;
Name_Model_Mantissa : constant Name_Id := N + 444;
Name_Model_Small : constant Name_Id := N + 445;
Name_Modulus : constant Name_Id := N + 446;
Name_Null_Parameter : constant Name_Id := N + 447; -- GNAT
Name_Object_Size : constant Name_Id := N + 448; -- GNAT
Name_Old : constant Name_Id := N + 449; -- GNAT
Name_Partition_ID : constant Name_Id := N + 450;
Name_Passed_By_Reference : constant Name_Id := N + 451; -- GNAT
Name_Pool_Address : constant Name_Id := N + 452;
Name_Pos : constant Name_Id := N + 453;
Name_Position : constant Name_Id := N + 454;
Name_Priority : constant Name_Id := N + 455; -- Ada 05
Name_Range : constant Name_Id := N + 456;
Name_Range_Length : constant Name_Id := N + 457; -- GNAT
Name_Result : constant Name_Id := N + 458; -- GNAT
Name_Round : constant Name_Id := N + 459;
Name_Safe_Emax : constant Name_Id := N + 460; -- Ada 83
Name_Safe_First : constant Name_Id := N + 461;
Name_Safe_Large : constant Name_Id := N + 462; -- Ada 83
Name_Safe_Last : constant Name_Id := N + 463;
Name_Safe_Small : constant Name_Id := N + 464; -- Ada 83
Name_Scale : constant Name_Id := N + 465;
Name_Scaling : constant Name_Id := N + 466;
Name_Signed_Zeros : constant Name_Id := N + 467;
Name_Size : constant Name_Id := N + 468;
Name_Small : constant Name_Id := N + 469;
Name_Storage_Size : constant Name_Id := N + 470;
Name_Storage_Unit : constant Name_Id := N + 471; -- GNAT
Name_Stream_Size : constant Name_Id := N + 472; -- Ada 05
Name_Tag : constant Name_Id := N + 473;
Name_Target_Name : constant Name_Id := N + 474; -- GNAT
Name_Terminated : constant Name_Id := N + 475;
Name_To_Address : constant Name_Id := N + 476; -- GNAT
Name_Type_Class : constant Name_Id := N + 477; -- GNAT
Name_UET_Address : constant Name_Id := N + 478; -- GNAT
Name_Unbiased_Rounding : constant Name_Id := N + 479;
Name_Unchecked_Access : constant Name_Id := N + 480;
Name_Unconstrained_Array : constant Name_Id := N + 481;
Name_Universal_Literal_String : constant Name_Id := N + 482; -- GNAT
Name_Unrestricted_Access : constant Name_Id := N + 483; -- GNAT
Name_VADS_Size : constant Name_Id := N + 484; -- GNAT
Name_Val : constant Name_Id := N + 485;
Name_Valid : constant Name_Id := N + 486;
Name_Value_Size : constant Name_Id := N + 487; -- GNAT
Name_Version : constant Name_Id := N + 488;
Name_Wchar_T_Size : constant Name_Id := N + 489; -- GNAT
Name_Wide_Wide_Width : constant Name_Id := N + 490; -- Ada 05
Name_Wide_Width : constant Name_Id := N + 491;
Name_Width : constant Name_Id := N + 492;
Name_Word_Size : constant Name_Id := N + 493; -- GNAT
First_Attribute_Name : constant Name_Id := N + 380;
Name_Abort_Signal : constant Name_Id := N + 380; -- GNAT
Name_Access : constant Name_Id := N + 381;
Name_Address : constant Name_Id := N + 382;
Name_Address_Size : constant Name_Id := N + 383; -- GNAT
Name_Aft : constant Name_Id := N + 384;
Name_Alignment : constant Name_Id := N + 385;
Name_Asm_Input : constant Name_Id := N + 386; -- GNAT
Name_Asm_Output : constant Name_Id := N + 387; -- GNAT
Name_AST_Entry : constant Name_Id := N + 388; -- VMS
Name_Bit : constant Name_Id := N + 389; -- GNAT
Name_Bit_Order : constant Name_Id := N + 390;
Name_Bit_Position : constant Name_Id := N + 391; -- GNAT
Name_Body_Version : constant Name_Id := N + 392;
Name_Callable : constant Name_Id := N + 393;
Name_Caller : constant Name_Id := N + 394;
Name_Code_Address : constant Name_Id := N + 395; -- GNAT
Name_Component_Size : constant Name_Id := N + 396;
Name_Compose : constant Name_Id := N + 397;
Name_Constrained : constant Name_Id := N + 398;
Name_Count : constant Name_Id := N + 399;
Name_Default_Bit_Order : constant Name_Id := N + 400; -- GNAT
Name_Definite : constant Name_Id := N + 401;
Name_Delta : constant Name_Id := N + 402;
Name_Denorm : constant Name_Id := N + 403;
Name_Digits : constant Name_Id := N + 404;
Name_Elaborated : constant Name_Id := N + 405; -- GNAT
Name_Emax : constant Name_Id := N + 406; -- Ada 83
Name_Enabled : constant Name_Id := N + 407; -- GNAT
Name_Enum_Rep : constant Name_Id := N + 408; -- GNAT
Name_Enum_Val : constant Name_Id := N + 409; -- GNAT
Name_Epsilon : constant Name_Id := N + 410; -- Ada 83
Name_Exponent : constant Name_Id := N + 411;
Name_External_Tag : constant Name_Id := N + 412;
Name_Fast_Math : constant Name_Id := N + 413; -- GNAT
Name_First : constant Name_Id := N + 414;
Name_First_Bit : constant Name_Id := N + 415;
Name_Fixed_Value : constant Name_Id := N + 416; -- GNAT
Name_Fore : constant Name_Id := N + 417;
Name_Has_Access_Values : constant Name_Id := N + 418; -- GNAT
Name_Has_Discriminants : constant Name_Id := N + 419; -- GNAT
Name_Has_Tagged_Values : constant Name_Id := N + 420; -- GNAT
Name_Identity : constant Name_Id := N + 421;
Name_Img : constant Name_Id := N + 422; -- GNAT
Name_Integer_Value : constant Name_Id := N + 423; -- GNAT
Name_Invalid_Value : constant Name_Id := N + 424; -- GNAT
Name_Large : constant Name_Id := N + 425; -- Ada 83
Name_Last : constant Name_Id := N + 426;
Name_Last_Bit : constant Name_Id := N + 427;
Name_Leading_Part : constant Name_Id := N + 428;
Name_Length : constant Name_Id := N + 429;
Name_Machine_Emax : constant Name_Id := N + 430;
Name_Machine_Emin : constant Name_Id := N + 431;
Name_Machine_Mantissa : constant Name_Id := N + 432;
Name_Machine_Overflows : constant Name_Id := N + 433;
Name_Machine_Radix : constant Name_Id := N + 434;
Name_Machine_Rounding : constant Name_Id := N + 435; -- Ada 05
Name_Machine_Rounds : constant Name_Id := N + 436;
Name_Machine_Size : constant Name_Id := N + 437; -- GNAT
Name_Mantissa : constant Name_Id := N + 438; -- Ada 83
Name_Max_Size_In_Storage_Elements : constant Name_Id := N + 439;
Name_Maximum_Alignment : constant Name_Id := N + 440; -- GNAT
Name_Mechanism_Code : constant Name_Id := N + 441; -- GNAT
Name_Mod : constant Name_Id := N + 442; -- Ada 05
Name_Model_Emin : constant Name_Id := N + 443;
Name_Model_Epsilon : constant Name_Id := N + 444;
Name_Model_Mantissa : constant Name_Id := N + 445;
Name_Model_Small : constant Name_Id := N + 446;
Name_Modulus : constant Name_Id := N + 447;
Name_Null_Parameter : constant Name_Id := N + 448; -- GNAT
Name_Object_Size : constant Name_Id := N + 449; -- GNAT
Name_Old : constant Name_Id := N + 450; -- GNAT
Name_Partition_ID : constant Name_Id := N + 451;
Name_Passed_By_Reference : constant Name_Id := N + 452; -- GNAT
Name_Pool_Address : constant Name_Id := N + 453;
Name_Pos : constant Name_Id := N + 454;
Name_Position : constant Name_Id := N + 455;
Name_Priority : constant Name_Id := N + 456; -- Ada 05
Name_Range : constant Name_Id := N + 457;
Name_Range_Length : constant Name_Id := N + 458; -- GNAT
Name_Result : constant Name_Id := N + 459; -- GNAT
Name_Round : constant Name_Id := N + 460;
Name_Safe_Emax : constant Name_Id := N + 461; -- Ada 83
Name_Safe_First : constant Name_Id := N + 462;
Name_Safe_Large : constant Name_Id := N + 463; -- Ada 83
Name_Safe_Last : constant Name_Id := N + 464;
Name_Safe_Small : constant Name_Id := N + 465; -- Ada 83
Name_Scale : constant Name_Id := N + 466;
Name_Scaling : constant Name_Id := N + 467;
Name_Signed_Zeros : constant Name_Id := N + 468;
Name_Size : constant Name_Id := N + 469;
Name_Small : constant Name_Id := N + 470;
Name_Storage_Size : constant Name_Id := N + 471;
Name_Storage_Unit : constant Name_Id := N + 472; -- GNAT
Name_Stream_Size : constant Name_Id := N + 473; -- Ada 05
Name_Tag : constant Name_Id := N + 474;
Name_Target_Name : constant Name_Id := N + 475; -- GNAT
Name_Terminated : constant Name_Id := N + 476;
Name_To_Address : constant Name_Id := N + 477; -- GNAT
Name_Type_Class : constant Name_Id := N + 478; -- GNAT
Name_UET_Address : constant Name_Id := N + 479; -- GNAT
Name_Unbiased_Rounding : constant Name_Id := N + 480;
Name_Unchecked_Access : constant Name_Id := N + 481;
Name_Unconstrained_Array : constant Name_Id := N + 482;
Name_Universal_Literal_String : constant Name_Id := N + 483; -- GNAT
Name_Unrestricted_Access : constant Name_Id := N + 484; -- GNAT
Name_VADS_Size : constant Name_Id := N + 485; -- GNAT
Name_Val : constant Name_Id := N + 486;
Name_Valid : constant Name_Id := N + 487;
Name_Value_Size : constant Name_Id := N + 488; -- GNAT
Name_Version : constant Name_Id := N + 489;
Name_Wchar_T_Size : constant Name_Id := N + 490; -- GNAT
Name_Wide_Wide_Width : constant Name_Id := N + 491; -- Ada 05
Name_Wide_Width : constant Name_Id := N + 492;
Name_Width : constant Name_Id := N + 493;
Name_Word_Size : constant Name_Id := N + 494; -- GNAT
-- Attributes that designate attributes returning renamable functions,
-- i.e. functions that return other than a universal value and that
-- have non-universal arguments.
First_Renamable_Function_Attribute : constant Name_Id := N + 494;
Name_Adjacent : constant Name_Id := N + 494;
Name_Ceiling : constant Name_Id := N + 495;
Name_Copy_Sign : constant Name_Id := N + 496;
Name_Floor : constant Name_Id := N + 497;
Name_Fraction : constant Name_Id := N + 498;
Name_Image : constant Name_Id := N + 499;
Name_Input : constant Name_Id := N + 500;
Name_Machine : constant Name_Id := N + 501;
Name_Max : constant Name_Id := N + 502;
Name_Min : constant Name_Id := N + 503;
Name_Model : constant Name_Id := N + 504;
Name_Pred : constant Name_Id := N + 505;
Name_Remainder : constant Name_Id := N + 506;
Name_Rounding : constant Name_Id := N + 507;
Name_Succ : constant Name_Id := N + 508;
Name_Truncation : constant Name_Id := N + 509;
Name_Value : constant Name_Id := N + 510;
Name_Wide_Image : constant Name_Id := N + 511;
Name_Wide_Wide_Image : constant Name_Id := N + 512;
Name_Wide_Value : constant Name_Id := N + 513;
Name_Wide_Wide_Value : constant Name_Id := N + 514;
Last_Renamable_Function_Attribute : constant Name_Id := N + 514;
First_Renamable_Function_Attribute : constant Name_Id := N + 495;
Name_Adjacent : constant Name_Id := N + 495;
Name_Ceiling : constant Name_Id := N + 496;
Name_Copy_Sign : constant Name_Id := N + 497;
Name_Floor : constant Name_Id := N + 498;
Name_Fraction : constant Name_Id := N + 499;
Name_Image : constant Name_Id := N + 500;
Name_Input : constant Name_Id := N + 501;
Name_Machine : constant Name_Id := N + 502;
Name_Max : constant Name_Id := N + 503;
Name_Min : constant Name_Id := N + 504;
Name_Model : constant Name_Id := N + 505;
Name_Pred : constant Name_Id := N + 506;
Name_Remainder : constant Name_Id := N + 507;
Name_Rounding : constant Name_Id := N + 508;
Name_Succ : constant Name_Id := N + 509;
Name_Truncation : constant Name_Id := N + 510;
Name_Value : constant Name_Id := N + 511;
Name_Wide_Image : constant Name_Id := N + 512;
Name_Wide_Wide_Image : constant Name_Id := N + 513;
Name_Wide_Value : constant Name_Id := N + 514;
Name_Wide_Wide_Value : constant Name_Id := N + 515;
Last_Renamable_Function_Attribute : constant Name_Id := N + 515;
-- Attributes that designate procedures
First_Procedure_Attribute : constant Name_Id := N + 515;
Name_Output : constant Name_Id := N + 515;
Name_Read : constant Name_Id := N + 516;
Name_Write : constant Name_Id := N + 517;
Last_Procedure_Attribute : constant Name_Id := N + 517;
First_Procedure_Attribute : constant Name_Id := N + 516;
Name_Output : constant Name_Id := N + 516;
Name_Read : constant Name_Id := N + 517;
Name_Write : constant Name_Id := N + 518;
Last_Procedure_Attribute : constant Name_Id := N + 518;
-- Remaining attributes are ones that return entities
First_Entity_Attribute_Name : constant Name_Id := N + 518;
Name_Elab_Body : constant Name_Id := N + 518; -- GNAT
Name_Elab_Spec : constant Name_Id := N + 519; -- GNAT
Name_Storage_Pool : constant Name_Id := N + 520;
First_Entity_Attribute_Name : constant Name_Id := N + 519;
Name_Elab_Body : constant Name_Id := N + 519; -- GNAT
Name_Elab_Spec : constant Name_Id := N + 520; -- GNAT
Name_Storage_Pool : constant Name_Id := N + 521;
-- These attributes are the ones that return types
First_Type_Attribute_Name : constant Name_Id := N + 521;
Name_Base : constant Name_Id := N + 521;
Name_Class : constant Name_Id := N + 522;
Name_Stub_Type : constant Name_Id := N + 523;
Last_Type_Attribute_Name : constant Name_Id := N + 523;
Last_Entity_Attribute_Name : constant Name_Id := N + 523;
Last_Attribute_Name : constant Name_Id := N + 523;
First_Type_Attribute_Name : constant Name_Id := N + 522;
Name_Base : constant Name_Id := N + 522;
Name_Class : constant Name_Id := N + 523;
Name_Stub_Type : constant Name_Id := N + 524;
Last_Type_Attribute_Name : constant Name_Id := N + 524;
Last_Entity_Attribute_Name : constant Name_Id := N + 524;
Last_Attribute_Name : constant Name_Id := N + 524;
-- Names of recognized locking policy identifiers
@ -854,10 +855,10 @@ package Snames is
-- name (e.g. C for Ceiling_Locking). If new policy names are added,
-- the first character must be distinct.
First_Locking_Policy_Name : constant Name_Id := N + 524;
Name_Ceiling_Locking : constant Name_Id := N + 524;
Name_Inheritance_Locking : constant Name_Id := N + 525;
Last_Locking_Policy_Name : constant Name_Id := N + 525;
First_Locking_Policy_Name : constant Name_Id := N + 525;
Name_Ceiling_Locking : constant Name_Id := N + 525;
Name_Inheritance_Locking : constant Name_Id := N + 526;
Last_Locking_Policy_Name : constant Name_Id := N + 526;
-- Names of recognized queuing policy identifiers
@ -865,10 +866,10 @@ package Snames is
-- name (e.g. F for FIFO_Queuing). If new policy names are added,
-- the first character must be distinct.
First_Queuing_Policy_Name : constant Name_Id := N + 526;
Name_FIFO_Queuing : constant Name_Id := N + 526;
Name_Priority_Queuing : constant Name_Id := N + 527;
Last_Queuing_Policy_Name : constant Name_Id := N + 527;
First_Queuing_Policy_Name : constant Name_Id := N + 527;
Name_FIFO_Queuing : constant Name_Id := N + 527;
Name_Priority_Queuing : constant Name_Id := N + 528;
Last_Queuing_Policy_Name : constant Name_Id := N + 528;
-- Names of recognized task dispatching policy identifiers
@ -876,283 +877,283 @@ package Snames is
-- name (e.g. F for FIFO_Within_Priorities). If new policy names
-- are added, the first character must be distinct.
First_Task_Dispatching_Policy_Name : constant Name_Id := N + 528;
Name_EDF_Across_Priorities : constant Name_Id := N + 528;
Name_FIFO_Within_Priorities : constant Name_Id := N + 529;
Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 530;
Name_Round_Robin_Within_Priorities : constant Name_Id := N + 531;
Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 531;
First_Task_Dispatching_Policy_Name : constant Name_Id := N + 529;
Name_EDF_Across_Priorities : constant Name_Id := N + 529;
Name_FIFO_Within_Priorities : constant Name_Id := N + 530;
Name_Non_Preemptive_Within_Priorities : constant Name_Id := N + 531;
Name_Round_Robin_Within_Priorities : constant Name_Id := N + 532;
Last_Task_Dispatching_Policy_Name : constant Name_Id := N + 532;
-- Names of recognized checks for pragma Suppress
First_Check_Name : constant Name_Id := N + 532;
Name_Access_Check : constant Name_Id := N + 532;
Name_Accessibility_Check : constant Name_Id := N + 533;
Name_Alignment_Check : constant Name_Id := N + 534; -- GNAT
Name_Discriminant_Check : constant Name_Id := N + 535;
Name_Division_Check : constant Name_Id := N + 536;
Name_Elaboration_Check : constant Name_Id := N + 537;
Name_Index_Check : constant Name_Id := N + 538;
Name_Length_Check : constant Name_Id := N + 539;
Name_Overflow_Check : constant Name_Id := N + 540;
Name_Range_Check : constant Name_Id := N + 541;
Name_Storage_Check : constant Name_Id := N + 542;
Name_Tag_Check : constant Name_Id := N + 543;
Name_Validity_Check : constant Name_Id := N + 544; -- GNAT
Name_All_Checks : constant Name_Id := N + 545;
Last_Check_Name : constant Name_Id := N + 545;
First_Check_Name : constant Name_Id := N + 533;
Name_Access_Check : constant Name_Id := N + 533;
Name_Accessibility_Check : constant Name_Id := N + 534;
Name_Alignment_Check : constant Name_Id := N + 535; -- GNAT
Name_Discriminant_Check : constant Name_Id := N + 536;
Name_Division_Check : constant Name_Id := N + 537;
Name_Elaboration_Check : constant Name_Id := N + 538;
Name_Index_Check : constant Name_Id := N + 539;
Name_Length_Check : constant Name_Id := N + 540;
Name_Overflow_Check : constant Name_Id := N + 541;
Name_Range_Check : constant Name_Id := N + 542;
Name_Storage_Check : constant Name_Id := N + 543;
Name_Tag_Check : constant Name_Id := N + 544;
Name_Validity_Check : constant Name_Id := N + 545; -- GNAT
Name_All_Checks : constant Name_Id := N + 546;
Last_Check_Name : constant Name_Id := N + 546;
-- Names corresponding to reserved keywords, excluding those already
-- declared in the attribute list (Access, Delta, Digits, Mod, Range).
Name_Abort : constant Name_Id := N + 546;
Name_Abs : constant Name_Id := N + 547;
Name_Accept : constant Name_Id := N + 548;
Name_And : constant Name_Id := N + 549;
Name_All : constant Name_Id := N + 550;
Name_Array : constant Name_Id := N + 551;
Name_At : constant Name_Id := N + 552;
Name_Begin : constant Name_Id := N + 553;
Name_Body : constant Name_Id := N + 554;
Name_Case : constant Name_Id := N + 555;
Name_Constant : constant Name_Id := N + 556;
Name_Declare : constant Name_Id := N + 557;
Name_Delay : constant Name_Id := N + 558;
Name_Do : constant Name_Id := N + 559;
Name_Else : constant Name_Id := N + 560;
Name_Elsif : constant Name_Id := N + 561;
Name_End : constant Name_Id := N + 562;
Name_Entry : constant Name_Id := N + 563;
Name_Exception : constant Name_Id := N + 564;
Name_Exit : constant Name_Id := N + 565;
Name_For : constant Name_Id := N + 566;
Name_Function : constant Name_Id := N + 567;
Name_Generic : constant Name_Id := N + 568;
Name_Goto : constant Name_Id := N + 569;
Name_If : constant Name_Id := N + 570;
Name_In : constant Name_Id := N + 571;
Name_Is : constant Name_Id := N + 572;
Name_Limited : constant Name_Id := N + 573;
Name_Loop : constant Name_Id := N + 574;
Name_New : constant Name_Id := N + 575;
Name_Not : constant Name_Id := N + 576;
Name_Null : constant Name_Id := N + 577;
Name_Of : constant Name_Id := N + 578;
Name_Or : constant Name_Id := N + 579;
Name_Others : constant Name_Id := N + 580;
Name_Out : constant Name_Id := N + 581;
Name_Package : constant Name_Id := N + 582;
Name_Pragma : constant Name_Id := N + 583;
Name_Private : constant Name_Id := N + 584;
Name_Procedure : constant Name_Id := N + 585;
Name_Raise : constant Name_Id := N + 586;
Name_Record : constant Name_Id := N + 587;
Name_Rem : constant Name_Id := N + 588;
Name_Renames : constant Name_Id := N + 589;
Name_Return : constant Name_Id := N + 590;
Name_Reverse : constant Name_Id := N + 591;
Name_Select : constant Name_Id := N + 592;
Name_Separate : constant Name_Id := N + 593;
Name_Subtype : constant Name_Id := N + 594;
Name_Task : constant Name_Id := N + 595;
Name_Terminate : constant Name_Id := N + 596;
Name_Then : constant Name_Id := N + 597;
Name_Type : constant Name_Id := N + 598;
Name_Use : constant Name_Id := N + 599;
Name_When : constant Name_Id := N + 600;
Name_While : constant Name_Id := N + 601;
Name_With : constant Name_Id := N + 602;
Name_Xor : constant Name_Id := N + 603;
Name_Abort : constant Name_Id := N + 547;
Name_Abs : constant Name_Id := N + 548;
Name_Accept : constant Name_Id := N + 549;
Name_And : constant Name_Id := N + 550;
Name_All : constant Name_Id := N + 551;
Name_Array : constant Name_Id := N + 552;
Name_At : constant Name_Id := N + 553;
Name_Begin : constant Name_Id := N + 554;
Name_Body : constant Name_Id := N + 555;
Name_Case : constant Name_Id := N + 556;
Name_Constant : constant Name_Id := N + 557;
Name_Declare : constant Name_Id := N + 558;
Name_Delay : constant Name_Id := N + 559;
Name_Do : constant Name_Id := N + 560;
Name_Else : constant Name_Id := N + 561;
Name_Elsif : constant Name_Id := N + 562;
Name_End : constant Name_Id := N + 563;
Name_Entry : constant Name_Id := N + 564;
Name_Exception : constant Name_Id := N + 565;
Name_Exit : constant Name_Id := N + 566;
Name_For : constant Name_Id := N + 567;
Name_Function : constant Name_Id := N + 568;
Name_Generic : constant Name_Id := N + 569;
Name_Goto : constant Name_Id := N + 570;
Name_If : constant Name_Id := N + 571;
Name_In : constant Name_Id := N + 572;
Name_Is : constant Name_Id := N + 573;
Name_Limited : constant Name_Id := N + 574;
Name_Loop : constant Name_Id := N + 575;
Name_New : constant Name_Id := N + 576;
Name_Not : constant Name_Id := N + 577;
Name_Null : constant Name_Id := N + 578;
Name_Of : constant Name_Id := N + 579;
Name_Or : constant Name_Id := N + 580;
Name_Others : constant Name_Id := N + 581;
Name_Out : constant Name_Id := N + 582;
Name_Package : constant Name_Id := N + 583;
Name_Pragma : constant Name_Id := N + 584;
Name_Private : constant Name_Id := N + 585;
Name_Procedure : constant Name_Id := N + 586;
Name_Raise : constant Name_Id := N + 587;
Name_Record : constant Name_Id := N + 588;
Name_Rem : constant Name_Id := N + 589;
Name_Renames : constant Name_Id := N + 590;
Name_Return : constant Name_Id := N + 591;
Name_Reverse : constant Name_Id := N + 592;
Name_Select : constant Name_Id := N + 593;
Name_Separate : constant Name_Id := N + 594;
Name_Subtype : constant Name_Id := N + 595;
Name_Task : constant Name_Id := N + 596;
Name_Terminate : constant Name_Id := N + 597;
Name_Then : constant Name_Id := N + 598;
Name_Type : constant Name_Id := N + 599;
Name_Use : constant Name_Id := N + 600;
Name_When : constant Name_Id := N + 601;
Name_While : constant Name_Id := N + 602;
Name_With : constant Name_Id := N + 603;
Name_Xor : constant Name_Id := N + 604;
-- Names of intrinsic subprograms
-- Note: Asm is missing from this list, since Asm is a legitimate
-- convention name. So is To_Address, which is a GNAT attribute.
First_Intrinsic_Name : constant Name_Id := N + 604;
Name_Divide : constant Name_Id := N + 604;
Name_Enclosing_Entity : constant Name_Id := N + 605;
Name_Exception_Information : constant Name_Id := N + 606;
Name_Exception_Message : constant Name_Id := N + 607;
Name_Exception_Name : constant Name_Id := N + 608;
Name_File : constant Name_Id := N + 609;
Name_Generic_Dispatching_Constructor : constant Name_Id := N + 610;
Name_Import_Address : constant Name_Id := N + 611;
Name_Import_Largest_Value : constant Name_Id := N + 612;
Name_Import_Value : constant Name_Id := N + 613;
Name_Is_Negative : constant Name_Id := N + 614;
Name_Line : constant Name_Id := N + 615;
Name_Rotate_Left : constant Name_Id := N + 616;
Name_Rotate_Right : constant Name_Id := N + 617;
Name_Shift_Left : constant Name_Id := N + 618;
Name_Shift_Right : constant Name_Id := N + 619;
Name_Shift_Right_Arithmetic : constant Name_Id := N + 620;
Name_Source_Location : constant Name_Id := N + 621;
Name_Unchecked_Conversion : constant Name_Id := N + 622;
Name_Unchecked_Deallocation : constant Name_Id := N + 623;
Name_To_Pointer : constant Name_Id := N + 624;
Last_Intrinsic_Name : constant Name_Id := N + 624;
First_Intrinsic_Name : constant Name_Id := N + 605;
Name_Divide : constant Name_Id := N + 605;
Name_Enclosing_Entity : constant Name_Id := N + 606;
Name_Exception_Information : constant Name_Id := N + 607;
Name_Exception_Message : constant Name_Id := N + 608;
Name_Exception_Name : constant Name_Id := N + 609;
Name_File : constant Name_Id := N + 610;
Name_Generic_Dispatching_Constructor : constant Name_Id := N + 611;
Name_Import_Address : constant Name_Id := N + 612;
Name_Import_Largest_Value : constant Name_Id := N + 613;
Name_Import_Value : constant Name_Id := N + 614;
Name_Is_Negative : constant Name_Id := N + 615;
Name_Line : constant Name_Id := N + 616;
Name_Rotate_Left : constant Name_Id := N + 617;
Name_Rotate_Right : constant Name_Id := N + 618;
Name_Shift_Left : constant Name_Id := N + 619;
Name_Shift_Right : constant Name_Id := N + 620;
Name_Shift_Right_Arithmetic : constant Name_Id := N + 621;
Name_Source_Location : constant Name_Id := N + 622;
Name_Unchecked_Conversion : constant Name_Id := N + 623;
Name_Unchecked_Deallocation : constant Name_Id := N + 624;
Name_To_Pointer : constant Name_Id := N + 625;
Last_Intrinsic_Name : constant Name_Id := N + 625;
-- Names used in processing intrinsic calls
Name_Free : constant Name_Id := N + 625;
Name_Free : constant Name_Id := N + 626;
-- Reserved words used only in Ada 95
First_95_Reserved_Word : constant Name_Id := N + 626;
Name_Abstract : constant Name_Id := N + 626;
Name_Aliased : constant Name_Id := N + 627;
Name_Protected : constant Name_Id := N + 628;
Name_Until : constant Name_Id := N + 629;
Name_Requeue : constant Name_Id := N + 630;
Name_Tagged : constant Name_Id := N + 631;
Last_95_Reserved_Word : constant Name_Id := N + 631;
First_95_Reserved_Word : constant Name_Id := N + 627;
Name_Abstract : constant Name_Id := N + 627;
Name_Aliased : constant Name_Id := N + 628;
Name_Protected : constant Name_Id := N + 629;
Name_Until : constant Name_Id := N + 630;
Name_Requeue : constant Name_Id := N + 631;
Name_Tagged : constant Name_Id := N + 632;
Last_95_Reserved_Word : constant Name_Id := N + 632;
subtype Ada_95_Reserved_Words is
Name_Id range First_95_Reserved_Word .. Last_95_Reserved_Word;
-- Miscellaneous names used in semantic checking
Name_Raise_Exception : constant Name_Id := N + 632;
Name_Raise_Exception : constant Name_Id := N + 633;
-- Additional reserved words and identifiers used in GNAT Project Files
-- Note that Name_External is already previously declared
Name_Ada_Roots : constant Name_Id := N + 633;
Name_Aggregate : constant Name_Id := N + 634;
Name_Archive_Builder : constant Name_Id := N + 635;
Name_Archive_Builder_Append_Option : constant Name_Id := N + 636;
Name_Archive_Indexer : constant Name_Id := N + 637;
Name_Archive_Suffix : constant Name_Id := N + 638;
Name_Binder : constant Name_Id := N + 639;
Name_Binder_Prefix : constant Name_Id := N + 640;
Name_Body_Suffix : constant Name_Id := N + 641;
Name_Builder : constant Name_Id := N + 642;
Name_Builder_Switches : constant Name_Id := N + 643;
Name_Compiler : constant Name_Id := N + 644;
Name_Compiler_Kind : constant Name_Id := N + 645;
Name_Config_Body_File_Name : constant Name_Id := N + 646;
Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 647;
Name_Config_File_Switches : constant Name_Id := N + 648;
Name_Config_File_Unique : constant Name_Id := N + 649;
Name_Config_Spec_File_Name : constant Name_Id := N + 650;
Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 651;
Name_Configuration : constant Name_Id := N + 652;
Name_Cross_Reference : constant Name_Id := N + 653;
Name_Default_Language : constant Name_Id := N + 654;
Name_Default_Switches : constant Name_Id := N + 655;
Name_Dependency_Driver : constant Name_Id := N + 656;
Name_Dependency_File_Kind : constant Name_Id := N + 657;
Name_Dependency_Switches : constant Name_Id := N + 658;
Name_Driver : constant Name_Id := N + 659;
Name_Excluded_Source_Dirs : constant Name_Id := N + 660;
Name_Excluded_Source_Files : constant Name_Id := N + 661;
Name_Excluded_Source_List_File : constant Name_Id := N + 662;
Name_Exec_Dir : constant Name_Id := N + 663;
Name_Executable : constant Name_Id := N + 664;
Name_Executable_Suffix : constant Name_Id := N + 665;
Name_Extends : constant Name_Id := N + 666;
Name_Externally_Built : constant Name_Id := N + 667;
Name_Finder : constant Name_Id := N + 668;
Name_Global_Configuration_Pragmas : constant Name_Id := N + 669;
Name_Global_Config_File : constant Name_Id := N + 670;
Name_Gnatls : constant Name_Id := N + 671;
Name_Gnatstub : constant Name_Id := N + 672;
Name_Implementation : constant Name_Id := N + 673;
Name_Implementation_Exceptions : constant Name_Id := N + 674;
Name_Implementation_Suffix : constant Name_Id := N + 675;
Name_Include_Switches : constant Name_Id := N + 676;
Name_Include_Path : constant Name_Id := N + 677;
Name_Include_Path_File : constant Name_Id := N + 678;
Name_Inherit_Source_Path : constant Name_Id := N + 679;
Name_Language_Kind : constant Name_Id := N + 680;
Name_Language_Processing : constant Name_Id := N + 681;
Name_Languages : constant Name_Id := N + 682;
Name_Library : constant Name_Id := N + 683;
Name_Library_Ali_Dir : constant Name_Id := N + 684;
Name_Library_Auto_Init : constant Name_Id := N + 685;
Name_Library_Auto_Init_Supported : constant Name_Id := N + 686;
Name_Library_Builder : constant Name_Id := N + 687;
Name_Library_Dir : constant Name_Id := N + 688;
Name_Library_GCC : constant Name_Id := N + 689;
Name_Library_Interface : constant Name_Id := N + 690;
Name_Library_Kind : constant Name_Id := N + 691;
Name_Library_Name : constant Name_Id := N + 692;
Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 693;
Name_Library_Options : constant Name_Id := N + 694;
Name_Library_Partial_Linker : constant Name_Id := N + 695;
Name_Library_Reference_Symbol_File : constant Name_Id := N + 696;
Name_Library_Src_Dir : constant Name_Id := N + 697;
Name_Library_Support : constant Name_Id := N + 698;
Name_Library_Symbol_File : constant Name_Id := N + 699;
Name_Library_Symbol_Policy : constant Name_Id := N + 700;
Name_Library_Version : constant Name_Id := N + 701;
Name_Library_Version_Switches : constant Name_Id := N + 702;
Name_Linker : constant Name_Id := N + 703;
Name_Linker_Executable_Option : constant Name_Id := N + 704;
Name_Linker_Lib_Dir_Option : constant Name_Id := N + 705;
Name_Linker_Lib_Name_Option : constant Name_Id := N + 706;
Name_Local_Config_File : constant Name_Id := N + 707;
Name_Local_Configuration_Pragmas : constant Name_Id := N + 708;
Name_Locally_Removed_Files : constant Name_Id := N + 709;
Name_Map_File_Option : constant Name_Id := N + 710;
Name_Mapping_File_Switches : constant Name_Id := N + 711;
Name_Mapping_Spec_Suffix : constant Name_Id := N + 712;
Name_Mapping_Body_Suffix : constant Name_Id := N + 713;
Name_Metrics : constant Name_Id := N + 714;
Name_Naming : constant Name_Id := N + 715;
Name_Object_Generated : constant Name_Id := N + 716;
Name_Objects_Linked : constant Name_Id := N + 717;
Name_Objects_Path : constant Name_Id := N + 718;
Name_Objects_Path_File : constant Name_Id := N + 719;
Name_Object_Dir : constant Name_Id := N + 720;
Name_Pic_Option : constant Name_Id := N + 721;
Name_Pretty_Printer : constant Name_Id := N + 722;
Name_Prefix : constant Name_Id := N + 723;
Name_Project : constant Name_Id := N + 724;
Name_Roots : constant Name_Id := N + 725;
Name_Required_Switches : constant Name_Id := N + 726;
Name_Run_Path_Option : constant Name_Id := N + 727;
Name_Runtime_Project : constant Name_Id := N + 728;
Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 729;
Name_Shared_Library_Prefix : constant Name_Id := N + 730;
Name_Shared_Library_Suffix : constant Name_Id := N + 731;
Name_Separate_Suffix : constant Name_Id := N + 732;
Name_Source_Dirs : constant Name_Id := N + 733;
Name_Source_Files : constant Name_Id := N + 734;
Name_Source_List_File : constant Name_Id := N + 735;
Name_Spec : constant Name_Id := N + 736;
Name_Spec_Suffix : constant Name_Id := N + 737;
Name_Specification : constant Name_Id := N + 738;
Name_Specification_Exceptions : constant Name_Id := N + 739;
Name_Specification_Suffix : constant Name_Id := N + 740;
Name_Stack : constant Name_Id := N + 741;
Name_Switches : constant Name_Id := N + 742;
Name_Symbolic_Link_Supported : constant Name_Id := N + 743;
Name_Sync : constant Name_Id := N + 744;
Name_Synchronize : constant Name_Id := N + 745;
Name_Toolchain_Description : constant Name_Id := N + 746;
Name_Toolchain_Version : constant Name_Id := N + 747;
Name_Runtime_Library_Dir : constant Name_Id := N + 748;
Name_Ada_Roots : constant Name_Id := N + 634;
Name_Aggregate : constant Name_Id := N + 635;
Name_Archive_Builder : constant Name_Id := N + 636;
Name_Archive_Builder_Append_Option : constant Name_Id := N + 637;
Name_Archive_Indexer : constant Name_Id := N + 638;
Name_Archive_Suffix : constant Name_Id := N + 639;
Name_Binder : constant Name_Id := N + 640;
Name_Binder_Prefix : constant Name_Id := N + 641;
Name_Body_Suffix : constant Name_Id := N + 642;
Name_Builder : constant Name_Id := N + 643;
Name_Builder_Switches : constant Name_Id := N + 644;
Name_Compiler : constant Name_Id := N + 645;
Name_Compiler_Kind : constant Name_Id := N + 646;
Name_Config_Body_File_Name : constant Name_Id := N + 647;
Name_Config_Body_File_Name_Pattern : constant Name_Id := N + 648;
Name_Config_File_Switches : constant Name_Id := N + 649;
Name_Config_File_Unique : constant Name_Id := N + 650;
Name_Config_Spec_File_Name : constant Name_Id := N + 651;
Name_Config_Spec_File_Name_Pattern : constant Name_Id := N + 652;
Name_Configuration : constant Name_Id := N + 653;
Name_Cross_Reference : constant Name_Id := N + 654;
Name_Default_Language : constant Name_Id := N + 655;
Name_Default_Switches : constant Name_Id := N + 656;
Name_Dependency_Driver : constant Name_Id := N + 657;
Name_Dependency_File_Kind : constant Name_Id := N + 658;
Name_Dependency_Switches : constant Name_Id := N + 659;
Name_Driver : constant Name_Id := N + 660;
Name_Excluded_Source_Dirs : constant Name_Id := N + 661;
Name_Excluded_Source_Files : constant Name_Id := N + 662;
Name_Excluded_Source_List_File : constant Name_Id := N + 663;
Name_Exec_Dir : constant Name_Id := N + 664;
Name_Executable : constant Name_Id := N + 665;
Name_Executable_Suffix : constant Name_Id := N + 666;
Name_Extends : constant Name_Id := N + 667;
Name_Externally_Built : constant Name_Id := N + 668;
Name_Finder : constant Name_Id := N + 669;
Name_Global_Configuration_Pragmas : constant Name_Id := N + 670;
Name_Global_Config_File : constant Name_Id := N + 671;
Name_Gnatls : constant Name_Id := N + 672;
Name_Gnatstub : constant Name_Id := N + 673;
Name_Implementation : constant Name_Id := N + 674;
Name_Implementation_Exceptions : constant Name_Id := N + 675;
Name_Implementation_Suffix : constant Name_Id := N + 676;
Name_Include_Switches : constant Name_Id := N + 677;
Name_Include_Path : constant Name_Id := N + 678;
Name_Include_Path_File : constant Name_Id := N + 679;
Name_Inherit_Source_Path : constant Name_Id := N + 680;
Name_Language_Kind : constant Name_Id := N + 681;
Name_Language_Processing : constant Name_Id := N + 682;
Name_Languages : constant Name_Id := N + 683;
Name_Library : constant Name_Id := N + 684;
Name_Library_Ali_Dir : constant Name_Id := N + 685;
Name_Library_Auto_Init : constant Name_Id := N + 686;
Name_Library_Auto_Init_Supported : constant Name_Id := N + 687;
Name_Library_Builder : constant Name_Id := N + 688;
Name_Library_Dir : constant Name_Id := N + 689;
Name_Library_GCC : constant Name_Id := N + 690;
Name_Library_Interface : constant Name_Id := N + 691;
Name_Library_Kind : constant Name_Id := N + 692;
Name_Library_Name : constant Name_Id := N + 693;
Name_Library_Major_Minor_Id_Supported : constant Name_Id := N + 694;
Name_Library_Options : constant Name_Id := N + 695;
Name_Library_Partial_Linker : constant Name_Id := N + 696;
Name_Library_Reference_Symbol_File : constant Name_Id := N + 697;
Name_Library_Src_Dir : constant Name_Id := N + 698;
Name_Library_Support : constant Name_Id := N + 699;
Name_Library_Symbol_File : constant Name_Id := N + 700;
Name_Library_Symbol_Policy : constant Name_Id := N + 701;
Name_Library_Version : constant Name_Id := N + 702;
Name_Library_Version_Switches : constant Name_Id := N + 703;
Name_Linker : constant Name_Id := N + 704;
Name_Linker_Executable_Option : constant Name_Id := N + 705;
Name_Linker_Lib_Dir_Option : constant Name_Id := N + 706;
Name_Linker_Lib_Name_Option : constant Name_Id := N + 707;
Name_Local_Config_File : constant Name_Id := N + 708;
Name_Local_Configuration_Pragmas : constant Name_Id := N + 709;
Name_Locally_Removed_Files : constant Name_Id := N + 710;
Name_Map_File_Option : constant Name_Id := N + 711;
Name_Mapping_File_Switches : constant Name_Id := N + 712;
Name_Mapping_Spec_Suffix : constant Name_Id := N + 713;
Name_Mapping_Body_Suffix : constant Name_Id := N + 714;
Name_Metrics : constant Name_Id := N + 715;
Name_Naming : constant Name_Id := N + 716;
Name_Object_Generated : constant Name_Id := N + 717;
Name_Objects_Linked : constant Name_Id := N + 718;
Name_Objects_Path : constant Name_Id := N + 719;
Name_Objects_Path_File : constant Name_Id := N + 720;
Name_Object_Dir : constant Name_Id := N + 721;
Name_Pic_Option : constant Name_Id := N + 722;
Name_Pretty_Printer : constant Name_Id := N + 723;
Name_Prefix : constant Name_Id := N + 724;
Name_Project : constant Name_Id := N + 725;
Name_Roots : constant Name_Id := N + 726;
Name_Required_Switches : constant Name_Id := N + 727;
Name_Run_Path_Option : constant Name_Id := N + 728;
Name_Runtime_Project : constant Name_Id := N + 729;
Name_Shared_Library_Minimum_Switches : constant Name_Id := N + 730;
Name_Shared_Library_Prefix : constant Name_Id := N + 731;
Name_Shared_Library_Suffix : constant Name_Id := N + 732;
Name_Separate_Suffix : constant Name_Id := N + 733;
Name_Source_Dirs : constant Name_Id := N + 734;
Name_Source_Files : constant Name_Id := N + 735;
Name_Source_List_File : constant Name_Id := N + 736;
Name_Spec : constant Name_Id := N + 737;
Name_Spec_Suffix : constant Name_Id := N + 738;
Name_Specification : constant Name_Id := N + 739;
Name_Specification_Exceptions : constant Name_Id := N + 740;
Name_Specification_Suffix : constant Name_Id := N + 741;
Name_Stack : constant Name_Id := N + 742;
Name_Switches : constant Name_Id := N + 743;
Name_Symbolic_Link_Supported : constant Name_Id := N + 744;
Name_Sync : constant Name_Id := N + 745;
Name_Synchronize : constant Name_Id := N + 746;
Name_Toolchain_Description : constant Name_Id := N + 747;
Name_Toolchain_Version : constant Name_Id := N + 748;
Name_Runtime_Library_Dir : constant Name_Id := N + 749;
-- Other miscellaneous names used in front end
Name_Unaligned_Valid : constant Name_Id := N + 749;
Name_Unaligned_Valid : constant Name_Id := N + 750;
-- Ada 2005 reserved words
First_2005_Reserved_Word : constant Name_Id := N + 750;
Name_Interface : constant Name_Id := N + 750;
Name_Overriding : constant Name_Id := N + 751;
Name_Synchronized : constant Name_Id := N + 752;
Last_2005_Reserved_Word : constant Name_Id := N + 752;
First_2005_Reserved_Word : constant Name_Id := N + 751;
Name_Interface : constant Name_Id := N + 751;
Name_Overriding : constant Name_Id := N + 752;
Name_Synchronized : constant Name_Id := N + 753;
Last_2005_Reserved_Word : constant Name_Id := N + 753;
subtype Ada_2005_Reserved_Words is
Name_Id range First_2005_Reserved_Word .. Last_2005_Reserved_Word;
-- Mark last defined name for consistency check in Snames body
Last_Predefined_Name : constant Name_Id := N + 752;
Last_Predefined_Name : constant Name_Id := N + 753;
---------------------------------------
-- Subtypes Defining Name Categories --

View File

@ -531,17 +531,44 @@ package body Treepr is
begin
case M is
when Default_Mechanism => Write_Str ("Default");
when By_Copy => Write_Str ("By_Copy");
when By_Reference => Write_Str ("By_Reference");
when By_Descriptor => Write_Str ("By_Descriptor");
when By_Descriptor_UBS => Write_Str ("By_Descriptor_UBS");
when By_Descriptor_UBSB => Write_Str ("By_Descriptor_UBSB");
when By_Descriptor_UBA => Write_Str ("By_Descriptor_UBA");
when By_Descriptor_S => Write_Str ("By_Descriptor_S");
when By_Descriptor_SB => Write_Str ("By_Descriptor_SB");
when By_Descriptor_A => Write_Str ("By_Descriptor_A");
when By_Descriptor_NCA => Write_Str ("By_Descriptor_NCA");
when Default_Mechanism
=> Write_Str ("Default");
when By_Copy
=> Write_Str ("By_Copy");
when By_Reference
=> Write_Str ("By_Reference");
when By_Descriptor
=> Write_Str ("By_Descriptor");
when By_Descriptor_UBS
=> Write_Str ("By_Descriptor_UBS");
when By_Descriptor_UBSB
=> Write_Str ("By_Descriptor_UBSB");
when By_Descriptor_UBA
=> Write_Str ("By_Descriptor_UBA");
when By_Descriptor_S
=> Write_Str ("By_Descriptor_S");
when By_Descriptor_SB
=> Write_Str ("By_Descriptor_SB");
when By_Descriptor_A
=> Write_Str ("By_Descriptor_A");
when By_Descriptor_NCA
=> Write_Str ("By_Descriptor_NCA");
when By_Short_Descriptor
=> Write_Str ("By_Short_Descriptor");
when By_Short_Descriptor_UBS
=> Write_Str ("By_Short_Descriptor_UBS");
when By_Short_Descriptor_UBSB
=> Write_Str ("By_Short_Descriptor_UBSB");
when By_Short_Descriptor_UBA
=> Write_Str ("By_Short_Descriptor_UBA");
when By_Short_Descriptor_S
=> Write_Str ("By_Short_Descriptor_S");
when By_Short_Descriptor_SB
=> Write_Str ("By_Short_Descriptor_SB");
when By_Short_Descriptor_A
=> Write_Str ("By_Short_Descriptor_A");
when By_Short_Descriptor_NCA
=> Write_Str ("By_Short_Descriptor_NCA");
when 1 .. Mechanism_Type'Last =>
Write_Str ("By_Copy if size <= ");

View File

@ -736,7 +736,7 @@ package Types is
-- passing mechanism. See specification of Sem_Mech for full details.
-- The following subtype is used to represent values of this type:
subtype Mechanism_Type is Int range -10 .. Int'Last;
subtype Mechanism_Type is Int range -18 .. Int'Last;
-- Type used to represent a mechanism value. This is a subtype rather
-- than a type to avoid some annoying processing problems with certain
-- routines in Einfo (processing them to create the corresponding C).

View File

@ -328,6 +328,15 @@ typedef Int Mechanism_Type;
#define By_Descriptor_A (-9)
#define By_Descriptor_NCA (-10)
#define By_Descriptor_Last (-10)
#define By_Short_Descriptor (-11)
#define By_Short_Descriptor_UBS (-12)
#define By_Short_Descriptor_UBSB (-13)
#define By_Short_Descriptor_UBA (-14)
#define By_Short_Descriptor_S (-15)
#define By_Short_Descriptor_SB (-16)
#define By_Short_Descriptor_A (-17)
#define By_Short_Descriptor_NCA (-18)
#define By_Short_Descriptor_Last (-18)
/* Internal to Gigi. */
#define By_Copy_Return (-128)