mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-19 06:20:27 +08:00
gigi.h (fill_vms_descriptor): Take GNU_TYPE instead of GNAT_FORMAL.
* gcc-interface/gigi.h (fill_vms_descriptor): Take GNU_TYPE instead of GNAT_FORMAL. * gcc-interface/utils2.c (fill_vms_descriptor): Move from here to... * gcc-interface/utils.c (fill_vms_descriptor): ...here. Take GNU_TYPE instead of GNAT_FORMAL. Protect the expression against multiple uses. Do not generate the check directly, instead instantiate the template check present in the descriptor. (make_descriptor_field): Move around. (build_vms_descriptor32): Build a template check in the POINTER field. (build_vms_descriptor): Remove useless suffixes. * gcc-interface/trans.c (call_to_gnu): Adjust fill_vms_descriptor call. From-SVN: r169788
This commit is contained in:
Eric Botcazou
Eric Botcazou
parent
6479ed4b07
commit
31a5a54750
@ -1,3 +1,17 @@
|
||||
2011-02-03 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/gigi.h (fill_vms_descriptor): Take GNU_TYPE instead of
|
||||
GNAT_FORMAL.
|
||||
* gcc-interface/utils2.c (fill_vms_descriptor): Move from here to...
|
||||
* gcc-interface/utils.c (fill_vms_descriptor): ...here. Take GNU_TYPE
|
||||
instead of GNAT_FORMAL. Protect the expression against multiple uses.
|
||||
Do not generate the check directly, instead instantiate the template
|
||||
check present in the descriptor.
|
||||
(make_descriptor_field): Move around.
|
||||
(build_vms_descriptor32): Build a template check in the POINTER field.
|
||||
(build_vms_descriptor): Remove useless suffixes.
|
||||
* gcc-interface/trans.c (call_to_gnu): Adjust fill_vms_descriptor call.
|
||||
|
||||
2011-01-26 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
PR bootstrap/47467
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
* *
|
||||
* C Header File *
|
||||
* *
|
||||
* Copyright (C) 1992-2010, Free Software Foundation, Inc. *
|
||||
* Copyright (C) 1992-2011, 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- *
|
||||
@ -861,10 +861,9 @@ 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. GNAT_ACTUAL is how
|
||||
we derive the source location on a C_E */
|
||||
extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal,
|
||||
/* Fill in a VMS descriptor of GNU_TYPE for GNU_EXPR and return the result.
|
||||
GNAT_ACTUAL is the actual parameter for which the descriptor is built. */
|
||||
extern tree fill_vms_descriptor (tree gnu_type, tree gnu_expr,
|
||||
Node_Id gnat_actual);
|
||||
|
||||
/* Indicate that we need to take the address of T and that it therefore
|
||||
|
||||
@ -3071,9 +3071,9 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
|
||||
= convert (DECL_ARG_TYPE (gnu_formal), integer_zero_node);
|
||||
else
|
||||
gnu_actual = build_unary_op (ADDR_EXPR, NULL_TREE,
|
||||
fill_vms_descriptor (gnu_actual,
|
||||
gnat_formal,
|
||||
gnat_actual));
|
||||
fill_vms_descriptor
|
||||
(TREE_TYPE (TREE_TYPE (gnu_formal)),
|
||||
gnu_actual, gnat_actual));
|
||||
}
|
||||
else
|
||||
{
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
* *
|
||||
* C Implementation File *
|
||||
* *
|
||||
* Copyright (C) 1992-2010, Free Software Foundation, Inc. *
|
||||
* Copyright (C) 1992-2011, 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- *
|
||||
@ -203,7 +203,6 @@ static tree split_plus (tree, tree *);
|
||||
static tree float_type_for_precision (int, enum machine_mode);
|
||||
static tree convert_to_fat_pointer (tree, tree);
|
||||
static tree convert_to_thin_pointer (tree, tree);
|
||||
static tree make_descriptor_field (const char *,tree, tree, tree, tree);
|
||||
static bool potential_alignment_gap (tree, tree, tree);
|
||||
static void process_attributes (tree, struct attrib *);
|
||||
|
||||
@ -2280,6 +2279,22 @@ build_template (tree template_type, tree array_type, tree expr)
|
||||
return gnat_build_constructor (template_type, template_elts);
|
||||
}
|
||||
|
||||
/* Helper routine to make a descriptor field. FIELD_LIST is the list of decls
|
||||
being built; the new decl is chained on to the front of the list. */
|
||||
|
||||
static tree
|
||||
make_descriptor_field (const char *name, tree type, tree rec_type,
|
||||
tree initial, tree field_list)
|
||||
{
|
||||
tree field
|
||||
= create_field_decl (get_identifier (name), type, rec_type, NULL_TREE,
|
||||
NULL_TREE, 0, 0);
|
||||
|
||||
DECL_INITIAL (field) = initial;
|
||||
DECL_CHAIN (field) = field_list;
|
||||
return field;
|
||||
}
|
||||
|
||||
/* Build a 32-bit VMS descriptor from a Mechanism_Type, which must specify a
|
||||
descriptor type, and the GCC type of an object. Each FIELD_DECL in the
|
||||
type contains in its DECL_INITIAL the expression to use when a constructor
|
||||
@ -2291,15 +2306,11 @@ tree
|
||||
build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
{
|
||||
tree record_type = make_node (RECORD_TYPE);
|
||||
tree pointer32_type;
|
||||
tree pointer32_type, pointer64_type;
|
||||
tree field_list = NULL_TREE;
|
||||
int klass;
|
||||
int dtype = 0;
|
||||
tree inner_type;
|
||||
int ndim;
|
||||
int i;
|
||||
int klass, ndim, i, dtype = 0;
|
||||
tree inner_type, tem;
|
||||
tree *idx_arr;
|
||||
tree tem;
|
||||
|
||||
/* If TYPE is an unconstrained array, use the underlying array type. */
|
||||
if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
|
||||
@ -2439,15 +2450,22 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
= make_descriptor_field ("CLASS", gnat_type_for_size (8, 1), record_type,
|
||||
size_int (klass), field_list);
|
||||
|
||||
/* Of course this will crash at run time if the address space is not
|
||||
within the low 32 bits, but there is nothing else we can do. */
|
||||
pointer32_type = build_pointer_type_for_mode (type, SImode, false);
|
||||
pointer64_type = build_pointer_type_for_mode (type, DImode, false);
|
||||
|
||||
/* Ensure that only 32-bit pointers are passed in 32-bit descriptors. Note
|
||||
that we cannot build a template call to the CE routine as it would get a
|
||||
wrong source location; instead we use a second placeholder for it. */
|
||||
tem = build_unary_op (ADDR_EXPR, pointer64_type,
|
||||
build0 (PLACEHOLDER_EXPR, type));
|
||||
tem = build3 (COND_EXPR, pointer32_type,
|
||||
build_binary_op (GE_EXPR, boolean_type_node, tem,
|
||||
build_int_cstu (pointer64_type, 0x80000000)),
|
||||
build0 (PLACEHOLDER_EXPR, void_type_node),
|
||||
convert (pointer32_type, tem));
|
||||
|
||||
field_list
|
||||
= make_descriptor_field ("POINTER", pointer32_type, record_type,
|
||||
build_unary_op (ADDR_EXPR,
|
||||
pointer32_type,
|
||||
build0 (PLACEHOLDER_EXPR, type)),
|
||||
= make_descriptor_field ("POINTER", pointer32_type, record_type, tem,
|
||||
field_list);
|
||||
|
||||
switch (mech)
|
||||
@ -2488,7 +2506,6 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
= make_descriptor_field ("DIGITS", gnat_type_for_size (8, 1),
|
||||
record_type, size_zero_node, field_list);
|
||||
|
||||
|
||||
field_list
|
||||
= make_descriptor_field ("AFLAGS", gnat_type_for_size (8, 1),
|
||||
record_type,
|
||||
@ -2587,16 +2604,12 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
tree
|
||||
build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
{
|
||||
tree record64_type = make_node (RECORD_TYPE);
|
||||
tree record_type = make_node (RECORD_TYPE);
|
||||
tree pointer64_type;
|
||||
tree field_list64 = NULL_TREE;
|
||||
int klass;
|
||||
int dtype = 0;
|
||||
tree inner_type;
|
||||
int ndim;
|
||||
int i;
|
||||
tree field_list = NULL_TREE;
|
||||
int klass, ndim, i, dtype = 0;
|
||||
tree inner_type, tem;
|
||||
tree *idx_arr;
|
||||
tree tem;
|
||||
|
||||
/* If TYPE is an unconstrained array, use the underlying array type. */
|
||||
if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
|
||||
@ -2718,32 +2731,32 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
|
||||
/* Make the type for a 64-bit descriptor for VMS. The first six fields
|
||||
are the same for all types. */
|
||||
field_list64
|
||||
field_list
|
||||
= make_descriptor_field ("MBO", gnat_type_for_size (16, 1),
|
||||
record64_type, size_int (1), field_list64);
|
||||
field_list64
|
||||
record_type, size_int (1), field_list);
|
||||
field_list
|
||||
= make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1),
|
||||
record64_type, size_int (dtype), field_list64);
|
||||
field_list64
|
||||
record_type, size_int (dtype), field_list);
|
||||
field_list
|
||||
= make_descriptor_field ("CLASS", gnat_type_for_size (8, 1),
|
||||
record64_type, size_int (klass), field_list64);
|
||||
field_list64
|
||||
record_type, size_int (klass), field_list);
|
||||
field_list
|
||||
= make_descriptor_field ("MBMO", gnat_type_for_size (32, 1),
|
||||
record64_type, ssize_int (-1), field_list64);
|
||||
field_list64
|
||||
record_type, ssize_int (-1), field_list);
|
||||
field_list
|
||||
= make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1),
|
||||
record64_type,
|
||||
record_type,
|
||||
size_in_bytes (mech == By_Descriptor_A
|
||||
? inner_type : type),
|
||||
field_list64);
|
||||
field_list);
|
||||
|
||||
pointer64_type = build_pointer_type_for_mode (type, DImode, false);
|
||||
|
||||
field_list64
|
||||
= make_descriptor_field ("POINTER", pointer64_type, record64_type,
|
||||
field_list
|
||||
= make_descriptor_field ("POINTER", pointer64_type, record_type,
|
||||
build_unary_op (ADDR_EXPR, pointer64_type,
|
||||
build0 (PLACEHOLDER_EXPR, type)),
|
||||
field_list64);
|
||||
field_list);
|
||||
|
||||
switch (mech)
|
||||
{
|
||||
@ -2752,31 +2765,31 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
break;
|
||||
|
||||
case By_Descriptor_SB:
|
||||
field_list64
|
||||
field_list
|
||||
= make_descriptor_field ("SB_L1", gnat_type_for_size (64, 1),
|
||||
record64_type,
|
||||
record_type,
|
||||
(TREE_CODE (type) == ARRAY_TYPE
|
||||
? TYPE_MIN_VALUE (TYPE_DOMAIN (type))
|
||||
: size_zero_node),
|
||||
field_list64);
|
||||
field_list64
|
||||
field_list);
|
||||
field_list
|
||||
= make_descriptor_field ("SB_U1", gnat_type_for_size (64, 1),
|
||||
record64_type,
|
||||
record_type,
|
||||
(TREE_CODE (type) == ARRAY_TYPE
|
||||
? TYPE_MAX_VALUE (TYPE_DOMAIN (type))
|
||||
: size_zero_node),
|
||||
field_list64);
|
||||
field_list);
|
||||
break;
|
||||
|
||||
case By_Descriptor_A:
|
||||
case By_Descriptor_NCA:
|
||||
field_list64
|
||||
field_list
|
||||
= make_descriptor_field ("SCALE", gnat_type_for_size (8, 1),
|
||||
record64_type, size_zero_node, field_list64);
|
||||
record_type, size_zero_node, field_list);
|
||||
|
||||
field_list64
|
||||
field_list
|
||||
= make_descriptor_field ("DIGITS", gnat_type_for_size (8, 1),
|
||||
record64_type, size_zero_node, field_list64);
|
||||
record_type, size_zero_node, field_list);
|
||||
|
||||
dtype = (mech == By_Descriptor_NCA
|
||||
? 0
|
||||
@ -2785,22 +2798,22 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
: (TREE_CODE (type) == ARRAY_TYPE
|
||||
&& TYPE_CONVENTION_FORTRAN_P (type)
|
||||
? 224 : 192));
|
||||
field_list64
|
||||
field_list
|
||||
= make_descriptor_field ("AFLAGS", gnat_type_for_size (8, 1),
|
||||
record64_type, size_int (dtype),
|
||||
field_list64);
|
||||
record_type, size_int (dtype),
|
||||
field_list);
|
||||
|
||||
field_list64
|
||||
field_list
|
||||
= make_descriptor_field ("DIMCT", gnat_type_for_size (8, 1),
|
||||
record64_type, size_int (ndim), field_list64);
|
||||
record_type, size_int (ndim), field_list);
|
||||
|
||||
field_list64
|
||||
field_list
|
||||
= make_descriptor_field ("MBZ", gnat_type_for_size (32, 1),
|
||||
record64_type, size_int (0), field_list64);
|
||||
field_list64
|
||||
record_type, size_int (0), field_list);
|
||||
field_list
|
||||
= make_descriptor_field ("ARSIZE", gnat_type_for_size (64, 1),
|
||||
record64_type, size_in_bytes (type),
|
||||
field_list64);
|
||||
record_type, size_in_bytes (type),
|
||||
field_list);
|
||||
|
||||
/* Now build a pointer to the 0,0,0... element. */
|
||||
tem = build0 (PLACEHOLDER_EXPR, type);
|
||||
@ -2810,10 +2823,10 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
convert (TYPE_DOMAIN (inner_type), size_zero_node),
|
||||
NULL_TREE, NULL_TREE);
|
||||
|
||||
field_list64
|
||||
= make_descriptor_field ("A0", pointer64_type, record64_type,
|
||||
field_list
|
||||
= make_descriptor_field ("A0", pointer64_type, record_type,
|
||||
build1 (ADDR_EXPR, pointer64_type, tem),
|
||||
field_list64);
|
||||
field_list);
|
||||
|
||||
/* Next come the addressing coefficients. */
|
||||
tem = size_one_node;
|
||||
@ -2830,9 +2843,9 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
|
||||
fname[0] = (mech == By_Descriptor_NCA ? 'S' : 'M');
|
||||
fname[1] = '0' + i, fname[2] = 0;
|
||||
field_list64
|
||||
field_list
|
||||
= make_descriptor_field (fname, gnat_type_for_size (64, 1),
|
||||
record64_type, idx_length, field_list64);
|
||||
record_type, idx_length, field_list);
|
||||
|
||||
if (mech == By_Descriptor_NCA)
|
||||
tem = idx_length;
|
||||
@ -2844,16 +2857,16 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
char fname[3];
|
||||
|
||||
fname[0] = 'L', fname[1] = '0' + i, fname[2] = 0;
|
||||
field_list64
|
||||
field_list
|
||||
= make_descriptor_field (fname, gnat_type_for_size (64, 1),
|
||||
record64_type,
|
||||
TYPE_MIN_VALUE (idx_arr[i]), field_list64);
|
||||
record_type,
|
||||
TYPE_MIN_VALUE (idx_arr[i]), field_list);
|
||||
|
||||
fname[0] = 'U';
|
||||
field_list64
|
||||
field_list
|
||||
= make_descriptor_field (fname, gnat_type_for_size (64, 1),
|
||||
record64_type,
|
||||
TYPE_MAX_VALUE (idx_arr[i]), field_list64);
|
||||
record_type,
|
||||
TYPE_MAX_VALUE (idx_arr[i]), field_list);
|
||||
}
|
||||
break;
|
||||
|
||||
@ -2861,26 +2874,41 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
|
||||
post_error ("unsupported descriptor type for &", gnat_entity);
|
||||
}
|
||||
|
||||
TYPE_NAME (record64_type) = create_concat_name (gnat_entity, "DESC64");
|
||||
finish_record_type (record64_type, nreverse (field_list64), 0, false);
|
||||
return record64_type;
|
||||
TYPE_NAME (record_type) = create_concat_name (gnat_entity, "DESC64");
|
||||
finish_record_type (record_type, nreverse (field_list), 0, false);
|
||||
return record_type;
|
||||
}
|
||||
|
||||
/* Utility routine for above code to make a field. FIELD_LIST is the
|
||||
list of decls being built; the new decl is chained on to the front of
|
||||
the list. */
|
||||
/* Fill in a VMS descriptor of GNU_TYPE for GNU_EXPR and return the result.
|
||||
GNAT_ACTUAL is the actual parameter for which the descriptor is built. */
|
||||
|
||||
static tree
|
||||
make_descriptor_field (const char *name, tree type,
|
||||
tree rec_type, tree initial, tree field_list)
|
||||
tree
|
||||
fill_vms_descriptor (tree gnu_type, tree gnu_expr, Node_Id gnat_actual)
|
||||
{
|
||||
tree field
|
||||
= create_field_decl (get_identifier (name), type, rec_type, NULL_TREE,
|
||||
NULL_TREE, 0, 0);
|
||||
VEC(constructor_elt,gc) *v = NULL;
|
||||
tree field;
|
||||
|
||||
DECL_INITIAL (field) = initial;
|
||||
DECL_CHAIN (field) = field_list;
|
||||
return field;
|
||||
gnu_expr = maybe_unconstrained_array (gnu_expr);
|
||||
gnu_expr = gnat_protect_expr (gnu_expr);
|
||||
gnat_mark_addressable (gnu_expr);
|
||||
|
||||
/* We may need to substitute both GNU_EXPR and a CALL_EXPR to the raise CE
|
||||
routine in case we have a 32-bit descriptor. */
|
||||
gnu_expr = build2 (COMPOUND_EXPR, void_type_node,
|
||||
build_call_raise (CE_Range_Check_Failed, gnat_actual,
|
||||
N_Raise_Constraint_Error),
|
||||
gnu_expr);
|
||||
|
||||
for (field = TYPE_FIELDS (gnu_type); field; field = DECL_CHAIN (field))
|
||||
{
|
||||
tree value
|
||||
= convert (TREE_TYPE (field),
|
||||
SUBSTITUTE_PLACEHOLDER_IN_EXPR (DECL_INITIAL (field),
|
||||
gnu_expr));
|
||||
CONSTRUCTOR_APPEND_ELT (v, field, value);
|
||||
}
|
||||
|
||||
return gnat_build_constructor (gnu_type, v);
|
||||
}
|
||||
|
||||
/* Convert GNU_EXPR, a pointer to a 64bit VMS descriptor, to GNU_TYPE, a
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
* *
|
||||
* C Implementation File *
|
||||
* *
|
||||
* Copyright (C) 1992-2010, Free Software Foundation, Inc. *
|
||||
* Copyright (C) 1992-2011, 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- *
|
||||
@ -2216,58 +2216,6 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
|
||||
return convert (result_type, result);
|
||||
}
|
||||
|
||||
/* 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 derive the source location to raise C_E on an out of range
|
||||
pointer. */
|
||||
|
||||
tree
|
||||
fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual)
|
||||
{
|
||||
tree parm_decl = get_gnu_tree (gnat_formal);
|
||||
tree record_type = TREE_TYPE (TREE_TYPE (parm_decl));
|
||||
tree field;
|
||||
const bool do_range_check
|
||||
= strcmp ("MBO",
|
||||
IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type))));
|
||||
VEC(constructor_elt,gc) *v = NULL;
|
||||
|
||||
expr = maybe_unconstrained_array (expr);
|
||||
gnat_mark_addressable (expr);
|
||||
|
||||
for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field))
|
||||
{
|
||||
tree conexpr = convert (TREE_TYPE (field),
|
||||
SUBSTITUTE_PLACEHOLDER_IN_EXPR
|
||||
(DECL_INITIAL (field), expr));
|
||||
|
||||
/* Check to ensure that only 32-bit pointers are passed in
|
||||
32-bit descriptors */
|
||||
if (do_range_check
|
||||
&& strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), "POINTER") == 0)
|
||||
{
|
||||
tree pointer64type
|
||||
= build_pointer_type_for_mode (void_type_node, DImode, false);
|
||||
tree addr64expr = build_unary_op (ADDR_EXPR, pointer64type, expr);
|
||||
tree malloc64low
|
||||
= build_int_cstu (long_integer_type_node, 0x80000000);
|
||||
|
||||
add_stmt (build3 (COND_EXPR, void_type_node,
|
||||
build_binary_op (GE_EXPR, boolean_type_node,
|
||||
convert (long_integer_type_node,
|
||||
addr64expr),
|
||||
malloc64low),
|
||||
build_call_raise (CE_Range_Check_Failed,
|
||||
gnat_actual,
|
||||
N_Raise_Constraint_Error),
|
||||
NULL_TREE));
|
||||
}
|
||||
CONSTRUCTOR_APPEND_ELT (v, field, conexpr);
|
||||
}
|
||||
|
||||
return gnat_build_constructor (record_type, v);
|
||||
}
|
||||
|
||||
/* Indicate that we need to take the address of T and that it therefore
|
||||
should not be allocated in a register. Returns true if successful. */
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user