aboutsummaryrefslogtreecommitdiff
path: root/libgfortran
diff options
context:
space:
mode:
Diffstat (limited to 'libgfortran')
-rw-r--r--libgfortran/ChangeLog17
-rw-r--r--libgfortran/caf/single.c8
-rw-r--r--libgfortran/intrinsics/associated.c4
-rw-r--r--libgfortran/intrinsics/date_and_time.c7
-rw-r--r--libgfortran/io/transfer.c19
-rw-r--r--libgfortran/libgfortran.h34
6 files changed, 62 insertions, 27 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 55b087f..bd12b5d 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 8911752..bead09a 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -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;
diff --git a/libgfortran/intrinsics/associated.c b/libgfortran/intrinsics/associated.c
index 2907818..08a7412 100644
--- a/libgfortran/intrinsics/associated.c
+++ b/libgfortran/intrinsics/associated.c
@@ -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);
diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c
index 7e288ef..a493b44 100644
--- a/libgfortran/intrinsics/date_and_time.c
+++ b/libgfortran/intrinsics/date_and_time.c
@@ -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);
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 7e076de..8bc828c 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -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);
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 4c643b7..80580a9 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -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))
generated by cgit v1.1 at 2024-10-20 02:48:29 +0000