re PR fortran/37577 ([meta-bug] change internal array descriptor format for better syntax, C interop TR, rank 15)
2018-25-01 Paul Thomas <pault@gcc.gnu.org> PR fortran/37577 * array.c (gfc_match_array_ref): If standard earlier than F2008 it is an error if the reference dimension is greater than 7. libgfortran.h : Increase GFC_MAX_DIMENSIONS to 15. Change the dtype masks and shifts accordingly. * trans-array.c (gfc_conv_descriptor_dtype): Use the dtype type node to check the field. (gfc_conv_descriptor_dtype): Access the rank field of dtype. (duplicate_allocatable_coarray): Access the rank field of the dtype descriptor rather than the dtype itself. * trans-expr.c (get_scalar_to_descriptor_type): Store the type of 'scalar' on entry and use its TREE_TYPE if it is ARRAY_TYPE (ie. a character). (gfc_conv_procedure_call): Pass TREE_OPERAND (tmp,0) to get_scalar_to_descriptor_type if the actual expression is a constant. (gfc_trans_structure_assign): Assign the rank directly to the dtype rank field. * trans-intrinsic.c (gfc_conv_intrinsic_rank): Cast the result to default integer kind. (gfc_conv_intrinsic_sizeof): Obtain the element size from the 'elem_len' field of the dtype. * trans-io.c (gfc_build_io_library_fndecls): Replace gfc_int4_type_node with dtype_type_node where necessary. (transfer_namelist_element): Use gfc_get_dtype_rank_type for scalars. * trans-types.c : Provide 'get_dtype_type_node' to acces the dtype_type_node and, if necessary, build it. The maximum size of an array element is now determined by the maximum value of size_t. Update the description of the array descriptor, including the type def for the dtype_type. (gfc_get_dtype_rank_type): Build a constructor for the dtype. Distinguish RECORD_TYPEs that are BT_DERIVED or BT_CLASS. (gfc_get_array_descriptor_base): Change the type of the dtype field to dtype_type_node. (gfc_get_array_descr_info): Get the offset to the rank field of the dtype. * trans-types.h : Add a prototype for 'get_dtype_type_node ()'. * trans.h : Define the indices of the dtype fields. 2018-25-01 Paul Thomas <pault@gcc.gnu.org> PR fortran/37577 * gfortran.dg/coarray_18.f90: Allow dimension 15 for F2008. * gfortran.dg/coarray_lib_this_image_2.f90: Change 'array1' to 'array01' in the tree dump comparison. * gfortran.dg/coarray_lib_token_4.f90: Likewise. * gfortran.dg/inline_sum_1.f90: Similar - allow two digits. * gfortran.dg/rank_1.f90: Allow dimension 15 for F2008. 2018-25-01 Paul Thomas <pault@gcc.gnu.org> PR fortran/37577 * caf/single.c (_gfortran_caf_failed_images): Access the 'type' and 'elem_len' fields of the dtype instead of the shifts. (_gfortran_caf_stopped_images): Likewise. * intrinsics/associated.c (associated): Compare the 'type' and 'elem_len' fields instead of the dtype. * caf/date_and_time.c : Access the dtype fields rather using shifts and masks. * io/transfer.c (transfer_array ): Comment on item count. (set_nml_var,st_set_nml_var): Change dtype type and use fields. (st_set_nml_dtio_var): Likewise. * libgfortran.h : Change definition of GFC_ARRAY_DESCRIPTOR and add a typedef for the dtype_type. Change the GFC_DTYPE_* macros to access the dtype fields. From-SVN: r257065
This commit is contained in:
Paul Thomas
parent
09cf48c9de
commit
7fb43006b2
22 changed files with 272 additions and 110 deletions
|
|
@ -1,3 +1,46 @@
|
|||
2018-25-01 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/37577
|
||||
* array.c (gfc_match_array_ref): If standard earlier than F2008
|
||||
it is an error if the reference dimension is greater than 7.
|
||||
libgfortran.h : Increase GFC_MAX_DIMENSIONS to 15. Change the
|
||||
dtype masks and shifts accordingly.
|
||||
* trans-array.c (gfc_conv_descriptor_dtype): Use the dtype
|
||||
type node to check the field.
|
||||
(gfc_conv_descriptor_dtype): Access the rank field of dtype.
|
||||
(duplicate_allocatable_coarray): Access the rank field of the
|
||||
dtype descriptor rather than the dtype itself.
|
||||
* trans-expr.c (get_scalar_to_descriptor_type): Store the type
|
||||
of 'scalar' on entry and use its TREE_TYPE if it is ARRAY_TYPE
|
||||
(ie. a character).
|
||||
(gfc_conv_procedure_call): Pass TREE_OPERAND (tmp,0) to
|
||||
get_scalar_to_descriptor_type if the actual expression is a
|
||||
constant.
|
||||
(gfc_trans_structure_assign): Assign the rank directly to the
|
||||
dtype rank field.
|
||||
* trans-intrinsic.c (gfc_conv_intrinsic_rank): Cast the result
|
||||
to default integer kind.
|
||||
(gfc_conv_intrinsic_sizeof): Obtain the element size from the
|
||||
'elem_len' field of the dtype.
|
||||
* trans-io.c (gfc_build_io_library_fndecls): Replace
|
||||
gfc_int4_type_node with dtype_type_node where necessary.
|
||||
(transfer_namelist_element): Use gfc_get_dtype_rank_type for
|
||||
scalars.
|
||||
* trans-types.c : Provide 'get_dtype_type_node' to acces the
|
||||
dtype_type_node and, if necessary, build it.
|
||||
The maximum size of an array element is now determined by the
|
||||
maximum value of size_t.
|
||||
Update the description of the array descriptor, including the
|
||||
type def for the dtype_type.
|
||||
(gfc_get_dtype_rank_type): Build a constructor for the dtype.
|
||||
Distinguish RECORD_TYPEs that are BT_DERIVED or BT_CLASS.
|
||||
(gfc_get_array_descriptor_base): Change the type of the dtype
|
||||
field to dtype_type_node.
|
||||
(gfc_get_array_descr_info): Get the offset to the rank field of
|
||||
the dtype.
|
||||
* trans-types.h : Add a prototype for 'get_dtype_type_node ()'.
|
||||
* trans.h : Define the indices of the dtype fields.
|
||||
|
||||
2018-23-01 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/83866
|
||||
|
|
|
|||
|
|
@ -197,6 +197,11 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
|
|||
}
|
||||
}
|
||||
|
||||
if (ar->dimen >= 7
|
||||
&& !gfc_notify_std (GFC_STD_F2008,
|
||||
"Array reference at %C has more than 7 dimensions"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
gfc_error ("Array reference at %C cannot have more than %d dimensions",
|
||||
GFC_MAX_DIMENSIONS);
|
||||
return MATCH_ERROR;
|
||||
|
|
|
|||
|
|
@ -150,15 +150,13 @@ typedef enum
|
|||
#define GFC_STDOUT_UNIT_NUMBER 6
|
||||
#define GFC_STDERR_UNIT_NUMBER 0
|
||||
|
||||
/* F2003 onward. For std < F2003, error caught in array.c(gfc_match_array_ref). */
|
||||
#define GFC_MAX_DIMENSIONS 15
|
||||
|
||||
/* FIXME: Increase to 15 for Fortran 2008. Also needs changes to
|
||||
GFC_DTYPE_RANK_MASK. See PR 36825. */
|
||||
#define GFC_MAX_DIMENSIONS 7
|
||||
|
||||
#define GFC_DTYPE_RANK_MASK 0x07
|
||||
#define GFC_DTYPE_TYPE_SHIFT 3
|
||||
#define GFC_DTYPE_TYPE_MASK 0x38
|
||||
#define GFC_DTYPE_SIZE_SHIFT 6
|
||||
#define GFC_DTYPE_RANK_MASK 0x0F
|
||||
#define GFC_DTYPE_TYPE_SHIFT 4
|
||||
#define GFC_DTYPE_TYPE_MASK 0x70
|
||||
#define GFC_DTYPE_SIZE_SHIFT 7
|
||||
|
||||
/* Basic types. BT_VOID is used by ISO C Binding so funcs like c_f_pointer
|
||||
can take any arg with the pointer attribute as a param. These are also
|
||||
|
|
|
|||
|
|
@ -239,7 +239,8 @@ gfc_conv_descriptor_dtype (tree desc)
|
|||
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
|
||||
|
||||
field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD);
|
||||
gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
|
||||
gcc_assert (field != NULL_TREE
|
||||
&& TREE_TYPE (field) == get_dtype_type_node ());
|
||||
|
||||
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
|
||||
desc, field, NULL_TREE);
|
||||
|
|
@ -283,10 +284,11 @@ gfc_conv_descriptor_rank (tree desc)
|
|||
tree dtype;
|
||||
|
||||
dtype = gfc_conv_descriptor_dtype (desc);
|
||||
tmp = build_int_cst (TREE_TYPE (dtype), GFC_DTYPE_RANK_MASK);
|
||||
tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (dtype),
|
||||
dtype, tmp);
|
||||
return fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
|
||||
tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
|
||||
gcc_assert (tmp!= NULL_TREE
|
||||
&& TREE_TYPE (tmp) == signed_char_type_node);
|
||||
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
|
||||
dtype, tmp, NULL_TREE);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -8205,7 +8207,7 @@ duplicate_allocatable_coarray (tree dest, tree dest_tok, tree src,
|
|||
else
|
||||
{
|
||||
/* Set the rank or unitialized memory access may be reported. */
|
||||
tmp = gfc_conv_descriptor_dtype (dest);
|
||||
tmp = gfc_conv_descriptor_rank (dest);
|
||||
gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp), rank));
|
||||
|
||||
if (rank)
|
||||
|
|
|
|||
|
|
@ -66,9 +66,10 @@ get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
|
|||
tree
|
||||
gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
|
||||
{
|
||||
tree desc, type;
|
||||
tree desc, type, etype;
|
||||
|
||||
type = get_scalar_to_descriptor_type (scalar, attr);
|
||||
etype = TREE_TYPE (scalar);
|
||||
desc = gfc_create_var (type, "desc");
|
||||
DECL_ARTIFICIAL (desc) = 1;
|
||||
|
||||
|
|
@ -81,8 +82,10 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
|
|||
}
|
||||
if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
|
||||
scalar = gfc_build_addr_expr (NULL_TREE, scalar);
|
||||
else if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE)
|
||||
etype = TREE_TYPE (etype);
|
||||
gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
|
||||
gfc_get_dtype (type));
|
||||
gfc_get_dtype_rank_type (0, etype));
|
||||
gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
|
||||
|
||||
/* Copy pointer address back - but only if it could have changed and
|
||||
|
|
@ -5323,7 +5326,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
{
|
||||
tmp = parmse.expr;
|
||||
if (TREE_CODE (tmp) == ADDR_EXPR
|
||||
&& POINTER_TYPE_P (TREE_TYPE (TREE_OPERAND (tmp, 0))))
|
||||
&& (POINTER_TYPE_P (TREE_TYPE (TREE_OPERAND (tmp, 0)))
|
||||
|| e->expr_type == EXPR_CONSTANT))
|
||||
tmp = TREE_OPERAND (tmp, 0);
|
||||
parmse.expr = gfc_conv_scalar_to_descriptor (&parmse, tmp,
|
||||
fsym->attr);
|
||||
|
|
@ -7611,8 +7615,8 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr, bool init, bool coarray)
|
|||
rank = 1;
|
||||
size = integer_zero_node;
|
||||
desc = field;
|
||||
gfc_add_modify (&block, gfc_conv_descriptor_dtype (desc),
|
||||
build_int_cst (gfc_array_index_type, rank));
|
||||
gfc_add_modify (&block, gfc_conv_descriptor_rank (desc),
|
||||
build_int_cst (signed_char_type_node, rank));
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
|
|||
|
|
@ -2602,6 +2602,8 @@ gfc_conv_intrinsic_rank (gfc_se *se, gfc_expr *expr)
|
|||
gfc_add_block_to_block (&se->post, &argse.post);
|
||||
|
||||
se->expr = gfc_conv_descriptor_rank (argse.expr);
|
||||
se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
|
||||
se->expr);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -6783,6 +6785,7 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
|
|||
tree lower;
|
||||
tree upper;
|
||||
tree byte_size;
|
||||
tree field;
|
||||
int n;
|
||||
|
||||
gfc_init_se (&argse, NULL);
|
||||
|
|
@ -6805,10 +6808,13 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
|
|||
? GFC_DECL_SAVED_DESCRIPTOR (tmp) : tmp;
|
||||
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
|
||||
tmp = build_fold_indirect_ref_loc (input_location, tmp);
|
||||
tmp = fold_convert (size_type_node, gfc_conv_descriptor_dtype (tmp));
|
||||
tmp = fold_build2_loc (input_location, RSHIFT_EXPR, TREE_TYPE (tmp), tmp,
|
||||
build_int_cst (TREE_TYPE (tmp),
|
||||
GFC_DTYPE_SIZE_SHIFT));
|
||||
|
||||
tmp = gfc_conv_descriptor_dtype (tmp);
|
||||
field = gfc_advance_chain (TYPE_FIELDS (get_dtype_type_node ()),
|
||||
GFC_DTYPE_ELEM_LEN);
|
||||
tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
|
||||
tmp, field, NULL_TREE);
|
||||
|
||||
byte_size = fold_convert (gfc_array_index_type, tmp);
|
||||
}
|
||||
else if (arg->ts.type == BT_CLASS)
|
||||
|
|
|
|||
|
|
@ -478,12 +478,12 @@ gfc_build_io_library_fndecls (void)
|
|||
iocall[IOCALL_SET_NML_VAL] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("st_set_nml_var")), ".w.R",
|
||||
void_type_node, 6, dt_parm_type, pvoid_type_node, pvoid_type_node,
|
||||
gfc_int4_type_node, gfc_charlen_type_node, gfc_int4_type_node);
|
||||
gfc_int4_type_node, gfc_charlen_type_node, get_dtype_type_node());
|
||||
|
||||
iocall[IOCALL_SET_NML_DTIO_VAL] = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("st_set_nml_dtio_var")), ".w.R",
|
||||
void_type_node, 8, dt_parm_type, pvoid_type_node, pvoid_type_node,
|
||||
gfc_int4_type_node, gfc_charlen_type_node, gfc_int4_type_node,
|
||||
gfc_int4_type_node, gfc_charlen_type_node, get_dtype_type_node(),
|
||||
pvoid_type_node, pvoid_type_node);
|
||||
|
||||
iocall[IOCALL_SET_NML_VAL_DIM] = gfc_build_library_function_decl_with_spec (
|
||||
|
|
@ -1662,7 +1662,6 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
|
|||
tree dtio_proc = null_pointer_node;
|
||||
tree vtable = null_pointer_node;
|
||||
int n_dim;
|
||||
int itype;
|
||||
int rank = 0;
|
||||
|
||||
gcc_assert (sym || c);
|
||||
|
|
@ -1699,8 +1698,8 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
|
|||
}
|
||||
else
|
||||
{
|
||||
itype = ts->type;
|
||||
dtype = IARG (itype << GFC_DTYPE_TYPE_SHIFT);
|
||||
dt = gfc_typenode_for_spec (ts);
|
||||
dtype = gfc_get_dtype_rank_type (0, dt);
|
||||
}
|
||||
|
||||
/* Build up the arguments for the transfer call.
|
||||
|
|
|
|||
|
|
@ -130,6 +130,47 @@ int gfc_size_kind;
|
|||
int gfc_numeric_storage_size;
|
||||
int gfc_character_storage_size;
|
||||
|
||||
tree dtype_type_node = NULL_TREE;
|
||||
|
||||
|
||||
/* Build the dtype_type_node if necessary. */
|
||||
tree get_dtype_type_node (void)
|
||||
{
|
||||
tree field;
|
||||
tree dtype_node;
|
||||
tree *dtype_chain = NULL;
|
||||
|
||||
if (dtype_type_node == NULL_TREE)
|
||||
{
|
||||
dtype_node = make_node (RECORD_TYPE);
|
||||
TYPE_NAME (dtype_node) = get_identifier ("dtype_type");
|
||||
TYPE_NAMELESS (dtype_node) = 1;
|
||||
field = gfc_add_field_to_struct_1 (dtype_node,
|
||||
get_identifier ("elem_len"),
|
||||
size_type_node, &dtype_chain);
|
||||
TREE_NO_WARNING (field) = 1;
|
||||
field = gfc_add_field_to_struct_1 (dtype_node,
|
||||
get_identifier ("version"),
|
||||
integer_type_node, &dtype_chain);
|
||||
TREE_NO_WARNING (field) = 1;
|
||||
field = gfc_add_field_to_struct_1 (dtype_node,
|
||||
get_identifier ("rank"),
|
||||
signed_char_type_node, &dtype_chain);
|
||||
TREE_NO_WARNING (field) = 1;
|
||||
field = gfc_add_field_to_struct_1 (dtype_node,
|
||||
get_identifier ("type"),
|
||||
signed_char_type_node, &dtype_chain);
|
||||
TREE_NO_WARNING (field) = 1;
|
||||
field = gfc_add_field_to_struct_1 (dtype_node,
|
||||
get_identifier ("attribute"),
|
||||
short_integer_type_node, &dtype_chain);
|
||||
TREE_NO_WARNING (field) = 1;
|
||||
gfc_finish_type (dtype_node);
|
||||
TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (dtype_node)) = 1;
|
||||
dtype_type_node = dtype_node;
|
||||
}
|
||||
return dtype_type_node;
|
||||
}
|
||||
|
||||
bool
|
||||
gfc_check_any_c_kind (gfc_typespec *ts)
|
||||
|
|
@ -1003,7 +1044,7 @@ gfc_init_types (void)
|
|||
by the number of bits available to store this field in the array
|
||||
descriptor. */
|
||||
|
||||
n = TYPE_PRECISION (gfc_array_index_type) - GFC_DTYPE_SIZE_SHIFT;
|
||||
n = TYPE_PRECISION (size_type_node);
|
||||
gfc_max_array_element_size
|
||||
= wide_int_to_tree (size_type_node,
|
||||
wi::mask (n, UNSIGNED,
|
||||
|
|
@ -1255,12 +1296,21 @@ gfc_get_element_type (tree type)
|
|||
|
||||
struct gfc_array_descriptor
|
||||
{
|
||||
array *data
|
||||
array *data;
|
||||
index offset;
|
||||
index dtype;
|
||||
struct dtype_type dtype;
|
||||
struct descriptor_dimension dimension[N_DIM];
|
||||
}
|
||||
|
||||
struct dtype_type
|
||||
{
|
||||
size_t elem_len;
|
||||
int version;
|
||||
signed char rank;
|
||||
signed char type;
|
||||
signed short attribute;
|
||||
}
|
||||
|
||||
struct descriptor_dimension
|
||||
{
|
||||
index stride;
|
||||
|
|
@ -1277,11 +1327,6 @@ gfc_get_element_type (tree type)
|
|||
are gfc_array_index_type and the data node is a pointer to the
|
||||
data. See below for the handling of character types.
|
||||
|
||||
The dtype member is formatted as follows:
|
||||
rank = dtype & GFC_DTYPE_RANK_MASK // 3 bits
|
||||
type = (dtype & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT // 3 bits
|
||||
size = dtype >> GFC_DTYPE_SIZE_SHIFT
|
||||
|
||||
I originally used nested ARRAY_TYPE nodes to represent arrays, but
|
||||
this generated poor code for assumed/deferred size arrays. These
|
||||
require use of PLACEHOLDER_EXPR/WITH_RECORD_EXPR, which isn't part
|
||||
|
|
@ -1468,9 +1513,10 @@ gfc_get_dtype_rank_type (int rank, tree etype)
|
|||
{
|
||||
tree size;
|
||||
int n;
|
||||
HOST_WIDE_INT i;
|
||||
tree tmp;
|
||||
tree dtype;
|
||||
tree field;
|
||||
vec<constructor_elt, va_gc> *v = NULL;
|
||||
|
||||
switch (TREE_CODE (etype))
|
||||
{
|
||||
|
|
@ -1490,18 +1536,21 @@ gfc_get_dtype_rank_type (int rank, tree etype)
|
|||
n = BT_COMPLEX;
|
||||
break;
|
||||
|
||||
/* We will never have arrays of arrays. */
|
||||
case RECORD_TYPE:
|
||||
n = BT_DERIVED;
|
||||
if (GFC_CLASS_TYPE_P (etype))
|
||||
n = BT_CLASS;
|
||||
else
|
||||
n = BT_DERIVED;
|
||||
break;
|
||||
|
||||
/* We will never have arrays of arrays. */
|
||||
case ARRAY_TYPE:
|
||||
n = BT_CHARACTER;
|
||||
break;
|
||||
|
||||
case POINTER_TYPE:
|
||||
n = BT_ASSUMED;
|
||||
break;
|
||||
break;
|
||||
|
||||
default:
|
||||
/* TODO: Don't do dtype for temporary descriptorless arrays. */
|
||||
|
|
@ -1509,32 +1558,27 @@ gfc_get_dtype_rank_type (int rank, tree etype)
|
|||
return gfc_index_zero_node;
|
||||
}
|
||||
|
||||
gcc_assert (rank <= GFC_DTYPE_RANK_MASK);
|
||||
size = TYPE_SIZE_UNIT (etype);
|
||||
if (n == BT_CHARACTER && size == NULL_TREE)
|
||||
size = TYPE_SIZE_UNIT (TREE_TYPE (etype));
|
||||
|
||||
i = rank | (n << GFC_DTYPE_TYPE_SHIFT);
|
||||
if (size && INTEGER_CST_P (size))
|
||||
{
|
||||
if (tree_int_cst_lt (gfc_max_array_element_size, size))
|
||||
gfc_fatal_error ("Array element size too big at %C");
|
||||
tmp = get_dtype_type_node ();
|
||||
field = gfc_advance_chain (TYPE_FIELDS (tmp),
|
||||
GFC_DTYPE_ELEM_LEN);
|
||||
CONSTRUCTOR_APPEND_ELT (v, field,
|
||||
fold_convert (TREE_TYPE (field), size));
|
||||
|
||||
i += TREE_INT_CST_LOW (size) << GFC_DTYPE_SIZE_SHIFT;
|
||||
}
|
||||
dtype = build_int_cst (gfc_array_index_type, i);
|
||||
field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
|
||||
GFC_DTYPE_RANK);
|
||||
CONSTRUCTOR_APPEND_ELT (v, field,
|
||||
build_int_cst (TREE_TYPE (field), rank));
|
||||
|
||||
if (size && !INTEGER_CST_P (size))
|
||||
{
|
||||
tmp = build_int_cst (gfc_array_index_type, GFC_DTYPE_SIZE_SHIFT);
|
||||
tmp = fold_build2_loc (input_location, LSHIFT_EXPR,
|
||||
gfc_array_index_type,
|
||||
fold_convert (gfc_array_index_type, size), tmp);
|
||||
dtype = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
|
||||
tmp, dtype);
|
||||
}
|
||||
/* If we don't know the size we leave it as zero. This should never happen
|
||||
for anything that is actually used. */
|
||||
/* TODO: Check this is actually true, particularly when repacking
|
||||
assumed size parameters. */
|
||||
field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
|
||||
GFC_DTYPE_TYPE);
|
||||
CONSTRUCTOR_APPEND_ELT (v, field,
|
||||
build_int_cst (TREE_TYPE (field), n));
|
||||
|
||||
dtype = build_constructor (tmp, v);
|
||||
|
||||
return dtype;
|
||||
}
|
||||
|
|
@ -1820,7 +1864,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
|
|||
/* Add the dtype component. */
|
||||
decl = gfc_add_field_to_struct_1 (fat_type,
|
||||
get_identifier ("dtype"),
|
||||
gfc_array_index_type, &chain);
|
||||
get_dtype_type_node (), &chain);
|
||||
TREE_NO_WARNING (decl) = 1;
|
||||
|
||||
/* Add the span component. */
|
||||
|
|
@ -3232,6 +3276,7 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
|
|||
tree etype, ptype, t, base_decl;
|
||||
tree data_off, dim_off, dtype_off, dim_size, elem_size;
|
||||
tree lower_suboff, upper_suboff, stride_suboff;
|
||||
tree dtype, field, rank_off;
|
||||
|
||||
if (! GFC_DESCRIPTOR_TYPE_P (type))
|
||||
{
|
||||
|
|
@ -3313,11 +3358,15 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
|
|||
t = base_decl;
|
||||
if (!integer_zerop (dtype_off))
|
||||
t = fold_build_pointer_plus (t, dtype_off);
|
||||
dtype = TYPE_MAIN_VARIANT (get_dtype_type_node ());
|
||||
field = gfc_advance_chain (TYPE_FIELDS (dtype), GFC_DTYPE_RANK);
|
||||
rank_off = byte_position (field);
|
||||
if (!integer_zerop (dtype_off))
|
||||
t = fold_build_pointer_plus (t, rank_off);
|
||||
|
||||
t = build1 (NOP_EXPR, build_pointer_type (gfc_array_index_type), t);
|
||||
t = build1 (INDIRECT_REF, gfc_array_index_type, t);
|
||||
info->rank = build2 (BIT_AND_EXPR, gfc_array_index_type, t,
|
||||
build_int_cst (gfc_array_index_type,
|
||||
GFC_DTYPE_RANK_MASK));
|
||||
info->rank = t;
|
||||
t = build0 (PLACEHOLDER_EXPR, TREE_TYPE (dim_off));
|
||||
t = size_binop (MULT_EXPR, t, dim_size);
|
||||
dim_off = build2 (PLUS_EXPR, TREE_TYPE (dim_off), t, dim_off);
|
||||
|
|
|
|||
|
|
@ -73,6 +73,7 @@ void gfc_init_kinds (void);
|
|||
void gfc_init_types (void);
|
||||
void gfc_init_c_interop_kinds (void);
|
||||
|
||||
tree get_dtype_type_node (void);
|
||||
tree gfc_get_int_type (int);
|
||||
tree gfc_get_real_type (int);
|
||||
tree gfc_get_complex_type (int);
|
||||
|
|
|
|||
|
|
@ -914,6 +914,12 @@ extern GTY(()) tree gfor_fndecl_ieee_procedure_exit;
|
|||
/* gfortran-specific declaration information, the _CONT versions denote
|
||||
arrays with CONTIGUOUS attribute. */
|
||||
|
||||
#define GFC_DTYPE_ELEM_LEN 0
|
||||
#define GFC_DTYPE_VERSION 1
|
||||
#define GFC_DTYPE_RANK 2
|
||||
#define GFC_DTYPE_TYPE 3
|
||||
#define GFC_DTYPE_ATTRIBUTE 4
|
||||
|
||||
enum gfc_array_kind
|
||||
{
|
||||
GFC_ARRAY_UNKNOWN,
|
||||
|
|
|
|||
|
|
@ -1,3 +1,13 @@
|
|||
2018-25-01 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/37577
|
||||
* gfortran.dg/coarray_18.f90: Allow dimension 15 for F2008.
|
||||
* gfortran.dg/coarray_lib_this_image_2.f90: Change 'array1' to
|
||||
'array01' in the tree dump comparison.
|
||||
* gfortran.dg/coarray_lib_token_4.f90: Likewise.
|
||||
* gfortran.dg/inline_sum_1.f90: Similar - allow two digits.
|
||||
* gfortran.dg/rank_1.f90: Allow dimension 15 for F2008.
|
||||
|
||||
2018-01-25 Jan Hubicka <hubicka@ucw.cz>
|
||||
|
||||
PR middle-end/83055
|
||||
|
|
|
|||
|
|
@ -5,8 +5,7 @@
|
|||
! dimensions (normal + codimensions).
|
||||
!
|
||||
! Fortran 2008 allows (co)arrays with 15 ranks
|
||||
! Currently, gfortran only supports 7, cf. PR 37577
|
||||
! Thus, the program is valid Fortran 2008 ...
|
||||
! Previously gfortran only supported 7, cf. PR 37577
|
||||
!
|
||||
! See also general coarray PR 18918
|
||||
!
|
||||
|
|
@ -19,14 +18,20 @@ program ar
|
|||
integer :: ic(2)[*]
|
||||
integer :: id(2,2)[2,*]
|
||||
integer :: ie(2,2,2)[2,2,*]
|
||||
integer :: ig(2,2,2,2)[2,2,2,*] ! { dg-error "has more than 7 dimensions" }
|
||||
integer :: ih(2,2,2,2,2)[2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
|
||||
integer :: ij(2,2,2,2,2,2)[2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
|
||||
integer :: ik(2,2,2,2,2,2,2)[2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
|
||||
integer :: il[2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
|
||||
integer :: im[2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
|
||||
integer :: in[2,2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
|
||||
integer :: io[2,2,2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 7 dimensions" }
|
||||
! Previously, these would give errors.
|
||||
integer :: ig(2,2,2,2)[2,2,2,*]
|
||||
integer :: ih(2,2,2,2,2)[2,2,2,2,*]
|
||||
integer :: ij(2,2,2,2,2,2)[2,2,2,2,2,*]
|
||||
integer :: ik(2,2,2,2,2,2,2)[2,2,2,2,2,2,*]
|
||||
integer :: il[2,2,2,2,2,2,2,*]
|
||||
integer :: im[2,2,2,2,2,2,2,2,*]
|
||||
integer :: in[2,2,2,2,2,2,2,2,2,*]
|
||||
integer :: io[2,2,2,2,2,2,2,2,2,2,*]
|
||||
! Now with max dimensions 15.....
|
||||
integer :: ip(2,2,2,2,2,2,2,2)[2,2,2,2,2,2,2,*] ! { dg-error "has more than 15 dimensions" }
|
||||
integer :: iq[2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,*] ! { dg-error "has more than 15 dimensions" }
|
||||
! Check a non-coarray
|
||||
integer :: ir(2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2) ! { dg-error "has more than 15 dimensions" }
|
||||
real :: x2(2,2,4)[2,*]
|
||||
complex :: c2(4,2)[2,*]
|
||||
double precision :: d2(1,5,9)[2,*]
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ contains
|
|||
end subroutine bar
|
||||
end
|
||||
|
||||
! { dg-final { scan-tree-dump-times "bar \\(struct array1_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "bar \\(struct array01_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "myucobound =\[^\n\r\]* parm...dim\\\[1\\\].lbound \\+ \[^\n\r\]*_gfortran_caf_num_images \\(0, -1\\).? \\+ -?\[0-9\]+\\);" 1 "original" } }
|
||||
|
|
|
|||
|
|
@ -35,9 +35,9 @@ end program test_caf
|
|||
|
||||
! { dg-final { scan-tree-dump-times "expl \\(integer\\(kind=4\\).0:. . restrict z, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
|
||||
!
|
||||
! { dg-final { scan-tree-dump-times "bar \\(struct array1_integer\\(kind=4\\) & restrict y, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "bar \\(struct array01_integer\\(kind=4\\) & restrict y, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
|
||||
!
|
||||
! { dg-final { scan-tree-dump-times "foo \\(struct array1_integer\\(kind=4\\) & restrict x, struct array1_integer\\(kind=4\\) & restrict y, integer\\(kind=4\\) & restrict test, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "foo \\(struct array01_integer\\(kind=4\\) & restrict x, struct array01_integer\\(kind=4\\) & restrict y, integer\\(kind=4\\) & restrict test, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
|
||||
!
|
||||
! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(\\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) x.\[0-9\]+\\) \\+ caf_offset.\[0-9\]+\\);" 1 "original" } }
|
||||
!
|
||||
|
|
|
|||
|
|
@ -188,6 +188,6 @@ contains
|
|||
o = i
|
||||
end subroutine tes
|
||||
end
|
||||
! { dg-final { scan-tree-dump-times "struct array._integer\\(kind=4\\) atmp" 13 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "struct array.._integer\\(kind=4\\) atmp" 13 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "struct array\[^\\n\]*atmp" 13 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "_gfortran_sum_" 0 "original" } }
|
||||
|
|
|
|||
|
|
@ -4,7 +4,6 @@
|
|||
! Fortran < 2008 allows 7 dimensions
|
||||
! Fortran 2008 allows 15 dimensions (including co-array ranks)
|
||||
!
|
||||
! FIXME: Rank patch was reverted because of PR 36825.
|
||||
integer :: a(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) ! { dg-error "has more than 7 dimensions" }
|
||||
integer :: b(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16) ! { dg-error "has more than 7 dimensions" }
|
||||
integer :: a(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
|
||||
integer :: b(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16) ! { dg-error "has more than 15 dimensions" }
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,3 +1,20 @@
|
|||
2018-25-01 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/37577
|
||||
* caf/single.c (_gfortran_caf_failed_images): Access the 'type'
|
||||
and 'elem_len' fields of the dtype instead of the shifts.
|
||||
(_gfortran_caf_stopped_images): Likewise.
|
||||
* intrinsics/associated.c (associated): Compare the 'type' and
|
||||
'elem_len' fields instead of the dtype.
|
||||
* caf/date_and_time.c : Access the dtype fields rather using
|
||||
shifts and masks.
|
||||
* io/transfer.c (transfer_array ): Comment on item count.
|
||||
(set_nml_var,st_set_nml_var): Change dtype type and use fields.
|
||||
(st_set_nml_dtio_var): Likewise.
|
||||
* libgfortran.h : Change definition of GFC_ARRAY_DESCRIPTOR and
|
||||
add a typedef for the dtype_type. Change the GFC_DTYPE_* macros
|
||||
to access the dtype fields.
|
||||
|
||||
2018-01-15 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/54613
|
||||
|
|
|
|||
|
|
@ -332,8 +332,8 @@ _gfortran_caf_failed_images (gfc_descriptor_t *array,
|
|||
int local_kind = kind != NULL ? *kind : 4;
|
||||
|
||||
array->base_addr = NULL;
|
||||
array->dtype = ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT)
|
||||
| (local_kind << GFC_DTYPE_SIZE_SHIFT));
|
||||
array->dtype.type = BT_INTEGER;
|
||||
array->dtype.elem_len = local_kind;
|
||||
/* Setting lower_bound higher then upper_bound is what the compiler does to
|
||||
indicate an empty array. */
|
||||
array->dim[0].lower_bound = 0;
|
||||
|
|
@ -354,8 +354,8 @@ _gfortran_caf_stopped_images (gfc_descriptor_t *array,
|
|||
int local_kind = kind != NULL ? *kind : 4;
|
||||
|
||||
array->base_addr = NULL;
|
||||
array->dtype = ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT)
|
||||
| (local_kind << GFC_DTYPE_SIZE_SHIFT));
|
||||
array->dtype.type = BT_INTEGER;
|
||||
array->dtype.elem_len = local_kind;
|
||||
/* Setting lower_bound higher then upper_bound is what the compiler does to
|
||||
indicate an empty array. */
|
||||
array->dim[0].lower_bound = 0;
|
||||
|
|
|
|||
|
|
@ -37,7 +37,9 @@ associated (const gfc_array_void *pointer, const gfc_array_void *target)
|
|||
return 0;
|
||||
if (GFC_DESCRIPTOR_DATA (pointer) != GFC_DESCRIPTOR_DATA (target))
|
||||
return 0;
|
||||
if (GFC_DESCRIPTOR_DTYPE (pointer) != GFC_DESCRIPTOR_DTYPE (target))
|
||||
if (GFC_DESCRIPTOR_DTYPE (pointer).elem_len != GFC_DESCRIPTOR_DTYPE (target).elem_len)
|
||||
return 0;
|
||||
if (GFC_DESCRIPTOR_DTYPE (pointer).type != GFC_DESCRIPTOR_DTYPE (target).type)
|
||||
return 0;
|
||||
|
||||
rank = GFC_DESCRIPTOR_RANK (pointer);
|
||||
|
|
|
|||
|
|
@ -270,10 +270,9 @@ secnds (GFC_REAL_4 *x)
|
|||
/* Make the INTEGER*4 array for passing to date_and_time. */
|
||||
gfc_array_i4 *avalues = xmalloc (sizeof (gfc_array_i4));
|
||||
avalues->base_addr = &values[0];
|
||||
GFC_DESCRIPTOR_DTYPE (avalues) = ((BT_REAL << GFC_DTYPE_TYPE_SHIFT)
|
||||
& GFC_DTYPE_TYPE_MASK) +
|
||||
(4 << GFC_DTYPE_SIZE_SHIFT);
|
||||
|
||||
GFC_DESCRIPTOR_DTYPE (avalues).type = BT_REAL;
|
||||
GFC_DESCRIPTOR_DTYPE (avalues).elem_len = 4;
|
||||
GFC_DESCRIPTOR_DTYPE (avalues).rank = 1;
|
||||
GFC_DIMENSION_SET(avalues->dim[0], 0, 7, 1);
|
||||
|
||||
date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0);
|
||||
|
|
|
|||
|
|
@ -2406,6 +2406,8 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
|
|||
char *data;
|
||||
bt iotype;
|
||||
|
||||
/* Adjust item_count before emitting error message. */
|
||||
|
||||
if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
|
||||
return;
|
||||
|
||||
|
|
@ -2413,6 +2415,7 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind,
|
|||
size = iotype == BT_CHARACTER ? (index_type) charlen : GFC_DESCRIPTOR_SIZE (desc);
|
||||
|
||||
rank = GFC_DESCRIPTOR_RANK (desc);
|
||||
|
||||
for (n = 0; n < rank; n++)
|
||||
{
|
||||
count[n] = 0;
|
||||
|
|
@ -4208,7 +4211,7 @@ st_wait (st_parameter_wait *wtp __attribute__((unused)))
|
|||
static void
|
||||
set_nml_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
|
||||
GFC_INTEGER_4 len, gfc_charlen_type string_length,
|
||||
GFC_INTEGER_4 dtype, void *dtio_sub, void *vtable)
|
||||
dtype_type dtype, void *dtio_sub, void *vtable)
|
||||
{
|
||||
namelist_info *t1 = NULL;
|
||||
namelist_info *nml;
|
||||
|
|
@ -4227,9 +4230,9 @@ set_nml_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
|
|||
nml->len = (int) len;
|
||||
nml->string_length = (index_type) string_length;
|
||||
|
||||
nml->var_rank = (int) (dtype & GFC_DTYPE_RANK_MASK);
|
||||
nml->size = (index_type) (dtype >> GFC_DTYPE_SIZE_SHIFT);
|
||||
nml->type = (bt) ((dtype & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT);
|
||||
nml->var_rank = (int) (dtype.rank);
|
||||
nml->size = (index_type) (dtype.elem_len);
|
||||
nml->type = (bt) (dtype.type);
|
||||
|
||||
if (nml->var_rank > 0)
|
||||
{
|
||||
|
|
@ -4259,13 +4262,13 @@ set_nml_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
|
|||
}
|
||||
|
||||
extern void st_set_nml_var (st_parameter_dt *dtp, void *, char *,
|
||||
GFC_INTEGER_4, gfc_charlen_type, GFC_INTEGER_4);
|
||||
GFC_INTEGER_4, gfc_charlen_type, dtype_type);
|
||||
export_proto(st_set_nml_var);
|
||||
|
||||
void
|
||||
st_set_nml_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
|
||||
GFC_INTEGER_4 len, gfc_charlen_type string_length,
|
||||
GFC_INTEGER_4 dtype)
|
||||
dtype_type dtype)
|
||||
{
|
||||
set_nml_var (dtp, var_addr, var_name, len, string_length,
|
||||
dtype, NULL, NULL);
|
||||
|
|
@ -4275,7 +4278,7 @@ st_set_nml_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
|
|||
/* Essentially the same as previous but carrying the dtio procedure
|
||||
and the vtable as additional arguments. */
|
||||
extern void st_set_nml_dtio_var (st_parameter_dt *dtp, void *, char *,
|
||||
GFC_INTEGER_4, gfc_charlen_type, GFC_INTEGER_4,
|
||||
GFC_INTEGER_4, gfc_charlen_type, dtype_type,
|
||||
void *, void *);
|
||||
export_proto(st_set_nml_dtio_var);
|
||||
|
||||
|
|
@ -4283,7 +4286,7 @@ export_proto(st_set_nml_dtio_var);
|
|||
void
|
||||
st_set_nml_dtio_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
|
||||
GFC_INTEGER_4 len, gfc_charlen_type string_length,
|
||||
GFC_INTEGER_4 dtype, void *dtio_sub, void *vtable)
|
||||
dtype_type dtype, void *dtio_sub, void *vtable)
|
||||
{
|
||||
set_nml_var (dtp, var_addr, var_name, len, string_length,
|
||||
dtype, dtio_sub, vtable);
|
||||
|
|
|
|||
|
|
@ -327,14 +327,23 @@ typedef struct descriptor_dimension
|
|||
index_type lower_bound;
|
||||
index_type _ubound;
|
||||
}
|
||||
|
||||
descriptor_dimension;
|
||||
|
||||
typedef struct dtype_type
|
||||
{
|
||||
size_t elem_len;
|
||||
int version;
|
||||
signed char rank;
|
||||
signed char type;
|
||||
signed short attribute;
|
||||
}
|
||||
dtype_type;
|
||||
|
||||
#define GFC_ARRAY_DESCRIPTOR(r, type) \
|
||||
struct {\
|
||||
type *base_addr;\
|
||||
size_t offset;\
|
||||
index_type dtype;\
|
||||
dtype_type dtype;\
|
||||
index_type span;\
|
||||
descriptor_dimension dim[r];\
|
||||
}
|
||||
|
|
@ -375,10 +384,9 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
|
|||
typedef gfc_array_i1 gfc_array_s1;
|
||||
typedef gfc_array_i4 gfc_array_s4;
|
||||
|
||||
#define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK)
|
||||
#define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \
|
||||
>> GFC_DTYPE_TYPE_SHIFT)
|
||||
#define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype >> GFC_DTYPE_SIZE_SHIFT)
|
||||
#define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype.rank)
|
||||
#define GFC_DESCRIPTOR_TYPE(desc) ((desc)->dtype.type)
|
||||
#define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype.elem_len)
|
||||
#define GFC_DESCRIPTOR_DATA(desc) ((desc)->base_addr)
|
||||
#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
|
||||
|
||||
|
|
@ -411,18 +419,24 @@ typedef gfc_array_i4 gfc_array_s4;
|
|||
#define GFC_DTYPE_SIZE_MASK (-((index_type) 1 << GFC_DTYPE_SIZE_SHIFT))
|
||||
#define GFC_DTYPE_TYPE_SIZE_MASK (GFC_DTYPE_SIZE_MASK | GFC_DTYPE_TYPE_MASK)
|
||||
|
||||
#define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK)
|
||||
#define GFC_DTYPE_TYPE_SIZE(desc) (( ((desc)->dtype.type << GFC_DTYPE_TYPE_SHIFT) \
|
||||
| ((desc)->dtype.elem_len << GFC_DTYPE_SIZE_SHIFT) ) & GFC_DTYPE_TYPE_SIZE_MASK)
|
||||
|
||||
/* Macros to set size and type information. */
|
||||
|
||||
#define GFC_DTYPE_COPY(a,b) do { (a)->dtype = (b)->dtype; } while(0)
|
||||
#define GFC_DTYPE_COPY_SETRANK(a,b,n) \
|
||||
do { \
|
||||
(a)->dtype = (((b)->dtype & ~GFC_DTYPE_RANK_MASK) | n ); \
|
||||
(a)->dtype.rank = ((b)->dtype.rank | n ); \
|
||||
} while (0)
|
||||
|
||||
#define GFC_DTYPE_IS_UNSET(a) (unlikely((a)->dtype == 0))
|
||||
#define GFC_DTYPE_CLEAR(a) do { (a)->dtype = 0; } while(0)
|
||||
#define GFC_DTYPE_IS_UNSET(a) (unlikely((a)->dtype.elem_len == 0))
|
||||
#define GFC_DTYPE_CLEAR(a) do { (a)->dtype.elem_len = 0; \
|
||||
(a)->dtype.version = 0; \
|
||||
(a)->dtype.rank = 0; \
|
||||
(a)->dtype.type = 0; \
|
||||
(a)->dtype.attribute = 0; \
|
||||
} while(0)
|
||||
|
||||
#define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
|
||||
| (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue