This patch has been triggered by Thomas's recent message to the list.
Not only did I start work late relative to stage 3 but debugging took
somewhat longer than anticipated. Therefore, to get this committed
asap, we will have to beg the indulgence of the release managers and
prompt review and/or testing by fortran maintainers. (Dominique has
already undertaken to test -m32.)
The patch delivers rank up to 15 for F2008, the descriptor information
needed to enact the F2018 C descriptor macros and an attribute field
to store such information as pointer/allocatable, contiguous etc..
Only the first has been enabled so far but it was necessary to submit
the array descriptor changes now to avoid any further ABI breakage in
9.0.0.
I took the design choice choice to replace the dtype with a structure:
typedef struct dtype_type
{
size_t elem_len;
int version;
int rank;
int type;
int attribute;
}
dtype_type;
This choice was intended to reduce the changes to a minimum, since in
most references to the dtype, one dtype is assigned to another.
The F2018 interop defines the 'type and 'attribute fields to be signed
char types. I used this intially but found that using int was the best
way to silence the warnings about padding since it also allows for
more attribute information to be carried.
Some parts of the patch (eg. in get_scalar_to_descriptor_type) look as
if latent bugs were uncovered by the change to the descriptor. If so,
the time spent debugging was well worthwhile.
It should be noted that some of the intrinsics, which use switch/case
for the type/kind selection, limit the effective element size that
they handle to the maximum value of size_t, less 7 bits. A bit of
straightforward work there would fix this limitation and would allow
the GFC_DTYPE shifts and masks to be eliminated.
Bootstraps and regtests on FC23/x86_64 - OK for trunk?
Paul
2018-22-01 Paul Thomas <pa...@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.
(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-22-01 Paul Thomas <pa...@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-22-01 Paul Thomas <pa...@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.
Index: gcc/fortran/array.c
===================================================================
*** gcc/fortran/array.c (revision 256606)
--- gcc/fortran/array.c (working copy)
*************** gfc_match_array_ref (gfc_array_ref *ar,
*** 197,202 ****
--- 197,207 ----
}
}
+ 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;
Index: gcc/fortran/libgfortran.h
===================================================================
*** gcc/fortran/libgfortran.h (revision 256606)
--- gcc/fortran/libgfortran.h (working copy)
*************** typedef enum
*** 150,164 ****
#define GFC_STDOUT_UNIT_NUMBER 6
#define GFC_STDERR_UNIT_NUMBER 0
! /* 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
/* 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
--- 150,162 ----
#define GFC_STDOUT_UNIT_NUMBER 6
#define GFC_STDERR_UNIT_NUMBER 0
+ /* F2008 onward. For std < F2008, error caught in
array.c(gfc_match_array_ref). */
+ #define GFC_MAX_DIMENSIONS 15
! #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
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 256607)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_conv_descriptor_dtype (tree desc)
*** 239,245 ****
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);
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
desc, field, NULL_TREE);
--- 239,246 ----
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD);
! 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);
*************** gfc_conv_descriptor_rank (tree desc)
*** 283,292 ****
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);
}
--- 284,294 ----
tree dtype;
dtype = gfc_conv_descriptor_dtype (desc);
! tmp = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (dtype)), GFC_DTYPE_RANK);
! gcc_assert (tmp!= NULL_TREE
! && TREE_TYPE (tmp) == integer_type_node);
! return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
! dtype, tmp, NULL_TREE);
}
*************** duplicate_allocatable_coarray (tree dest
*** 8205,8211 ****
else
{
/* Set the rank or unitialized memory access may be reported. */
! tmp = gfc_conv_descriptor_dtype (dest);
gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp),
rank));
if (rank)
--- 8207,8213 ----
else
{
/* Set the rank or unitialized memory access may be reported. */
! tmp = gfc_conv_descriptor_rank (dest);
gfc_add_modify (&globalblock, tmp, build_int_cst (TREE_TYPE (tmp),
rank));
if (rank)
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 256607)
--- gcc/fortran/trans-expr.c (working copy)
*************** get_scalar_to_descriptor_type (tree scal
*** 66,74 ****
tree
gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
{
! tree desc, type;
type = get_scalar_to_descriptor_type (scalar, attr);
desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
--- 66,75 ----
tree
gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
{
! 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;
*************** gfc_conv_scalar_to_descriptor (gfc_se *s
*** 81,88 ****
}
if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
scalar = gfc_build_addr_expr (NULL_TREE, scalar);
gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
! gfc_get_dtype (type));
gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
/* Copy pointer address back - but only if it could have changed and
--- 82,91 ----
}
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_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
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5323,5329 ****
{
tmp = parmse.expr;
if (TREE_CODE (tmp) == ADDR_EXPR
! && POINTER_TYPE_P (TREE_TYPE (TREE_OPERAND (tmp, 0))))
tmp = TREE_OPERAND (tmp, 0);
parmse.expr = gfc_conv_scalar_to_descriptor (&parmse, tmp,
fsym->attr);
--- 5326,5333 ----
{
tmp = parmse.expr;
if (TREE_CODE (tmp) == ADDR_EXPR
! && (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);
*************** gfc_trans_structure_assign (tree dest, g
*** 7611,7618 ****
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));
}
else
{
--- 7615,7622 ----
rank = 1;
size = integer_zero_node;
desc = field;
! gfc_add_modify (&block, gfc_conv_descriptor_rank (desc),
! build_int_cst (integer_type_node, rank));
}
else
{
Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c (revision 256606)
--- gcc/fortran/trans-intrinsic.c (working copy)
*************** gfc_conv_intrinsic_sizeof (gfc_se *se, g
*** 6777,6782 ****
--- 6777,6783 ----
tree lower;
tree upper;
tree byte_size;
+ tree field;
int n;
gfc_init_se (&argse, NULL);
*************** gfc_conv_intrinsic_sizeof (gfc_se *se, g
*** 6799,6808 ****
? 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));
byte_size = fold_convert (gfc_array_index_type, tmp);
}
else if (arg->ts.type == BT_CLASS)
--- 6800,6812 ----
? GFC_DECL_SAVED_DESCRIPTOR (tmp) : tmp;
if (POINTER_TYPE_P (TREE_TYPE (tmp)))
tmp = build_fold_indirect_ref_loc (input_location, tmp);
!
! 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)
Index: gcc/fortran/trans-io.c
===================================================================
*** gcc/fortran/trans-io.c (revision 256606)
--- gcc/fortran/trans-io.c (working copy)
*************** gfc_build_io_library_fndecls (void)
*** 478,489 ****
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);
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,
pvoid_type_node, pvoid_type_node);
iocall[IOCALL_SET_NML_VAL_DIM] = gfc_build_library_function_decl_with_spec (
--- 478,489 ----
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, 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, get_dtype_type_node(),
pvoid_type_node, pvoid_type_node);
iocall[IOCALL_SET_NML_VAL_DIM] = gfc_build_library_function_decl_with_spec (
*************** transfer_namelist_element (stmtblock_t *
*** 1662,1668 ****
tree dtio_proc = null_pointer_node;
tree vtable = null_pointer_node;
int n_dim;
- int itype;
int rank = 0;
gcc_assert (sym || c);
--- 1662,1667 ----
*************** transfer_namelist_element (stmtblock_t *
*** 1699,1706 ****
}
else
{
! itype = ts->type;
! dtype = IARG (itype << GFC_DTYPE_TYPE_SHIFT);
}
/* Build up the arguments for the transfer call.
--- 1698,1705 ----
}
else
{
! dt = gfc_typenode_for_spec (ts);
! dtype = gfc_get_dtype_rank_type (0, dt);
}
/* Build up the arguments for the transfer call.
Index: gcc/fortran/trans-types.c
===================================================================
*** gcc/fortran/trans-types.c (revision 256606)
--- gcc/fortran/trans-types.c (working copy)
*************** int gfc_size_kind;
*** 130,135 ****
--- 130,176 ----
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"),
+ integer_type_node, &dtype_chain);
+ TREE_NO_WARNING (field) = 1;
+ field = gfc_add_field_to_struct_1 (dtype_node,
+ get_identifier ("type"),
+ integer_type_node, &dtype_chain);
+ TREE_NO_WARNING (field) = 1;
+ field = gfc_add_field_to_struct_1 (dtype_node,
+ get_identifier ("attribute"),
+ 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)
*************** gfc_init_types (void)
*** 1003,1009 ****
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;
gfc_max_array_element_size
= wide_int_to_tree (size_type_node,
wi::mask (n, UNSIGNED,
--- 1044,1050 ----
by the number of bits available to store this field in the array
descriptor. */
! n = TYPE_PRECISION (size_type_node);
gfc_max_array_element_size
= wide_int_to_tree (size_type_node,
wi::mask (n, UNSIGNED,
*************** gfc_get_element_type (tree type)
*** 1255,1266 ****
struct gfc_array_descriptor
{
! array *data
index offset;
! index dtype;
struct descriptor_dimension dimension[N_DIM];
}
struct descriptor_dimension
{
index stride;
--- 1296,1316 ----
struct gfc_array_descriptor
{
! array *data;
index offset;
! structure dtype_type dtype;
struct descriptor_dimension dimension[N_DIM];
}
+ struct dtype_type
+ {
+ size_t elem_len;
+ int version;
+ int rank;
+ int type;
+ int attribute;
+ }
+
struct descriptor_dimension
{
index stride;
*************** gfc_get_element_type (tree type)
*** 1277,1287 ****
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
--- 1327,1332 ----
*************** gfc_get_dtype_rank_type (int rank, tree
*** 1468,1476 ****
{
tree size;
int n;
- HOST_WIDE_INT i;
tree tmp;
tree dtype;
switch (TREE_CODE (etype))
{
--- 1513,1522 ----
{
tree size;
int n;
tree tmp;
tree dtype;
+ tree field;
+ vec<constructor_elt, va_gc> *v = NULL;
switch (TREE_CODE (etype))
{
*************** gfc_get_dtype_rank_type (int rank, tree
*** 1490,1507 ****
n = BT_COMPLEX;
break;
- /* We will never have arrays of arrays. */
case RECORD_TYPE:
! n = BT_DERIVED;
break;
case ARRAY_TYPE:
n = BT_CHARACTER;
break;
case POINTER_TYPE:
n = BT_ASSUMED;
! break;
default:
/* TODO: Don't do dtype for temporary descriptorless arrays. */
--- 1536,1556 ----
n = BT_COMPLEX;
break;
case RECORD_TYPE:
! 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;
default:
/* TODO: Don't do dtype for temporary descriptorless arrays. */
*************** gfc_get_dtype_rank_type (int rank, tree
*** 1509,1540 ****
return gfc_index_zero_node;
}
- gcc_assert (rank <= GFC_DTYPE_RANK_MASK);
size = TYPE_SIZE_UNIT (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");
!
! i += TREE_INT_CST_LOW (size) << GFC_DTYPE_SIZE_SHIFT;
! }
! dtype = build_int_cst (gfc_array_index_type, i);
! 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. */
return dtype;
}
--- 1558,1584 ----
return gfc_index_zero_node;
}
size = TYPE_SIZE_UNIT (etype);
+ if (n == BT_CHARACTER && size == NULL_TREE)
+ size = TYPE_SIZE_UNIT (TREE_TYPE (etype));
! 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));
!
! field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
! GFC_DTYPE_RANK);
! CONSTRUCTOR_APPEND_ELT (v, field,
! build_int_cst (TREE_TYPE (field), rank));
!
! 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;
}
*************** gfc_get_array_descriptor_base (int dimen
*** 1820,1826 ****
/* Add the dtype component. */
decl = gfc_add_field_to_struct_1 (fat_type,
get_identifier ("dtype"),
! gfc_array_index_type, &chain);
TREE_NO_WARNING (decl) = 1;
/* Add the span component. */
--- 1864,1870 ----
/* Add the dtype component. */
decl = gfc_add_field_to_struct_1 (fat_type,
get_identifier ("dtype"),
! get_dtype_type_node (), &chain);
TREE_NO_WARNING (decl) = 1;
/* Add the span component. */
*************** gfc_get_array_descr_info (const_tree typ
*** 3232,3237 ****
--- 3276,3282 ----
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))
{
*************** gfc_get_array_descr_info (const_tree typ
*** 3313,3323 ****
t = base_decl;
if (!integer_zerop (dtype_off))
t = fold_build_pointer_plus (t, dtype_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));
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);
--- 3358,3372 ----
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 = 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);
Index: gcc/fortran/trans-types.h
===================================================================
*** gcc/fortran/trans-types.h (revision 256606)
--- gcc/fortran/trans-types.h (working copy)
*************** void gfc_init_kinds (void);
*** 73,78 ****
--- 73,79 ----
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);
Index: gcc/fortran/trans.h
===================================================================
*** gcc/fortran/trans.h (revision 256606)
--- gcc/fortran/trans.h (working copy)
*************** extern GTY(()) tree gfor_fndecl_ieee_pro
*** 914,919 ****
--- 914,925 ----
/* 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,
Index: gcc/testsuite/gfortran.dg/coarray_18.f90
===================================================================
*** gcc/testsuite/gfortran.dg/coarray_18.f90 (revision 256606)
--- gcc/testsuite/gfortran.dg/coarray_18.f90 (working copy)
***************
*** 5,12 ****
! 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 ...
!
! See also general coarray PR 18918
!
--- 5,11 ----
! dimensions (normal + codimensions).
!
! Fortran 2008 allows (co)arrays with 15 ranks
! ! Previously gfortran only supported 7, cf. PR 37577
!
! See also general coarray PR 18918
!
*************** program ar
*** 19,32 ****
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" }
real :: x2(2,2,4)[2,*]
complex :: c2(4,2)[2,*]
double precision :: d2(1,5,9)[2,*]
--- 18,37 ----
integer :: ic(2)[*]
integer :: id(2,2)[2,*]
integer :: ie(2,2,2)[2,2,*]
! ! 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,*]
Index: gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 (revision
256606)
--- gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 (working copy)
*************** contains
*** 16,22 ****
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 "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" } }
--- 16,22 ----
end subroutine bar
end
! ! { 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" } }
Index: gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 (revision 256606)
--- gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 (working copy)
*************** end program test_caf
*** 35,43 ****
! { 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 "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 "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" } }
!
--- 35,43 ----
! { 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
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
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" } }
!
Index: gcc/testsuite/gfortran.dg/inline_sum_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/inline_sum_1.f90 (revision 256606)
--- gcc/testsuite/gfortran.dg/inline_sum_1.f90 (working copy)
*************** contains
*** 188,193 ****
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\[^\\n\]*atmp" 13 "original"
} }
! { dg-final { scan-tree-dump-times "_gfortran_sum_" 0 "original" } }
--- 188,193 ----
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\[^\\n\]*atmp" 13 "original"
} }
! { dg-final { scan-tree-dump-times "_gfortran_sum_" 0 "original" } }
Index: gcc/testsuite/gfortran.dg/rank_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/rank_1.f90 (revision 256606)
--- gcc/testsuite/gfortran.dg/rank_1.f90 (working copy)
***************
*** 4,10 ****
! 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" }
end
--- 4,9 ----
! Fortran < 2008 allows 7 dimensions
! Fortran 2008 allows 15 dimensions (including co-array ranks)
!
! 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
Index: libgfortran/caf/single.c
===================================================================
*** libgfortran/caf/single.c (revision 256606)
--- libgfortran/caf/single.c (working copy)
*************** _gfortran_caf_failed_images (gfc_descrip
*** 332,339 ****
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));
/* Setting lower_bound higher then upper_bound is what the compiler does to
indicate an empty array. */
array->dim[0].lower_bound = 0;
--- 332,339 ----
int local_kind = kind != NULL ? *kind : 4;
array->base_addr = NULL;
! 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;
*************** _gfortran_caf_stopped_images (gfc_descri
*** 354,361 ****
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));
/* Setting lower_bound higher then upper_bound is what the compiler does to
indicate an empty array. */
array->dim[0].lower_bound = 0;
--- 354,361 ----
int local_kind = kind != NULL ? *kind : 4;
array->base_addr = NULL;
! 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;
Index: libgfortran/intrinsics/associated.c
===================================================================
*** libgfortran/intrinsics/associated.c (revision 256606)
--- libgfortran/intrinsics/associated.c (working copy)
*************** associated (const gfc_array_void *pointe
*** 37,43 ****
return 0;
if (GFC_DESCRIPTOR_DATA (pointer) != GFC_DESCRIPTOR_DATA (target))
return 0;
! if (GFC_DESCRIPTOR_DTYPE (pointer) != GFC_DESCRIPTOR_DTYPE (target))
return 0;
rank = GFC_DESCRIPTOR_RANK (pointer);
--- 37,45 ----
return 0;
if (GFC_DESCRIPTOR_DATA (pointer) != GFC_DESCRIPTOR_DATA (target))
return 0;
! 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);
Index: libgfortran/intrinsics/date_and_time.c
===================================================================
*** libgfortran/intrinsics/date_and_time.c (revision 256606)
--- libgfortran/intrinsics/date_and_time.c (working copy)
*************** secnds (GFC_REAL_4 *x)
*** 270,279 ****
/* 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_DIMENSION_SET(avalues->dim[0], 0, 7, 1);
date_and_time (NULL, NULL, NULL, avalues, 0, 0, 0);
--- 270,278 ----
/* 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).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);
Index: libgfortran/io/transfer.c
===================================================================
*** libgfortran/io/transfer.c (revision 256606)
--- libgfortran/io/transfer.c (working copy)
*************** transfer_array (st_parameter_dt *dtp, gf
*** 2406,2411 ****
--- 2406,2413 ----
char *data;
bt iotype;
+ /* Adjust item_count before emitting error message. */
+
if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
return;
*************** transfer_array (st_parameter_dt *dtp, gf
*** 2413,2418 ****
--- 2415,2421 ----
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;
*************** st_wait (st_parameter_wait *wtp __attrib
*** 4208,4214 ****
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)
{
namelist_info *t1 = NULL;
namelist_info *nml;
--- 4211,4217 ----
static void
set_nml_var (st_parameter_dt *dtp, void *var_addr, char *var_name,
GFC_INTEGER_4 len, gfc_charlen_type string_length,
! dtype_type dtype, void *dtio_sub, void *vtable)
{
namelist_info *t1 = NULL;
namelist_info *nml;
*************** set_nml_var (st_parameter_dt *dtp, void
*** 4227,4235 ****
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);
if (nml->var_rank > 0)
{
--- 4230,4238 ----
nml->len = (int) len;
nml->string_length = (index_type) string_length;
! nml->var_rank = (int) (dtype.rank);
! nml->size = (index_type) (dtype.elem_len);
! nml->type = (bt) (dtype.type);
if (nml->var_rank > 0)
{
*************** set_nml_var (st_parameter_dt *dtp, void
*** 4259,4271 ****
}
extern void st_set_nml_var (st_parameter_dt *dtp, void *, char *,
! GFC_INTEGER_4, gfc_charlen_type, GFC_INTEGER_4);
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)
{
set_nml_var (dtp, var_addr, var_name, len, string_length,
dtype, NULL, NULL);
--- 4262,4274 ----
}
extern void st_set_nml_var (st_parameter_dt *dtp, void *, char *,
! 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,
! dtype_type dtype)
{
set_nml_var (dtp, var_addr, var_name, len, string_length,
dtype, NULL, NULL);
*************** st_set_nml_var (st_parameter_dt *dtp, vo
*** 4275,4281 ****
/* 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,
void *, void *);
export_proto(st_set_nml_dtio_var);
--- 4278,4284 ----
/* 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, dtype_type,
void *, void *);
export_proto(st_set_nml_dtio_var);
*************** export_proto(st_set_nml_dtio_var);
*** 4283,4289 ****
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)
{
set_nml_var (dtp, var_addr, var_name, len, string_length,
dtype, dtio_sub, vtable);
--- 4286,4292 ----
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,
! dtype_type dtype, void *dtio_sub, void *vtable)
{
set_nml_var (dtp, var_addr, var_name, len, string_length,
dtype, dtio_sub, vtable);
Index: libgfortran/libgfortran.h
===================================================================
*** libgfortran/libgfortran.h (revision 256606)
--- libgfortran/libgfortran.h (working copy)
*************** typedef struct descriptor_dimension
*** 327,340 ****
index_type lower_bound;
index_type _ubound;
}
-
descriptor_dimension;
#define GFC_ARRAY_DESCRIPTOR(r, type) \
struct {\
type *base_addr;\
size_t offset;\
! index_type dtype;\
index_type span;\
descriptor_dimension dim[r];\
}
--- 327,349 ----
index_type lower_bound;
index_type _ubound;
}
descriptor_dimension;
+ typedef struct dtype_type
+ {
+ size_t elem_len;
+ int version;
+ int rank;
+ int type;
+ int attribute;
+ }
+ dtype_type;
+
#define GFC_ARRAY_DESCRIPTOR(r, type) \
struct {\
type *base_addr;\
size_t offset;\
! dtype_type dtype;\
index_type span;\
descriptor_dimension dim[r];\
}
*************** typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DI
*** 375,384 ****
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_DATA(desc) ((desc)->base_addr)
#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
--- 384,392 ----
typedef gfc_array_i1 gfc_array_s1;
typedef gfc_array_i4 gfc_array_s4;
! #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)
*************** typedef gfc_array_i4 gfc_array_s4;
*** 411,428 ****
#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)
/* 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 ); \
} 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_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \
| (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT))
--- 419,442 ----
#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.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.rank = ((b)->dtype.rank | n ); \
} 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))
