From 79dda023e156a636f6aca7f72c92dfd987504559 Mon Sep 17 00:00:00 2001 From: jvdelisle Date: Tue, 19 Oct 2010 01:28:50 +0000 Subject: [PATCH] 2010-10-18 Jerry DeLisle * io/io.h: Remove definition of the BT enumerator. * libgfortran.h: Replace GFC_DTYPE enumerator with BT. * intrinsics/iso_c_generated_procs.c: Likewise * intrinsics/date_and_time.c: Likewise. * intrinsics/iso_c_binding.c: Likewise. * io/list_read.c: Likewise. * io/transfer.c: Likewise. * io/write.c: Likewise. 2010-10-18 Jerry DeLisle * gfortran.h: Remove definition of bt enumerator. * libgfortran.h: Add bt enumerator type alighned with defintion. Remove the dtype enumerator, no longer used. previously given in libgfortran/io.h * trans-types.c: Use new bt enumerator. * trans-io.c: Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165675 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 +++++ gcc/fortran/gfortran.h | 8 ---- gcc/fortran/libgfortran.h | 17 +++------ gcc/fortran/trans-io.c | 28 +------------- gcc/fortran/trans-types.c | 12 +++--- libgfortran/ChangeLog | 11 ++++++ libgfortran/intrinsics/date_and_time.c | 2 +- libgfortran/intrinsics/iso_c_binding.c | 4 +- libgfortran/intrinsics/iso_c_generated_procs.c | 36 +++++++++--------- libgfortran/io/io.h | 12 +----- libgfortran/io/list_read.c | 51 ++++++++++++-------------- libgfortran/io/transfer.c | 37 ++----------------- libgfortran/io/write.c | 22 +++++------ libgfortran/libgfortran.h | 46 +++++++++++------------ 14 files changed, 118 insertions(+), 178 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b3ff2020422..43360d89108 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2010-10-18 Jerry DeLisle + + * gfortran.h: Remove definition of bt enumerator. + * libgfortran.h: Add bt enumerator type alighned with defintion. + Remove the dtype enumerator, no longer used. + previously given in libgfortran/io.h + * trans-types.c: Use new bt enumerator. + * trans-io.c: Likewise. + 2010-10-16 Thomas Koenig * trans-io.c (gfc_build_io_library_fndecls): @@ -19,6 +28,7 @@ the iocall with the original version, otherwise the version with _WRITE. (transfer_array_desc): Likewise. + 2010-10-15 Tobias Burnus PR fortran/45186 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 8a415f40196..33c7ba6e1a5 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -139,14 +139,6 @@ typedef enum { FORM_FREE, FORM_FIXED, FORM_UNKNOWN } gfc_source_form; -/* 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. */ -typedef enum -{ BT_UNKNOWN = 1, BT_INTEGER, BT_REAL, BT_COMPLEX, BT_LOGICAL, BT_CHARACTER, - BT_DERIVED, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID -} -bt; - /* Expression node types. */ typedef enum { EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE, diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index e26cbf9b5f4..85a73d8166c 100644 --- a/gcc/fortran/libgfortran.h +++ b/gcc/fortran/libgfortran.h @@ -122,16 +122,11 @@ libgfortran_stat_codes; #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 + used in the run-time library for IO. */ typedef enum -{ - GFC_DTYPE_UNKNOWN = 0, - GFC_DTYPE_INTEGER, - /* TODO: recognize logical types. */ - GFC_DTYPE_LOGICAL, - GFC_DTYPE_REAL, - GFC_DTYPE_COMPLEX, - GFC_DTYPE_DERIVED, - GFC_DTYPE_CHARACTER +{ BT_UNKNOWN = 0, BT_INTEGER, BT_LOGICAL, BT_REAL, BT_COMPLEX, + BT_DERIVED, BT_CHARACTER, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID } -dtype; - +bt; diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 6a3428a61ee..2ac3e5c1166 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1572,33 +1572,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name, } else { - itype = GFC_DTYPE_UNKNOWN; - - switch (ts->type) - - { - case BT_INTEGER: - itype = GFC_DTYPE_INTEGER; - break; - case BT_LOGICAL: - itype = GFC_DTYPE_LOGICAL; - break; - case BT_REAL: - itype = GFC_DTYPE_REAL; - break; - case BT_COMPLEX: - itype = GFC_DTYPE_COMPLEX; - break; - case BT_DERIVED: - itype = GFC_DTYPE_DERIVED; - break; - case BT_CHARACTER: - itype = GFC_DTYPE_CHARACTER; - break; - default: - gcc_unreachable (); - } - + itype = ts->type; dtype = IARG (itype << GFC_DTYPE_TYPE_SHIFT); } diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index ebea9af69cc..1ccba7a656d 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1319,28 +1319,28 @@ gfc_get_dtype (tree type) switch (TREE_CODE (etype)) { case INTEGER_TYPE: - n = GFC_DTYPE_INTEGER; + n = BT_INTEGER; break; case BOOLEAN_TYPE: - n = GFC_DTYPE_LOGICAL; + n = BT_LOGICAL; break; case REAL_TYPE: - n = GFC_DTYPE_REAL; + n = BT_REAL; break; case COMPLEX_TYPE: - n = GFC_DTYPE_COMPLEX; + n = BT_COMPLEX; break; /* We will never have arrays of arrays. */ case RECORD_TYPE: - n = GFC_DTYPE_DERIVED; + n = BT_DERIVED; break; case ARRAY_TYPE: - n = GFC_DTYPE_CHARACTER; + n = BT_CHARACTER; break; default: diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index adcb386bb6c..58a7a93bbcb 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,14 @@ +2010-10-18 Jerry DeLisle + + * io/io.h: Remove definition of the BT enumerator. + * libgfortran.h: Replace GFC_DTYPE enumerator with BT. + * intrinsics/iso_c_generated_procs.c: Likewise + * intrinsics/date_and_time.c: Likewise. + * intrinsics/iso_c_binding.c: Likewise. + * io/list_read.c: Likewise. + * io/transfer.c: Likewise. + * io/write.c: Likewise. + 2010-10-16 Thomas Koenig PR fortran/20165 diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c index 2ee8e5c0af7..dea835b36f0 100644 --- a/libgfortran/intrinsics/date_and_time.c +++ b/libgfortran/intrinsics/date_and_time.c @@ -349,7 +349,7 @@ secnds (GFC_REAL_4 *x) /* Make the INTEGER*4 array for passing to date_and_time. */ gfc_array_i4 *avalues = internal_malloc_size (sizeof (gfc_array_i4)); avalues->data = &values[0]; - GFC_DESCRIPTOR_DTYPE (avalues) = ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) + GFC_DESCRIPTOR_DTYPE (avalues) = ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) & GFC_DTYPE_TYPE_MASK) + (4 << GFC_DTYPE_SIZE_SHIFT); diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c index d0549b03dfa..5baa14ca599 100644 --- a/libgfortran/intrinsics/iso_c_binding.c +++ b/libgfortran/intrinsics/iso_c_binding.c @@ -65,7 +65,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer) (void *c_ptr_in, /* Put in the element size. */ f_ptr_out->dtype = f_ptr_out->dtype | (elemSize << GFC_DTYPE_SIZE_SHIFT); - /* Set the data type (e.g., GFC_DTYPE_INTEGER). */ + /* Set the data type (e.g., BT_INTEGER). */ f_ptr_out->dtype = f_ptr_out->dtype | (type << GFC_DTYPE_TYPE_SHIFT); } @@ -184,6 +184,6 @@ ISO_C_BINDING_PREFIX (c_f_pointer_d0) (void *c_ptr_in, { f_ptr_out->dtype = f_ptr_out->dtype & (~GFC_DTYPE_TYPE_MASK); f_ptr_out->dtype = f_ptr_out->dtype - | (GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT); + | (BT_DERIVED << GFC_DTYPE_TYPE_SHIFT); } } diff --git a/libgfortran/intrinsics/iso_c_generated_procs.c b/libgfortran/intrinsics/iso_c_generated_procs.c index e5ef7e1834f..7172858255e 100644 --- a/libgfortran/intrinsics/iso_c_generated_procs.c +++ b/libgfortran/intrinsics/iso_c_generated_procs.c @@ -139,7 +139,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_i1) (void *c_ptr_in, { /* Here we have an integer(kind=1). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_INTEGER, + (int) BT_INTEGER, (int) sizeof (GFC_INTEGER_1)); } #endif @@ -162,7 +162,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_i2) (void *c_ptr_in, { /* Here we have an integer(kind=2). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_INTEGER, + (int) BT_INTEGER, (int) sizeof (GFC_INTEGER_2)); } #endif @@ -181,7 +181,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_i4) (void *c_ptr_in, { /* Here we have an integer(kind=4). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_INTEGER, + (int) BT_INTEGER, (int) sizeof (GFC_INTEGER_4)); } #endif @@ -200,7 +200,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_i8) (void *c_ptr_in, { /* Here we have an integer(kind=8). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_INTEGER, + (int) BT_INTEGER, (int) sizeof (GFC_INTEGER_8)); } #endif @@ -223,7 +223,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_i16) (void *c_ptr_in, { /* Here we have an integer(kind=16). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_INTEGER, + (int) BT_INTEGER, (int) sizeof (GFC_INTEGER_16)); } #endif @@ -242,7 +242,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_r4) (void *c_ptr_in, { /* Here we have an real(kind=4). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_REAL, + (int) BT_REAL, (int) sizeof (GFC_REAL_4)); } #endif @@ -261,7 +261,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_r8) (void *c_ptr_in, { /* Here we have an real(kind=8). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_REAL, + (int) BT_REAL, (int) sizeof (GFC_REAL_8)); } #endif @@ -280,7 +280,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_r10) (void *c_ptr_in, { /* Here we have an real(kind=10). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_REAL, + (int) BT_REAL, (int) sizeof (GFC_REAL_10)); } #endif @@ -299,7 +299,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_r16) (void *c_ptr_in, { /* Here we have an real(kind=16). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_REAL, + (int) BT_REAL, (int) sizeof (GFC_REAL_16)); } #endif @@ -318,7 +318,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_c4) (void *c_ptr_in, { /* Here we have an complex(kind=4). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_COMPLEX, + (int) BT_COMPLEX, (int) sizeof (GFC_COMPLEX_4)); } #endif @@ -337,7 +337,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_c8) (void *c_ptr_in, { /* Here we have an complex(kind=8). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_COMPLEX, + (int) BT_COMPLEX, (int) sizeof (GFC_COMPLEX_8)); } #endif @@ -356,7 +356,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_c10) (void *c_ptr_in, { /* Here we have an complex(kind=10). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_COMPLEX, + (int) BT_COMPLEX, (int) sizeof (GFC_COMPLEX_10)); } #endif @@ -375,7 +375,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_c16) (void *c_ptr_in, { /* Here we have an complex(kind=16). */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_COMPLEX, + (int) BT_COMPLEX, (int) sizeof (GFC_COMPLEX_16)); } #endif @@ -392,7 +392,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_s0) (void *c_ptr_in, { /* Here we have a character string of len=1. */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_CHARACTER, + (int) BT_CHARACTER, (int) sizeof (char)); } #endif @@ -409,7 +409,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_l1) (void *c_ptr_in, { /* Here we have a logical of kind=1. */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_LOGICAL, + (int) BT_LOGICAL, (int) sizeof (GFC_LOGICAL_1)); } #endif @@ -426,7 +426,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_l2) (void *c_ptr_in, { /* Here we have a logical of kind=2. */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_LOGICAL, + (int) BT_LOGICAL, (int) sizeof (GFC_LOGICAL_2)); } #endif @@ -443,7 +443,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_l4) (void *c_ptr_in, { /* Here we have a logical of kind=4. */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_LOGICAL, + (int) BT_LOGICAL, (int) sizeof (GFC_LOGICAL_4)); } #endif @@ -460,7 +460,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_l8) (void *c_ptr_in, { /* Here we have a logical of kind=8. */ ISO_C_BINDING_PREFIX (c_f_pointer) (c_ptr_in, f_ptr_out, shape, - (int) GFC_DTYPE_LOGICAL, + (int) BT_LOGICAL, (int) sizeof (GFC_LOGICAL_8)); } #endif diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 99553486f8b..5089b6f7877 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -34,14 +34,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include #include -/* Basic types used in data transfers. */ - -typedef enum -{ BT_NULL, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL, - BT_COMPLEX -} -bt; - /* Forward declarations. */ struct st_parameter_dt; typedef struct stream stream; @@ -114,8 +106,8 @@ format_hash_entry; typedef struct namelist_type { - /* Object type, stored as GFC_DTYPE_xxxx. */ - dtype type; + /* Object type. */ + bt type; /* Object name. */ char * var_name; diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index b3c1cf6a89d..113b469bfce 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -1668,7 +1668,7 @@ check_type (st_parameter_dt *dtp, bt type, int len) { char message[100]; - if (dtp->u.p.saved_type != BT_NULL && dtp->u.p.saved_type != type) + if (dtp->u.p.saved_type != BT_UNKNOWN && dtp->u.p.saved_type != type) { sprintf (message, "Read type %s where %s was expected for item %d", type_name (dtp->u.p.saved_type), type_name (type), @@ -1678,7 +1678,7 @@ check_type (st_parameter_dt *dtp, bt type, int len) return 1; } - if (dtp->u.p.saved_type == BT_NULL || dtp->u.p.saved_type == BT_CHARACTER) + if (dtp->u.p.saved_type == BT_UNKNOWN || dtp->u.p.saved_type == BT_CHARACTER) return 0; if (dtp->u.p.saved_length != len) @@ -1771,7 +1771,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p, finish_separator (dtp); } - dtp->u.p.saved_type = BT_NULL; + dtp->u.p.saved_type = BT_UNKNOWN; dtp->u.p.repeat_count = 1; } @@ -1802,7 +1802,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p, internal_error (&dtp->common, "Bad type for list read"); } - if (dtp->u.p.saved_type != BT_CHARACTER && dtp->u.p.saved_type != BT_NULL) + if (dtp->u.p.saved_type != BT_CHARACTER && dtp->u.p.saved_type != BT_UNKNOWN) dtp->u.p.saved_length = size; if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) @@ -1853,8 +1853,11 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p, } break; - case BT_NULL: + case BT_UNKNOWN: break; + + default: + internal_error (&dtp->common, "Bad type for list read"); } if (--dtp->u.p.repeat_count <= 0) @@ -2362,20 +2365,20 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, len = nl->len; switch (nl->type) { - case GFC_DTYPE_INTEGER: - case GFC_DTYPE_LOGICAL: + case BT_INTEGER: + case BT_LOGICAL: dlen = len; break; - case GFC_DTYPE_REAL: + case BT_REAL: dlen = size_from_real_kind (len); break; - case GFC_DTYPE_COMPLEX: + case BT_COMPLEX: dlen = size_from_complex_kind (len); break; - case GFC_DTYPE_CHARACTER: + case BT_CHARACTER: dlen = chigh ? (chigh - clow + 1) : nl->string_length; break; @@ -2407,40 +2410,37 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, if (dtp->u.p.input_complete) return SUCCESS; - /* BT_NULL (equivalent to GFC_DTYPE_UNKNOWN) falls through - for nulls and is detected at default: of switch block. */ - - dtp->u.p.saved_type = BT_NULL; + dtp->u.p.saved_type = BT_UNKNOWN; free_saved (dtp); switch (nl->type) { - case GFC_DTYPE_INTEGER: + case BT_INTEGER: read_integer (dtp, len); break; - case GFC_DTYPE_LOGICAL: + case BT_LOGICAL: read_logical (dtp, len); break; - case GFC_DTYPE_CHARACTER: + case BT_CHARACTER: read_character (dtp, len); break; - case GFC_DTYPE_REAL: + case BT_REAL: /* Need to copy data back from the real location to the temp in order to handle nml reads into arrays. */ read_real (dtp, pdata, len); memcpy (dtp->u.p.value, pdata, dlen); break; - case GFC_DTYPE_COMPLEX: + case BT_COMPLEX: /* Same as for REAL, copy back to temp. */ read_complex (dtp, pdata, len, dlen); memcpy (dtp->u.p.value, pdata, dlen); break; - case GFC_DTYPE_DERIVED: + case BT_DERIVED: obj_name_len = strlen (nl->var_name) + 1; obj_name = get_mem (obj_name_len+1); memcpy (obj_name, nl->var_name, obj_name_len-1); @@ -2500,15 +2500,12 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, return SUCCESS; } - if (dtp->u.p.saved_type == BT_NULL) + if (dtp->u.p.saved_type == BT_UNKNOWN) { dtp->u.p.expanded_read = 0; goto incr_idx; } - /* Note the switch from GFC_DTYPE_type to BT_type at this point. - This comes about because the read functions return BT_types. */ - switch (dtp->u.p.saved_type) { @@ -2750,7 +2747,7 @@ get_name: if (c == '%') { - if (nl->type != GFC_DTYPE_DERIVED) + if (nl->type != BT_DERIVED) { snprintf (nml_err_msg, nml_err_msg_size, "Attempt to get derived component for %s", nl->var_name); @@ -2774,7 +2771,7 @@ get_name: clow = 1; chigh = 0; - if (c == '(' && nl->type == GFC_DTYPE_CHARACTER) + if (c == '(' && nl->type == BT_CHARACTER) { descriptor_dimension chd[1] = { {1, clow, nl->string_length} }; array_loop_spec ind[1] = { {1, clow, nl->string_length, 1} }; @@ -2852,7 +2849,7 @@ get_name: namelist_info if we have parsed a qualified derived type component. */ - if (nl->type == GFC_DTYPE_DERIVED) + if (nl->type == BT_DERIVED) nml_touch_nodes (nl); if (first_nl) diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 41d5a42f04c..e327eea8f80 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1977,7 +1977,7 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, index_type count[GFC_MAX_DIMENSIONS]; index_type extent[GFC_MAX_DIMENSIONS]; index_type stride[GFC_MAX_DIMENSIONS]; - index_type stride0, rank, size, type, n; + index_type stride0, rank, size, n; size_t tsize; char *data; bt iotype; @@ -1985,39 +1985,8 @@ transfer_array (st_parameter_dt *dtp, gfc_array_char *desc, int kind, if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; - type = GFC_DESCRIPTOR_TYPE (desc); - size = GFC_DESCRIPTOR_SIZE (desc); - - /* FIXME: What a kludge: Array descriptors and the IO library use - different enums for types. */ - switch (type) - { - case GFC_DTYPE_UNKNOWN: - iotype = BT_NULL; /* Is this correct? */ - break; - case GFC_DTYPE_INTEGER: - iotype = BT_INTEGER; - break; - case GFC_DTYPE_LOGICAL: - iotype = BT_LOGICAL; - break; - case GFC_DTYPE_REAL: - iotype = BT_REAL; - break; - case GFC_DTYPE_COMPLEX: - iotype = BT_COMPLEX; - break; - case GFC_DTYPE_CHARACTER: - iotype = BT_CHARACTER; - size = charlen; - break; - case GFC_DTYPE_DERIVED: - internal_error (&dtp->common, - "Derived type I/O should have been handled via the frontend."); - break; - default: - internal_error (&dtp->common, "transfer_array(): Bad type"); - } + iotype = (bt) GFC_DESCRIPTOR_TYPE (desc); + size = iotype == BT_CHARACTER ? charlen : GFC_DESCRIPTOR_SIZE (desc); rank = GFC_DESCRIPTOR_RANK (desc); for (n = 0; n < rank; n++) diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index fabbaffc9e9..0a6aee1588e 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1705,7 +1705,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, /* Write namelist variable names in upper case. If a derived type, nothing is output. If a component, base and base_name are set. */ - if (obj->type != GFC_DTYPE_DERIVED) + if (obj->type != BT_DERIVED) { namelist_write_newline (dtp); write_character (dtp, " ", 1, 1); @@ -1739,15 +1739,15 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, switch (obj->type) { - case GFC_DTYPE_REAL: + case BT_REAL: obj_size = size_from_real_kind (len); break; - case GFC_DTYPE_COMPLEX: + case BT_COMPLEX: obj_size = size_from_complex_kind (len); break; - case GFC_DTYPE_CHARACTER: + case BT_CHARACTER: obj_size = obj->string_length; break; @@ -1783,7 +1783,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, /* Check for repeat counts of intrinsic types. */ if ((elem_ctr < (nelem - 1)) && - (obj->type != GFC_DTYPE_DERIVED) && + (obj->type != BT_DERIVED) && !memcmp (p, (void*)(p + obj_size ), obj_size )) { rep_ctr++; @@ -1808,15 +1808,15 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, switch (obj->type) { - case GFC_DTYPE_INTEGER: + case BT_INTEGER: write_integer (dtp, p, len); break; - case GFC_DTYPE_LOGICAL: + case BT_LOGICAL: write_logical (dtp, p, len); break; - case GFC_DTYPE_CHARACTER: + case BT_CHARACTER: tmp_delim = dtp->u.p.current_unit->delim_status; if (dtp->u.p.nml_delim == '"') dtp->u.p.current_unit->delim_status = DELIM_QUOTE; @@ -1826,17 +1826,17 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, dtp->u.p.current_unit->delim_status = tmp_delim; break; - case GFC_DTYPE_REAL: + case BT_REAL: write_real (dtp, p, len); break; - case GFC_DTYPE_COMPLEX: + case BT_COMPLEX: dtp->u.p.no_leading_blank = 0; num++; write_complex (dtp, p, len, obj_size); break; - case GFC_DTYPE_DERIVED: + case BT_DERIVED: /* To treat a derived type, we need to build two strings: ext_name = the name, including qualifiers that prepends diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 8c08c7b3e9f..cadd4367e4c 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -418,68 +418,68 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16; #define GFC_DTYPE_TYPE_SIZE(desc) ((desc)->dtype & GFC_DTYPE_TYPE_SIZE_MASK) -#define GFC_DTYPE_INTEGER_1 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_INTEGER_1 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT)) -#define GFC_DTYPE_INTEGER_2 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_INTEGER_2 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT)) -#define GFC_DTYPE_INTEGER_4 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_INTEGER_4 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT)) -#define GFC_DTYPE_INTEGER_8 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_INTEGER_8 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT)) #ifdef HAVE_GFC_INTEGER_16 -#define GFC_DTYPE_INTEGER_16 ((GFC_DTYPE_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_INTEGER_16 ((BT_INTEGER << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT)) #endif -#define GFC_DTYPE_LOGICAL_1 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_LOGICAL_1 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_LOGICAL_1) << GFC_DTYPE_SIZE_SHIFT)) -#define GFC_DTYPE_LOGICAL_2 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_LOGICAL_2 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_LOGICAL_2) << GFC_DTYPE_SIZE_SHIFT)) -#define GFC_DTYPE_LOGICAL_4 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_LOGICAL_4 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_LOGICAL_4) << GFC_DTYPE_SIZE_SHIFT)) -#define GFC_DTYPE_LOGICAL_8 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_LOGICAL_8 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_LOGICAL_8) << GFC_DTYPE_SIZE_SHIFT)) #ifdef HAVE_GFC_LOGICAL_16 -#define GFC_DTYPE_LOGICAL_16 ((GFC_DTYPE_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_LOGICAL_16 ((BT_LOGICAL << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_LOGICAL_16) << GFC_DTYPE_SIZE_SHIFT)) #endif -#define GFC_DTYPE_REAL_4 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_REAL_4 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_REAL_4) << GFC_DTYPE_SIZE_SHIFT)) -#define GFC_DTYPE_REAL_8 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_REAL_8 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_REAL_8) << GFC_DTYPE_SIZE_SHIFT)) #ifdef HAVE_GFC_REAL_10 -#define GFC_DTYPE_REAL_10 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_REAL_10 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_REAL_10) << GFC_DTYPE_SIZE_SHIFT)) #endif #ifdef HAVE_GFC_REAL_16 -#define GFC_DTYPE_REAL_16 ((GFC_DTYPE_REAL << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_REAL_16 ((BT_REAL << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_REAL_16) << GFC_DTYPE_SIZE_SHIFT)) #endif -#define GFC_DTYPE_COMPLEX_4 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_COMPLEX_4 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_COMPLEX_4) << GFC_DTYPE_SIZE_SHIFT)) -#define GFC_DTYPE_COMPLEX_8 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_COMPLEX_8 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_COMPLEX_8) << GFC_DTYPE_SIZE_SHIFT)) #ifdef HAVE_GFC_COMPLEX_10 -#define GFC_DTYPE_COMPLEX_10 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_COMPLEX_10 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_COMPLEX_10) << GFC_DTYPE_SIZE_SHIFT)) #endif #ifdef HAVE_GFC_COMPLEX_16 -#define GFC_DTYPE_COMPLEX_16 ((GFC_DTYPE_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_COMPLEX_16 ((BT_COMPLEX << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_COMPLEX_16) << GFC_DTYPE_SIZE_SHIFT)) #endif -#define GFC_DTYPE_DERIVED_1 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_DERIVED_1 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_INTEGER_1) << GFC_DTYPE_SIZE_SHIFT)) -#define GFC_DTYPE_DERIVED_2 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_DERIVED_2 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_INTEGER_2) << GFC_DTYPE_SIZE_SHIFT)) -#define GFC_DTYPE_DERIVED_4 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_DERIVED_4 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_INTEGER_4) << GFC_DTYPE_SIZE_SHIFT)) -#define GFC_DTYPE_DERIVED_8 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_DERIVED_8 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_INTEGER_8) << GFC_DTYPE_SIZE_SHIFT)) #ifdef HAVE_GFC_INTEGER_16 -#define GFC_DTYPE_DERIVED_16 ((GFC_DTYPE_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ +#define GFC_DTYPE_DERIVED_16 ((BT_DERIVED << GFC_DTYPE_TYPE_SHIFT) \ | (sizeof(GFC_INTEGER_16) << GFC_DTYPE_SIZE_SHIFT)) #endif -- 2.11.0